1;;; vhdl-mode.el --- major mode for editing VHDL code  -*- lexical-binding: t; -*-
2
3;; Copyright (C) 1992-2021 Free Software Foundation, Inc.
4
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:         https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
10
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.
15;;
16;; Reto also said in Apr 2021 that he preferred to keep the XEmacs
17;; compatibility code.
18
19(defconst vhdl-version "3.38.1"
20  "VHDL Mode version number.")
21
22(defconst vhdl-time-stamp "2015-03-12"
23  "VHDL Mode time stamp for last update.")
24
25;; This file is part of GNU Emacs.
26
27;; GNU Emacs is free software: you can redistribute it and/or modify
28;; it under the terms of the GNU General Public License as published by
29;; the Free Software Foundation, either version 3 of the License, or
30;; (at your option) any later version.
31
32;; GNU Emacs is distributed in the hope that it will be useful,
33;; but WITHOUT ANY WARRANTY; without even the implied warranty of
34;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
35;; GNU General Public License for more details.
36
37;; You should have received a copy of the GNU General Public License
38;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
39
40;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41;;; Commentary:
42;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
43
44;; This package provides an Emacs major mode for editing VHDL code.
45;; It includes the following features:
46
47;;   - Syntax highlighting
48;;   - Indentation
49;;   - Template insertion (electrification)
50;;   - Insertion of file headers
51;;   - Insertion of user-specified models
52;;   - Port translation / testbench generation
53;;   - Structural composition
54;;   - Configuration generation
55;;   - Sensitivity list updating
56;;   - File browser
57;;   - Design hierarchy browser
58;;   - Source file compilation (syntax analysis)
59;;   - Makefile generation
60;;   - Code hiding
61;;   - Word/keyword completion
62;;   - Block commenting
63;;   - Code fixing/alignment/beautification
64;;   - PostScript printing
65;;   - VHDL'87/'93/'02/'08 and VHDL-AMS supported
66;;   - Comprehensive menu
67;;   - Fully customizable
68;;   - Works under GNU Emacs (recommended) and XEmacs
69
70;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
71;; Documentation
72
73;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
74
75;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
76;; Emacs Versions
77
78;; this updated version was only tested on: GNU Emacs 24.1
79
80;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81;; Installation
82
83;; Prerequisites:  GNU Emacs >= 21, XEmacs 20/21.
84
85;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
86;; or into an arbitrary directory that is added to the load path by the
87;; following line in your Emacs start-up file `.emacs':
88
89;;   (push (expand-file-name "<directory-name>") load-path)
90
91;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
92;; directory.  Otherwise, byte-compile the source file:
93;;   Emacs:  M-x byte-compile-file RET vhdl-mode.el RET
94;;   Unix:   emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
95
96;; Add the following lines to the `site-start.el' file in the `site-lisp'
97;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
98;; (not required in Emacs):
99
100;;   (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
101;;   (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
102
103;; More detailed installation instructions are included in the official
104;; VHDL Mode distribution.
105
106;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
107;; Acknowledgments
108
109;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
110;; and Steve Grout.
111
112;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
113;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
114
115;; Many thanks to all the users who sent me bug reports and enhancement
116;; requests.
117;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
118;; enhancement suggestions and the fruitful discussions.
119;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
120;; Thanks to Ulf Klaperski for the indentation speedup hint.
121
122;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated
123;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for
124;; giving me the opportunity to develop this code.
125;; This work has been funded in part by MICROSWISS, a Microelectronics Program
126;; of the Swiss Government.
127
128;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129
130;;; Code:
131
132(eval-when-compile
133  (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))
134  (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew)))
135
136;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin'
137;; even for relatively simple cases such as used here.  We only test <25
138;; because it's easier and sufficient.
139(when (< emacs-major-version 25)
140  (condition-case nil (require 'cl-lib) (file-missing (require 'cl))))
141
142;; Emacs 22+ handling
143(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
144  "Non-nil if GNU Emacs >= 22, ... is used.")
145
146(defvar compilation-file-regexp-alist)
147(defvar conf-alist)
148(defvar conf-entry)
149(defvar conf-key)
150(defvar ent-alist)
151(defvar itimer-version)
152(defvar lazy-lock-defer-contextually)
153(defvar lazy-lock-defer-on-scrolling)
154(defvar lazy-lock-defer-on-the-fly)
155(defvar speedbar-attached-frame)
156
157
158;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
159;;; Variables
160;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
161
162;; help function for user options
163(defun vhdl-custom-set (variable value &rest functions)
164  "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
165  (if (fboundp 'custom-set-default)
166      (custom-set-default variable value)
167    (set-default variable value))
168  (while functions
169    (when (fboundp (car functions)) (funcall (car functions)))
170    (setq functions (cdr functions))))
171
172(defun vhdl-widget-directory-validate (widget)
173  "Check that the value of WIDGET is a valid directory entry (i.e. ends with
174'/' or is empty)."
175  (let ((val (widget-value widget)))
176    (unless (string-match "^\\(\\|.*/\\)$" val)
177      (widget-put widget :error "Invalid directory entry: must end with `/'")
178      widget)))
179
180;; help string for user options
181(defconst vhdl-name-doc-string "
182
183FROM REGEXP is a regular expression matching the original name:
184  \".*\"       matches the entire string
185  \"\\(...\\)\"  matches a substring
186TO STRING specifies the string to be inserted as new name:
187  \"\\&\"  means substitute entire matched text
188  \"\\N\"  means substitute what matched the Nth \"\\(...\\)\"
189Examples:
190  \".*\"           \"\\&\"    inserts original string
191  \".*\"           \"\\&_i\"  attaches \"_i\" to original string
192  \"\\(.*\\)_[io]$\" \"\\1\"    strips off \"_i\" or \"_o\" from original string
193  \".*\"           \"foo\"   inserts constant string \"foo\"
194  \".*\"           \"\"      inserts empty string")
195
196;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
197;; User variables (customization options)
198
199(defgroup vhdl nil
200  "Customizations for VHDL Mode."
201  :prefix "vhdl-"
202  :group 'languages
203;  :version "21.2"  ; comment out for XEmacs
204  )
205
206(defgroup vhdl-mode nil
207  "Customizations for modes."
208  :group 'vhdl)
209
210(defcustom vhdl-indent-tabs-mode nil
211  "Non-nil means indentation can insert tabs.
212Overrides local variable `indent-tabs-mode'."
213  :type 'boolean
214  :group 'vhdl-mode)
215
216
217(defgroup vhdl-compile nil
218  "Customizations for compilation."
219  :group 'vhdl)
220
221(defcustom vhdl-compiler-alist
222  '(
223    ;;     60:       docal  <= false;
224    ;;               ^^^^^
225    ;; [Error] Assignment error: variable is illegal target of signal assignment
226    ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
227     nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
228     ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1)
229     ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
230      "PACK/\\1.vif" "BODY/\\1.vif" upcase))
231    ;; Aldec
232    ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3
233    ("Aldec" "vcom" "-work \\1" "make" "-f \\1"
234     nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
235     ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
236     nil)
237    ;; Cadence Leapfrog: cv -file test.vhd
238    ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
239    ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
240     nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
241     ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
242     ("\\1/entity" "\\2/\\1" "\\1/configuration"
243      "\\1/package" "\\1/body" downcase))
244    ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
245    ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
246    ;; (PLL_400X_TOP) is not declared [10.3].
247    ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
248     nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
249     ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
250     ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
251      "\\1/package/pc.db" "\\1/body/pc.db" downcase))
252    ;; ghdl vhdl
253    ;; ghdl -a bad_counter.vhdl
254    ;; bad_counter.vhdl:13:14: operator "=" is overloaded
255    ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
256     nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
257     ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
258     ("\\1/entity" "\\2/\\1" "\\1/configuration"
259      "\\1/package" "\\1/body" downcase))
260    ;; IBM Compiler
261    ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6
262    ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1"
263     nil "mkdir \\1" "./" "work/" "Makefile" "ibm"
264     ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
265     nil)
266    ;; Ikos Voyager: analyze test.vhd
267    ;; analyze test.vhd
268    ;; E L4/C5:        this library unit is inaccessible
269    ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
270     nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
271     ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
272     ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
273     nil)
274    ;; ModelSim, Model Technology: vcom test.vhd
275    ;; ERROR: test.vhd(14): Unknown identifier: positiv
276    ;; WARNING[2]: test.vhd(85): Possible infinite loop
277    ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
278    ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
279    ;; ** Error: counter_rtl.vhd(18): Nonresolved signal 'hallo' has multiple sources.
280    ;;  Drivers:
281    ;;    counter_rtl.vhd(27):Conditional signal assignment line__27
282    ;;    counter_rtl.vhd(29):Conditional signal assignment line__29
283    ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
284     nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
285     ("\\(ERROR:\\|WARNING\\[[0-9]+\\]:\\|\\*\\* Error:\\|\\*\\* Warning: \\[[0-9]+\\]\\| +\\) \\([^ ]+\\)(\\([0-9]+\\)):" 2 3 nil)
286     ("" 0)
287     ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
288      "\\1/_primary.dat" "\\1/body.dat" downcase))
289    ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
290    ;; test.vhd:34: error message
291    ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
292     nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
293     ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
294     ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
295      "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
296    ;; Quartus compiler
297    ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used
298    ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text
299    ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal
300    ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library
301    ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ...
302    ("Quartus" "make" "-work \\1" "make" "-f \\1"
303     nil "mkdir \\1" "./" "work/" "Makefile" "quartus"
304     ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
305     nil)
306    ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
307    ;; ERROR: test.vhd(24): near "dnd": expecting: END
308    ;; WARNING[4]: test.vhd(30): A space is required between ...
309    ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
310     nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
311     ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
312     ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
313      "\\1/_primary.dat" "\\1/body.dat" downcase))
314    ;; Savant: scram -publish-cc test.vhd
315    ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
316    ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
317     nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
318     ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
319     ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
320      "\\1_config.vhdl" "\\1_package.vhdl"
321      "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
322    ;; Simili: vhdlp -work test.vhd
323    ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
324    ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
325     nil "mkdir \\1" "./" "work/" "Makefile" "simili"
326     ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
327     ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
328      "\\1/prim.var" "\\1/_body.var" downcase))
329    ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
330    ;;     ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
331    ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
332     nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
333     ("^ *ERROR\\[[0-9]+]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
334     nil)
335    ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
336    ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
337    ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
338     nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
339     ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
340     ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
341    ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
342    ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
343    ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
344     nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
345     ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
346     ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
347    ;; Synplify:
348    ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
349    ("Synplify" "n/a" "n/a" "make" "-f \\1"
350     nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
351     ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
352     nil)
353    ;; Vantage: 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    ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
357     nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
358     ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
359     ("^ *Compiling \"\\(.+\\)\" " 1)
360     nil)
361    ;; VeriBest: vc vhdl test.vhd
362    ;; (no file name printed out!)
363    ;;     32:   Z <=  A and BitA ;
364    ;;                       ^^^^
365    ;; [Error] Name BITA is unknown
366    ("VeriBest" "vc" "vhdl" "make" "-f \\1"
367     nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
368     ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0)
369     nil)
370    ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
371    ;;     Compiling "test.vhd" line 1...
372    ;; **Error: LINE 49 *** No aggregate value is valid in this context.
373    ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
374     nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
375     ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
376     ("^ *Compiling \"\\(.+\\)\" " 1)
377     nil)
378    ;; Xilinx XST:
379    ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
380    ("Xilinx XST" "xflow" "" "make" "-f \\1"
381     nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
382     ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil) ("" 0)
383     nil)
384    )
385  "List of available VHDL compilers and their properties.
386Each list entry specifies the following items for a compiler:
387Compiler:
388  Compiler name    : name used in option `vhdl-compiler' to choose compiler
389  Compile command  : command used for source file compilation
390  Compile options  : compile options (\"\\1\" inserts library name)
391  Make command     : command used for compilation using a Makefile
392  Make options     : make options (\"\\1\" inserts Makefile name)
393  Generate Makefile: use built-in function or command to generate a Makefile
394                     (\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
395  Library command  : command to create library directory (\"\\1\" inserts
396                     library directory, \"\\2\" inserts library name)
397  Compile directory: where compilation is run and the Makefile is placed
398  Library directory: directory of default library
399  Makefile name    : name of Makefile (default is \"Makefile\")
400  ID string        : compiler identification string (see `vhdl-project-alist')
401Error message:
402  Regexp           : regular expression to match error messages (*)
403  File subexp index: index of subexpression that matches the file name
404  Line subexp index: index of subexpression that matches the line number
405  Column subexp idx: index of subexpression that matches the column number
406File message:
407  Regexp           : regular expression to match a file name message
408  File subexp index: index of subexpression that matches the file name
409Unit-to-file name mapping: mapping of library unit names to names of files
410                     generated by the compiler (used for Makefile generation)
411  To string        : string a name is mapped to (\"\\1\" inserts the unit name,
412                     \"\\2\" inserts the entity name for architectures,
413                     \"\\3\" inserts the library name)
414  Case adjustment  : adjust case of inserted unit names
415
416\(*) The regular expression must match the error message starting from the
417    beginning of the line (but not necessarily to the end of the line).
418
419Compile options allows insertion of the library name (see `vhdl-project-alist')
420in order to set the compilers library option (e.g. \"vcom -work my_lib\").
421
422For Makefile generation, the built-in function can be used (requires
423specification of the unit-to-file name mapping).  Alternatively, an
424external command can be specified.  Work directory allows specification of
425an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
426used for Makefile generation).  To use another library name than \"work\",
427customize `vhdl-project-alist'.  The library command is inserted in Makefiles
428to automatically create the library directory if not existent.
429
430Compile options, compile directory, library directory, and Makefile name are
431overwritten by the project settings if a project is defined (see
432`vhdl-project-alist').  Directory paths are relative to the source file
433directory.
434
435Some compilers do not include the file name in the error message, but print
436out a file name message in advance.  In this case, set \"File Subexp Index\"
437under \"Error Message\" to 0 and fill out the \"File Message\" entries.
438If no file name at all is printed out, set both \"File Message\" entries to 0
439\(a default file name message will be printed out instead, does not work in
440XEmacs).
441
442A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
443assigning its name to option `vhdl-compiler'.
444
445Please send any missing or erroneous compiler properties to the maintainer for
446updating.
447
448NOTE: Activate new error and file message regexps and reflect the new setting
449      in the choice list of option `vhdl-compiler' by restarting Emacs."
450  :type '(repeat
451	  (list :tag "Compiler" :indent 2
452		(string :tag "Compiler name      ")
453		(string :tag "Compile command    ")
454		(string :tag "Compile options    " "-work \\1")
455		(string :tag "Make command       " "make")
456		(string :tag "Make options       " "-f \\1")
457		(choice :tag "Generate Makefile  "
458			(const :tag "Built-in function" nil)
459			(string :tag "Command" "vmake \\2 > \\1"))
460		(string :tag "Library command    " "mkdir \\1")
461		(directory :tag "Compile directory  "
462			   :validate vhdl-widget-directory-validate "./")
463		(directory :tag "Library directory  "
464			   :validate vhdl-widget-directory-validate "work/")
465		(file :tag "Makefile name      " "Makefile")
466		(string :tag "ID string          ")
467		(list :tag "Error message" :indent 4
468		      (regexp  :tag "Regexp           ")
469		      (choice  :tag "File subexp      "
470			      (integer :tag "Index")
471			      (const :tag "No file name" nil))
472		      (integer :tag "Line subexp index")
473		      (choice  :tag "Column subexp    "
474			      (integer :tag "Index")
475			      (const :tag "No column number" nil)))
476		(list :tag "File message" :indent 4
477		      (regexp  :tag "Regexp           ")
478		      (integer :tag "File subexp index"))
479		(choice :tag "Unit-to-file name mapping"
480			:format "%t: %[Value Menu%] %v\n"
481			(const :tag "Not defined" nil)
482			(list :tag "To string" :indent 4
483			      (string :tag "Entity           " "\\1.vhd")
484			      (string :tag "Architecture     " "\\2_\\1.vhd")
485			      (string :tag "Configuration    " "\\1.vhd")
486			      (string :tag "Package          " "\\1.vhd")
487			      (string :tag "Package Body     " "\\1_body.vhd")
488			      (choice :tag "Case adjustment  "
489				      (const :tag "None" identity)
490				      (const :tag "Upcase" upcase)
491				      (const :tag "Downcase" downcase))))))
492  :set (lambda (variable value)
493	 (vhdl-custom-set variable value #'vhdl-update-mode-menu))
494  :version "24.4"
495  :group 'vhdl-compile)
496
497(defcustom vhdl-compiler "GHDL"
498  "Specifies the VHDL compiler to be used for syntax analysis.
499Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
500  :type (let ((alist vhdl-compiler-alist) list)
501	  (while alist
502	    (push (list 'const (caar alist)) list)
503	    (setq alist (cdr alist)))
504	  (append '(choice) (nreverse list)))
505  :group 'vhdl-compile)
506
507(defcustom vhdl-compile-use-local-error-regexp nil
508  "Non-nil means use buffer-local `compilation-error-regexp-alist'.
509In this case, only error message regexps for VHDL compilers are active if
510compilation is started from a VHDL buffer.  Otherwise, the error message
511regexps are appended to the predefined global regexps, and all regexps are
512active all the time.  Note that by doing that, the predefined global regexps
513might result in erroneous parsing of error messages for some VHDL compilers.
514
515NOTE: Activate the new setting by restarting Emacs."
516  :version "25.1"			; t -> nil
517  :type 'boolean
518  :group 'vhdl-compile)
519
520(defcustom vhdl-makefile-default-targets '("all" "clean" "library")
521  "List of default target names in Makefiles.
522Automatically generated Makefiles include three default targets to compile
523the entire design, clean the entire design and to create the design library.
524This option allows you to change the names of these targets to avoid conflicts
525with other user Makefiles."
526  :type '(list (string :tag "Compile entire design")
527	       (string :tag "Clean entire design  ")
528	       (string :tag "Create design library"))
529  :version "24.3"
530  :group 'vhdl-compile)
531
532(defcustom vhdl-makefile-generation-hook nil
533  "Functions to run at the end of Makefile generation.
534Allows you to insert user specific parts into a Makefile.
535
536Example:
537  (lambda nil
538    (re-search-backward \"^# Rule for compiling entire design\")
539    (insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
540  :type 'hook
541  :group 'vhdl-compile)
542
543(defcustom vhdl-default-library "work"
544  "Name of default library.
545Is overwritten by project settings if a project is active."
546  :type 'string
547  :group 'vhdl-compile)
548
549
550(defgroup vhdl-project nil
551  "Customizations for projects."
552  :group 'vhdl)
553
554(defcustom vhdl-project-alist
555  '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
556     "~/example1/" ("src/system/" "src/components/") ""
557     (("ModelSim" "-87 \\2" "-f \\1 top_level" nil)
558      ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
559     "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
560    ("Example 2" "Individual source files, multiple compilers in different directories"
561     "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
562     nil "\\1/" "work" "\\1/work/" "Makefile" "")
563    ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
564     "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
565     nil "./" "work" "work-\\1/" "Makefile-\\1" "\
566-------------------------------------------------------------------------------
567-- This is a multi-line project description
568-- that can be used as a project dependent part of the file header.
569"))
570  "List of projects and their properties.
571  Name             : name used in option `vhdl-project' to choose project
572  Title            : title of project (single-line string)
573  Default directory: default project directory (absolute path)
574  Sources          : a) source files  : path + \"/\" + file name
575                     b) directory     : path + \"/\"
576                     c) directory tree: \"-r \" + path + \"/\"
577  Exclude regexp   : matches file/directory names to be excluded as sources
578  Compile options  : project-specific options for each compiler
579    Compiler name  : name of compiler for which these options are valid
580    Compile options: project-specific compiler options
581                     (\"\\1\" inserts library name, \"\\2\" default options)
582    Make options:    project-specific make options
583                     (\"\\1\" inserts Makefile name, \"\\2\" default options)
584    Exceptions     : file-specific exceptions
585      File name regexp: matches file names for which exceptions are valid
586      - Options       : file-specific compiler options string
587                        (\"\\1\" inserts library name, \"\\2\" default options,
588                        \"\\3\" project-specific options)
589      - Do not compile: do not compile this file (in Makefile)
590  Compile directory: where compilation is run and the Makefile is placed
591                     (\"\\1\" inserts compiler ID string)
592  Library name     : name of library (default is \"work\")
593  Library directory: path to library (\"\\1\" inserts compiler ID string)
594  Makefile name    : name of Makefile
595                     (\"\\1\" inserts compiler ID string, \"\\2\" library name)
596  Description      : description of project (multi-line string)
597
598Project title and description are used to insert into the file header (see
599option `vhdl-file-header').
600
601The default directory must have an absolute path (use `M-TAB' for completion).
602All other paths can be absolute or relative to the default directory.  All
603paths must end with `/'.
604
605The design units found in the sources (files and directories) are shown in the
606hierarchy browser.  Path and file name can contain wildcards `*' and `?' as
607well as \"./\" and \"../\" (\"sh\" syntax).  Paths can also be absolute.
608Environment variables (e.g. \"$EXAMPLE2\") are resolved.  If no sources are
609specified, the default directory is taken as source directory.  Otherwise,
610the default directory is only taken as source directory if there is a sources
611entry with the empty string or \"./\".  Exclude regexp allows you to filter
612out specific file and directory names from the list of sources (e.g. CVS
613directories).
614
615Files are compiled in the compile directory.  Makefiles are also placed into
616the compile directory.  Library directory specifies which directory the
617compiler compiles into (used to generate the Makefile).
618
619Since different compile/library directories and Makefiles may exist for
620different compilers within one project, these paths and names allow the
621insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
622Compile options, compile directory, library directory, and Makefile name
623overwrite the settings of the current compiler.
624
625File-specific compiler options (highest priority) overwrite project-specific
626options which overwrite default options (lowest priority).  Lower priority
627options can be inserted in higher priority options.  This allows you to reuse
628default options (e.g. \"-file\") in project- or file-specific options (e.g.
629\"-93 -file\").
630
631NOTE: Reflect the new setting in the choice list of option `vhdl-project'
632      by restarting Emacs."
633  :type `(repeat
634	  (list :tag "Project" :indent 2
635		(string :tag "Name             ")
636		(string :tag "Title            ")
637		(directory :tag "Default directory"
638			   :validate vhdl-widget-directory-validate
639			   ,(abbreviate-file-name default-directory))
640		(repeat :tag "Sources          " :indent 4
641			(directory :format "     %v" "./"))
642		(regexp :tag "Exclude regexp   ")
643		(repeat
644		 :tag "Compile options  " :indent 4
645		 (list :tag "Compiler" :indent 6
646		       ,(let ((alist vhdl-compiler-alist) list)
647			  (while alist
648			    (push (list 'const (caar alist)) list)
649			    (setq alist (cdr alist)))
650			  (append '(choice :tag "Compiler name")
651				  (nreverse list)))
652		       (string :tag "Compile options" "\\2")
653		       (string :tag "Make options   " "\\2")
654		       (repeat
655			:tag "Exceptions   " :indent 8
656			(cons :format "%v"
657			      (regexp :tag "File name regexp    ")
658			      (choice :format "%[Value Menu%] %v"
659				      (string :tag "Options" "\\3")
660				      (const :tag "Do not compile" nil))))))
661		(directory :tag "Compile directory"
662			   :validate vhdl-widget-directory-validate "./")
663		(string :tag "Library name     " "work")
664		(directory :tag "Library directory"
665			   :validate vhdl-widget-directory-validate "work/")
666		(file :tag "Makefile name    " "Makefile")
667		(string :tag "Description: (type `C-j' for newline)"
668			:format "%t\n%v\n")))
669  :set (lambda (variable value)
670	 (vhdl-custom-set variable value
671			  #'vhdl-update-mode-menu
672			  #'vhdl-speedbar-refresh))
673  :group 'vhdl-project)
674
675(defcustom vhdl-project nil
676  "Specifies the default for the current project.
677Select a project name from the ones defined in option `vhdl-project-alist'.
678Is used to determine the project title and description to be inserted in file
679headers and the source files/directories to be scanned in the hierarchy
680browser.  The current project can also be changed temporarily in the menu."
681  :type (let ((alist vhdl-project-alist) list)
682	  (while alist
683	    (push (list 'const (caar alist)) list)
684	    (setq alist (cdr alist)))
685	  (append '(choice (const :tag "None" nil) (const :tag "--"))
686		  (nreverse list)))
687  :group 'vhdl-project)
688
689(defcustom vhdl-project-file-name '("\\1.prj")
690  "List of file names/paths for importing/exporting project setups.
691\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
692replaced by the user name (allows you to have user-specific project setups).
693The first entry is used as file name to import/export individual project
694setups.  All entries are used to automatically import project setups at
695startup (see option `vhdl-project-autoload').  Projects loaded from the
696first entry are automatically made current.  Hint: specify local project
697setups in first entry, global setups in following entries; loading a local
698project setup will make it current, while loading the global setups
699is done without changing the current project.
700Names can also have an absolute path (i.e. project setups can be stored
701in global directories)."
702  :type '(repeat (string :tag "File name" "\\1.prj"))
703  :group 'vhdl-project)
704
705
706(define-obsolete-variable-alias 'vhdl-project-auto-load
707  'vhdl-project-autoload "27.1")
708
709(defcustom vhdl-project-autoload '(startup)
710  "Automatically load project setups from files.
711All project setup files that match the file names specified in option
712`vhdl-project-file-name' are automatically loaded.  The project of the
713\(alphabetically) last loaded setup of the first `vhdl-project-file-name'
714entry is activated.
715A project setup file can be obtained by exporting a project (see menu).
716  At startup: project setup file is loaded at Emacs startup."
717  :type '(set (const :tag "At startup" startup))
718  :group 'vhdl-project)
719
720(defcustom vhdl-project-sort t
721  "Non-nil means projects are displayed in alphabetical order."
722  :type 'boolean
723  :group 'vhdl-project)
724
725
726(defgroup vhdl-style nil
727  "Customizations for coding styles."
728  :group 'vhdl
729  :group 'vhdl-template
730  :group 'vhdl-port
731  :group 'vhdl-compose)
732
733(defcustom vhdl-standard '(93 nil)
734  "VHDL standards used.
735Basic standard:
736  VHDL'87      : IEEE Std 1076-1987
737  VHDL'93/02   : IEEE Std 1076-1993/2002
738  VHDL'08      : IEEE Std 1076-2008
739Additional standards:
740  VHDL-AMS     : IEEE Std 1076.1 (analog-mixed-signal)
741  Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
742
743NOTE: Activate the new setting in a VHDL buffer by using the menu entry
744      \"Activate Options\"."
745  :type '(list (choice :tag "Basic standard"
746		       (const :tag "VHDL'87" 87)
747		       (const :tag "VHDL'93/02" 93)
748		       (const :tag "VHDL'08" 08))
749	       (set :tag "Additional standards" :indent 2
750		    (const :tag "VHDL-AMS" ams)
751		    (const :tag "Math packages" math)))
752  :set (lambda (variable value)
753	 (vhdl-custom-set variable value
754			  #'vhdl-template-map-init
755			  #'vhdl-mode-abbrev-table-init
756			  #'vhdl-template-construct-alist-init
757			  #'vhdl-template-package-alist-init
758			  #'vhdl-update-mode-menu
759			  #'vhdl-words-init 'vhdl-font-lock-init))
760  :group 'vhdl-style)
761
762(defcustom vhdl-basic-offset 2
763  "Amount of basic offset used for indentation.
764This value is used by + and - symbols in `vhdl-offsets-alist'."
765  :type 'integer
766  :group 'vhdl-style)
767
768(defcustom vhdl-upper-case-keywords nil
769  "Non-nil means convert keywords to upper case.
770This is done when typed or expanded or by the fix case functions."
771  :type 'boolean
772  :set (lambda (variable value)
773	 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
774  :group 'vhdl-style)
775
776(defcustom vhdl-upper-case-types nil
777  "Non-nil means convert standardized types to upper case.
778This is done when expanded or by the fix case functions."
779  :type 'boolean
780  :set (lambda (variable value)
781	 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
782  :group 'vhdl-style)
783
784(defcustom vhdl-upper-case-attributes nil
785  "Non-nil means convert standardized attributes to upper case.
786This is done when expanded or by the fix case functions."
787  :type 'boolean
788  :set (lambda (variable value)
789	 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
790  :group 'vhdl-style)
791
792(defcustom vhdl-upper-case-enum-values nil
793  "Non-nil means convert standardized enumeration values to upper case.
794This is done when expanded or by the fix case functions."
795  :type 'boolean
796  :set (lambda (variable value)
797	 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
798  :group 'vhdl-style)
799
800(defcustom vhdl-upper-case-constants t
801  "Non-nil means convert standardized constants to upper case.
802This is done when expanded."
803  :type 'boolean
804  :set (lambda (variable value)
805	 (vhdl-custom-set variable value #'vhdl-abbrev-list-init))
806  :group 'vhdl-style)
807
808(defcustom vhdl-use-direct-instantiation 'standard
809  "Non-nil means use VHDL'93 direct component instantiation.
810  Never   : never
811  Standard: only in VHDL standards that allow it (VHDL'93 and higher)
812  Always  : always"
813  :type '(choice (const :tag "Never" never)
814		 (const :tag "Standard" standard)
815		 (const :tag "Always" always))
816  :group 'vhdl-style)
817
818(defcustom vhdl-array-index-record-field-in-sensitivity-list t
819  "Non-nil means include array indices / record fields in sensitivity list.
820If a signal read in a process is a record field or pointed to by an array
821index, the record field or array index is included with the record name in
822the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
823Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
824  :type 'boolean
825  :version "24.3"
826  :group 'vhdl-style)
827
828(defgroup vhdl-naming nil
829  "Customizations for naming conventions."
830  :group 'vhdl)
831
832(defcustom vhdl-entity-file-name '(".*" . "\\&")
833  (concat
834   "Specifies how the entity file name is obtained.
835The entity file name can be obtained by modifying the entity name (e.g.
836attaching or stripping off a substring).  The file extension is automatically
837taken from the file name of the current buffer."
838   vhdl-name-doc-string)
839  :type '(cons (regexp :tag "From regexp")
840	       (string :tag "To string  "))
841  :group 'vhdl-naming
842  :group 'vhdl-compose)
843
844(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
845  (concat
846   "Specifies how the architecture file name is obtained.
847The architecture file name can be obtained by modifying the entity
848and/or architecture name (e.g. attaching or stripping off a substring).  The
849file extension is automatically taken from the file name of the current
850buffer.  The string that is matched against the regexp is the concatenation
851of the entity and the architecture name separated by a space.  This gives
852access to both names (see default setting as example)."
853   vhdl-name-doc-string)
854  :type '(cons (regexp :tag "From regexp")
855	       (string :tag "To string  "))
856  :group 'vhdl-naming
857  :group 'vhdl-compose)
858
859(defcustom vhdl-configuration-file-name '(".*" . "\\&")
860  (concat
861   "Specifies how the configuration file name is obtained.
862The configuration file name can be obtained by modifying the configuration
863name (e.g. attaching or stripping off a substring).  The file extension is
864automatically taken from the file name of the current buffer."
865   vhdl-name-doc-string)
866  :type '(cons (regexp :tag "From regexp")
867	       (string :tag "To string  "))
868  :group 'vhdl-naming
869  :group 'vhdl-compose)
870
871(defcustom vhdl-package-file-name '(".*" . "\\&")
872  (concat
873   "Specifies how the package file name is obtained.
874The package file name can be obtained by modifying the package name (e.g.
875attaching or stripping off a substring).  The file extension is automatically
876taken from the file name of the current buffer.  Package files can be created
877in a different directory by prepending a relative or absolute path to the
878file name."
879   vhdl-name-doc-string)
880  :type '(cons (regexp :tag "From regexp")
881	       (string :tag "To string  "))
882  :group 'vhdl-naming
883  :group 'vhdl-compose)
884
885(defcustom vhdl-file-name-case 'identity
886  "Specifies how to change case for obtaining file names.
887When deriving a file name from a VHDL unit name, case can be changed as
888follows:
889  As Is:      case is not changed (taken as is)
890  Lower Case: whole name is changed to lower case
891  Upper Case: whole name is changed to upper case
892  Capitalize: first letter of each word in name is capitalized"
893  :type '(choice (const :tag "As Is" identity)
894		 (const :tag "Lower Case" downcase)
895		 (const :tag "Upper Case" upcase)
896		 (const :tag "Capitalize" capitalize))
897  :group 'vhdl-naming
898  :group 'vhdl-compose)
899
900
901(defgroup vhdl-template nil
902  "Customizations for electrification."
903  :group 'vhdl)
904
905(defcustom vhdl-electric-keywords '(vhdl user)
906  "Type of keywords for which electrification is enabled.
907  VHDL keywords: invoke built-in templates
908  User keywords: invoke user models (see option `vhdl-model-alist')"
909  :type '(set (const :tag "VHDL keywords" vhdl)
910	      (const :tag "User model keywords" user))
911  :set (lambda (variable value)
912	 (vhdl-custom-set variable value #'vhdl-mode-abbrev-table-init))
913  :group 'vhdl-template)
914
915(defcustom vhdl-optional-labels 'process
916  "Constructs for which labels are to be queried.
917Template generators prompt for optional labels for:
918  None          : no constructs
919  Processes only: processes only (also procedurals in VHDL-AMS)
920  All constructs: all constructs with optional labels and keyword END"
921  :type '(choice (const :tag "None" none)
922		 (const :tag "Processes only" process)
923		 (const :tag "All constructs" all))
924  :group 'vhdl-template)
925
926(defcustom vhdl-insert-empty-lines 'unit
927  "Specifies whether to insert empty lines in some templates.
928This improves readability of code.  Empty lines are inserted in:
929  None             : no constructs
930  Design units only: entities, architectures, configurations, packages only
931  All constructs   : also all constructs with BEGIN...END parts
932
933Replaces option `vhdl-additional-empty-lines'."
934  :type '(choice (const :tag "None" none)
935		 (const :tag "Design units only" unit)
936		 (const :tag "All constructs" all))
937  :group 'vhdl-template
938  :group 'vhdl-port
939  :group 'vhdl-compose)
940
941(defcustom vhdl-argument-list-indent nil
942  "Non-nil means indent argument lists relative to opening parenthesis.
943That is, argument, association, and port lists start on the same line as the
944opening parenthesis and subsequent lines are indented accordingly.
945Otherwise, lists start on a new line and are indented as normal code."
946  :type 'boolean
947  :group 'vhdl-template
948  :group 'vhdl-port
949  :group 'vhdl-compose)
950
951(defcustom vhdl-association-list-with-formals t
952  "Non-nil means write association lists with formal parameters.
953Templates prompt for formal and actual parameters (ports/generics).
954When pasting component instantiations, formals are included.
955If nil, only a list of actual parameters is entered."
956  :type 'boolean
957  :group 'vhdl-template
958  :group 'vhdl-port
959  :group 'vhdl-compose)
960
961(defcustom vhdl-conditions-in-parenthesis nil
962  "Non-nil means place parenthesis around condition expressions."
963  :type 'boolean
964  :group 'vhdl-template)
965
966(defcustom vhdl-sensitivity-list-all t
967  "Non-nil means use `all' keyword in sensitivity list."
968  :version "25.1"
969  :type 'boolean
970  :group 'vhdl-template)
971
972(defcustom vhdl-zero-string "'0'"
973  "String to use for a logic zero."
974  :type 'string
975  :group 'vhdl-template)
976
977(defcustom vhdl-one-string "'1'"
978  "String to use for a logic one."
979  :type 'string
980  :group 'vhdl-template)
981
982
983(defgroup vhdl-header nil
984  "Customizations for file header."
985  :group 'vhdl-template
986  :group 'vhdl-compose)
987
988(defcustom vhdl-file-header "\
989-------------------------------------------------------------------------------
990-- Title      : <title string>
991-- Project    : <project>
992-------------------------------------------------------------------------------
993-- File       : <filename>
994-- Author     : <author>
995-- Company    : <company>
996-- Created    : <date>
997-- Last update: <date>
998-- Platform   : <platform>
999-- Standard   : <standard>
1000<projectdesc>-------------------------------------------------------------------------------
1001-- Description: <cursor>
1002<copyright>-------------------------------------------------------------------------------
1003-- Revisions  :
1004-- Date        Version  Author  Description
1005-- <date>  1.0      <login>\tCreated
1006-------------------------------------------------------------------------------
1007
1008"
1009  "String or file to insert as file header.
1010If the string specifies an existing file name, the contents of the file is
1011inserted, otherwise the string itself is inserted as file header.
1012Type `C-j' for newlines.
1013If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
1014if the header needs to be version controlled.
1015
1016The following keywords for template generation are supported:
1017  <filename>    : replaced by the name of the buffer
1018  <author>      : replaced by the user name and email address
1019                  (`user-full-name', `user-mail-address')
1020  <authorfull>  : replaced by the user full name (`user-full-name')
1021  <login>       : replaced by user login name (`user-login-name')
1022  <company>     : replaced by contents of option `vhdl-company-name'
1023  <date>        : replaced by the current date
1024  <year>        : replaced by the current year
1025  <project>     : replaced by title of current project (`vhdl-project')
1026  <projectdesc> : replaced by description of current project (`vhdl-project')
1027  <copyright>   : replaced by copyright string (`vhdl-copyright-string')
1028  <platform>    : replaced by contents of option `vhdl-platform-spec'
1029  <standard>    : replaced by the VHDL language standard(s) used
1030  <... string>  : replaced by a queried string (\"...\" is the prompt word)
1031  <title string>: replaced by file title in automatically generated files
1032  <cursor>      : final cursor position
1033
1034The (multi-line) project description <projectdesc> can be used as a project
1035dependent part of the file header and can also contain the above keywords."
1036  :type 'string
1037  :group 'vhdl-header)
1038
1039(defcustom vhdl-file-footer ""
1040  "String or file to insert as file footer.
1041If the string specifies an existing file name, the contents of the file is
1042inserted, otherwise the string itself is inserted as file footer (i.e. at
1043the end of the file).
1044Type `C-j' for newlines.
1045The same keywords as in option `vhdl-file-header' can be used."
1046  :type 'string
1047  :group 'vhdl-header)
1048
1049(defcustom vhdl-company-name ""
1050  "Name of company to insert in file header.
1051See option `vhdl-file-header'."
1052  :type 'string
1053  :group 'vhdl-header)
1054
1055(defcustom vhdl-copyright-string "\
1056-------------------------------------------------------------------------------
1057-- Copyright (c) <year> <company>
1058"
1059  "Copyright string to insert in file header.
1060Can be multi-line string (type `C-j' for newline) and contain other file
1061header keywords (see option `vhdl-file-header')."
1062  :type 'string
1063  :group 'vhdl-header)
1064
1065(defcustom vhdl-platform-spec ""
1066  "Specification of VHDL platform to insert in file header.
1067The platform specification should contain names and versions of the
1068simulation and synthesis tools used.
1069See option `vhdl-file-header'."
1070  :type 'string
1071  :group 'vhdl-header)
1072
1073(defcustom vhdl-date-format "%Y-%m-%d"
1074  "Specifies the date format to use in the header.
1075This string is passed as argument to the command `format-time-string'.
1076For more information on format strings, see the documentation for the
1077`format-time-string' command (C-h f `format-time-string')."
1078  :type 'string
1079  :group 'vhdl-header)
1080
1081(defcustom vhdl-modify-date-prefix-string "-- Last update: "
1082  "Prefix string of modification date in VHDL file header.
1083If actualization of the modification date is called (menu,
1084`\\[vhdl-template-modify]'), this string is searched and the rest
1085of the line replaced by the current date."
1086  :type 'string
1087  :group 'vhdl-header)
1088
1089(defcustom vhdl-modify-date-on-saving t
1090  "Non-nil means update the modification date when the buffer is saved.
1091Calls function `\\[vhdl-template-modify]').
1092
1093NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1094      \"Activate Options\"."
1095  :type 'boolean
1096  :group 'vhdl-header)
1097
1098
1099(defgroup vhdl-sequential-process nil
1100  "Customizations for sequential processes."
1101  :group 'vhdl-template)
1102
1103(defcustom vhdl-reset-kind 'async
1104  "Specifies which kind of reset to use in sequential processes."
1105  :type '(choice (const :tag "None" none)
1106		 (const :tag "Synchronous" sync)
1107		 (const :tag "Asynchronous" async)
1108		 (const :tag "Query" query))
1109  :group 'vhdl-sequential-process)
1110
1111(defcustom vhdl-reset-active-high nil
1112  "Non-nil means reset in sequential processes is active high.
1113Otherwise, reset is active low."
1114  :type 'boolean
1115  :group 'vhdl-sequential-process)
1116
1117(defcustom vhdl-clock-rising-edge t
1118  "Non-nil means rising edge of clock triggers sequential processes.
1119Otherwise, falling edge triggers."
1120  :type 'boolean
1121  :group 'vhdl-sequential-process)
1122
1123(defcustom vhdl-clock-edge-condition 'standard
1124  "Syntax of the clock edge condition.
1125  Standard: \"clk\\='event and clk = \\='1\\='\"
1126  Function: \"rising_edge(clk)\""
1127  :type '(choice (const :tag "Standard" standard)
1128		 (const :tag "Function" function))
1129  :group 'vhdl-sequential-process)
1130
1131(defcustom vhdl-clock-name ""
1132  "Name of clock signal to use in templates."
1133  :type 'string
1134  :group 'vhdl-sequential-process)
1135
1136(defcustom vhdl-reset-name ""
1137  "Name of reset signal to use in templates."
1138  :type 'string
1139  :group 'vhdl-sequential-process)
1140
1141
1142(defgroup vhdl-model nil
1143  "Customizations for user models."
1144  :group 'vhdl)
1145
1146(defcustom vhdl-model-alist
1147  '(("Example Model"
1148     "<label> : process (<clock>, <reset>)
1149begin  -- process <label>
1150  if <reset> = '0' then  -- asynchronous reset (active low)
1151    <cursor>
1152  elsif <clock>'event and <clock> = '1' then  -- rising clock edge
1153    if <enable> = '1' then  -- synchronous load
1154
1155    end if;
1156  end if;
1157end process <label>;"
1158     "e" ""))
1159  "List of user models.
1160VHDL models (templates) can be specified by the user in this list.  They can be
1161invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1162electrification (i.e. overriding existing or creating new keywords, see
1163option `vhdl-electric-keywords').
1164  Name       : name of model (string of words and spaces)
1165  String     : string or name of file to be inserted as model (newline: `C-j')
1166  Key Binding: key binding to invoke model, added to prefix `C-c C-m'
1167                (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\")
1168  Keyword    : keyword to invoke model
1169
1170The models can contain prompts to be queried.  A prompt is of the form \"<...>\".
1171A prompt that appears several times is queried once and replaced throughout
1172the model.  Special prompts are:
1173  <clock> : name specified in `vhdl-clock-name' (if not empty)
1174  <reset> : name specified in `vhdl-reset-name' (if not empty)
1175  <cursor>: final cursor position
1176File header prompts (see variable `vhdl-file-header') are automatically
1177replaced, so that user models can also be used to insert different types of
1178headers.
1179
1180If the string specifies an existing file name, the contents of the file is
1181inserted, otherwise the string itself is inserted.
1182The code within the models should be correctly indented.
1183Type `C-j' for newlines.
1184
1185NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1186      \"Activate Options\"."
1187  :type '(repeat (list :tag "Model" :indent 2
1188		       (string :tag "Name       ")
1189		       (string :tag "String     : (type `C-j' for newline)"
1190			       :format "%t\n%v")
1191		       (sexp   :tag "Key binding" x)
1192		       (string :tag "Keyword    " :format "%t: %v\n")))
1193  :set (lambda (variable value)
1194	 (vhdl-custom-set variable value
1195			  #'vhdl-model-map-init
1196			  #'vhdl-model-defun
1197			  #'vhdl-mode-abbrev-table-init
1198			  #'vhdl-update-mode-menu))
1199  :group 'vhdl-model)
1200
1201
1202(defgroup vhdl-compose nil
1203  "Customizations for structural composition."
1204  :group 'vhdl)
1205
1206(defcustom vhdl-compose-architecture-name '(".*" . "str")
1207  (concat
1208   "Specifies how the component architecture name is obtained.
1209The component architecture name can be obtained by modifying the entity name
1210\(e.g. attaching or stripping off a substring).
1211If TO STRING is empty, the architecture name is queried."
1212   vhdl-name-doc-string)
1213  :type '(cons (regexp :tag "From regexp")
1214	       (string :tag "To string  "))
1215  :group 'vhdl-compose)
1216
1217(defcustom vhdl-compose-configuration-name
1218  '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
1219  (concat
1220   "Specifies how the configuration name is obtained.
1221The configuration name can be obtained by modifying the entity and/or
1222architecture name (e.g. attaching or stripping off a substring).  The string
1223that is matched against the regexp is the concatenation of the entity and the
1224architecture name separated by a space.  This gives access to both names (see
1225default setting as example)."
1226   vhdl-name-doc-string)
1227  :type '(cons (regexp :tag "From regexp")
1228	       (string :tag "To string  "))
1229  :group 'vhdl-compose)
1230
1231(defcustom vhdl-components-package-name
1232  '((".*" . "\\&_components") . "components")
1233  (concat
1234   "Specifies how the name for the components package is obtained.
1235The components package is a package containing all component declarations for
1236the current design.  Its name can be obtained by modifying the project name
1237\(e.g. attaching or stripping off a substring).  If no project is defined, the
1238DIRECTORY entry is chosen."
1239   vhdl-name-doc-string)
1240  :type '(cons (cons :tag "Project" :indent 2
1241		     (regexp :tag "From regexp")
1242		     (string :tag "To string  "))
1243	       (string :tag "Directory:\n  String     "))
1244  :group 'vhdl-compose)
1245
1246(defcustom vhdl-use-components-package nil
1247  "Non-nil means use a separate components package for component declarations.
1248Otherwise, component declarations are inserted and searched for in the
1249architecture declarative parts."
1250  :type 'boolean
1251  :group 'vhdl-compose)
1252
1253(defcustom vhdl-compose-include-header t
1254  "Non-nil means include a header in automatically generated files."
1255  :type 'boolean
1256  :group 'vhdl-compose)
1257
1258(defcustom vhdl-compose-create-files 'single
1259  "Specifies whether new files should be created for the new component.
1260The component's entity and architecture are inserted:
1261  None          : in current buffer
1262  Single file   : in new single file
1263  Separate files: in two separate files
1264The file names are obtained from variables `vhdl-entity-file-name' and
1265`vhdl-architecture-file-name'."
1266  :type '(choice (const :tag "None" none)
1267		 (const :tag "Single file" single)
1268		 (const :tag "Separate files" separate))
1269  :group 'vhdl-compose)
1270
1271(defcustom vhdl-compose-configuration-create-file nil
1272  "Specifies whether a new file should be created for the configuration.
1273If non-nil, a new file is created for the configuration.
1274The file name is obtained from variable `vhdl-configuration-file-name'."
1275  :type 'boolean
1276  :group 'vhdl-compose)
1277
1278(defcustom vhdl-compose-configuration-hierarchical t
1279  "Specifies whether hierarchical configurations should be created.
1280If non-nil, automatically created configurations are hierarchical and include
1281the whole hierarchy of subcomponents.  Otherwise the configuration only
1282includes one level of subcomponents."
1283  :type 'boolean
1284  :group 'vhdl-compose)
1285
1286(defcustom vhdl-compose-configuration-use-subconfiguration t
1287  "Specifies whether subconfigurations should be used inside configurations.
1288If non-nil, automatically created configurations use configurations in binding
1289indications for subcomponents, if such configurations exist.  Otherwise,
1290entities are used in binding indications for subcomponents."
1291  :type 'boolean
1292  :group 'vhdl-compose)
1293
1294
1295(defgroup vhdl-port nil
1296  "Customizations for port translation functions."
1297  :group 'vhdl
1298  :group 'vhdl-compose)
1299
1300(defcustom vhdl-include-port-comments nil
1301  "Non-nil means include port comments when a port is pasted."
1302  :type 'boolean
1303  :group 'vhdl-port)
1304
1305(defcustom vhdl-include-direction-comments nil
1306  "Non-nil means include port direction in instantiations as comments."
1307  :type 'boolean
1308  :group 'vhdl-port)
1309
1310(defcustom vhdl-include-type-comments nil
1311  "Non-nil means include generic/port type in instantiations as comments."
1312  :type 'boolean
1313  :group 'vhdl-port)
1314
1315(defcustom vhdl-include-group-comments 'never
1316  "Specifies whether to include group comments and spacings.
1317The comments and empty lines between groups of ports are pasted:
1318  Never       : never
1319  Declarations: in entity/component/constant/signal declarations only
1320  Always      : also in generic/port maps"
1321  :type '(choice (const :tag "Never" never)
1322		 (const :tag "Declarations" decl)
1323		 (const :tag "Always" always))
1324  :group 'vhdl-port)
1325
1326(defcustom vhdl-actual-generic-name '(".*" . "\\&")
1327  (concat
1328   "Specifies how actual generic names are obtained from formal generic names.
1329In a component instantiation, an actual generic name can be
1330obtained by modifying the formal generic name (e.g. attaching or stripping
1331off a substring)."
1332   vhdl-name-doc-string)
1333  :type '(cons (regexp :tag "From regexp")
1334	       (string :tag "To string  "))
1335  :group 'vhdl-port
1336  :version "24.4")
1337
1338(defcustom vhdl-actual-port-name '(".*" . "\\&")
1339  (concat
1340   "Specifies how actual port names are obtained from formal port names.
1341In a component instantiation, an actual port name can be obtained by
1342modifying the formal port name (e.g. attaching or stripping off a substring)."
1343   vhdl-name-doc-string)
1344  :type '(cons (regexp :tag "From regexp")
1345	       (string :tag "To string  "))
1346  :group 'vhdl-port)
1347
1348(defcustom vhdl-instance-name '(".*" . "\\&_%d")
1349  (concat
1350   "Specifies how an instance name is obtained.
1351The instance name can be obtained by modifying the name of the component to be
1352instantiated (e.g. attaching or stripping off a substring).  \"%d\" is replaced
1353by a unique number (starting with 1).
1354If TO STRING is empty, the instance name is queried."
1355   vhdl-name-doc-string)
1356  :type '(cons (regexp :tag "From regexp")
1357	       (string :tag "To string  "))
1358  :group 'vhdl-port)
1359
1360
1361(defgroup vhdl-testbench nil
1362  "Customizations for testbench generation."
1363  :group 'vhdl-port)
1364
1365(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
1366  (concat
1367   "Specifies how the testbench entity name is obtained.
1368The entity name of a testbench can be obtained by modifying the name of
1369the component to be tested (e.g. attaching or stripping off a substring)."
1370   vhdl-name-doc-string)
1371  :type '(cons (regexp :tag "From regexp")
1372	       (string :tag "To string  "))
1373  :group 'vhdl-testbench)
1374
1375(defcustom vhdl-testbench-architecture-name '(".*" . "")
1376  (concat
1377   "Specifies how the testbench architecture name is obtained.
1378The testbench architecture name can be obtained by modifying the name of
1379the component to be tested (e.g. attaching or stripping off a substring).
1380If TO STRING is empty, the architecture name is queried."
1381   vhdl-name-doc-string)
1382  :type '(cons (regexp :tag "From regexp")
1383	       (string :tag "To string  "))
1384  :group 'vhdl-testbench)
1385
1386(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
1387  (concat
1388   "Specifies how the testbench configuration name is obtained.
1389The configuration name of a testbench can be obtained by modifying the entity
1390and/or architecture name (e.g. attaching or stripping off a substring).  The
1391string that is matched against the regexp is the concatenation of the entity
1392and the architecture name separated by a space.  This gives access to both
1393names (see default setting as example)."
1394   vhdl-name-doc-string)
1395  :type '(cons (regexp :tag "From regexp")
1396	       (string :tag "To string  "))
1397  :group 'vhdl-testbench)
1398
1399(defcustom vhdl-testbench-dut-name '(".*" . "DUT")
1400  (concat
1401   "Specifies how a DUT instance name is obtained.
1402The design-under-test instance name (i.e. the component instantiated in the
1403testbench) can be obtained by modifying the component name (e.g. attaching
1404or stripping off a substring)."
1405   vhdl-name-doc-string)
1406  :type '(cons (regexp :tag "From regexp")
1407	       (string :tag "To string  "))
1408  :group 'vhdl-testbench)
1409
1410(defcustom vhdl-testbench-include-header t
1411  "Non-nil means include a header in automatically generated files."
1412  :type 'boolean
1413  :group 'vhdl-testbench)
1414
1415(defcustom vhdl-testbench-declarations "\
1416  -- clock
1417  signal Clk : std_logic := '1';
1418"
1419  "String or file to be inserted in the testbench declarative part.
1420If the string specifies an existing file name, the contents of the file is
1421inserted, otherwise the string itself is inserted in the testbench
1422architecture before the BEGIN keyword.
1423Type `C-j' for newlines."
1424  :type 'string
1425  :group 'vhdl-testbench)
1426
1427(defcustom vhdl-testbench-statements "\
1428  -- clock generation
1429  Clk <= not Clk after 10 ns;
1430
1431  -- waveform generation
1432  WaveGen_Proc: process
1433  begin
1434    -- insert signal assignments here
1435
1436    wait until Clk = '1';
1437  end process WaveGen_Proc;
1438"
1439  "String or file to be inserted in the testbench statement part.
1440If the string specifies an existing file name, the contents of the file is
1441inserted, otherwise the string itself is inserted in the testbench
1442architecture before the END keyword.
1443Type `C-j' for newlines."
1444  :type 'string
1445  :group 'vhdl-testbench)
1446
1447(defcustom vhdl-testbench-initialize-signals nil
1448  "Non-nil means initialize signals with `0' when declared in testbench."
1449  :type 'boolean
1450  :group 'vhdl-testbench)
1451
1452(defcustom vhdl-testbench-include-library t
1453  "Non-nil means a library/use clause for std_logic_1164 is included."
1454  :type 'boolean
1455  :group 'vhdl-testbench)
1456
1457(defcustom vhdl-testbench-include-configuration t
1458  "Non-nil means a testbench configuration is attached at the end."
1459  :type 'boolean
1460  :group 'vhdl-testbench)
1461
1462(defcustom vhdl-testbench-create-files 'single
1463  "Specifies whether new files should be created for the testbench.
1464testbench entity and architecture are inserted:
1465  None          : in current buffer
1466  Single file   : in new single file
1467  Separate files: in two separate files
1468The file names are obtained from variables `vhdl-testbench-entity-file-name'
1469and `vhdl-testbench-architecture-file-name'."
1470  :type '(choice (const :tag "None" none)
1471		 (const :tag "Single file" single)
1472		 (const :tag "Separate files" separate))
1473  :group 'vhdl-testbench)
1474
1475(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
1476  (concat
1477   "Specifies how the testbench entity file name is obtained.
1478The entity file name can be obtained by modifying the testbench entity name
1479\(e.g. attaching or stripping off a substring).  The file extension is
1480automatically taken from the file name of the current buffer.  Testbench
1481files can be created in a different directory by prepending a relative or
1482absolute path to the file name."
1483   vhdl-name-doc-string)
1484  :type '(cons (regexp :tag "From regexp")
1485	       (string :tag "To string  "))
1486  :group 'vhdl-testbench)
1487
1488(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
1489  (concat
1490   "Specifies how the testbench architecture file name is obtained.
1491The architecture file name can be obtained by modifying the testbench entity
1492and/or architecture name (e.g. attaching or stripping off a substring).  The
1493string that is matched against the regexp is the concatenation of the entity
1494and the architecture name separated by a space.  This gives access to both
1495names (see default setting as example).  Testbench files can be created in
1496a different directory by prepending a relative or absolute path to the file
1497name."
1498   vhdl-name-doc-string)
1499  :type '(cons (regexp :tag "From regexp")
1500	       (string :tag "To string  "))
1501  :group 'vhdl-testbench)
1502
1503
1504(defgroup vhdl-comment nil
1505  "Customizations for comments."
1506  :group 'vhdl)
1507
1508(defcustom vhdl-self-insert-comments t
1509  "Non-nil means various templates automatically insert help comments."
1510  :type 'boolean
1511  :group 'vhdl-comment)
1512
1513(defcustom vhdl-prompt-for-comments t
1514  "Non-nil means various templates prompt for user definable comments."
1515  :type 'boolean
1516  :group 'vhdl-comment)
1517
1518(defcustom vhdl-inline-comment-column 40
1519  "Column to indent and align inline comments to.
1520Overrides local option `comment-column'.
1521
1522NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1523      \"Activate Options\"."
1524  :type 'integer
1525  :group 'vhdl-comment)
1526
1527(defcustom vhdl-end-comment-column 79
1528  "End of comment column.
1529Comments that exceed this column number are wrapped.
1530
1531NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1532      \"Activate Options\"."
1533  :type 'integer
1534  :group 'vhdl-comment)
1535
1536(defvar end-comment-column)
1537
1538
1539(defgroup vhdl-beautify nil
1540  "Customizations for beautification."
1541  :group 'vhdl)
1542
1543(defcustom vhdl-auto-align t
1544  "Non-nil means align some templates automatically after generation."
1545  :type 'boolean
1546  :group 'vhdl-beautify)
1547
1548(defcustom vhdl-align-groups t
1549  "Non-nil means align groups of code lines separately.
1550A group of code lines is a region of consecutive lines between two lines that
1551match the regexp in option `vhdl-align-group-separate'."
1552  :type 'boolean
1553  :group 'vhdl-beautify)
1554
1555(defcustom vhdl-align-group-separate "^\\s-*$"
1556  "Regexp for matching a line that separates groups of lines for alignment.
1557Examples:
1558  \"^\\s-*$\":          matches an empty line
1559  \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1560  :type 'regexp
1561  :group 'vhdl-beautify)
1562
1563(defcustom vhdl-align-same-indent t
1564  "Non-nil means align blocks with same indent separately.
1565When a region or the entire buffer is aligned, the code is divided into
1566blocks of same indent which are aligned separately (except for argument/port
1567lists).  This gives nicer alignment in most cases.
1568Option `vhdl-align-groups' still applies within these blocks."
1569  :type 'boolean
1570  :group 'vhdl-beautify)
1571
1572(defcustom vhdl-beautify-options '(t t t t t)
1573  "List of options for beautifying code.
1574Allows you to disable individual features of code beautification."
1575  :type '(list (boolean :tag "Whitespace cleanup       ")
1576	       (boolean :tag "Single statement per line")
1577	       (boolean :tag "Indentation              ")
1578	       (boolean :tag "Alignment                ")
1579	       (boolean :tag "Case fixing              "))
1580  :group 'vhdl-beautify
1581  :version "24.4")
1582
1583
1584(defgroup vhdl-highlight nil
1585  "Customizations for highlighting."
1586  :group 'vhdl)
1587
1588(defcustom vhdl-highlight-keywords t
1589  "Non-nil means highlight VHDL keywords and other standardized words.
1590The following faces are used:
1591  `font-lock-keyword-face'       : keywords
1592  `font-lock-type-face'          : standardized types
1593  `vhdl-font-lock-attribute-face': standardized attributes
1594  `vhdl-font-lock-enumvalue-face': standardized enumeration values
1595  `vhdl-font-lock-function-face' : standardized function and package names
1596
1597NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1598      entry \"Fontify Buffer\")."
1599  :type 'boolean
1600  :set (lambda (variable value)
1601	 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1602  :group 'vhdl-highlight)
1603
1604(defcustom vhdl-highlight-names t
1605  "Non-nil means highlight declaration names and construct labels.
1606The following faces are used:
1607  `font-lock-function-name-face' : names in declarations of units,
1608     subprograms, components, as well as labels of VHDL constructs
1609  `font-lock-type-face'          : names in type/nature declarations
1610  `vhdl-font-lock-attribute-face': names in attribute declarations
1611  `font-lock-variable-name-face' : names in declarations of signals,
1612     variables, constants, subprogram parameters, generics, and ports
1613
1614NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1615      entry \"Fontify Buffer\")."
1616  :type 'boolean
1617  :set (lambda (variable value)
1618	 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1619  :group 'vhdl-highlight)
1620
1621(defcustom vhdl-highlight-special-words nil
1622  "Non-nil means highlight words with special syntax.
1623The words with syntax and color specified in option `vhdl-special-syntax-alist'
1624are highlighted accordingly.
1625Can be used for visual support of naming conventions.
1626
1627NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1628      entry \"Fontify Buffer\")."
1629  :type 'boolean
1630  :set (lambda (variable value)
1631	 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1632  :group 'vhdl-highlight)
1633
1634(defcustom vhdl-highlight-forbidden-words nil
1635  "Non-nil means highlight forbidden words.
1636The reserved words specified in option `vhdl-forbidden-words' or having the
1637syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1638warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1639use them.
1640
1641NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1642      entry \"Fontify Buffer\")."
1643  :type 'boolean
1644  :set (lambda (variable value)
1645	 (vhdl-custom-set variable value
1646			  #'vhdl-words-init #'vhdl-font-lock-init))
1647  :group 'vhdl-highlight)
1648
1649(defcustom vhdl-highlight-verilog-keywords nil
1650  "Non-nil means highlight Verilog keywords as reserved words.
1651Verilog keywords are highlighted in a warning color (face
1652`vhdl-font-lock-reserved-words-face') to indicate not to use them.
1653
1654NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1655      entry \"Fontify Buffer\")."
1656  :type 'boolean
1657  :set (lambda (variable value)
1658	 (vhdl-custom-set variable value
1659			  #'vhdl-words-init #'vhdl-font-lock-init))
1660  :group 'vhdl-highlight)
1661
1662(defcustom vhdl-highlight-translate-off nil
1663  "Non-nil means background-highlight code excluded from translation.
1664That is, all code between \"-- pragma translate_off\" and
1665\"-- pragma translate_on\" is highlighted using a different background color
1666\(face `vhdl-font-lock-translate-off-face').
1667Note: this might slow down on-the-fly fontification (and thus editing).
1668
1669NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1670      entry \"Fontify Buffer\")."
1671  :type 'boolean
1672  :set (lambda (variable value)
1673	 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1674  :group 'vhdl-highlight)
1675
1676(defcustom vhdl-highlight-case-sensitive nil
1677  "Non-nil means consider case for highlighting.
1678Possible trade-off:
1679  non-nil  also upper-case VHDL words are highlighted, but case of words with
1680           special syntax is not considered
1681  nil      only lower-case VHDL words are highlighted, but case of words with
1682           special syntax is considered
1683Overrides local option `font-lock-keywords-case-fold-search'.
1684
1685NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1686      entry \"Fontify Buffer\")."
1687  :type 'boolean
1688  :group 'vhdl-highlight)
1689
1690(defcustom vhdl-special-syntax-alist
1691  '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil)
1692    ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil)
1693    ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil))
1694  "List of special syntax to be highlighted.
1695If option `vhdl-highlight-special-words' is non-nil, words with the specified
1696syntax (as regular expression) are highlighted in the corresponding color.
1697
1698  Name         : string of words and spaces
1699  Regexp       : regular expression describing word syntax
1700                 (e.g., `\\=\\<\\w+_c\\>' matches word with suffix `_c')
1701                 expression must start with `\\=\\<' and end with `\\>'
1702                 if only whole words should be matched (no substrings)
1703  Color (light): foreground color for light background
1704                 (matching color examples: Gold3, Grey50, LimeGreen, Tomato,
1705                 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
1706  Color (dark) : foreground color for dark background
1707                 (matching color examples: BurlyWood1, Grey80, Green, Coral,
1708                 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1709  In comments  : If non-nil, words are also highlighted inside comments
1710
1711Can be used for visual support of naming conventions, such as highlighting
1712different kinds of signals (e.g. `Clk50', `Rst_n') or objects (e.g.
1713`Signal_s', `Variable_v', `Constant_c') by distinguishing them using
1714common substrings or name suffices.
1715For each entry, a new face is generated with the specified colors and name
1716`vhdl-font-lock-' + name + `-face'.
1717
1718NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1719      entry `Fontify Buffer').  All other changes require restarting Emacs."
1720  :type '(repeat (list :tag "Face" :indent 2
1721		       (string :tag "Name         ")
1722		       (regexp :tag "Regexp       " "\\w+_")
1723		       (string :tag "Color (light)")
1724		       (string :tag "Color (dark) ")
1725		       (boolean :tag "In comments  ")))
1726  :set (lambda (variable value)
1727	 (vhdl-custom-set variable value #'vhdl-font-lock-init))
1728  :group 'vhdl-highlight)
1729
1730(defcustom vhdl-forbidden-words '()
1731  "List of forbidden words to be highlighted.
1732If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1733words are highlighted in a warning color to indicate not to use them.
1734
1735NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1736      entry \"Fontify Buffer\")."
1737  :type '(repeat (string :format "%v"))
1738  :set (lambda (variable value)
1739	 (vhdl-custom-set variable value
1740			  #'vhdl-words-init #'vhdl-font-lock-init))
1741  :group 'vhdl-highlight)
1742
1743(defcustom vhdl-forbidden-syntax ""
1744  "Syntax of forbidden words to be highlighted.
1745If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1746syntax are highlighted in a warning color to indicate not to use them.
1747Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1748highlights identifiers with 10 or more characters).
1749
1750NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1751      entry \"Fontify Buffer\")."
1752  :type 'regexp
1753  :set (lambda (variable value)
1754	 (vhdl-custom-set variable value
1755			  #'vhdl-words-init #'vhdl-font-lock-init))
1756  :group 'vhdl-highlight)
1757
1758(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
1759  "List of compiler directive keywords recognized for highlighting.
1760
1761NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1762      entry \"Fontify Buffer\")."
1763  :type '(repeat (string :format "%v"))
1764  :set (lambda (variable value)
1765	 (vhdl-custom-set variable value
1766			  #'vhdl-words-init #'vhdl-font-lock-init))
1767  :group 'vhdl-highlight)
1768
1769
1770(defgroup vhdl-speedbar nil
1771  "Customizations for speedbar."
1772  :group 'vhdl)
1773
1774(defcustom vhdl-speedbar-auto-open nil
1775  "Non-nil means automatically open speedbar at startup.
1776Alternatively, the speedbar can be opened from the VHDL menu."
1777  :type 'boolean
1778  :group 'vhdl-speedbar)
1779
1780(defcustom vhdl-speedbar-display-mode 'files
1781  "Specifies the default displaying mode when opening speedbar.
1782Alternatively, the displaying mode can be selected from the speedbar menu or
1783by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1784  :type '(choice (const :tag "Files" files)
1785		 (const :tag "Directory hierarchy" directory)
1786		 (const :tag "Project hierarchy" project))
1787  :group 'vhdl-speedbar)
1788
1789(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
1790  "Limits scanning of large files and netlists.
1791Design units: maximum file size to scan for design units
1792Hierarchy (instances of subcomponents):
1793  File size: maximum file size to scan for instances (in bytes)
1794  Instances per arch: maximum number of instances to scan per architecture
1795
1796\"None\" always means that there is no limit.
1797In case of files not or incompletely scanned, a warning message and the file
1798names are printed out.
1799Background: scanning for instances is considerably slower than scanning for
1800design units, especially when there are many instances.  These limits should
1801prevent the scanning of large netlists."
1802  :type '(list (choice :tag "Design units"
1803		       :format "%t        : %[Value Menu%] %v"
1804		       (const :tag "None" nil)
1805		       (integer :tag "File size"))
1806	       (list :tag "Hierarchy" :indent 2
1807		     (choice :tag "File size"
1808			     :format "%t         : %[Value Menu%] %v"
1809			     (const :tag "None" nil)
1810			     (integer :tag "Size     "))
1811		     (choice :tag "Instances per arch"
1812			     (const :tag "None" nil)
1813			     (integer :tag "Number   "))))
1814  :group 'vhdl-speedbar)
1815
1816(defcustom vhdl-speedbar-jump-to-unit t
1817  "Non-nil means jump to the design unit code when opened in a buffer.
1818The buffer cursor position is left unchanged otherwise."
1819  :type 'boolean
1820  :group 'vhdl-speedbar)
1821
1822(defcustom vhdl-speedbar-update-on-saving t
1823  "Automatically update design hierarchy when buffer is saved."
1824  :type 'boolean
1825  :group 'vhdl-speedbar)
1826
1827(defcustom vhdl-speedbar-save-cache '(hierarchy display)
1828  "Automatically save modified hierarchy caches when exiting Emacs.
1829  Hierarchy: design hierarchy information
1830  Display:   displaying information (which design units to expand)"
1831  :type '(set (const :tag "Hierarchy" hierarchy)
1832	      (const :tag "Display"   display))
1833  :group 'vhdl-speedbar)
1834
1835(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
1836  "Name of file for saving hierarchy cache.
1837\"\\1\" is replaced by the project name if a project is specified,
1838\"directory\" otherwise.  \"\\2\" is replaced by the user name (allows for
1839different users to have cache files in the same directory). Can also have
1840an absolute path (i.e. all caches can be stored in one global directory)."
1841  :type 'string
1842  :group 'vhdl-speedbar)
1843
1844
1845(defgroup vhdl-menu nil
1846  "Customizations for menus."
1847  :group 'vhdl)
1848
1849(defcustom vhdl-index-menu nil
1850  "Non-nil means add an index menu for a source file when loading.
1851Alternatively, the speedbar can be used.  Note that the index menu scans a file
1852when it is opened, while speedbar only scans the file upon request."
1853  :type 'boolean
1854  :group 'vhdl-menu)
1855
1856(defcustom vhdl-source-file-menu nil
1857  "Non-nil means add a menu of all source files in current directory.
1858Alternatively, the speedbar can be used."
1859  :type 'boolean
1860  :group 'vhdl-menu)
1861
1862(defcustom vhdl-hideshow-menu nil
1863  "Non-nil means add hideshow menu and functionality at startup.
1864Hideshow can also be enabled from the VHDL Mode menu.
1865Hideshow allows hiding code of various VHDL constructs.
1866
1867NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1868      \"Activate Options\"."
1869  :type 'boolean
1870  :group 'vhdl-menu)
1871
1872(defcustom vhdl-hide-all-init nil
1873  "Non-nil means hide all design units initially after a file is loaded."
1874  :type 'boolean
1875  :group 'vhdl-menu)
1876
1877
1878(defgroup vhdl-print nil
1879  "Customizations for printing."
1880  :group 'vhdl)
1881
1882(defcustom vhdl-print-two-column t
1883  "Non-nil means print code in two columns and landscape format.
1884Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
1885prints VHDL files in a nice two-column landscape style.
1886
1887NOTE: Activate the new setting by restarting Emacs.
1888      Overrides `ps-print' settings locally."
1889  :type 'boolean
1890  :group 'vhdl-print)
1891
1892(defcustom vhdl-print-customize-faces t
1893  "Non-nil means use an optimized set of faces for PostScript printing.
1894
1895NOTE: Activate the new setting by restarting Emacs.
1896      Overrides `ps-print' settings locally."
1897  :type 'boolean
1898  :group 'vhdl-print)
1899
1900
1901(defgroup vhdl-misc nil
1902  "Miscellaneous customizations."
1903  :group 'vhdl)
1904
1905(defcustom vhdl-intelligent-tab t
1906  "Non-nil means `TAB' does indentation, word completion and tab insertion.
1907That is, if preceding character is part of a word then complete word,
1908else if not at beginning of line then insert tab,
1909else if last command was a `TAB' or `RET' then dedent one step,
1910else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1911If nil, TAB always indents current line (i.e. `TAB' is bound to
1912`indent-according-to-mode').
1913
1914NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1915      \"Activate Options\"."
1916  :type 'boolean
1917  :group 'vhdl-misc)
1918
1919(defcustom vhdl-indent-syntax-based t
1920  "Non-nil means indent lines of code based on their syntactic context.
1921Otherwise, a line is indented like the previous nonblank line.  This can be
1922useful in large files where syntax-based indentation gets very slow."
1923  :type 'boolean
1924  :group 'vhdl-misc)
1925
1926(defcustom vhdl-indent-comment-like-next-code-line t
1927  "Non-nil means comment lines are indented like the following code line.
1928Otherwise, comment lines are indented like the preceding code line.
1929Indenting comment lines like the following code line gives nicer indentation
1930when comments precede the code that they refer to."
1931  :type 'boolean
1932  :version "24.3"
1933  :group 'vhdl-misc)
1934
1935(defcustom vhdl-word-completion-case-sensitive nil
1936  "Non-nil means word completion using `TAB' is case sensitive.
1937That is, `TAB' completes words that start with the same letters and case.
1938Otherwise, case is ignored."
1939  :type 'boolean
1940  :group 'vhdl-misc)
1941
1942(defcustom vhdl-word-completion-in-minibuffer t
1943  "Non-nil enables word completion in minibuffer (for template prompts).
1944
1945NOTE: Activate the new setting by restarting Emacs."
1946  :type 'boolean
1947  :group 'vhdl-misc)
1948
1949(defcustom vhdl-underscore-is-part-of-word nil
1950  "Non-nil means consider the underscore character `_' as part of word.
1951An identifier containing underscores is then treated as a single word in
1952select and move operations.  All parts of an identifier separated by underscore
1953are treated as single words otherwise."
1954  :type 'boolean
1955  :group 'vhdl-misc)
1956(make-obsolete-variable 'vhdl-underscore-is-part-of-word
1957                        'superword-mode "24.4")
1958
1959
1960(defgroup vhdl-related nil
1961  "Related general customizations."
1962  :group 'vhdl)
1963
1964;; add related general customizations
1965(custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
1966(if (featurep 'xemacs)
1967    (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
1968  (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
1969(custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
1970(custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
1971(custom-add-to-group 'vhdl-related 'comment-style 'custom-variable)
1972(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
1973(unless (featurep 'xemacs)
1974  (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
1975(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
1976(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
1977
1978;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1979;; Hidden user variables
1980
1981(defvar vhdl-compile-absolute-path nil
1982  "If non-nil, use absolute instead of relative path for compiled files.")
1983
1984(defvar vhdl-comment-display-line-char ?-
1985  "Character to use in comment display line.")
1986
1987;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1988;; Internal variables
1989
1990(defvar vhdl-menu-max-size 20
1991  "Specifies the maximum size of a menu before splitting it into submenus.")
1992
1993(defvar vhdl-progress-interval 1
1994  "Interval used to update progress status during long operations.
1995If a number, percentage complete gets updated after each interval of
1996that many seconds.  To inhibit all messages, set this option to nil.")
1997
1998(defvar vhdl-inhibit-startup-warnings-p nil
1999  "If non-nil, inhibits start up compatibility warnings.")
2000
2001(defvar vhdl-strict-syntax-p nil
2002  "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
2003If the syntactic symbol for a particular line does not match a symbol
2004in the offsets alist, an error is generated, otherwise no error is
2005reported and the syntactic symbol is ignored.")
2006
2007(defvar vhdl-echo-syntactic-information-p nil
2008  "If non-nil, syntactic info is echoed when the line is indented.")
2009
2010(defconst vhdl-offsets-alist-default
2011  '((string		   . -1000)
2012    (cpp-macro		   . -1000)
2013    (block-open		   . 0)
2014    (block-close	   . 0)
2015    (statement		   . 0)
2016    (statement-cont	   . vhdl-lineup-statement-cont)
2017    (statement-block-intro . +)
2018    (statement-case-intro  . +)
2019    (case-alternative	   . +)
2020    (comment		   . vhdl-lineup-comment)
2021    (arglist-intro	   . +)
2022    (arglist-cont	   . 0)
2023    (arglist-cont-nonempty . vhdl-lineup-arglist)
2024    (arglist-close	   . vhdl-lineup-arglist)
2025    (entity		   . 0)
2026    (configuration	   . 0)
2027    (package		   . 0)
2028    (architecture	   . 0)
2029    (package-body	   . 0)
2030    (context		   . 0)
2031    (directive		   . 0)
2032    )
2033  "Default settings for offsets of syntactic elements.
2034Do not change this constant!  See the variable `vhdl-offsets-alist' for
2035more information.")
2036
2037(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
2038  "Association list of syntactic element symbols and indentation offsets.
2039As described below, each cons cell in this list has the form:
2040
2041    (SYNTACTIC-SYMBOL . OFFSET)
2042
2043When a line is indented, `vhdl-mode' first determines the syntactic
2044context of the line by generating a list of symbols called syntactic
2045elements.  This list can contain more than one syntactic element and
2046the global variable `vhdl-syntactic-context' contains the context list
2047for the line being indented.  Each element in this list is actually a
2048cons cell of the syntactic symbol and a buffer position.  This buffer
2049position is call the relative indent point for the line.  Some
2050syntactic symbols may not have a relative indent point associated with
2051them.
2052
2053After the syntactic context list for a line is generated, `vhdl-mode'
2054calculates the absolute indentation for the line by looking at each
2055syntactic element in the list.  First, it compares the syntactic
2056element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'.  When it
2057finds a match, it adds the OFFSET to the column of the relative indent
2058point.  The sum of this calculation for each element in the syntactic
2059list is the absolute offset for line being indented.
2060
2061If the syntactic element does not match any in the `vhdl-offsets-alist',
2062an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
2063the element is ignored.
2064
2065Actually, OFFSET can be an integer, a function, a variable, or one of
2066the following symbols: `+', `-', `++', or `--'.  These latter
2067designate positive or negative multiples of `vhdl-basic-offset',
2068respectively: *1, *-1, *2, and *-2.  If OFFSET is a function, it is
2069called with a single argument containing the cons of the syntactic
2070element symbol and the relative indent point.  The function should
2071return an integer offset.
2072
2073Here is the current list of valid syntactic element symbols:
2074
2075 string                 -- inside multi-line string
2076 block-open             -- statement block open
2077 block-close            -- statement block close
2078 statement              -- a VHDL statement
2079 statement-cont         -- a continuation of a VHDL statement
2080 statement-block-intro  -- the first line in a new statement block
2081 statement-case-intro   -- the first line in a case alternative block
2082 case-alternative       -- a case statement alternative clause
2083 comment                -- a line containing only a comment
2084 arglist-intro          -- the first line in an argument list
2085 arglist-cont           -- subsequent argument list lines when no
2086                           arguments follow on the same line as
2087                           the arglist opening paren
2088 arglist-cont-nonempty  -- subsequent argument list lines when at
2089                           least one argument follows on the same
2090                           line as the arglist opening paren
2091 arglist-close          -- the solo close paren of an argument list
2092 entity                 -- inside an entity declaration
2093 configuration          -- inside a configuration declaration
2094 package                -- inside a package declaration
2095 architecture           -- inside an architecture body
2096 package-body           -- inside a package body
2097 context                -- inside a context declaration")
2098
2099(defvar vhdl-comment-only-line-offset 0
2100  "Extra offset for line which contains only the start of a comment.
2101Can contain an integer or a cons cell of the form:
2102
2103 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
2104
2105Where NON-ANCHORED-OFFSET is the amount of offset given to
2106non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
2107the amount of offset to give column-zero anchored comment-only lines.
2108Just an integer as value is equivalent to (<val> . 0)")
2109
2110(defvar vhdl-special-indent-hook nil
2111  "Hook for user defined special indentation adjustments.
2112This hook gets called after a line is indented by the mode.")
2113
2114(defvar vhdl-style-alist
2115  '(("IEEE"
2116     (vhdl-basic-offset . 4)
2117     (vhdl-offsets-alist . ())))
2118  "Styles of Indentation.
2119Elements of this alist are of the form:
2120
2121  (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
2122
2123where STYLE-STRING is a short descriptive string used to select a
2124style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended
2125value for that variable when using the selected style.
2126
2127There is one special case when VARIABLE is `vhdl-offsets-alist'.  In this
2128case, the VALUE is a list containing elements of the form:
2129
2130  (SYNTACTIC-SYMBOL . VALUE)
2131
2132as described in `vhdl-offsets-alist'.  These are passed directly to
2133`vhdl-set-offset' so there is no need to set every syntactic symbol in
2134your style, only those that are different from the default.")
2135
2136;; dynamically append the default value of most variables
2137(or (assoc "Default" vhdl-style-alist)
2138    (let* ((varlist '(vhdl-inhibit-startup-warnings-p
2139		      vhdl-strict-syntax-p
2140		      vhdl-echo-syntactic-information-p
2141		      vhdl-basic-offset
2142		      vhdl-offsets-alist
2143		      vhdl-comment-only-line-offset))
2144	   (default (cons "Default"
2145			  (mapcar
2146			   (function
2147			    (lambda (var)
2148			      (cons var (symbol-value var))))
2149			   varlist))))
2150      (push default vhdl-style-alist)))
2151
2152(defvar vhdl-mode-hook nil
2153  "Hook called by `vhdl-mode'.")
2154
2155
2156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2157;;; Required packages
2158;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2159
2160;; mandatory
2161(require 'compile)			; XEmacs
2162(when (< emacs-major-version 28)	; preloaded in Emacs 28
2163  (require 'easymenu))
2164(require 'hippie-exp)
2165
2166;; optional (minimize warning messages during compile)
2167(unless (featurep 'xemacs)
2168(eval-when-compile
2169  (require 'font-lock)
2170  (require 'ps-print)
2171    (require 'speedbar)))		; for speedbar-with-writable
2172
2173(defun vhdl-aput (alist-symbol key &optional value)
2174  "Insert a key-value pair into an alist.
2175The alist is referenced by ALIST-SYMBOL.  The key-value pair is made
2176from KEY and VALUE.  If the key-value pair referenced by KEY can be
2177found in the alist, the value of KEY will be set to VALUE.  If the
2178key-value pair cannot be found in the alist, it will be inserted into
2179the head of the alist."
2180  (let* ((alist (symbol-value alist-symbol))
2181	 (elem (assoc key alist)))
2182    (if elem
2183	(setcdr elem value)
2184      (set alist-symbol (cons (cons key value) alist)))))
2185
2186(defun vhdl-adelete (alist-symbol key)
2187  "Delete a key-value pair from the alist.
2188Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
2189is pair matching KEY."
2190  (let ((alist (symbol-value alist-symbol)) alist-cdr)
2191    (while (equal key (caar alist))
2192      (setq alist (cdr alist))
2193      (set alist-symbol alist))
2194    (while (setq alist-cdr (cdr alist))
2195      (if (equal key (caar alist-cdr))
2196	  (setcdr alist (cdr alist-cdr))
2197	(setq alist alist-cdr)))))
2198
2199(defun vhdl-aget (alist key)
2200  "Return the value in ALIST that is associated with KEY.
2201If KEY is not found, then nil is returned."
2202  (cdr (assoc key alist)))
2203
2204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2205;;; Compatibility
2206;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2207
2208;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2209;; XEmacs compatibility
2210
2211;; active regions
2212(defun vhdl-keep-region-active ()
2213  "Do whatever is necessary to keep the region active in XEmacs.
2214Ignore byte-compiler warnings you might see."
2215  (and (featurep 'xemacs)
2216       (setq zmacs-region-stays t)))
2217
2218;; `wildcard-to-regexp' is included only in XEmacs 21
2219(unless (fboundp 'wildcard-to-regexp)
2220  (defun wildcard-to-regexp (wildcard)
2221    "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'."
2222    (let* ((i (string-match "[*?]" wildcard))
2223	   (result (substring wildcard 0 i))
2224	   (len (length wildcard)))
2225      (when i
2226	(while (< i len)
2227	  (let ((ch (aref wildcard i)))
2228	    (setq result (concat result
2229				 (cond ((eq ch ?*)  "[^\000]*")
2230				       ((eq ch ??)  "[^\000]")
2231				       (t (char-to-string ch)))))
2232	    (setq i (1+ i)))))
2233      (concat "\\`" result "\\'"))))
2234
2235;; `regexp-opt' undefined (`xemacs-devel' not installed)
2236;; `regexp-opt' accelerates fontification by 10-20%
2237(unless (fboundp 'regexp-opt)
2238;  (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
2239  (defun regexp-opt (strings &optional paren)
2240    (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
2241      (concat open (mapconcat #'regexp-quote strings "\\|") close))))
2242
2243;; `match-string-no-properties' undefined (XEmacs, what else?)
2244(unless (fboundp 'match-string-no-properties)
2245  (defalias 'match-string-no-properties #'match-string))
2246
2247;; `subst-char-in-string' undefined (XEmacs)
2248(unless (fboundp 'subst-char-in-string)
2249  (defun subst-char-in-string (fromchar tochar string &optional inplace)
2250    (let ((i (length string))
2251	  (newstr (if inplace string (copy-sequence string))))
2252      (while (> i 0)
2253	(setq i (1- i))
2254	(if (eq (aref newstr i) fromchar) (aset newstr i tochar)))
2255      newstr)))
2256
2257;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
2258(when (and (featurep 'xemacs) (string< itimer-version "1.09")
2259	   (not noninteractive))
2260  (load "itimer")
2261  (when (string< itimer-version "1.09")
2262    (message "WARNING:  Install included `itimer.el' patch first (see INSTALL file)")
2263    (beep) (sit-for 5)))
2264
2265;; `file-expand-wildcards' undefined (XEmacs)
2266(unless (fboundp 'file-expand-wildcards)
2267  (defun file-expand-wildcards (pattern &optional full)
2268    "Taken from Emacs's `files.el'."
2269    (let* ((nondir (file-name-nondirectory pattern))
2270    	   (dirpart (file-name-directory pattern))
2271    	   (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2272		     (mapcar #'file-name-as-directory
2273			     (file-expand-wildcards (directory-file-name dirpart)))
2274		   (list dirpart)))
2275	   contents)
2276      (while dirs
2277	(when (or (null (car dirs))	; Possible if DIRPART is not wild.
2278		  (file-directory-p (directory-file-name (car dirs))))
2279	  (let ((this-dir-contents
2280		 (delq nil
2281		       (mapcar #'(lambda (name)
2282				   (unless (string-match "\\`\\.\\.?\\'"
2283							 (file-name-nondirectory name))
2284				     name))
2285			       (directory-files (or (car dirs) ".") full
2286						(wildcard-to-regexp nondir))))))
2287	    (setq contents
2288		  (nconc
2289		   (if (and (car dirs) (not full))
2290                       (mapcar (lambda (name) (concat (car dirs) name))
2291			       this-dir-contents)
2292		     this-dir-contents)
2293		   contents))))
2294	(setq dirs (cdr dirs)))
2295      contents)))
2296
2297;; `member-ignore-case' undefined (XEmacs)
2298(unless (fboundp 'member-ignore-case)
2299  (defalias 'member-ignore-case #'member))
2300
2301;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
2302;; behavior in XEmacs
2303(defvar vhdl-last-input-event)
2304(if (featurep 'xemacs)
2305    (defvaralias 'vhdl-last-input-event 'last-input-char)
2306  (defvaralias 'vhdl-last-input-event 'last-input-event))
2307
2308;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2309;; Compatibility with older VHDL Mode versions
2310
2311(defvar vhdl-warnings nil
2312  "Warnings to tell the user during start up.")
2313
2314(defun vhdl-run-when-idle (secs repeat function)
2315  "Wait until idle, then run FUNCTION."
2316  (if (fboundp 'start-itimer)
2317      (start-itimer "vhdl-mode" function secs repeat t)
2318    ;; explicitly activate timer (necessary when Emacs is already idle)
2319    (aset (run-with-idle-timer secs repeat function) 0 nil)))
2320
2321(defun vhdl-warning-when-idle (&rest args)
2322  "Wait until idle, then print out warning STRING and beep."
2323  (let ((message (apply #'format-message args)))
2324    (if noninteractive
2325        (vhdl-warning message t)
2326      (unless vhdl-warnings
2327        (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2328      (push message vhdl-warnings))))
2329
2330(defun vhdl-warning (string &optional nobeep)
2331  "Print out warning STRING and beep."
2332  (message "WARNING:  %s" string)
2333  (unless (or nobeep noninteractive) (beep)))
2334
2335(defun vhdl-print-warnings ()
2336  "Print out messages in variable `vhdl-warnings'."
2337  (let ((no-warnings (length vhdl-warnings)))
2338    (setq vhdl-warnings (nreverse vhdl-warnings))
2339    (while vhdl-warnings
2340      (message "WARNING:  %s" (car vhdl-warnings))
2341      (setq vhdl-warnings (cdr vhdl-warnings)))
2342    (beep)
2343    (when (> no-warnings 1)
2344      (message "WARNING:  See warnings in message buffer (type `C-c M-m')."))))
2345
2346;; Backward compatibility checks and fixes
2347;; option `vhdl-compiler' changed format
2348(unless (stringp vhdl-compiler)
2349  (setq vhdl-compiler "ModelSim")
2350  (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2351
2352;; option `vhdl-standard' changed format
2353(unless (listp vhdl-standard)
2354  (setq vhdl-standard '(87 nil))
2355  (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2356
2357;; option `vhdl-model-alist' changed format
2358(when (= (length (car vhdl-model-alist)) 3)
2359  (let ((old-alist vhdl-model-alist)
2360	new-alist)
2361    (while old-alist
2362      (push (append (car old-alist) '("")) new-alist)
2363      (setq old-alist (cdr old-alist)))
2364    (setq vhdl-model-alist (nreverse new-alist)))
2365  (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2366
2367;; option `vhdl-project-alist' changed format
2368(when (= (length (car vhdl-project-alist)) 3)
2369  (let ((old-alist vhdl-project-alist)
2370	new-alist)
2371    (while old-alist
2372      (push (append (car old-alist) '("")) new-alist)
2373      (setq old-alist (cdr old-alist)))
2374    (setq vhdl-project-alist (nreverse new-alist)))
2375  (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2376
2377;; option `vhdl-project-alist' changed format (3.31.1)
2378(when (= (length (car vhdl-project-alist)) 4)
2379  (let ((old-alist vhdl-project-alist)
2380	new-alist elem)
2381    (while old-alist
2382      (setq elem (car old-alist))
2383      (setq new-alist
2384	    (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2385			nil "./" "work" "work/" "Makefile" (nth 3 elem))
2386		  new-alist))
2387      (setq old-alist (cdr old-alist)))
2388    (setq vhdl-project-alist (nreverse new-alist)))
2389  (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2390
2391;; option `vhdl-project-alist' changed format (3.31.12)
2392(when (= (length (car vhdl-project-alist)) 10)
2393  (let ((tmp-alist vhdl-project-alist))
2394    (while tmp-alist
2395      (setcdr (nthcdr 3 (car tmp-alist))
2396	      (cons "" (nthcdr 4 (car tmp-alist))))
2397      (setq tmp-alist (cdr tmp-alist))))
2398  (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2399
2400;; option `vhdl-compiler-alist' changed format (3.31.1)
2401(when (= (length (car vhdl-compiler-alist)) 7)
2402  (let ((old-alist vhdl-compiler-alist)
2403	new-alist elem)
2404    (while old-alist
2405      (setq elem (car old-alist))
2406      (setq new-alist
2407	    (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2408			(if (equal (nth 3 elem) "") nil (nth 3 elem))
2409			(nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2410			(nth 5 elem) (nth 6 elem) nil)
2411		  new-alist))
2412      (setq old-alist (cdr old-alist)))
2413    (setq vhdl-compiler-alist (nreverse new-alist)))
2414  (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2415
2416;; option `vhdl-compiler-alist' changed format (3.31.10)
2417(when (= (length (car vhdl-compiler-alist)) 12)
2418  (let ((tmp-alist vhdl-compiler-alist))
2419    (while tmp-alist
2420      (setcdr (nthcdr 4 (car tmp-alist))
2421	      (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2422      (setq tmp-alist (cdr tmp-alist))))
2423  (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2424
2425;; option `vhdl-compiler-alist' changed format (3.31.11)
2426(when (= (length (car vhdl-compiler-alist)) 13)
2427  (let ((tmp-alist vhdl-compiler-alist))
2428    (while tmp-alist
2429      (setcdr (nthcdr 3 (car tmp-alist))
2430	      (cons "" (nthcdr 4 (car tmp-alist))))
2431      (setq tmp-alist (cdr tmp-alist))))
2432  (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2433
2434;; option `vhdl-compiler-alist' changed format (3.32.7)
2435(when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2436  (let ((tmp-alist vhdl-compiler-alist))
2437    (while tmp-alist
2438      (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2439	      '(0 . nil))
2440      (setq tmp-alist (cdr tmp-alist))))
2441  (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2442
2443;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2444(when (equal vhdl-project "")
2445  (setq vhdl-project nil)
2446  (customize-save-variable 'vhdl-project vhdl-project))
2447
2448;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2449(when (stringp vhdl-project-file-name)
2450  (setq vhdl-project-file-name (list vhdl-project-file-name))
2451  (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2452
2453;; option `speedbar-indentation-width': introduced in speedbar 0.10
2454(if (not (boundp 'speedbar-indentation-width))
2455    (defvar speedbar-indentation-width 2)
2456  ;; set default to 2 if not already customized
2457  (unless (get 'speedbar-indentation-width 'saved-value)
2458    (setq speedbar-indentation-width 2)))
2459
2460;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2461;;; Help functions / inline substitutions / macros
2462;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2463
2464(defun vhdl-standard-p (standard)
2465  "Check if STANDARD is specified as used standard."
2466  (or (eq standard (car vhdl-standard))
2467      (memq standard (cadr vhdl-standard))))
2468
2469(defun vhdl-project-p (&optional warning)
2470  "Return non-nil if a project is displayed, i.e. directories or files are
2471specified."
2472  (if (assoc vhdl-project vhdl-project-alist)
2473      vhdl-project
2474    (when (and vhdl-project warning)
2475      (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2476    nil))
2477
2478(defun vhdl-resolve-env-variable (string)
2479  "Resolve environment variables in STRING."
2480  (while (string-match "\\(.*\\)\\${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2481    (setq string (concat (match-string 1 string)
2482			 (getenv (match-string 2 string))
2483			 (match-string 4 string))))
2484  string)
2485
2486(defun vhdl-default-directory ()
2487  "Return the default directory of the current project or the directory of the
2488current buffer if no project is defined."
2489  (if (vhdl-project-p)
2490      (expand-file-name (vhdl-resolve-env-variable
2491			 (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
2492    default-directory))
2493
2494(defmacro vhdl-prepare-search-1 (&rest body)
2495  "Enable case insensitive search and switch to syntax table that includes `_',
2496then execute BODY, and finally restore the old environment.  Used for
2497consistent searching."
2498  (declare (debug t))
2499  `(let ((case-fold-search t))		; case insensitive search
2500     ;; use extended syntax table
2501     (with-syntax-table vhdl-mode-ext-syntax-table
2502       ,@body)))
2503
2504(defmacro vhdl-prepare-search-2 (&rest body)
2505  "Enable case insensitive search, switch to syntax table that includes `_',
2506arrange to ignore `intangible' overlays, then execute BODY, and finally restore
2507the old environment.  Used for consistent searching."
2508  (declare (debug t))
2509  `(let ((case-fold-search t)		; case insensitive search
2510         (inhibit-point-motion-hooks t))
2511     ;; use extended syntax table
2512     (with-syntax-table vhdl-mode-ext-syntax-table
2513       ;; execute BODY safely
2514       (progn ,@body))))
2515
2516(defmacro vhdl-visit-file (file-name issue-error &rest body)
2517  "Visit file FILE-NAME and execute BODY."
2518  (declare (debug t) (indent 2))
2519  `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body)))
2520
2521(defun vhdl--visit-file (file-name issue-error body-fun)
2522  (if (null file-name)
2523      (funcall body-fun)
2524    (unless (file-directory-p file-name)
2525      (let ((source-buffer (current-buffer))
2526	    (visiting-buffer (find-buffer-visiting file-name))
2527	    file-opened)
2528	(when (or (and visiting-buffer (set-buffer visiting-buffer))
2529		  (condition-case ()
2530		      (progn (set-buffer (create-file-buffer file-name))
2531			     (setq file-opened t)
2532			     (vhdl-insert-file-contents file-name)
2533			     (let ((st (copy-syntax-table (syntax-table))))
2534			       (modify-syntax-entry ?\- ". 12" st)
2535			       (modify-syntax-entry ?\n ">" st)
2536			       (modify-syntax-entry ?\^M ">" st)
2537			       (modify-syntax-entry ?_ "w" st)
2538			       ;; FIXME: We should arguably reset the
2539                               ;; syntax-table after running `body-fun'.
2540			       (set-syntax-table st))
2541			     t)
2542		    (error
2543		     (if issue-error
2544			 (progn
2545			   (when file-opened (kill-buffer (current-buffer)))
2546			   (set-buffer source-buffer)
2547			   (error "ERROR:  File cannot be opened: \"%s\"" file-name))
2548		       (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t)
2549		       nil))))
2550	  (condition-case info
2551	      (funcall body-fun)
2552	    (error
2553	     (if issue-error
2554		 (progn
2555		   (when file-opened (kill-buffer (current-buffer)))
2556		   (set-buffer source-buffer)
2557		   (error (cadr info)))
2558	       (vhdl-warning (cadr info))))))
2559	(when file-opened (kill-buffer (current-buffer)))
2560	(set-buffer source-buffer)))))
2561
2562(defun vhdl-insert-file-contents (filename)
2563  "Nicked from `insert-file-contents-literally', but allow coding system
2564conversion."
2565  (let ((format-alist nil)
2566	(after-insert-file-functions nil)
2567	(jka-compr-compression-info-list nil))
2568    (insert-file-contents filename t)))
2569
2570(defun vhdl-sort-alist (alist)
2571  "Sort ALIST."
2572  (sort alist (lambda (a b) (string< (car a) (car b)))))
2573
2574(defun vhdl-get-subdirs (directory)
2575  "Recursively get subdirectories of DIRECTORY."
2576  (let ((dir-list (list (file-name-as-directory directory)))
2577	file-list)
2578    (setq file-list (vhdl-directory-files directory t "\\w.*"))
2579    (while file-list
2580      (when (file-directory-p (car file-list))
2581	(setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2582      (setq file-list (cdr file-list)))
2583    dir-list))
2584
2585(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
2586  "As `aput', but delete key-value pair if VALUE is nil."
2587  (if value
2588      (vhdl-aput alist-symbol key value)
2589    (vhdl-adelete alist-symbol key)))
2590
2591(defun vhdl-delete (elt list)
2592  "Delete by side effect the first occurrence of ELT as a member of LIST."
2593  (push nil list)
2594  (let ((list1 list))
2595    (while (and (cdr list1) (not (equal elt (cadr list1))))
2596      (setq list1 (cdr list1)))
2597    (when list
2598      (setcdr list1 (cddr list1))))
2599  (cdr list))
2600
2601(declare-function speedbar-refresh "speedbar" (&optional arg))
2602(declare-function speedbar-do-function-pointer "speedbar" ())
2603
2604(defun vhdl-speedbar-refresh (&optional key)
2605  "Refresh directory or project with name KEY."
2606  (when (and (boundp 'speedbar-frame)
2607	     (frame-live-p speedbar-frame))
2608    (let (;; (pos (point))
2609	  (last-frame (selected-frame)))
2610      (if (null key)
2611	  (speedbar-refresh)
2612	(select-frame speedbar-frame)
2613	(when (save-excursion
2614		(goto-char (point-min))
2615		(re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2616	  (goto-char (match-end 1))
2617	  (speedbar-do-function-pointer)
2618	  (backward-char 2)
2619	  (speedbar-do-function-pointer)
2620	  (message "Refreshing speedbar...done"))
2621	(select-frame last-frame)))))
2622
2623(defun vhdl-show-messages ()
2624  "Get *Messages* buffer to show recent messages."
2625  (interactive)
2626  (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*")))
2627
2628(defun vhdl-use-direct-instantiation ()
2629  "Return whether direct instantiation is used."
2630  (or (eq vhdl-use-direct-instantiation 'always)
2631      (and (eq vhdl-use-direct-instantiation 'standard)
2632	   (not (vhdl-standard-p '87)))))
2633
2634(defun vhdl-max-marker (marker1 marker2)
2635  "Return larger marker."
2636  (if (> marker1 marker2) marker1 marker2))
2637
2638(defun vhdl-goto-marker (marker)
2639  "Goto marker in appropriate buffer."
2640  (when (markerp marker)
2641    (set-buffer (marker-buffer marker)))
2642  (goto-char marker))
2643
2644(defun vhdl-menu-split (list title)
2645  "Split menu LIST into several submenus, if number of
2646elements > `vhdl-menu-max-size'."
2647  (if (> (length list) vhdl-menu-max-size)
2648      (let ((remain list)
2649	    (result '())
2650	    (sublist '())
2651	    (menuno 1)
2652	    (i 0))
2653	(while remain
2654	  (push (car remain) sublist)
2655	  (setq remain (cdr remain))
2656	  (setq i (+ i 1))
2657	  (if (= i vhdl-menu-max-size)
2658	      (progn
2659		(push (cons (format "%s %s" title menuno)
2660			    (nreverse sublist)) result)
2661		(setq i 0)
2662		(setq menuno (+ menuno 1))
2663		(setq sublist '()))))
2664	(and sublist
2665	     (push (cons (format "%s %s" title menuno)
2666			 (nreverse sublist)) result))
2667	(nreverse result))
2668    list))
2669
2670
2671;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2672;;; Bindings
2673;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2674
2675;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2676;; Key bindings
2677
2678(defvar vhdl-template-map nil
2679  "Keymap for VHDL templates.")
2680
2681(defun vhdl-template-map-init ()
2682  "Initialize `vhdl-template-map'."
2683  (setq vhdl-template-map (make-sparse-keymap))
2684  ;; key bindings for VHDL templates
2685  (define-key vhdl-template-map "al"	#'vhdl-template-alias)
2686  (define-key vhdl-template-map "ar"	#'vhdl-template-architecture)
2687  (define-key vhdl-template-map "at"	#'vhdl-template-assert)
2688  (define-key vhdl-template-map "ad"	#'vhdl-template-attribute-decl)
2689  (define-key vhdl-template-map "as"	#'vhdl-template-attribute-spec)
2690  (define-key vhdl-template-map "bl"	#'vhdl-template-block)
2691  (define-key vhdl-template-map "ca"	#'vhdl-template-case-is)
2692  (define-key vhdl-template-map "cd"	#'vhdl-template-component-decl)
2693  (define-key vhdl-template-map "ci"	#'vhdl-template-component-inst)
2694  (define-key vhdl-template-map "cs"	#'vhdl-template-conditional-signal-asst)
2695  (define-key vhdl-template-map "Cb"	#'vhdl-template-block-configuration)
2696  (define-key vhdl-template-map "Cc"	#'vhdl-template-component-conf)
2697  (define-key vhdl-template-map "Cd"	#'vhdl-template-configuration-decl)
2698  (define-key vhdl-template-map "Cs"	#'vhdl-template-configuration-spec)
2699  (define-key vhdl-template-map "co"	#'vhdl-template-constant)
2700  (define-key vhdl-template-map "ct"	#'vhdl-template-context)
2701  (define-key vhdl-template-map "di"	#'vhdl-template-disconnect)
2702  (define-key vhdl-template-map "el"	#'vhdl-template-else)
2703  (define-key vhdl-template-map "ei"	#'vhdl-template-elsif)
2704  (define-key vhdl-template-map "en"	#'vhdl-template-entity)
2705  (define-key vhdl-template-map "ex"	#'vhdl-template-exit)
2706  (define-key vhdl-template-map "fi"	#'vhdl-template-file)
2707  (define-key vhdl-template-map "fg"	#'vhdl-template-for-generate)
2708  (define-key vhdl-template-map "fl"	#'vhdl-template-for-loop)
2709  (define-key vhdl-template-map "\C-f"	#'vhdl-template-footer)
2710  (define-key vhdl-template-map "fb"	#'vhdl-template-function-body)
2711  (define-key vhdl-template-map "fd"	#'vhdl-template-function-decl)
2712  (define-key vhdl-template-map "ge"	#'vhdl-template-generic)
2713  (define-key vhdl-template-map "gd"	#'vhdl-template-group-decl)
2714  (define-key vhdl-template-map "gt"	#'vhdl-template-group-template)
2715  (define-key vhdl-template-map "\C-h"	#'vhdl-template-header)
2716  (define-key vhdl-template-map "ig"	#'vhdl-template-if-generate)
2717  (define-key vhdl-template-map "it"	#'vhdl-template-if-then)
2718  (define-key vhdl-template-map "li"	#'vhdl-template-library)
2719  (define-key vhdl-template-map "lo"	#'vhdl-template-bare-loop)
2720  (define-key vhdl-template-map "\C-m"	#'vhdl-template-modify)
2721  (define-key vhdl-template-map "\C-t"	#'vhdl-template-insert-date)
2722  (define-key vhdl-template-map "ma"	#'vhdl-template-map)
2723  (define-key vhdl-template-map "ne"	#'vhdl-template-next)
2724  (define-key vhdl-template-map "ot"	#'vhdl-template-others)
2725  (define-key vhdl-template-map "Pd"	#'vhdl-template-package-decl)
2726  (define-key vhdl-template-map "Pb"	#'vhdl-template-package-body)
2727  (define-key vhdl-template-map "("     #'vhdl-template-paired-parens)
2728  (define-key vhdl-template-map "po"	#'vhdl-template-port)
2729  (define-key vhdl-template-map "pb"	#'vhdl-template-procedure-body)
2730  (define-key vhdl-template-map "pd"	#'vhdl-template-procedure-decl)
2731  (define-key vhdl-template-map "pc"	#'vhdl-template-process-comb)
2732  (define-key vhdl-template-map "ps"	#'vhdl-template-process-seq)
2733  (define-key vhdl-template-map "rp"	#'vhdl-template-report)
2734  (define-key vhdl-template-map "rt"	#'vhdl-template-return)
2735  (define-key vhdl-template-map "ss"	#'vhdl-template-selected-signal-asst)
2736  (define-key vhdl-template-map "si"	#'vhdl-template-signal)
2737  (define-key vhdl-template-map "su"	#'vhdl-template-subtype)
2738  (define-key vhdl-template-map "ty"	#'vhdl-template-type)
2739  (define-key vhdl-template-map "us"	#'vhdl-template-use)
2740  (define-key vhdl-template-map "va"	#'vhdl-template-variable)
2741  (define-key vhdl-template-map "wa"	#'vhdl-template-wait)
2742  (define-key vhdl-template-map "wl"	#'vhdl-template-while-loop)
2743  (define-key vhdl-template-map "wi"	#'vhdl-template-with)
2744  (define-key vhdl-template-map "wc"	#'vhdl-template-clocked-wait)
2745  (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit)
2746  (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std)
2747  (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164)
2748  (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith)
2749  (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc)
2750  (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed)
2751  (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio)
2752  (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned)
2753  (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio)
2754  (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on)
2755  (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off)
2756  (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on)
2757  (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off)
2758  (define-key vhdl-template-map "\C-q"  #'vhdl-template-search-prompt)
2759  (when (vhdl-standard-p 'ams)
2760    (define-key vhdl-template-map "br"	#'vhdl-template-break)
2761    (define-key vhdl-template-map "cu"	#'vhdl-template-case-use)
2762    (define-key vhdl-template-map "iu"	#'vhdl-template-if-use)
2763    (define-key vhdl-template-map "lm"	#'vhdl-template-limit)
2764    (define-key vhdl-template-map "na"	#'vhdl-template-nature)
2765    (define-key vhdl-template-map "pa"	#'vhdl-template-procedural)
2766    (define-key vhdl-template-map "qf"	#'vhdl-template-quantity-free)
2767    (define-key vhdl-template-map "qb"	#'vhdl-template-quantity-branch)
2768    (define-key vhdl-template-map "qs"	#'vhdl-template-quantity-source)
2769    (define-key vhdl-template-map "sn"	#'vhdl-template-subnature)
2770    (define-key vhdl-template-map "te"	#'vhdl-template-terminal)
2771    )
2772  (when (vhdl-standard-p 'math)
2773    (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex)
2774    (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real)
2775    ))
2776
2777;; initialize template map for VHDL Mode
2778(vhdl-template-map-init)
2779
2780(defun vhdl-function-name (prefix string &optional postfix)
2781  "Generate a Lisp function name.
2782PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in
2783STRING are replaced by `-' and substrings are converted to lower case."
2784  (let ((name prefix))
2785    (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
2786      (setq name
2787	    (concat name "-" (downcase (substring string 0 (match-end 1)))))
2788      (setq string (substring string (match-beginning 2))))
2789    (when postfix (setq name (concat name "-" postfix)))
2790    (intern name)))
2791
2792(defvar vhdl-model-map nil
2793  "Keymap for VHDL models.")
2794
2795(defun vhdl-model-map-init ()
2796  "Initialize `vhdl-model-map'."
2797  (setq vhdl-model-map (make-sparse-keymap))
2798  ;; key bindings for VHDL models
2799  (let ((model-alist vhdl-model-alist) model)
2800    (while model-alist
2801      (setq model (car model-alist))
2802      (define-key vhdl-model-map (nth 2 model)
2803	(vhdl-function-name "vhdl-model" (nth 0 model)))
2804      (setq model-alist (cdr model-alist)))))
2805
2806;; initialize user model map for VHDL Mode
2807(vhdl-model-map-init)
2808
2809(defvar vhdl-mode-map nil
2810  "Keymap for VHDL Mode.")
2811
2812(defun vhdl-mode-map-init ()
2813  "Initialize `vhdl-mode-map'."
2814  (setq vhdl-mode-map (make-sparse-keymap))
2815  ;; template key bindings
2816  (define-key vhdl-mode-map "\C-c\C-t"	   vhdl-template-map)
2817  ;; model key bindings
2818  (define-key vhdl-mode-map "\C-c\C-m"	   vhdl-model-map)
2819  ;; standard key bindings
2820  (define-key vhdl-mode-map "\M-a"	   #'vhdl-beginning-of-statement)
2821  (define-key vhdl-mode-map "\M-e"	   #'vhdl-end-of-statement)
2822  (define-key vhdl-mode-map "\M-\C-f"	   #'vhdl-forward-sexp)
2823  (define-key vhdl-mode-map "\M-\C-b"	   #'vhdl-backward-sexp)
2824  (define-key vhdl-mode-map "\M-\C-u"	   #'vhdl-backward-up-list)
2825  (define-key vhdl-mode-map "\M-\C-a"	   #'vhdl-backward-same-indent)
2826  (define-key vhdl-mode-map "\M-\C-e"	   #'vhdl-forward-same-indent)
2827  (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
2828    (define-key vhdl-mode-map "\M-\C-h"	   #'vhdl-mark-defun))
2829  (define-key vhdl-mode-map "\M-\C-q"	   #'vhdl-indent-sexp)
2830  (define-key vhdl-mode-map "\M-^"	   #'vhdl-delete-indentation)
2831  ;; mode specific key bindings
2832  (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode)
2833  (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode)
2834  (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project)
2835  (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project)
2836  (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project)
2837  (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project)
2838  (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler)
2839  (define-key vhdl-mode-map "\C-c\C-k"	   #'vhdl-compile)
2840  (define-key vhdl-mode-map "\C-c\M-\C-k"  #'vhdl-make)
2841  (define-key vhdl-mode-map "\C-c\M-k"	   #'vhdl-generate-makefile)
2842  (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy)
2843  (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy)
2844  (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity)
2845  (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component)
2846  (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance)
2847  (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals)
2848  (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants)
2849  (define-key vhdl-mode-map
2850    ;; `... C-g' not allowed in XEmacs.
2851    (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g")
2852    #'vhdl-port-paste-generic-map)
2853  (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations)
2854  (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench)
2855  (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten)
2856  (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction)
2857  (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy)
2858  (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy)
2859  (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration)
2860  (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body)
2861  (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call)
2862  (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten)
2863  (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component)
2864  (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component)
2865  (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components)
2866  (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration)
2867  (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package)
2868  (define-key vhdl-mode-map "\C-c\C-c"	   #'vhdl-comment-uncomment-region)
2869  (define-key vhdl-mode-map "\C-c-"	   #'vhdl-comment-append-inline)
2870  (define-key vhdl-mode-map "\C-c\M--"	   #'vhdl-comment-display-line)
2871  (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode)
2872  (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group)
2873  (define-key vhdl-mode-map "\M-\C-\\"	   #'indent-region)
2874  (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer)
2875  (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group)
2876  (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group)
2877  (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent)
2878  (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list)
2879  (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations)
2880  (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region)
2881  (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer)
2882  (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group)
2883  (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region)
2884  (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list)
2885  (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list)
2886  (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group)
2887  (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent)
2888  (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region)
2889  (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill)
2890  (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy)
2891  (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank)
2892  (define-key vhdl-mode-map "\C-c\C-l\t"   #'vhdl-line-expand)
2893  (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next)
2894  (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous)
2895  (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open)
2896  (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line)
2897  (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line)
2898  (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region)
2899  (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer)
2900  (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause)
2901  (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region)
2902  (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer)
2903  (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region)
2904  (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer)
2905  (define-key vhdl-mode-map "\C-c\M-b"	   #'vhdl-beautify-region)
2906  (define-key vhdl-mode-map "\C-c\C-b"	   #'vhdl-beautify-buffer)
2907  (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process)
2908  (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer)
2909  (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer)
2910  (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer)
2911  (define-key vhdl-mode-map "\C-c\M-m"	   #'vhdl-show-messages)
2912  (define-key vhdl-mode-map "\C-c\C-h"	   #'vhdl-doc-mode)
2913  (define-key vhdl-mode-map "\C-c\C-v"	   #'vhdl-version)
2914  (define-key vhdl-mode-map "\M-\t"	   #'insert-tab)
2915  ;; insert commands bindings
2916  (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct)
2917  (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package)
2918  (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive)
2919  (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert)
2920  ;; electric key bindings
2921  (define-key vhdl-mode-map " "		   #'vhdl-electric-space)
2922  (when vhdl-intelligent-tab
2923    (define-key vhdl-mode-map "\t"	   #'vhdl-electric-tab))
2924  (define-key vhdl-mode-map "\r"	   #'vhdl-electric-return)
2925  (define-key vhdl-mode-map "-"		   #'vhdl-electric-dash)
2926  (define-key vhdl-mode-map "["		   #'vhdl-electric-open-bracket)
2927  (define-key vhdl-mode-map "]"		   #'vhdl-electric-close-bracket)
2928  (define-key vhdl-mode-map "'"		   #'vhdl-electric-quote)
2929  (define-key vhdl-mode-map ";"		   #'vhdl-electric-semicolon)
2930  (define-key vhdl-mode-map ","		   #'vhdl-electric-comma)
2931  (define-key vhdl-mode-map "."		   #'vhdl-electric-period)
2932  (when (vhdl-standard-p 'ams)
2933    (define-key vhdl-mode-map "="	   #'vhdl-electric-equal)))
2934
2935;; initialize mode map for VHDL Mode
2936(vhdl-mode-map-init)
2937
2938;; define special minibuffer keymap for enabling word completion in minibuffer
2939;; (useful in template generator prompts)
2940(defvar vhdl-minibuffer-local-map
2941  (let ((map (make-sparse-keymap)))
2942    (set-keymap-parent map minibuffer-local-map)
2943    (when vhdl-word-completion-in-minibuffer
2944      (define-key map "\t" #'vhdl-minibuffer-tab))
2945    map)
2946  "Keymap for minibuffer used in VHDL Mode.")
2947
2948;; set up electric character functions to work with
2949;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2950(mapc
2951 (lambda (sym)
2952   (put sym 'delete-selection t)	; for `delete-selection-mode' (Emacs)
2953   (put sym 'pending-delete t))	; for `pending-delete-mode' (XEmacs)
2954 '(vhdl-electric-space
2955   vhdl-electric-tab
2956   vhdl-electric-return
2957   vhdl-electric-dash
2958   vhdl-electric-open-bracket
2959   vhdl-electric-close-bracket
2960   vhdl-electric-quote
2961   vhdl-electric-semicolon
2962   vhdl-electric-comma
2963   vhdl-electric-period
2964   vhdl-electric-equal))
2965
2966;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2967;; Syntax table
2968
2969(defvar vhdl-mode-syntax-table
2970  (let ((st (make-syntax-table)))
2971    ;; define punctuation
2972    (modify-syntax-entry ?\# "."    st)
2973    (modify-syntax-entry ?\$ "."    st)
2974    (modify-syntax-entry ?\% "."    st)
2975    (modify-syntax-entry ?\& "."    st)
2976    (modify-syntax-entry ?\' "."    st)
2977    (modify-syntax-entry ?\* "."    st)
2978    (modify-syntax-entry ?\+ "."    st)
2979    (modify-syntax-entry ?\. "."    st)
2980;;;    (modify-syntax-entry ?\/ "."    st)
2981    (modify-syntax-entry ?\: "."    st)
2982    (modify-syntax-entry ?\; "."    st)
2983    (modify-syntax-entry ?\< "."    st)
2984    (modify-syntax-entry ?\= "."    st)
2985    (modify-syntax-entry ?\> "."    st)
2986    (modify-syntax-entry ?\\ "."    st)
2987    (modify-syntax-entry ?\| "."    st)
2988    ;; define string
2989    (modify-syntax-entry ?\" "\""   st)
2990    ;; define underscore
2991    (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
2992    ;; single-line comments
2993    (modify-syntax-entry ?\- ". 12b" st)
2994    ;; multi-line comments
2995    (modify-syntax-entry ?\/ ". 14b" st)
2996    (modify-syntax-entry ?*  ". 23" st)
2997    (modify-syntax-entry ?\n "> b"  st)
2998    (modify-syntax-entry ?\^M "> b"   st)
2999    ;; define parentheses to match
3000    (modify-syntax-entry ?\( "()"   st)
3001    (modify-syntax-entry ?\) ")("   st)
3002    (modify-syntax-entry ?\[ "(]"   st)
3003    (modify-syntax-entry ?\] ")["   st)
3004    (modify-syntax-entry ?\{ "(}"   st)
3005    (modify-syntax-entry ?\} "){"   st)
3006    st)
3007  "Syntax table used in `vhdl-mode' buffers.")
3008
3009(defvar vhdl-mode-ext-syntax-table
3010  ;; Extended syntax table including '_' (for simpler search regexps).
3011  (let ((st (copy-syntax-table vhdl-mode-syntax-table)))
3012    (modify-syntax-entry ?_ "w" st)
3013    st)
3014  "Syntax table extended by `_' used in `vhdl-mode' buffers.")
3015
3016(defvar vhdl-syntactic-context nil
3017  "Buffer local variable containing syntactic analysis list.")
3018(make-variable-buffer-local 'vhdl-syntactic-context)
3019
3020;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3021;; Abbrev hook bindings
3022
3023(defvar vhdl-mode-abbrev-table nil
3024  "Abbrev table to use in `vhdl-mode' buffers.")
3025
3026(defun vhdl-mode-abbrev-table-init ()
3027  "Initialize `vhdl-mode-abbrev-table'."
3028  (define-abbrev-table 'vhdl-mode-abbrev-table
3029    (append
3030     (when (memq 'vhdl vhdl-electric-keywords)
3031       ;; VHDL'02 keywords
3032       (mapcar (if (featurep 'xemacs)
3033 		   (lambda (x) (list (car x) "" (cdr x) 0))
3034		 (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3035               '(
3036                 ("--"		  . vhdl-template-display-comment-hook)
3037                 ("abs"		  . vhdl-template-default-hook)
3038                 ("access"	  . vhdl-template-default-hook)
3039                 ("after"	  . vhdl-template-default-hook)
3040                 ("alias"	  . vhdl-template-alias-hook)
3041                 ("all"		  . vhdl-template-default-hook)
3042                 ("and"		  . vhdl-template-default-hook)
3043                 ("arch"	  . vhdl-template-architecture-hook)
3044                 ("architecture"  . vhdl-template-architecture-hook)
3045                 ("array"	  . vhdl-template-default-hook)
3046                 ("assert"	  . vhdl-template-assert-hook)
3047                 ("attr"	  . vhdl-template-attribute-hook)
3048                 ("attribute"	  . vhdl-template-attribute-hook)
3049                 ("begin"	  . vhdl-template-default-indent-hook)
3050                 ("block"	  . vhdl-template-block-hook)
3051                 ("body"	  . vhdl-template-default-hook)
3052                 ("buffer"	  . vhdl-template-default-hook)
3053                 ("bus"		  . vhdl-template-default-hook)
3054                 ("case"	  . vhdl-template-case-hook)
3055                 ("comp"	  . vhdl-template-component-hook)
3056                 ("component"	  . vhdl-template-component-hook)
3057                 ("cond"	  . vhdl-template-conditional-signal-asst-hook)
3058                 ("conditional"	  . vhdl-template-conditional-signal-asst-hook)
3059                 ("conf"	  . vhdl-template-configuration-hook)
3060                 ("configuration" . vhdl-template-configuration-hook)
3061                 ("cons"	  . vhdl-template-constant-hook)
3062                 ("constant"	  . vhdl-template-constant-hook)
3063                 ("context"	  . vhdl-template-context-hook)
3064                 ("disconnect"	  . vhdl-template-disconnect-hook)
3065                 ("downto"	  . vhdl-template-default-hook)
3066                 ("else"	  . vhdl-template-else-hook)
3067                 ("elseif"	  . vhdl-template-elsif-hook)
3068                 ("elsif"	  . vhdl-template-elsif-hook)
3069                 ("end"		  . vhdl-template-default-indent-hook)
3070                 ("entity"	  . vhdl-template-entity-hook)
3071                 ("exit"	  . vhdl-template-exit-hook)
3072                 ("file"	  . vhdl-template-file-hook)
3073                 ("for"		  . vhdl-template-for-hook)
3074                 ("func"	  . vhdl-template-function-hook)
3075                 ("function"	  . vhdl-template-function-hook)
3076                 ("generic"	  . vhdl-template-generic-hook)
3077                 ("group"	  . vhdl-template-group-hook)
3078                 ("guarded"	  . vhdl-template-default-hook)
3079                 ("if"		  . vhdl-template-if-hook)
3080                 ("impure"	  . vhdl-template-default-hook)
3081                 ("in"		  . vhdl-template-default-hook)
3082                 ("inertial"	  . vhdl-template-default-hook)
3083                 ("inout"	  . vhdl-template-default-hook)
3084                 ("inst"	  . vhdl-template-instance-hook)
3085                 ("instance"	  . vhdl-template-instance-hook)
3086                 ("is"		  . vhdl-template-default-hook)
3087                 ("label"	  . vhdl-template-default-hook)
3088                 ("library"	  . vhdl-template-library-hook)
3089                 ("linkage"	  . vhdl-template-default-hook)
3090                 ("literal"	  . vhdl-template-default-hook)
3091                 ("loop"	  . vhdl-template-bare-loop-hook)
3092                 ("map"		  . vhdl-template-map-hook)
3093                 ("mod"		  . vhdl-template-default-hook)
3094                 ("nand"	  . vhdl-template-default-hook)
3095                 ("new"		  . vhdl-template-default-hook)
3096                 ("next"	  . vhdl-template-next-hook)
3097                 ("nor"		  . vhdl-template-default-hook)
3098                 ("not"		  . vhdl-template-default-hook)
3099                 ("null"	  . vhdl-template-default-hook)
3100                 ("of"		  . vhdl-template-default-hook)
3101                 ("on"		  . vhdl-template-default-hook)
3102                 ("open"	  . vhdl-template-default-hook)
3103                 ("or"		  . vhdl-template-default-hook)
3104                 ("others"	  . vhdl-template-others-hook)
3105                 ("out"		  . vhdl-template-default-hook)
3106                 ("pack"	  . vhdl-template-package-hook)
3107                 ("package"	  . vhdl-template-package-hook)
3108                 ("port"	  . vhdl-template-port-hook)
3109                 ("postponed"	  . vhdl-template-default-hook)
3110                 ("procedure"	  . vhdl-template-procedure-hook)
3111                 ("process"	  . vhdl-template-process-hook)
3112                 ("pure"	  . vhdl-template-default-hook)
3113                 ("range"	  . vhdl-template-default-hook)
3114                 ("record"	  . vhdl-template-default-hook)
3115                 ("register"	  . vhdl-template-default-hook)
3116                 ("reject"	  . vhdl-template-default-hook)
3117                 ("rem"		  . vhdl-template-default-hook)
3118                 ("report"	  . vhdl-template-report-hook)
3119                 ("return"	  . vhdl-template-return-hook)
3120                 ("rol"		  . vhdl-template-default-hook)
3121                 ("ror"		  . vhdl-template-default-hook)
3122                 ("select"	  . vhdl-template-selected-signal-asst-hook)
3123                 ("severity"	  . vhdl-template-default-hook)
3124                 ("shared"	  . vhdl-template-default-hook)
3125                 ("sig"		  . vhdl-template-signal-hook)
3126                 ("signal"	  . vhdl-template-signal-hook)
3127                 ("sla"		  . vhdl-template-default-hook)
3128                 ("sll"		  . vhdl-template-default-hook)
3129                 ("sra"		  . vhdl-template-default-hook)
3130                 ("srl"		  . vhdl-template-default-hook)
3131                 ("subtype"	  . vhdl-template-subtype-hook)
3132                 ("then"	  . vhdl-template-default-hook)
3133                 ("to"		  . vhdl-template-default-hook)
3134                 ("transport"	  . vhdl-template-default-hook)
3135                 ("type"	  . vhdl-template-type-hook)
3136                 ("unaffected"	  . vhdl-template-default-hook)
3137                 ("units"	  . vhdl-template-default-hook)
3138                 ("until"	  . vhdl-template-default-hook)
3139                 ("use"		  . vhdl-template-use-hook)
3140                 ("var"		  . vhdl-template-variable-hook)
3141                 ("variable"	  . vhdl-template-variable-hook)
3142                 ("wait"	  . vhdl-template-wait-hook)
3143                 ("when"	  . vhdl-template-when-hook)
3144                 ("while"	  . vhdl-template-while-loop-hook)
3145                 ("with"	  . vhdl-template-with-hook)
3146                 ("xnor"	  . vhdl-template-default-hook)
3147                 ("xor"		  . vhdl-template-default-hook)
3148                 )))
3149     ;; VHDL-AMS keywords
3150     (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
3151       (mapcar (if (featurep 'xemacs)
3152		   (lambda (x) (list (car x) "" (cdr x) 0))
3153		 (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3154               '(
3155                 ("across"     . vhdl-template-default-hook)
3156                 ("break"      . vhdl-template-break-hook)
3157                 ("limit"      . vhdl-template-limit-hook)
3158                 ("nature"     . vhdl-template-nature-hook)
3159                 ("noise"      . vhdl-template-default-hook)
3160                 ("procedural" . vhdl-template-procedural-hook)
3161                 ("quantity"   . vhdl-template-quantity-hook)
3162                 ("reference"  . vhdl-template-default-hook)
3163                 ("spectrum"   . vhdl-template-default-hook)
3164                 ("subnature"  . vhdl-template-subnature-hook)
3165                 ("terminal"   . vhdl-template-terminal-hook)
3166                 ("through"    . vhdl-template-default-hook)
3167                 ("tolerance"  . vhdl-template-default-hook)
3168                 )))
3169     ;; user model keywords
3170     (when (memq 'user vhdl-electric-keywords)
3171       (let (abbrev-list keyword)
3172         (dolist (elem vhdl-model-alist)
3173	   (setq keyword (nth 3 elem))
3174	   (unless (equal keyword "")
3175             (push (list keyword ""
3176                         (vhdl-function-name
3177                          "vhdl-model" (nth 0 elem) "hook")
3178                         0 'system)
3179                   abbrev-list)))
3180	 abbrev-list)))))
3181
3182;; initialize abbrev table for VHDL Mode
3183(vhdl-mode-abbrev-table-init)
3184
3185;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3186;; Template completion lists
3187
3188(defvar vhdl-template-construct-alist nil
3189  "List of built-in construct templates.")
3190
3191(defun vhdl-template-construct-alist-init ()
3192  "Initialize `vhdl-template-construct-alist'."
3193  (setq
3194   vhdl-template-construct-alist
3195   (append
3196    '(
3197      ("alias declaration"		   vhdl-template-alias)
3198      ("architecture body"		   vhdl-template-architecture)
3199      ("assertion"			   vhdl-template-assert)
3200      ("attribute declaration"		   vhdl-template-attribute-decl)
3201      ("attribute specification"	   vhdl-template-attribute-spec)
3202      ("block configuration"		   vhdl-template-block-configuration)
3203      ("block statement"		   vhdl-template-block)
3204      ("case statement"			   vhdl-template-case-is)
3205      ("component configuration"	   vhdl-template-component-conf)
3206      ("component declaration"		   vhdl-template-component-decl)
3207      ("component instantiation statement" vhdl-template-component-inst)
3208      ("conditional signal assignment"	   vhdl-template-conditional-signal-asst)
3209      ("configuration declaration"	   vhdl-template-configuration-decl)
3210      ("configuration specification" 	   vhdl-template-configuration-spec)
3211      ("constant declaration"		   vhdl-template-constant)
3212      ("context declaration"		   vhdl-template-context)
3213      ("disconnection specification"	   vhdl-template-disconnect)
3214      ("entity declaration"		   vhdl-template-entity)
3215      ("exit statement"			   vhdl-template-exit)
3216      ("file declaration"		   vhdl-template-file)
3217      ("generate statement"		   vhdl-template-generate)
3218      ("generic clause"			   vhdl-template-generic)
3219      ("group declaration"		   vhdl-template-group-decl)
3220      ("group template declaration" 	   vhdl-template-group-template)
3221      ("if statement"			   vhdl-template-if-then)
3222      ("library clause"			   vhdl-template-library)
3223      ("loop statement"			   vhdl-template-loop)
3224      ("next statement"			   vhdl-template-next)
3225      ("package declaration"		   vhdl-template-package-decl)
3226      ("package body"			   vhdl-template-package-body)
3227      ("port clause"			   vhdl-template-port)
3228      ("process statement"	 	   vhdl-template-process)
3229      ("report statement"		   vhdl-template-report)
3230      ("return statement"		   vhdl-template-return)
3231      ("selected signal assignment"	   vhdl-template-selected-signal-asst)
3232      ("signal declaration"		   vhdl-template-signal)
3233      ("subprogram declaration"		   vhdl-template-subprogram-decl)
3234      ("subprogram body"		   vhdl-template-subprogram-body)
3235      ("subtype declaration"		   vhdl-template-subtype)
3236      ("type declaration"		   vhdl-template-type)
3237      ("use clause"			   vhdl-template-use)
3238      ("variable declaration"	 	   vhdl-template-variable)
3239      ("wait statement"			   vhdl-template-wait)
3240      )
3241    (when (vhdl-standard-p 'ams)
3242      '(
3243	("break statement"		     vhdl-template-break)
3244	("nature declaration"		     vhdl-template-nature)
3245	("quantity declaration"		     vhdl-template-quantity)
3246	("simultaneous case statement"	     vhdl-template-case-use)
3247	("simultaneous if statement"	     vhdl-template-if-use)
3248	("simultaneous procedural statement" vhdl-template-procedural)
3249	("step limit specification"	     vhdl-template-limit)
3250	("subnature declaration"	     vhdl-template-subnature)
3251	("terminal declaration"		     vhdl-template-terminal)
3252	)))))
3253
3254;; initialize for VHDL Mode
3255(vhdl-template-construct-alist-init)
3256
3257(defvar vhdl-template-package-alist nil
3258  "List of built-in package templates.")
3259
3260(defun vhdl-template-package-alist-init ()
3261  "Initialize `vhdl-template-package-alist'."
3262  (setq
3263   vhdl-template-package-alist
3264   (append
3265    '(
3266      ("numeric_bit"	    vhdl-template-package-numeric-bit)
3267      ("numeric_std"	    vhdl-template-package-numeric-std)
3268      ("std_logic_1164"	    vhdl-template-package-std-logic-1164)
3269      ("std_logic_arith"    vhdl-template-package-std-logic-arith)
3270      ("std_logic_misc"     vhdl-template-package-std-logic-misc)
3271      ("std_logic_signed"   vhdl-template-package-std-logic-signed)
3272      ("std_logic_textio"   vhdl-template-package-std-logic-textio)
3273      ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned)
3274      ("textio"		    vhdl-template-package-textio)
3275      )
3276    (when (vhdl-standard-p 'math)
3277      '(
3278	("math_complex"	vhdl-template-package-math-complex)
3279	("math_real"	vhdl-template-package-math-real)
3280	)))))
3281
3282;; initialize for VHDL Mode
3283(vhdl-template-package-alist-init)
3284
3285(defvar vhdl-template-directive-alist
3286  '(
3287    ("translate_on"	vhdl-template-directive-translate-on)
3288    ("translate_off"	vhdl-template-directive-translate-off)
3289    ("synthesis_on"	vhdl-template-directive-synthesis-on)
3290    ("synthesis_off"	vhdl-template-directive-synthesis-off)
3291    )
3292  "List of built-in directive templates.")
3293
3294
3295;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3296;;; Menus
3297;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3298
3299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3300;; VHDL menu (using `easy-menu.el')
3301
3302(defun vhdl-customize ()
3303  "Call the customize function with `vhdl' as argument."
3304  (interactive)
3305  (customize-browse 'vhdl))
3306
3307(defun vhdl-create-mode-menu ()
3308  "Create VHDL Mode menu."
3309  `("VHDL"
3310    ,(append
3311      '("Project"
3312	["None"			(vhdl-set-project "")
3313				:style radio :selected (null vhdl-project)]
3314	"--")
3315      ;; add menu entries for defined projects
3316      (let ((project-alist vhdl-project-alist) menu-list name)
3317	(while project-alist
3318	  (setq name (caar project-alist))
3319	  (setq menu-list
3320		(cons `[,name (vhdl-set-project ,name)
3321			:style radio :selected (equal ,name vhdl-project)]
3322		      menu-list))
3323	  (setq project-alist (cdr project-alist)))
3324	(setq menu-list
3325	      (if vhdl-project-sort
3326		  (sort menu-list
3327                        (lambda (a b) (string< (elt a 0) (elt b 0))))
3328		(nreverse menu-list)))
3329	(vhdl-menu-split menu-list "Project"))
3330      '("--" "--"
3331	["Select Project..."	vhdl-set-project t]
3332	["Set As Default Project" vhdl-set-default-project t]
3333	"--"
3334	["Duplicate Project"	vhdl-duplicate-project vhdl-project]
3335	["Import Project..."	vhdl-import-project
3336				:keys "C-c C-p C-m" :active t]
3337	["Export Project"	vhdl-export-project vhdl-project]
3338	"--"
3339	["Customize Project..." (customize-option 'vhdl-project-alist) t]))
3340    "--"
3341    ("Compile"
3342     ["Compile Buffer"		vhdl-compile t]
3343     ["Stop Compilation"	kill-compilation t]
3344     "--"
3345     ["Make"			vhdl-make t]
3346     ["Generate Makefile"	vhdl-generate-makefile t]
3347     "--"
3348     ["Next Error"		next-error t]
3349     ["Previous Error"		previous-error t]
3350     ["First Error"		first-error t]
3351     "--"
3352     ,(append
3353       '("Compiler")
3354       ;; add menu entries for defined compilers
3355       (let ((comp-alist vhdl-compiler-alist) menu-list name)
3356	 (while comp-alist
3357	   (setq name (caar comp-alist))
3358	   (setq menu-list
3359		 (cons `[,name (setq vhdl-compiler ,name)
3360			 :style radio :selected (equal ,name vhdl-compiler)]
3361		       menu-list))
3362	   (setq comp-alist (cdr comp-alist)))
3363	 (setq menu-list (nreverse menu-list))
3364	 (vhdl-menu-split menu-list "Compiler"))
3365       '("--" "--"
3366	 ["Select Compiler..."	vhdl-set-compiler t]
3367	 "--"
3368	 ["Customize Compiler..."
3369	  (customize-option 'vhdl-compiler-alist) t])))
3370    "--"
3371    ,(append
3372      '("Template"
3373	("VHDL Construct 1"
3374	 ["Alias"		vhdl-template-alias t]
3375	 ["Architecture"	vhdl-template-architecture t]
3376	 ["Assert"		vhdl-template-assert t]
3377	 ["Attribute (Decl)"	vhdl-template-attribute-decl t]
3378	 ["Attribute (Spec)"	vhdl-template-attribute-spec t]
3379	 ["Block"		vhdl-template-block t]
3380	 ["Case"		vhdl-template-case-is t]
3381	 ["Component (Decl)"	vhdl-template-component-decl t]
3382	 ["(Component) Instance"	vhdl-template-component-inst t]
3383	 ["Conditional (Signal Asst)"	vhdl-template-conditional-signal-asst t]
3384	 ["Configuration (Block)"	vhdl-template-block-configuration t]
3385	 ["Configuration (Comp)"	vhdl-template-component-conf t]
3386	 ["Configuration (Decl)"	vhdl-template-configuration-decl t]
3387	 ["Configuration (Spec)"	vhdl-template-configuration-spec t]
3388	 ["Constant"		vhdl-template-constant t]
3389	 ["Context"		vhdl-template-context t]
3390	 ["Disconnect"		vhdl-template-disconnect t]
3391	 ["Else"		vhdl-template-else t]
3392	 ["Elsif"		vhdl-template-elsif t]
3393	 ["Entity"		vhdl-template-entity t]
3394	 ["Exit"		vhdl-template-exit t]
3395	 ["File"		vhdl-template-file t]
3396	 ["For (Generate)"	vhdl-template-for-generate t]
3397	 ["For (Loop)"		vhdl-template-for-loop t]
3398	 ["Function (Body)"	vhdl-template-function-body t]
3399	 ["Function (Decl)"	vhdl-template-function-decl t]
3400	 ["Generic"		vhdl-template-generic t]
3401	 ["Group (Decl)"	vhdl-template-group-decl t]
3402	 ["Group (Template)"	vhdl-template-group-template t])
3403	("VHDL Construct 2"
3404	 ["If (Generate)"	vhdl-template-if-generate t]
3405	 ["If (Then)"		vhdl-template-if-then t]
3406	 ["Library"		vhdl-template-library t]
3407	 ["Loop"		vhdl-template-bare-loop t]
3408	 ["Map"			vhdl-template-map t]
3409	 ["Next"		vhdl-template-next t]
3410	 ["Others (Aggregate)"	vhdl-template-others t]
3411	 ["Package (Decl)"	vhdl-template-package-decl t]
3412	 ["Package (Body)"	vhdl-template-package-body t]
3413	 ["Port"		vhdl-template-port t]
3414	 ["Procedure (Body)"	vhdl-template-procedure-body t]
3415	 ["Procedure (Decl)"	vhdl-template-procedure-decl t]
3416	 ["Process (Comb)"	vhdl-template-process-comb t]
3417	 ["Process (Seq)"	vhdl-template-process-seq t]
3418	 ["Report"		vhdl-template-report t]
3419	 ["Return"		vhdl-template-return t]
3420	 ["Select"		vhdl-template-selected-signal-asst t]
3421	 ["Signal"		vhdl-template-signal t]
3422	 ["Subtype"		vhdl-template-subtype t]
3423	 ["Type"		vhdl-template-type t]
3424	 ["Use"			vhdl-template-use t]
3425	 ["Variable"		vhdl-template-variable t]
3426	 ["Wait"		vhdl-template-wait t]
3427	 ["(Clocked Wait)"	vhdl-template-clocked-wait t]
3428	 ["When"		vhdl-template-when t]
3429	 ["While (Loop)"	vhdl-template-while-loop t]
3430	 ["With"		vhdl-template-with t]))
3431      (when (vhdl-standard-p 'ams)
3432	'(("VHDL-AMS Construct"
3433	   ["Break"		vhdl-template-break t]
3434	   ["Case (Use)"	vhdl-template-case-use t]
3435	   ["If (Use)"		vhdl-template-if-use t]
3436	   ["Limit"		vhdl-template-limit t]
3437	   ["Nature"		vhdl-template-nature t]
3438	   ["Procedural"	vhdl-template-procedural t]
3439	   ["Quantity (Free)"	vhdl-template-quantity-free t]
3440	   ["Quantity (Branch)"	vhdl-template-quantity-branch t]
3441	   ["Quantity (Source)"	vhdl-template-quantity-source t]
3442	   ["Subnature"		vhdl-template-subnature t]
3443	   ["Terminal"		vhdl-template-terminal t])))
3444      '(["Insert Construct..."	vhdl-template-insert-construct
3445				:keys "C-c C-i C-t"]
3446	"--")
3447      (list
3448       (append
3449	'("Package")
3450	'(["numeric_bit"	vhdl-template-package-numeric-bit t]
3451	  ["numeric_std"	vhdl-template-package-numeric-std t]
3452	  ["std_logic_1164"	vhdl-template-package-std-logic-1164 t]
3453	  ["textio"		vhdl-template-package-textio t]
3454	  "--"
3455	  ["std_logic_arith"	vhdl-template-package-std-logic-arith t]
3456	  ["std_logic_signed"	vhdl-template-package-std-logic-signed t]
3457	  ["std_logic_unsigned"	vhdl-template-package-std-logic-unsigned t]
3458	  ["std_logic_misc"	vhdl-template-package-std-logic-misc t]
3459	  ["std_logic_textio"	vhdl-template-package-std-logic-textio t]
3460	  "--")
3461	(when (vhdl-standard-p 'ams)
3462	  '(["fundamental_constants" vhdl-template-package-fundamental-constants t]
3463	    ["material_constants" vhdl-template-package-material-constants t]
3464	    ["energy_systems"	vhdl-template-package-energy-systems t]
3465	    ["electrical_systems" vhdl-template-package-electrical-systems t]
3466	    ["mechanical_systems" vhdl-template-package-mechanical-systems t]
3467	    ["radiant_systems"	vhdl-template-package-radiant-systems t]
3468	    ["thermal_systems"	vhdl-template-package-thermal-systems t]
3469	    ["fluidic_systems"	vhdl-template-package-fluidic-systems t]
3470	    "--"))
3471	(when (vhdl-standard-p 'math)
3472	  '(["math_complex"	vhdl-template-package-math-complex t]
3473	    ["math_real"	vhdl-template-package-math-real t]
3474	    "--"))
3475	'(["Insert Package..."	vhdl-template-insert-package
3476				:keys "C-c C-i C-p"])))
3477      '(("Directive"
3478	 ["translate_on"	vhdl-template-directive-translate-on t]
3479	 ["translate_off"	vhdl-template-directive-translate-off t]
3480	 ["synthesis_on"	vhdl-template-directive-synthesis-on t]
3481	 ["synthesis_off"	vhdl-template-directive-synthesis-off t]
3482	 "--"
3483	 ["Insert Directive..."	vhdl-template-insert-directive
3484				:keys "C-c C-i C-d"])
3485	"--"
3486	["Insert Header"	vhdl-template-header :keys "C-c C-t C-h"]
3487	["Insert Footer"	vhdl-template-footer t]
3488	["Insert Date"		vhdl-template-insert-date t]
3489	["Modify Date"		vhdl-template-modify :keys "C-c C-t C-m"]
3490	"--"
3491	["Query Next Prompt"	vhdl-template-search-prompt t]))
3492    ,(append
3493      '("Model")
3494      ;; add menu entries for defined models
3495      (let ((model-alist vhdl-model-alist) menu-list model)
3496	(while model-alist
3497	  (setq model (car model-alist))
3498	  (setq menu-list
3499		(cons
3500		 (vector
3501		  (nth 0 model)
3502		  (vhdl-function-name "vhdl-model" (nth 0 model))
3503		  :keys (concat "C-c C-m " (key-description (nth 2 model))))
3504		 menu-list))
3505	  (setq model-alist (cdr model-alist)))
3506	(setq menu-list (nreverse menu-list))
3507	(vhdl-menu-split menu-list "Model"))
3508      '("--" "--"
3509	["Insert Model..."	vhdl-model-insert :keys "C-c C-i C-m"]
3510	["Customize Model..."	(customize-option 'vhdl-model-alist) t]))
3511    ("Port"
3512     ["Copy"			vhdl-port-copy t]
3513     "--"
3514     ["Paste As Entity"		vhdl-port-paste-entity vhdl-port-list]
3515     ["Paste As Component"	vhdl-port-paste-component vhdl-port-list]
3516     ["Paste As Instance"	vhdl-port-paste-instance
3517				:keys "C-c C-p C-i" :active vhdl-port-list]
3518     ["Paste As Signals"	vhdl-port-paste-signals vhdl-port-list]
3519     ["Paste As Constants"	vhdl-port-paste-constants vhdl-port-list]
3520     ["Paste As Generic Map"	vhdl-port-paste-generic-map vhdl-port-list]
3521     ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3522     "--"
3523     ["Paste As Testbench"	vhdl-port-paste-testbench vhdl-port-list]
3524     "--"
3525     ["Flatten"			vhdl-port-flatten
3526      :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3527     ["Reverse Direction"	vhdl-port-reverse-direction
3528      :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3529    ("Compose"
3530     ["New Component"		vhdl-compose-new-component t]
3531     ["Copy Component"		vhdl-port-copy t]
3532     ["Place Component"		vhdl-compose-place-component vhdl-port-list]
3533     ["Wire Components"		vhdl-compose-wire-components t]
3534     "--"
3535     ["Generate Configuration"	vhdl-compose-configuration t]
3536     ["Generate Components Package"	vhdl-compose-components-package t])
3537    ("Subprogram"
3538     ["Copy"			vhdl-subprog-copy t]
3539     "--"
3540     ["Paste As Declaration"	vhdl-subprog-paste-declaration vhdl-subprog-list]
3541     ["Paste As Body"		vhdl-subprog-paste-body vhdl-subprog-list]
3542     ["Paste As Call"		vhdl-subprog-paste-call vhdl-subprog-list]
3543     "--"
3544     ["Flatten"			vhdl-subprog-flatten
3545      :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3546    "--"
3547    ("Comment"
3548     ["(Un)Comment Out Region"	vhdl-comment-uncomment-region (mark)]
3549     "--"
3550     ["Insert Inline Comment"	vhdl-comment-append-inline t]
3551     ["Insert Horizontal Line"	vhdl-comment-display-line t]
3552     ["Insert Display Comment"	vhdl-comment-display t]
3553     "--"
3554     ["Fill Comment"		fill-paragraph t]
3555     ["Fill Comment Region"	fill-region (mark)]
3556     ["Kill Comment Region"	vhdl-comment-kill-region (mark)]
3557     ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3558    ("Line"
3559     ["Kill"			vhdl-line-kill t]
3560     ["Copy"			vhdl-line-copy t]
3561     ["Yank"			vhdl-line-yank t]
3562     ["Expand"			vhdl-line-expand t]
3563     "--"
3564     ["Transpose Next"		vhdl-line-transpose-next t]
3565     ["Transpose Prev"		vhdl-line-transpose-previous t]
3566     ["Open"			vhdl-line-open t]
3567     ["Join"			vhdl-delete-indentation t]
3568     "--"
3569     ["Goto"			goto-line t]
3570     ["(Un)Comment Out"		vhdl-comment-uncomment-line t])
3571    ("Move"
3572     ["Forward Statement"	vhdl-end-of-statement t]
3573     ["Backward Statement"	vhdl-beginning-of-statement t]
3574     ["Forward Expression"	vhdl-forward-sexp t]
3575     ["Backward Expression"	vhdl-backward-sexp t]
3576     ["Forward Same Indent"	vhdl-forward-same-indent t]
3577     ["Backward Same Indent"	vhdl-backward-same-indent t]
3578     ["Forward Function"	vhdl-end-of-defun t]
3579     ["Backward Function"	vhdl-beginning-of-defun t]
3580     ["Mark Function"		vhdl-mark-defun t])
3581    "--"
3582    ("Indent"
3583     ["Line"			indent-according-to-mode :keys "C-c C-i C-l"]
3584     ["Group"			vhdl-indent-group :keys "C-c C-i C-g"]
3585     ["Region"			indent-region (mark)]
3586     ["Buffer"			vhdl-indent-buffer :keys "C-c C-i C-b"])
3587    ("Align"
3588     ["Group"			vhdl-align-group t]
3589     ["Same Indent"		vhdl-align-same-indent :keys "C-c C-a C-i"]
3590     ["List"			vhdl-align-list t]
3591     ["Declarations"		vhdl-align-declarations t]
3592     ["Region"			vhdl-align-region (mark)]
3593     ["Buffer"			vhdl-align-buffer t]
3594     "--"
3595     ["Inline Comment Group"	vhdl-align-inline-comment-group t]
3596     ["Inline Comment Region"	vhdl-align-inline-comment-region (mark)]
3597     ["Inline Comment Buffer"	vhdl-align-inline-comment-buffer t])
3598    ("Fill"
3599     ["List"			vhdl-fill-list t]
3600     ["Group"			vhdl-fill-group t]
3601     ["Same Indent"		vhdl-fill-same-indent :keys "C-c C-f C-i"]
3602     ["Region"			vhdl-fill-region (mark)])
3603    ("Beautify"
3604     ["Region"			vhdl-beautify-region (mark)]
3605     ["Buffer"			vhdl-beautify-buffer t])
3606    ("Fix"
3607     ["Generic/Port Clause"	vhdl-fix-clause t]
3608     ["Generic/Port Clause Buffer" vhdl-fix-clause t]
3609     "--"
3610     ["Case Region"		vhdl-fix-case-region (mark)]
3611     ["Case Buffer"		vhdl-fix-case-buffer t]
3612     "--"
3613     ["Whitespace Region"	vhdl-fixup-whitespace-region (mark)]
3614     ["Whitespace Buffer"	vhdl-fixup-whitespace-buffer t]
3615     "--"
3616     ["Statement Region"	vhdl-fix-statement-region (mark)]
3617     ["Statement Buffer"	vhdl-fix-statement-buffer t]
3618     "--"
3619     ["Trailing Spaces Buffer"	vhdl-remove-trailing-spaces t])
3620    ("Update"
3621     ["Sensitivity List"	vhdl-update-sensitivity-list-process t]
3622     ["Sensitivity List Buffer"	vhdl-update-sensitivity-list-buffer t])
3623    "--"
3624    ["Fontify Buffer"		vhdl-fontify-buffer t]
3625    ["Statistics Buffer"	vhdl-statistics-buffer t]
3626    ["Show Messages"		vhdl-show-messages t]
3627    ["Syntactic Info"		vhdl-show-syntactic-information t]
3628    "--"
3629    ["Speedbar"			vhdl-speedbar t]
3630    ["Hide/Show"		vhdl-hs-minor-mode t]
3631    "--"
3632    ("Documentation"
3633     ["VHDL Mode"		vhdl-doc-mode :keys "C-c C-h"]
3634     ["Release Notes"		(vhdl-doc-variable 'vhdl-doc-release-notes) t]
3635     ["Reserved Words"		(vhdl-doc-variable 'vhdl-doc-keywords) t]
3636     ["Coding Style"		(vhdl-doc-variable 'vhdl-doc-coding-style) t])
3637    ["Version"			vhdl-version t]
3638    ["Bug Report..."		vhdl-submit-bug-report t]
3639    "--"
3640    ("Options"
3641     ("Mode"
3642      ["Electric Mode"
3643       (progn (customize-set-variable 'vhdl-electric-mode
3644				      (not vhdl-electric-mode))
3645	      (vhdl-mode-line-update))
3646       :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3647      ["Stutter Mode"
3648       (progn (customize-set-variable 'vhdl-stutter-mode
3649				      (not vhdl-stutter-mode))
3650	      (vhdl-mode-line-update))
3651       :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3652      ["Indent Tabs Mode"
3653       (progn (customize-set-variable 'vhdl-indent-tabs-mode
3654				      (not vhdl-indent-tabs-mode))
3655	      (setq indent-tabs-mode vhdl-indent-tabs-mode))
3656       :style toggle :selected vhdl-indent-tabs-mode]
3657      "--"
3658      ["Customize Group..." (customize-group 'vhdl-mode) t])
3659     ("Project"
3660      ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3661      ,(append
3662	'("Selected Project at Startup"
3663	  ["None" (progn (customize-set-variable 'vhdl-project nil)
3664			 (vhdl-set-project ""))
3665	   :style radio :selected (null vhdl-project)]
3666	  "--")
3667	;; add menu entries for defined projects
3668	(let ((project-alist vhdl-project-alist) menu-list name)
3669	  (while project-alist
3670	    (setq name (caar project-alist))
3671	    (setq menu-list
3672		  (cons `[,name (progn (customize-set-variable
3673					'vhdl-project ,name)
3674				       (vhdl-set-project ,name))
3675			  :style radio :selected (equal ,name vhdl-project)]
3676			menu-list))
3677	    (setq project-alist (cdr project-alist)))
3678	  (setq menu-list (nreverse menu-list))
3679	  (vhdl-menu-split menu-list "Project")))
3680      ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3681      ("Auto Load Setup File"
3682       ["At Startup"
3683	(customize-set-variable 'vhdl-project-autoload
3684				(if (memq 'startup vhdl-project-autoload)
3685				   (delq 'startup vhdl-project-autoload)
3686				 (cons 'startup vhdl-project-autoload)))
3687       :style toggle :selected (memq 'startup vhdl-project-autoload)])
3688      ["Sort Projects"
3689       (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3690       :style toggle :selected vhdl-project-sort]
3691      "--"
3692      ["Customize Group..." (customize-group 'vhdl-project) t])
3693     ("Compiler"
3694      ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3695      ,(append
3696	'("Selected Compiler at Startup")
3697	;; add menu entries for defined compilers
3698	(let ((comp-alist vhdl-compiler-alist) menu-list name)
3699	  (while comp-alist
3700	    (setq name (caar comp-alist))
3701	    (setq menu-list
3702		  (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3703			  :style radio :selected (equal ,name vhdl-compiler)]
3704			menu-list))
3705	    (setq comp-alist (cdr comp-alist)))
3706	  (setq menu-list (nreverse menu-list))
3707	  (vhdl-menu-split menu-list "Compiler")))
3708      ["Use Local Error Regexp"
3709       (customize-set-variable 'vhdl-compile-use-local-error-regexp
3710			       (not vhdl-compile-use-local-error-regexp))
3711       :style toggle :selected vhdl-compile-use-local-error-regexp]
3712      ["Makefile Default Targets..."
3713       (customize-option 'vhdl-makefile-default-targets) t]
3714      ["Makefile Generation Hook..."
3715       (customize-option 'vhdl-makefile-generation-hook) t]
3716      ["Default Library Name" (customize-option 'vhdl-default-library) t]
3717      "--"
3718      ["Customize Group..." (customize-group 'vhdl-compiler) t])
3719     ("Style"
3720      ("VHDL Standard"
3721       ["VHDL'87"
3722	(progn (customize-set-variable 'vhdl-standard
3723				       (list '87 (cadr vhdl-standard)))
3724	       (vhdl-activate-customizations))
3725	:style radio :selected (eq '87 (car vhdl-standard))]
3726       ["VHDL'93/02"
3727	(progn (customize-set-variable 'vhdl-standard
3728				       (list '93 (cadr vhdl-standard)))
3729	       (vhdl-activate-customizations))
3730	:style radio :selected (eq '93 (car vhdl-standard))]
3731       ["VHDL'08"
3732	(progn (customize-set-variable 'vhdl-standard
3733				       (list '08 (cadr vhdl-standard)))
3734	       (vhdl-activate-customizations))
3735	:style radio :selected (eq '08 (car vhdl-standard))]
3736       "--"
3737       ["VHDL-AMS"
3738	(progn (customize-set-variable
3739		'vhdl-standard (list (car vhdl-standard)
3740				     (if (memq 'ams (cadr vhdl-standard))
3741					 (delq 'ams (cadr vhdl-standard))
3742				       (cons 'ams (cadr vhdl-standard)))))
3743	       (vhdl-activate-customizations))
3744	:style toggle :selected (memq 'ams (cadr vhdl-standard))]
3745       ["Math Packages"
3746	(progn (customize-set-variable
3747		'vhdl-standard (list (car vhdl-standard)
3748				     (if (memq 'math (cadr vhdl-standard))
3749					 (delq 'math (cadr vhdl-standard))
3750				       (cons 'math (cadr vhdl-standard)))))
3751	       (vhdl-activate-customizations))
3752	:style toggle :selected (memq 'math (cadr vhdl-standard))])
3753      ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3754      ["Upper Case Keywords"
3755       (customize-set-variable 'vhdl-upper-case-keywords
3756			       (not vhdl-upper-case-keywords))
3757       :style toggle :selected vhdl-upper-case-keywords]
3758      ["Upper Case Types"
3759       (customize-set-variable 'vhdl-upper-case-types
3760			       (not vhdl-upper-case-types))
3761       :style toggle :selected vhdl-upper-case-types]
3762      ["Upper Case Attributes"
3763       (customize-set-variable 'vhdl-upper-case-attributes
3764			       (not vhdl-upper-case-attributes))
3765       :style toggle :selected vhdl-upper-case-attributes]
3766      ["Upper Case Enumeration Values"
3767       (customize-set-variable 'vhdl-upper-case-enum-values
3768			       (not vhdl-upper-case-enum-values))
3769       :style toggle :selected vhdl-upper-case-enum-values]
3770      ["Upper Case Constants"
3771       (customize-set-variable 'vhdl-upper-case-constants
3772			       (not vhdl-upper-case-constants))
3773       :style toggle :selected vhdl-upper-case-constants]
3774      ("Use Direct Instantiation"
3775       ["Never"
3776	(customize-set-variable 'vhdl-use-direct-instantiation 'never)
3777	:style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3778       ["Standard"
3779	(customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3780	:style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3781       ["Always"
3782	(customize-set-variable 'vhdl-use-direct-instantiation 'always)
3783	:style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3784      ["Include Array Index and Record Field in Sensitivity List"
3785       (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
3786			       (not vhdl-array-index-record-field-in-sensitivity-list))
3787       :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list]
3788      "--"
3789      ["Customize Group..." (customize-group 'vhdl-style) t])
3790     ("Naming"
3791      ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3792      ["Architecture File Name..."
3793       (customize-option 'vhdl-architecture-file-name) t]
3794      ["Configuration File Name..."
3795       (customize-option 'vhdl-configuration-file-name) t]
3796      ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3797      ("File Name Case"
3798       ["As Is"
3799	(customize-set-variable 'vhdl-file-name-case 'identity)
3800	:style radio :selected (eq 'identity vhdl-file-name-case)]
3801       ["Lower Case"
3802	(customize-set-variable 'vhdl-file-name-case 'downcase)
3803	:style radio :selected (eq 'downcase vhdl-file-name-case)]
3804       ["Upper Case"
3805	(customize-set-variable 'vhdl-file-name-case 'upcase)
3806	:style radio :selected (eq 'upcase vhdl-file-name-case)]
3807       ["Capitalize"
3808	(customize-set-variable 'vhdl-file-name-case 'capitalize)
3809	:style radio :selected (eq 'capitalize vhdl-file-name-case)])
3810      "--"
3811      ["Customize Group..." (customize-group 'vhdl-naming) t])
3812     ("Template"
3813      ("Electric Keywords"
3814       ["VHDL Keywords"
3815	(customize-set-variable 'vhdl-electric-keywords
3816				(if (memq 'vhdl vhdl-electric-keywords)
3817				    (delq 'vhdl vhdl-electric-keywords)
3818				  (cons 'vhdl vhdl-electric-keywords)))
3819	:style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3820       ["User Model Keywords"
3821	(customize-set-variable 'vhdl-electric-keywords
3822				(if (memq 'user vhdl-electric-keywords)
3823				     (delq 'user vhdl-electric-keywords)
3824				   (cons 'user vhdl-electric-keywords)))
3825	:style toggle :selected (memq 'user vhdl-electric-keywords)])
3826      ("Insert Optional Labels"
3827       ["None"
3828	(customize-set-variable 'vhdl-optional-labels 'none)
3829	:style radio :selected (eq 'none vhdl-optional-labels)]
3830       ["Processes Only"
3831	(customize-set-variable 'vhdl-optional-labels 'process)
3832	:style radio :selected (eq 'process vhdl-optional-labels)]
3833       ["All Constructs"
3834	(customize-set-variable 'vhdl-optional-labels 'all)
3835	:style radio :selected (eq 'all vhdl-optional-labels)])
3836      ("Insert Empty Lines"
3837       ["None"
3838	(customize-set-variable 'vhdl-insert-empty-lines 'none)
3839	:style radio :selected (eq 'none vhdl-insert-empty-lines)]
3840       ["Design Units Only"
3841	(customize-set-variable 'vhdl-insert-empty-lines 'unit)
3842	:style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3843       ["All Constructs"
3844	(customize-set-variable 'vhdl-insert-empty-lines 'all)
3845	:style radio :selected (eq 'all vhdl-insert-empty-lines)])
3846      ["Argument List Indent"
3847       (customize-set-variable 'vhdl-argument-list-indent
3848			       (not vhdl-argument-list-indent))
3849       :style toggle :selected vhdl-argument-list-indent]
3850      ["Association List with Formals"
3851       (customize-set-variable 'vhdl-association-list-with-formals
3852			       (not vhdl-association-list-with-formals))
3853       :style toggle :selected vhdl-association-list-with-formals]
3854      ["Conditions in Parenthesis"
3855       (customize-set-variable 'vhdl-conditions-in-parenthesis
3856			       (not vhdl-conditions-in-parenthesis))
3857       :style toggle :selected vhdl-conditions-in-parenthesis]
3858      ["Sensitivity List uses 'all'"
3859       (customize-set-variable 'vhdl-sensitivity-list-all
3860			       (not vhdl-sensitivity-list-all))
3861       :style toggle :selected vhdl-sensitivity-list-all]
3862      ["Zero String..." (customize-option 'vhdl-zero-string) t]
3863      ["One String..." (customize-option 'vhdl-one-string) t]
3864      ("File Header"
3865       ["Header String..." (customize-option 'vhdl-file-header) t]
3866       ["Footer String..." (customize-option 'vhdl-file-footer) t]
3867       ["Company Name..." (customize-option 'vhdl-company-name) t]
3868       ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3869       ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3870       ["Date Format..." (customize-option 'vhdl-date-format) t]
3871       ["Modify Date Prefix String..."
3872	(customize-option 'vhdl-modify-date-prefix-string) t]
3873       ["Modify Date on Saving"
3874	(progn (customize-set-variable 'vhdl-modify-date-on-saving
3875				       (not vhdl-modify-date-on-saving))
3876	       (vhdl-activate-customizations))
3877	:style toggle :selected vhdl-modify-date-on-saving])
3878      ("Sequential Process"
3879       ("Kind of Reset"
3880	["None"
3881	 (customize-set-variable 'vhdl-reset-kind 'none)
3882	 :style radio :selected (eq 'none vhdl-reset-kind)]
3883	["Synchronous"
3884	 (customize-set-variable 'vhdl-reset-kind 'sync)
3885	 :style radio :selected (eq 'sync vhdl-reset-kind)]
3886	["Asynchronous"
3887	 (customize-set-variable 'vhdl-reset-kind 'async)
3888	 :style radio :selected (eq 'async vhdl-reset-kind)]
3889	["Query"
3890	 (customize-set-variable 'vhdl-reset-kind 'query)
3891	 :style radio :selected (eq 'query vhdl-reset-kind)])
3892       ["Reset is Active High"
3893	(customize-set-variable 'vhdl-reset-active-high
3894				(not vhdl-reset-active-high))
3895	:style toggle :selected vhdl-reset-active-high]
3896       ["Use Rising Clock Edge"
3897	(customize-set-variable 'vhdl-clock-rising-edge
3898				(not vhdl-clock-rising-edge))
3899	:style toggle :selected vhdl-clock-rising-edge]
3900       ("Clock Edge Condition"
3901	["Standard"
3902	 (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3903	 :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3904	["Function \"rising_edge\""
3905	 (customize-set-variable 'vhdl-clock-edge-condition 'function)
3906	 :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3907       ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3908       ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3909      "--"
3910      ["Customize Group..." (customize-group 'vhdl-template) t])
3911     ("Model"
3912      ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3913     ("Port"
3914      ["Include Port Comments"
3915       (customize-set-variable 'vhdl-include-port-comments
3916			       (not vhdl-include-port-comments))
3917       :style toggle :selected vhdl-include-port-comments]
3918      ["Include Direction Comments"
3919       (customize-set-variable 'vhdl-include-direction-comments
3920			       (not vhdl-include-direction-comments))
3921       :style toggle :selected vhdl-include-direction-comments]
3922      ["Include Type Comments"
3923       (customize-set-variable 'vhdl-include-type-comments
3924			       (not vhdl-include-type-comments))
3925       :style toggle :selected vhdl-include-type-comments]
3926      ("Include Group Comments"
3927       ["Never"
3928	(customize-set-variable 'vhdl-include-group-comments 'never)
3929	:style radio :selected (eq 'never vhdl-include-group-comments)]
3930       ["Declarations"
3931	(customize-set-variable 'vhdl-include-group-comments 'decl)
3932	:style radio :selected (eq 'decl vhdl-include-group-comments)]
3933       ["Always"
3934	(customize-set-variable 'vhdl-include-group-comments 'always)
3935	:style radio :selected (eq 'always vhdl-include-group-comments)])
3936      ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t]
3937      ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3938      ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3939      ("Testbench"
3940       ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3941       ["Architecture Name..."
3942	(customize-option 'vhdl-testbench-architecture-name) t]
3943       ["Configuration Name..."
3944	(customize-option 'vhdl-testbench-configuration-name) t]
3945       ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3946       ["Include Header"
3947	(customize-set-variable 'vhdl-testbench-include-header
3948				(not vhdl-testbench-include-header))
3949	:style toggle :selected vhdl-testbench-include-header]
3950       ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3951       ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3952       ["Initialize Signals"
3953	(customize-set-variable 'vhdl-testbench-initialize-signals
3954				(not vhdl-testbench-initialize-signals))
3955	:style toggle :selected vhdl-testbench-initialize-signals]
3956       ["Include Library Clause"
3957	(customize-set-variable 'vhdl-testbench-include-library
3958				(not vhdl-testbench-include-library))
3959	:style toggle :selected vhdl-testbench-include-library]
3960       ["Include Configuration"
3961	(customize-set-variable 'vhdl-testbench-include-configuration
3962				(not vhdl-testbench-include-configuration))
3963	:style toggle :selected vhdl-testbench-include-configuration]
3964       ("Create Files"
3965	["None"
3966	 (customize-set-variable 'vhdl-testbench-create-files 'none)
3967	 :style radio :selected (eq 'none vhdl-testbench-create-files)]
3968	["Single"
3969	 (customize-set-variable 'vhdl-testbench-create-files 'single)
3970	 :style radio :selected (eq 'single vhdl-testbench-create-files)]
3971	["Separate"
3972	 (customize-set-variable 'vhdl-testbench-create-files 'separate)
3973	 :style radio :selected (eq 'separate vhdl-testbench-create-files)])
3974       ["Testbench Entity File Name..."
3975	(customize-option 'vhdl-testbench-entity-file-name) t]
3976       ["Testbench Architecture File Name..."
3977	(customize-option 'vhdl-testbench-architecture-file-name) t])
3978      "--"
3979      ["Customize Group..." (customize-group 'vhdl-port) t])
3980     ("Compose"
3981      ["Architecture Name..."
3982       (customize-option 'vhdl-compose-architecture-name) t]
3983      ["Configuration Name..."
3984       (customize-option 'vhdl-compose-configuration-name) t]
3985      ["Components Package Name..."
3986       (customize-option 'vhdl-components-package-name) t]
3987      ["Use Components Package"
3988       (customize-set-variable 'vhdl-use-components-package
3989			       (not vhdl-use-components-package))
3990       :style toggle :selected vhdl-use-components-package]
3991      ["Include Header"
3992       (customize-set-variable 'vhdl-compose-include-header
3993			       (not vhdl-compose-include-header))
3994       :style toggle :selected vhdl-compose-include-header]
3995      ("Create Entity/Architecture Files"
3996       ["None"
3997	(customize-set-variable 'vhdl-compose-create-files 'none)
3998	:style radio :selected (eq 'none vhdl-compose-create-files)]
3999       ["Single"
4000	(customize-set-variable 'vhdl-compose-create-files 'single)
4001	:style radio :selected (eq 'single vhdl-compose-create-files)]
4002       ["Separate"
4003	(customize-set-variable 'vhdl-compose-create-files 'separate)
4004	:style radio :selected (eq 'separate vhdl-compose-create-files)])
4005      ["Create Configuration File"
4006       (customize-set-variable 'vhdl-compose-configuration-create-file
4007			       (not vhdl-compose-configuration-create-file))
4008       :style toggle :selected vhdl-compose-configuration-create-file]
4009      ["Hierarchical Configuration"
4010       (customize-set-variable 'vhdl-compose-configuration-hierarchical
4011			       (not vhdl-compose-configuration-hierarchical))
4012       :style toggle :selected vhdl-compose-configuration-hierarchical]
4013      ["Use Subconfiguration"
4014       (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration
4015			       (not vhdl-compose-configuration-use-subconfiguration))
4016       :style toggle :selected vhdl-compose-configuration-use-subconfiguration]
4017      "--"
4018      ["Customize Group..." (customize-group 'vhdl-compose) t])
4019     ("Comment"
4020      ["Self Insert Comments"
4021       (customize-set-variable 'vhdl-self-insert-comments
4022			       (not vhdl-self-insert-comments))
4023       :style toggle :selected vhdl-self-insert-comments]
4024      ["Prompt for Comments"
4025       (customize-set-variable 'vhdl-prompt-for-comments
4026			       (not vhdl-prompt-for-comments))
4027       :style toggle :selected vhdl-prompt-for-comments]
4028      ["Inline Comment Column..."
4029       (customize-option 'vhdl-inline-comment-column) t]
4030      ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
4031      "--"
4032      ["Customize Group..." (customize-group 'vhdl-comment) t])
4033     ("Beautify"
4034      ["Auto Align Templates"
4035       (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
4036       :style toggle :selected vhdl-auto-align]
4037      ["Align Line Groups"
4038       (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
4039       :style toggle :selected vhdl-align-groups]
4040      ["Group Separation String..."
4041       (customize-option 'vhdl-align-group-separate) t]
4042      ["Align Lines with Same Indent"
4043       (customize-set-variable 'vhdl-align-same-indent
4044			       (not vhdl-align-same-indent))
4045       :style toggle :selected vhdl-align-same-indent]
4046      ["Beautify Options..." (customize-option 'vhdl-beautify-options) t]
4047      "--"
4048      ["Customize Group..." (customize-group 'vhdl-beautify) t])
4049     ("Highlight"
4050      ["Highlighting On/Off..."
4051       (customize-option
4052	(if (fboundp 'global-font-lock-mode)
4053	    'global-font-lock-mode 'font-lock-auto-fontify)) t]
4054      ["Highlight Keywords"
4055       (progn (customize-set-variable 'vhdl-highlight-keywords
4056				      (not vhdl-highlight-keywords))
4057	      (vhdl-fontify-buffer))
4058       :style toggle :selected vhdl-highlight-keywords]
4059      ["Highlight Names"
4060       (progn (customize-set-variable 'vhdl-highlight-names
4061				      (not vhdl-highlight-names))
4062	      (vhdl-fontify-buffer))
4063       :style toggle :selected vhdl-highlight-names]
4064      ["Highlight Special Words"
4065       (progn (customize-set-variable 'vhdl-highlight-special-words
4066				      (not vhdl-highlight-special-words))
4067	      (vhdl-fontify-buffer))
4068       :style toggle :selected vhdl-highlight-special-words]
4069      ["Highlight Forbidden Words"
4070       (progn (customize-set-variable 'vhdl-highlight-forbidden-words
4071				      (not vhdl-highlight-forbidden-words))
4072	      (vhdl-fontify-buffer))
4073       :style toggle :selected vhdl-highlight-forbidden-words]
4074      ["Highlight Verilog Keywords"
4075       (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
4076				      (not vhdl-highlight-verilog-keywords))
4077	      (vhdl-fontify-buffer))
4078       :style toggle :selected vhdl-highlight-verilog-keywords]
4079      ["Highlight \"translate_off\""
4080       (progn (customize-set-variable 'vhdl-highlight-translate-off
4081				      (not vhdl-highlight-translate-off))
4082	      (vhdl-fontify-buffer))
4083       :style toggle :selected vhdl-highlight-translate-off]
4084      ["Case Sensitive Highlighting"
4085       (progn (customize-set-variable 'vhdl-highlight-case-sensitive
4086				      (not vhdl-highlight-case-sensitive))
4087	      (vhdl-fontify-buffer))
4088       :style toggle :selected vhdl-highlight-case-sensitive]
4089      ["Special Syntax Definition..."
4090       (customize-option 'vhdl-special-syntax-alist) t]
4091      ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
4092      ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
4093      ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
4094      ["Colors..." (customize-group 'vhdl-highlight-faces) t]
4095      "--"
4096      ["Customize Group..." (customize-group 'vhdl-highlight) t])
4097     ("Speedbar"
4098      ["Auto Open at Startup"
4099       (customize-set-variable 'vhdl-speedbar-auto-open
4100			       (not vhdl-speedbar-auto-open))
4101       :style toggle :selected vhdl-speedbar-auto-open]
4102      ("Default Displaying Mode"
4103       ["Files"
4104	(customize-set-variable 'vhdl-speedbar-display-mode 'files)
4105	:style radio :selected (eq 'files vhdl-speedbar-display-mode)]
4106       ["Directory Hierarchy"
4107	(customize-set-variable 'vhdl-speedbar-display-mode 'directory)
4108	:style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
4109       ["Project Hierarchy"
4110	(customize-set-variable 'vhdl-speedbar-display-mode 'project)
4111	:style radio :selected (eq 'project vhdl-speedbar-display-mode)])
4112      ["Indentation Offset..."
4113       (customize-option 'speedbar-indentation-width) t]
4114      ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
4115      ["Jump to Unit when Opening"
4116       (customize-set-variable 'vhdl-speedbar-jump-to-unit
4117			       (not vhdl-speedbar-jump-to-unit))
4118       :style toggle :selected vhdl-speedbar-jump-to-unit]
4119      ["Update Hierarchy on File Saving"
4120       (customize-set-variable 'vhdl-speedbar-update-on-saving
4121			       (not vhdl-speedbar-update-on-saving))
4122       :style toggle :selected vhdl-speedbar-update-on-saving]
4123      ("Save in Cache File"
4124       ["Hierarchy Information"
4125	(customize-set-variable 'vhdl-speedbar-save-cache
4126				(if (memq 'hierarchy vhdl-speedbar-save-cache)
4127				    (delq 'hierarchy vhdl-speedbar-save-cache)
4128				  (cons 'hierarchy vhdl-speedbar-save-cache)))
4129	:style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
4130       ["Displaying Status"
4131	(customize-set-variable 'vhdl-speedbar-save-cache
4132				(if (memq 'display vhdl-speedbar-save-cache)
4133				    (delq 'display vhdl-speedbar-save-cache)
4134				  (cons 'display vhdl-speedbar-save-cache)))
4135	:style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
4136      ["Cache File Name..."
4137       (customize-option 'vhdl-speedbar-cache-file-name) t]
4138      "--"
4139      ["Customize Group..." (customize-group 'vhdl-speedbar) t])
4140     ("Menu"
4141      ["Add Index Menu when Loading File"
4142       (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
4143	      (vhdl-index-menu-init))
4144       :style toggle :selected vhdl-index-menu]
4145      ["Add Source File Menu when Loading File"
4146       (progn (customize-set-variable 'vhdl-source-file-menu
4147				      (not vhdl-source-file-menu))
4148	      (vhdl-add-source-files-menu))
4149       :style toggle :selected vhdl-source-file-menu]
4150      ["Add Hideshow Menu at Startup"
4151       (progn (customize-set-variable 'vhdl-hideshow-menu
4152				      (not vhdl-hideshow-menu))
4153	      (vhdl-activate-customizations))
4154       :style toggle :selected vhdl-hideshow-menu]
4155      ["Hide Everything Initially"
4156       (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
4157       :style toggle :selected vhdl-hide-all-init]
4158      "--"
4159      ["Customize Group..." (customize-group 'vhdl-menu) t])
4160     ("Print"
4161      ["In Two Column Format"
4162       (progn (customize-set-variable 'vhdl-print-two-column
4163				      (not vhdl-print-two-column))
4164	      (message "Activate new setting by saving options and restarting Emacs"))
4165       :style toggle :selected vhdl-print-two-column]
4166      ["Use Customized Faces"
4167       (progn (customize-set-variable 'vhdl-print-customize-faces
4168				      (not vhdl-print-customize-faces))
4169	      (message "Activate new setting by saving options and restarting Emacs"))
4170       :style toggle :selected vhdl-print-customize-faces]
4171      "--"
4172      ["Customize Group..." (customize-group 'vhdl-print) t])
4173     ("Miscellaneous"
4174      ["Use Intelligent Tab"
4175       (progn (customize-set-variable 'vhdl-intelligent-tab
4176				      (not vhdl-intelligent-tab))
4177	      (vhdl-activate-customizations))
4178       :style toggle :selected vhdl-intelligent-tab]
4179      ["Indent Syntax-Based"
4180       (customize-set-variable 'vhdl-indent-syntax-based
4181			       (not vhdl-indent-syntax-based))
4182       :style toggle :selected vhdl-indent-syntax-based]
4183      ["Indent Comments Like Next Code Line"
4184       (customize-set-variable 'vhdl-indent-comment-like-next-code-line
4185			       (not vhdl-indent-comment-like-next-code-line))
4186       :style toggle :selected vhdl-indent-comment-like-next-code-line]
4187      ["Word Completion is Case Sensitive"
4188       (customize-set-variable 'vhdl-word-completion-case-sensitive
4189			       (not vhdl-word-completion-case-sensitive))
4190       :style toggle :selected vhdl-word-completion-case-sensitive]
4191      ["Word Completion in Minibuffer"
4192       (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
4193				      (not vhdl-word-completion-in-minibuffer))
4194	      (message "Activate new setting by saving options and restarting Emacs"))
4195       :style toggle :selected vhdl-word-completion-in-minibuffer]
4196      ["Underscore is Part of Word"
4197       (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
4198				      (not vhdl-underscore-is-part-of-word))
4199	      (vhdl-activate-customizations))
4200       :style toggle :selected vhdl-underscore-is-part-of-word]
4201      "--"
4202      ["Customize Group..." (customize-group 'vhdl-misc) t])
4203     ["Related..." (customize-browse 'vhdl-related) t]
4204     "--"
4205     ["Save Options" customize-save-customized t]
4206     ["Activate Options" vhdl-activate-customizations t]
4207     ["Browse Options..." vhdl-customize t])))
4208
4209(defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
4210  "VHDL Mode menu.")
4211
4212(defun vhdl-update-mode-menu ()
4213  "Update VHDL Mode menu."
4214  (interactive)
4215  (when (featurep 'xemacs)
4216    (easy-menu-remove vhdl-mode-menu-list))
4217  (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
4218  (when (featurep 'xemacs)
4219    (easy-menu-add vhdl-mode-menu-list))
4220  (easy-menu-define vhdl-mode-menu vhdl-mode-map
4221		    "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
4222
4223;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4224;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
4225
4226(defconst vhdl-imenu-generic-expression
4227  '(
4228    ("Subprogram"
4229     "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4230     4)
4231    ("Instance"
4232     "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
4233     1)
4234    ("Component"
4235     "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4236     2)
4237    ("Procedural"
4238     "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
4239     1)
4240    ("Process"
4241     "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
4242     1)
4243    ("Block"
4244     "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
4245     1)
4246    ("Package"
4247     "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4248     3)
4249    ("Configuration"
4250     "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4251     2)
4252    ("Architecture"
4253     "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4254     2)
4255    ("Entity"
4256     "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4257     2)
4258    ("Context"
4259     "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4260     2)
4261    )
4262  "Imenu generic expression for VHDL Mode.  See `imenu-generic-expression'.")
4263
4264(defun vhdl-index-menu-init ()
4265  "Initialize index menu."
4266  (set (make-local-variable 'imenu-case-fold-search) t)
4267  (set (make-local-variable 'imenu-generic-expression)
4268       vhdl-imenu-generic-expression)
4269  (when (and vhdl-index-menu (fboundp 'imenu))
4270    (imenu-add-to-menubar "Index")))
4271
4272;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4273;; Source file menu (using `easy-menu.el')
4274
4275(defvar vhdl-sources-menu nil)
4276
4277(defun vhdl-directory-files (directory &optional full match)
4278  "Call `directory-files' if DIRECTORY exists, otherwise generate error message."
4279  (if (not (file-directory-p directory))
4280      (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
4281    (let ((dir (directory-files directory full match)))
4282      (setq dir (delete "." dir))
4283      (setq dir (delete ".." dir))
4284      dir)))
4285
4286(defun vhdl-get-source-files (&optional full directory)
4287  "Get list of VHDL source files in DIRECTORY or current directory."
4288  (let ((mode-alist auto-mode-alist)
4289	filename-regexp)
4290    ;; create regular expressions for matching file names
4291    (setq filename-regexp "\\`[^.].*\\(")
4292    (while mode-alist
4293      (when (eq (cdar mode-alist) 'vhdl-mode)
4294	(setq filename-regexp
4295	      (concat filename-regexp (caar mode-alist) "\\|")))
4296      (setq mode-alist (cdr mode-alist)))
4297    (setq filename-regexp
4298	  (concat (substring filename-regexp 0
4299			     (string-match "\\\\|$" filename-regexp)) "\\)"))
4300    ;; find files
4301    (vhdl-directory-files
4302     (or directory default-directory) full filename-regexp)))
4303
4304(defun vhdl-add-source-files-menu ()
4305  "Scan directory for all VHDL source files and generate menu.
4306The directory of the current source file is scanned."
4307  (interactive)
4308  (message "Scanning directory for source files ...")
4309  (let ((newmap (current-local-map))
4310	(file-list (vhdl-get-source-files))
4311	menu-list found)
4312    ;; Create list for menu
4313    (setq found nil)
4314    (while file-list
4315      (setq found t)
4316      (push (vector (car file-list) (list 'find-file (car file-list)) t)
4317	    menu-list)
4318      (setq file-list (cdr file-list)))
4319    (setq menu-list (vhdl-menu-split menu-list "Sources"))
4320    (when found (push "--" menu-list))
4321    (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list)
4322    (push "Sources" menu-list)
4323    ;; Create menu
4324    (when (featurep 'xemacs)
4325      (easy-menu-add menu-list))
4326    (easy-menu-define vhdl-sources-menu newmap
4327		      "VHDL source files menu" menu-list))
4328  (message ""))
4329
4330
4331;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4332;;; Mode definition
4333;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4334;; performs all buffer local initializations
4335
4336;;;###autoload
4337(define-derived-mode vhdl-mode prog-mode
4338  '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/"))
4339           (vhdl-electric-mode "e")
4340           (vhdl-stutter-mode "s"))
4341  "Major mode for editing VHDL code.
4342
4343Usage:
4344------
4345
4346  TEMPLATE INSERTION (electrification):
4347    After typing a VHDL keyword and entering `SPC', you are prompted for
4348    arguments while a template is generated for that VHDL construct.  Typing
4349    `RET' or `C-g' at the first (mandatory) prompt aborts the current
4350    template generation.  Optional arguments are indicated by square
4351    brackets and removed if the queried string is left empty.  Prompts for
4352    mandatory arguments remain in the code if the queried string is left
4353    empty.  They can be queried again by `C-c C-t C-q'.  Enabled
4354    electrification is indicated by `/e' in the mode line.
4355
4356      Typing `M-SPC' after a keyword inserts a space without calling the
4357    template generator.  Automatic template generation (i.e.
4358    electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4359    setting option `vhdl-electric-mode' (see OPTIONS).
4360
4361      Template generators can be invoked from the VHDL menu, by key
4362    bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4363    the keyword (i.e. first word of menu entry not in parenthesis) and
4364    `SPC'.  The following abbreviations can also be used: arch, attr, cond,
4365    conf, comp, cons, func, inst, pack, sig, var.
4366
4367      Template styles can be customized in customization group
4368    `vhdl-template' (see OPTIONS).
4369
4370
4371  HEADER INSERTION:
4372    A file header can be inserted by `C-c C-t C-h'.  A file footer
4373    (template at the end of the file) can be inserted by `C-c C-t C-f'.
4374    See customization group `vhdl-header'.
4375
4376
4377  STUTTERING:
4378    Double striking of some keys inserts cumbersome VHDL syntax elements.
4379    Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4380    option `vhdl-stutter-mode'.  Enabled stuttering is indicated by `/s' in
4381    the mode line.  The stuttering keys and their effects are:
4382
4383      ;;   -->  \" : \"       [   -->  (        --    -->  comment
4384      ;;;  -->  \" := \"      [[  -->  [        --CR  -->  comment-out code
4385      ..   -->  \" => \"      ]   -->  )        ---   -->  horizontal line
4386      ,,   -->  \" <= \"      ]]  -->  ]        ----  -->  display comment
4387      ==   -->  \" == \"      \\='\\='  -->  \\\"
4388
4389
4390  WORD COMPLETION:
4391    Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4392    word in the buffer that starts alike, inserts it and adjusts case.
4393    Re-typing `TAB' toggles through alternative word completions.  This also
4394    works in the minibuffer (i.e. in template generator prompts).
4395
4396      Typing `TAB' after `(' looks for and inserts complete parenthesized
4397    expressions (e.g. for array index ranges).  All keywords as well as
4398    standard types and subprograms of VHDL have predefined abbreviations
4399    (e.g., type \"std\" and `TAB' will toggle through all standard types
4400    beginning with \"std\").
4401
4402      Typing `TAB' after a non-word character indents the line if at the
4403    beginning of a line (i.e. no preceding non-blank characters), and
4404    inserts a tabulator stop otherwise.  `M-TAB' always inserts a tabulator
4405    stop.
4406
4407
4408  COMMENTS:
4409        `--'       puts a single comment.
4410        `---'      draws a horizontal line for separating code segments.
4411        `----'     inserts a display comment, i.e. two horizontal lines
4412                   with a comment in between.
4413        `--CR'     comments out code on that line.  Re-hitting CR comments
4414                   out following lines.
4415        `C-c C-c'  comments out a region if not commented out,
4416                   uncomments a region if already commented out.  Option
4417                   `comment-style' defines where the comment characters
4418                   should be placed (beginning of line, indent, etc.).
4419
4420      You are prompted for comments after object definitions (i.e. signals,
4421    variables, constants, ports) and after subprogram and process
4422    specifications if option `vhdl-prompt-for-comments' is non-nil.
4423    Comments are automatically inserted as additional labels (e.g. after
4424    begin statements) and as help comments if `vhdl-self-insert-comments' is
4425    non-nil.
4426
4427      Inline comments (i.e. comments after a piece of code on the same line)
4428    are indented at least to `vhdl-inline-comment-column'.  Comments go at
4429    maximum to `vhdl-end-comment-column'.  `RET' after a space in a comment
4430    will open a new comment line.  Typing beyond `vhdl-end-comment-column'
4431    in a comment automatically opens a new comment line.  `M-q' re-fills
4432    multi-line comments.
4433
4434
4435  INDENTATION:
4436    `TAB' indents a line if at the beginning of the line.  The amount of
4437    indentation is specified by option `vhdl-basic-offset'.  `C-c C-i C-l'
4438    always indents the current line (is bound to `TAB' if option
4439    `vhdl-intelligent-tab' is nil).  If a region is active, `TAB' indents
4440    the entire region.
4441
4442      Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4443    (`M-C-\\') or the entire buffer (menu).  Argument and port lists are
4444    indented normally (nil) or relative to the opening parenthesis (non-nil)
4445    according to option `vhdl-argument-list-indent'.
4446
4447      If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4448    tabs.  `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
4449    tabs and vice versa.
4450
4451      Syntax-based indentation can be very slow in large files.  Option
4452    `vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
4453
4454      Option `vhdl-indent-comment-like-next-code-line' controls whether
4455    comment lines are indented like the preceding or like the following code
4456    line.
4457
4458
4459  ALIGNMENT:
4460    The alignment functions align operators, keywords, and inline comments
4461    to beautify the code.  `C-c C-a C-a' aligns a group of consecutive lines
4462    separated by blank lines, `C-c C-a C-i' a block of lines with same
4463    indent.  `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4464    a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4465    C-a C-d' all lines within the declarative part of a design unit.  `C-c
4466    C-a M-a' aligns an entire region.  `C-c C-a C-c' aligns inline comments
4467    for a group of lines, and `C-c C-a M-c' for a region.
4468
4469      If option `vhdl-align-groups' is non-nil, groups of code lines
4470    separated by special lines (see option `vhdl-align-group-separate') are
4471    aligned individually.  If option `vhdl-align-same-indent' is non-nil,
4472    blocks of lines with same indent are aligned separately.  Some templates
4473    are automatically aligned after generation if option `vhdl-auto-align'
4474    is non-nil.
4475
4476      Alignment tries to align inline comments at
4477    `vhdl-inline-comment-column' and tries inline comment not to exceed
4478    `vhdl-end-comment-column'.
4479
4480      `C-c C-x M-w' fixes up whitespace in a region.  That is, operator
4481    symbols are surrounded by one space, and multiple spaces are eliminated.
4482
4483
4484  CODE FILLING:
4485    Code filling allows you to condense code (e.g. sensitivity lists or port
4486    maps) by removing comments and newlines and re-wrapping so that all
4487    lines are maximally filled (block filling).  `C-c C-f C-f' fills a list
4488    enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4489    blank lines, `C-c C-f C-i' a block of lines with same indent, and
4490    `C-c C-f M-f' an entire region.
4491
4492
4493  CODE BEAUTIFICATION:
4494    `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4495    buffer respectively.  This includes indentation, alignment, and case
4496    fixing.  Code beautification can also be run non-interactively using the
4497    command:
4498
4499      emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4500
4501
4502  PORT TRANSLATION:
4503    Generic and port clauses from entity or component declarations can be
4504    copied (`C-c C-p C-w') and pasted as entity and component declarations,
4505    as component instantiations and corresponding internal constants and
4506    signals, as a generic map with constants as actual generics, and as
4507    internal signal initializations (menu).
4508
4509      To include formals in component instantiations, see option
4510    `vhdl-association-list-with-formals'.  To include comments in pasting,
4511    see options `vhdl-include-...-comments'.
4512
4513      A clause with several generic/port names on the same line can be
4514    flattened (`C-c C-p C-f') so that only one name per line exists.  The
4515    direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4516    outputs and vice versa, which can be useful in testbenches.  (This
4517    reversion is done on the internal data structure and is only reflected
4518    in subsequent paste operations.)
4519
4520      Names for actual ports, instances, testbenches, and
4521    design-under-test instances can be derived from existing names according
4522    to options `vhdl-...-name'.  See customization group `vhdl-port'.
4523
4524
4525  SUBPROGRAM TRANSLATION:
4526    Similar functionality exists for copying/pasting the interface of
4527    subprograms (function/procedure).  A subprogram interface can be copied
4528    and then pasted as a subprogram declaration, body or call (uses
4529    association list with formals).
4530
4531
4532  TESTBENCH GENERATION:
4533    A copied port can also be pasted as a testbench.  The generated
4534    testbench includes an entity, an architecture, and an optional
4535    configuration.  The architecture contains the component declaration and
4536    instantiation of the DUT as well as internal constant and signal
4537    declarations.  Additional user-defined templates can be inserted.  The
4538    names used for entity/architecture/configuration/DUT as well as the file
4539    structure to be generated can be customized. See customization group
4540   `vhdl-testbench'.
4541
4542
4543  KEY BINDINGS:
4544    Key bindings (`C-c ...') exist for most commands (see in menu).
4545
4546
4547  VHDL MENU:
4548    All commands can be found in the VHDL menu including their key bindings.
4549
4550
4551  FILE BROWSER:
4552    The speedbar allows browsing of directories and file contents.  It can
4553    be accessed from the VHDL menu and is automatically opened if option
4554    `vhdl-speedbar-auto-open' is non-nil.
4555
4556      In speedbar, open files and directories with `mouse-2' on the name and
4557    browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4558
4559
4560  DESIGN HIERARCHY BROWSER:
4561    The speedbar can also be used for browsing the hierarchy of design units
4562    contained in the source files of the current directory or the specified
4563    projects (see option `vhdl-project-alist').
4564
4565      The speedbar can be switched between file, directory hierarchy and
4566    project hierarchy browsing mode in the speedbar menu or by typing `f',
4567    `h' or `H' in speedbar.
4568
4569      In speedbar, open design units with `mouse-2' on the name and browse
4570    their hierarchy with `mouse-2' on the `+'.  Ports can directly be copied
4571    from entities and components (in packages).  Individual design units and
4572    complete designs can directly be compiled (\"Make\" menu entry).
4573
4574      The hierarchy is automatically updated upon saving a modified source
4575    file when option `vhdl-speedbar-update-on-saving' is non-nil.  The
4576    hierarchy is only updated for projects that have been opened once in the
4577    speedbar.  The hierarchy is cached between Emacs sessions in a file (see
4578    options in group `vhdl-speedbar').
4579
4580      Simple design consistency checks are done during scanning, such as
4581    multiple declarations of the same unit or missing primary units that are
4582    required by secondary units.
4583
4584
4585  STRUCTURAL COMPOSITION:
4586    Enables simple structural composition.  `C-c C-m C-n' creates a skeleton
4587    for a new component.  Subcomponents (i.e. component declaration and
4588    instantiation) can be automatically placed from a previously read port
4589    (`C-c C-m C-p') or directly from the hierarchy browser (`P').  Finally,
4590    all subcomponents can be automatically connected using internal signals
4591    and ports (`C-c C-m C-w') following these rules:
4592      - subcomponent actual ports with same name are considered to be
4593        connected by a signal (internal signal or port)
4594      - signals that are only inputs to subcomponents are considered as
4595        inputs to this component -> input port created
4596      - signals that are only outputs from subcomponents are considered as
4597        outputs from this component -> output port created
4598      - signals that are inputs to AND outputs from subcomponents are
4599        considered as internal connections -> internal signal created
4600
4601      Purpose:  With appropriate naming conventions it is possible to
4602    create higher design levels with only a few mouse clicks or key
4603    strokes.  A new design level can be created by simply generating a new
4604    component, placing the required subcomponents from the hierarchy
4605    browser, and wiring everything automatically.
4606
4607      Note: Automatic wiring only works reliably on templates of new
4608    components and component instantiations that were created by VHDL mode.
4609
4610      Component declarations can be placed in a components package (option
4611    `vhdl-use-components-package') which can be automatically generated for
4612    an entire directory or project (`C-c C-m M-p').  The VHDL'93 direct
4613    component instantiation is also supported (option
4614    `vhdl-use-direct-instantiation').
4615
4616      Configuration declarations can automatically be generated either from
4617    the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
4618    the speedbar menu (for the architecture under the cursor).  The
4619    configurations can optionally be hierarchical (i.e. include all
4620    component levels of a hierarchical design, option
4621    `vhdl-compose-configuration-hierarchical') or include subconfigurations
4622    (option `vhdl-compose-configuration-use-subconfiguration').  For
4623    subcomponents in hierarchical configurations, the most-recently-analyzed
4624    (mra) architecture is selected.  If another architecture is desired, it
4625    can be marked as most-recently-analyzed (speedbar menu) before
4626    generating the configuration.
4627
4628      Note: Configurations of subcomponents (i.e. hierarchical configuration
4629    declarations) are currently not considered when displaying
4630    configurations in speedbar.
4631
4632      See the options group `vhdl-compose' for all relevant user options.
4633
4634
4635  SOURCE FILE COMPILATION:
4636    The syntax of the current buffer can be analyzed by calling a VHDL
4637    compiler (menu, `C-c C-k').  The compiler to be used is specified by
4638    option `vhdl-compiler'.  The available compilers are listed in option
4639    `vhdl-compiler-alist' including all required compilation command,
4640    command options, compilation directory, and error message syntax
4641    information.  New compilers can be added.
4642
4643      All the source files of an entire design can be compiled by the `make'
4644    command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4645
4646
4647  MAKEFILE GENERATION:
4648    Makefiles can be generated automatically by an internal generation
4649    routine (`C-c M-k').  The library unit dependency information is
4650    obtained from the hierarchy browser.  Makefile generation can be
4651    customized for each compiler in option `vhdl-compiler-alist'.
4652
4653      Makefile generation can also be run non-interactively using the
4654    command:
4655
4656        emacs -batch -l ~/.emacs -l vhdl-mode
4657              [-compiler compilername] [-project projectname]
4658              -f vhdl-generate-makefile
4659
4660      The Makefile's default target \"all\" compiles the entire design, the
4661    target \"clean\" removes it and the target \"library\" creates the
4662    library directory if not existent.  These target names can be customized
4663    by option `vhdl-makefile-default-targets'.  The Makefile also includes a
4664    target for each primary library unit which allows selective compilation
4665    of this unit, its secondary units and its subhierarchy (example:
4666    compilation of a design specified by a configuration).  User specific
4667    parts can be inserted into a Makefile with option
4668    `vhdl-makefile-generation-hook'.
4669
4670    Limitations:
4671      - Only library units and dependencies within the current library are
4672        considered.  Makefiles for designs that span multiple libraries are
4673        not (yet) supported.
4674      - Only one-level configurations are supported (also hierarchical),
4675        but configurations that go down several levels are not.
4676      - The \"others\" keyword in configurations is not supported.
4677
4678
4679  PROJECTS:
4680    Projects can be defined in option `vhdl-project-alist' and a current
4681    project be selected using option `vhdl-project' (permanently) or from
4682    the menu or speedbar (temporarily).  For each project, title and
4683    description strings (for the file headers), source files/directories
4684    (for the hierarchy browser and Makefile generation), library name, and
4685    compiler-dependent options, exceptions and compilation directory can be
4686    specified.  Compilation settings overwrite the settings of option
4687    `vhdl-compiler-alist'.
4688
4689      Project setups can be exported (i.e. written to a file) and imported.
4690    Imported setups are not automatically saved in `vhdl-project-alist' but
4691    can be saved afterwards in its customization buffer.  When starting
4692    Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4693    vhdl-mode\") in a directory with an existing project setup file, it is
4694    automatically loaded and its project activated if option
4695    `vhdl-project-autoload' is non-nil.  Names/paths of the project setup
4696    files can be specified in option `vhdl-project-file-name'.  Multiple
4697    project setups can be automatically loaded from global directories.
4698    This is an alternative to specifying project setups with option
4699    `vhdl-project-alist'.
4700
4701
4702  SPECIAL MENUS:
4703    As an alternative to the speedbar, an index menu can be added (set
4704    option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4705    (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up
4706    file) for browsing the file contents (is not populated if buffer is
4707    larger than 256000).  Also, a source file menu can be
4708    added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4709    current directory for VHDL source files.
4710
4711
4712  VHDL STANDARDS:
4713    The VHDL standards to be used are specified in option `vhdl-standard'.
4714    Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
4715
4716
4717  KEYWORD CASE:
4718    Lower and upper case for keywords and standardized types, attributes,
4719    and enumeration values is supported.  If the option
4720    `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4721    lower case and are converted into upper case automatically (not for
4722    types, attributes, and enumeration values).  The case of keywords,
4723    types, attributes,and enumeration values can be fixed for an entire
4724    region (menu) or buffer (`C-c C-x C-c') according to the options
4725    `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4726
4727
4728  HIGHLIGHTING (fontification):
4729    Keywords and standardized types, attributes, enumeration values, and
4730    function names (controlled by option `vhdl-highlight-keywords'), as well
4731    as comments, strings, and template prompts are highlighted using
4732    different colors.  Unit, subprogram, signal, variable, constant,
4733    parameter and generic/port names in declarations as well as labels are
4734    highlighted if option `vhdl-highlight-names' is non-nil.
4735
4736      Additional reserved words or words with a forbidden syntax (e.g. words
4737    that should be avoided) can be specified in option
4738    `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4739    a warning color (option `vhdl-highlight-forbidden-words').  Verilog
4740    keywords are highlighted as forbidden words if option
4741    `vhdl-highlight-verilog-keywords' is non-nil.
4742
4743      Words with special syntax can be highlighted by specifying their
4744    syntax and color in option `vhdl-special-syntax-alist' and by setting
4745    option `vhdl-highlight-special-words' to non-nil.  This allows you to
4746    establish some naming conventions (e.g. to distinguish different kinds
4747    of signals or other objects by using name suffices) and to support them
4748    visually.
4749
4750      Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4751    to support case-sensitive highlighting.  However, keywords are then only
4752    highlighted if written in lower case.
4753
4754      Code between \"translate_off\" and \"translate_on\" pragmas is
4755    highlighted using a different background color if option
4756    `vhdl-highlight-translate-off' is non-nil.
4757
4758      For documentation and customization of the used colors see
4759    customization group `vhdl-highlight-faces' (`\\[customize-group]').  For
4760    highlighting of matching parenthesis, see customization group
4761    `paren-showing'.  Automatic buffer highlighting is turned on/off by
4762    option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4763
4764
4765  USER MODELS:
4766    VHDL models (templates) can be specified by the user and made accessible
4767    in the menu, through key bindings (`C-c C-m ...'), or by keyword
4768    electrification.  See option `vhdl-model-alist'.
4769
4770
4771  HIDE/SHOW:
4772    The code of blocks, processes, subprograms, component declarations and
4773    instantiations, generic/port clauses, and configuration declarations can
4774    be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4775    the code (see customization group `vhdl-menu').  XEmacs: limited
4776    functionality due to old `hideshow.el' package.
4777
4778
4779  CODE UPDATING:
4780    - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4781      current process, `C-c C-u M-s' of all processes in the current buffer.
4782      Limitations:
4783        - Only declared local signals (ports, signals declared in
4784          architecture and blocks) are automatically inserted.
4785        - Global signals declared in packages are not automatically inserted.
4786          Insert them once manually (will be kept afterwards).
4787        - Out parameters of procedures are considered to be read.
4788      Use option `vhdl-entity-file-name' to specify the entity file name
4789      (used to obtain the port names).
4790      Use option `vhdl-array-index-record-field-in-sensitivity-list' to
4791      specify whether to include array indices and record fields in
4792      sensitivity lists.
4793
4794
4795  CODE FIXING:
4796    `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4797    (e.g., if the closing parenthesis is on the wrong line or is missing).
4798
4799
4800  PRINTING:
4801    PostScript printing with different faces (an optimized set of faces is
4802    used if `vhdl-print-customize-faces' is non-nil) or colors (if
4803    `ps-print-color-p' is non-nil) is possible using the standard Emacs
4804    PostScript printing commands.  Option `vhdl-print-two-column' defines
4805    appropriate default settings for nice landscape two-column printing.
4806    The paper format can be set by option `ps-paper-type'.  Do not forget to
4807    switch `ps-print-color-p' to nil for printing on black-and-white
4808    printers.
4809
4810
4811  OPTIONS:
4812    User options allow customization of VHDL Mode.  All options are
4813    accessible from the \"Options\" menu entry.  Simple options (switches
4814    and choices) can directly be changed, while for complex options a
4815    customization buffer is opened.  Changed options can be saved for future
4816    sessions using the \"Save Options\" menu entry.
4817
4818      Options and their detailed descriptions can also be accessed by using
4819    the \"Customize\" menu entry or the command `\\[customize-option]'
4820    (`\\[customize-group]' for groups).  Some customizations only take effect
4821    after some action (read the NOTE in the option documentation).
4822    Customization can also be done globally (i.e. site-wide, read the
4823    INSTALL file).
4824
4825      Not all options are described in this documentation, so go and see
4826    what other useful user options there are (`\\[vhdl-customize]' or menu)!
4827
4828
4829  FILE EXTENSIONS:
4830    As default, files with extensions \".vhd\" and \".vhdl\" are
4831    automatically recognized as VHDL source files.  To add an extension
4832    \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4833
4834      (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist)
4835
4836
4837  HINTS:
4838    - To start Emacs with open VHDL hierarchy browser without having to load
4839      a VHDL file first, use the command:
4840
4841        emacs -l vhdl-mode -f speedbar-frame-mode
4842
4843    - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4844
4845    - Some features only work on properly indented code.
4846
4847
4848  RELEASE NOTES:
4849    See also the release notes (menu) for added features in new releases.
4850
4851
4852Maintenance:
4853------------
4854
4855To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
4856Add a description of the problem and include a reproducible test case.
4857
4858Questions and enhancement requests can be sent to <reto@gnu.org>.
4859
4860The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4861The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4862releases.  You are kindly invited to participate in beta testing.  Subscribe
4863to above mailing lists by sending an email to <reto@gnu.org>.
4864
4865VHDL Mode is officially distributed at
4866https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
4867where the latest version can be found.
4868
4869
4870Known problems:
4871---------------
4872
4873- XEmacs: Incorrect start-up when automatically opening speedbar.
4874- XEmacs: Indentation in XEmacs 21.4 (and higher).
4875- Indentation incorrect for new `postponed' VHDL keyword.
4876- Indentation incorrect for `protected body' construct.
4877
4878
4879                                                The VHDL Mode Authors
4880                                            Reto Zimmermann and Rod Whitby
4881
4882Key bindings:
4883-------------
4884
4885\\{vhdl-mode-map}"
4886  :abbrev-table vhdl-mode-abbrev-table
4887
4888  ;; set local variables
4889  (set (make-local-variable 'paragraph-start)
4890       "\\s-*\\(--+\\s-*$\\|$\\)")
4891  (set (make-local-variable 'paragraph-separate) paragraph-start)
4892  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4893  (set (make-local-variable 'parse-sexp-ignore-comments) t)
4894  (set (make-local-variable 'indent-line-function) #'vhdl-indent-line)
4895  (set (make-local-variable 'comment-start) "--")
4896  (set (make-local-variable 'comment-end) "")
4897  (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4898  (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4899  (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4900  (set (make-local-variable 'comment-multi-line) nil)
4901  (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
4902  (set (make-local-variable 'hippie-expand-verbose) nil)
4903
4904  ;; setup the comment indent variable in an Emacs version portable way
4905  ;; ignore any byte compiler warnings you might get here
4906  (when (boundp 'comment-indent-function)
4907    (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent))
4908
4909  ;; initialize font locking
4910  (set (make-local-variable 'font-lock-defaults)
4911       (list
4912	'(nil vhdl-font-lock-keywords) nil
4913	(not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line))
4914  (if (eval-when-compile (fboundp 'syntax-propertize-rules))
4915      (set (make-local-variable 'syntax-propertize-function)
4916           (syntax-propertize-rules
4917            ;; Mark single quotes as having string quote syntax in
4918            ;; 'c' instances.
4919            ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
4920    (set (make-local-variable 'font-lock-syntactic-keywords)
4921         vhdl-font-lock-syntactic-keywords))
4922  (when (featurep 'xemacs)
4923    (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4924    (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4925    (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4926    (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4927
4928  ;; variables for source file compilation
4929  (when vhdl-compile-use-local-error-regexp
4930    (set (make-local-variable 'compilation-error-regexp-alist) nil)
4931    (set (make-local-variable 'compilation-file-regexp-alist) nil))
4932
4933  ;; add index menu
4934  (vhdl-index-menu-init)
4935  ;; add source file menu
4936  (if vhdl-source-file-menu (vhdl-add-source-files-menu))
4937  ;; add VHDL menu
4938  (when (featurep 'xemacs)
4939    (easy-menu-add vhdl-mode-menu-list))
4940  (easy-menu-define vhdl-mode-menu vhdl-mode-map
4941		    "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4942  ;; initialize hideshow and add menu
4943  (vhdl-hideshow-init)
4944  (run-hooks 'menu-bar-update-hook)
4945
4946  ;; miscellaneous
4947  (vhdl-ps-print-init)
4948  (vhdl-write-file-hooks-init)
4949  (message "VHDL Mode %s.%s" vhdl-version
4950	   (if noninteractive "" "  See menu for documentation and release notes.")))
4951
4952(defun vhdl-activate-customizations ()
4953  "Activate all customizations on local variables."
4954  (interactive)
4955  (vhdl-mode-map-init)
4956  (use-local-map vhdl-mode-map)
4957  (set-syntax-table vhdl-mode-syntax-table)
4958  (setq comment-column vhdl-inline-comment-column)
4959  (setq end-comment-column vhdl-end-comment-column)
4960  (vhdl-write-file-hooks-init)
4961  (vhdl-update-mode-menu)
4962  (vhdl-hideshow-init)
4963  (run-hooks 'menu-bar-update-hook))
4964
4965(defun vhdl-write-file-hooks-init ()
4966  "Add/remove hooks when buffer is saved."
4967  (if vhdl-modify-date-on-saving
4968      (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t)
4969    (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t))
4970  (if (featurep 'xemacs) (make-local-hook 'after-save-hook))
4971  (add-hook 'after-save-hook #'vhdl-add-modified-file nil t))
4972
4973(defun vhdl-process-command-line-option (option)
4974  "Process command line options for VHDL Mode."
4975  (cond
4976   ;; set compiler
4977   ((equal option "-compiler")
4978    (vhdl-set-compiler (car command-line-args-left))
4979    (setq command-line-args-left (cdr command-line-args-left)))
4980   ;; set project
4981   ((equal option "-project")
4982    (vhdl-set-project (car command-line-args-left))
4983    (setq command-line-args-left (cdr command-line-args-left)))))
4984
4985;; make Emacs process VHDL Mode options
4986(setq command-switch-alist
4987      (append command-switch-alist
4988	      '(("-compiler" . vhdl-process-command-line-option)
4989		("-project" . vhdl-process-command-line-option))))
4990
4991
4992;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4993;;; Keywords and standardized words
4994;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4995
4996(defconst vhdl-02-keywords
4997  '(
4998    "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4999    "assert" "attribute"
5000    "begin" "block" "body" "buffer" "bus"
5001    "case" "component" "configuration" "constant"
5002    "disconnect" "downto"
5003    "else" "elsif" "end" "entity" "exit"
5004    "file" "for" "function"
5005    "generate" "generic" "group" "guarded"
5006    "if" "impure" "in" "inertial" "inout" "is"
5007    "label" "library" "linkage" "literal" "loop"
5008    "map" "mod"
5009    "nand" "new" "next" "nor" "not" "null"
5010    "of" "on" "open" "or" "others" "out"
5011    "package" "port" "postponed" "procedure" "process" "protected" "pure"
5012    "range" "record" "register" "reject" "rem" "report" "return"
5013    "rol" "ror"
5014    "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
5015    "then" "to" "transport" "type"
5016    "unaffected" "units" "until" "use"
5017    "variable"
5018    "wait" "when" "while" "with"
5019    "xnor" "xor"
5020    )
5021  "List of VHDL'02 keywords.")
5022
5023(defconst vhdl-08-keywords
5024  '(
5025    "context" "force" "property" "release" "sequence"
5026    )
5027  "List of VHDL'08 keywords.")
5028
5029(defconst vhdl-ams-keywords
5030  '(
5031    "across" "break" "limit" "nature" "noise" "procedural" "quantity"
5032    "reference" "spectrum" "subnature" "terminal" "through"
5033    "tolerance"
5034    )
5035  "List of VHDL-AMS keywords.")
5036
5037(defconst vhdl-verilog-keywords
5038  '(
5039    "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
5040    "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
5041    "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
5042    "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
5043    "endprimitive" "endspecify" "endtable" "endtask" "event"
5044    "for" "force" "forever" "fork" "function"
5045    "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
5046    "macromodule" "makefile" "medium" "module"
5047    "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
5048    "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
5049    "pullup"
5050    "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
5051    "rtranif0" "rtranif1"
5052    "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
5053    "strong1" "supply" "supply0" "supply1"
5054    "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
5055    "triand" "trior" "trireg"
5056    "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
5057    )
5058  "List of Verilog keywords as candidate for additional reserved words.")
5059
5060(defconst vhdl-02-types
5061  '(
5062    "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
5063    "real" "time" "natural" "positive" "string" "line" "text" "side"
5064    "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
5065    "std_logic" "std_logic_vector"
5066    "std_ulogic" "std_ulogic_vector"
5067    )
5068  "List of VHDL'02 standardized types.")
5069
5070(defconst vhdl-08-types
5071  '(
5072    "boolean_vector" "integer_vector" "real_vector" "time_vector"
5073    )
5074  "List of VHDL'08 standardized types.")
5075
5076(defconst vhdl-ams-types
5077  ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
5078  '(
5079    ;; package `standard'
5080    "domain_type" "real_vector"
5081    ;; package `energy_systems'
5082    "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
5083    "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
5084    "real_across_vector" "real_through_vector"
5085    ;; package `electrical_systems'
5086    "voltage" "current" "charge" "resistance" "conductance" "capacitance"
5087    "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
5088    "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
5089    "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
5090    "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
5091    "magnetic_flux_vector" "charge_vector" "resistance_vector"
5092    "conductance_vector" "capacitance_vector" "electric_flux_vector"
5093    "electric_flux_density_vector" "electric_field_strength_vector"
5094    "magnetic_flux_density_vector" "magnetic_field_strength_vector"
5095    "inductance_vector" "reluctance_vector" "ground"
5096    ;; package `mechanical_systems'
5097    "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
5098    "damping" "momentum" "angle" "torque" "angular_velocity"
5099    "angular_acceleration" "moment_inertia" "angular_momentum"
5100    "angular_stiffness" "angular_damping" "translational"
5101    "translational_vector" "translational_velocity"
5102    "translational_velocity_vector" "rotational" "rotational_vector"
5103    "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
5104    "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
5105    "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
5106    "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
5107    "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
5108    "angular_momentum_vector" "angular_stiffness_vector"
5109    "angular_damping_vector" "anchor" "translational_v_ref"
5110    "rotational_v_ref" "translational_v" "rotational_v"
5111    ;; package `radiant_systems'
5112    "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
5113    "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
5114    "illuminance_vector" "irradiance_vector"
5115    ;; package `thermal_systems'
5116    "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
5117    "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
5118    "heat_flow_vector" "thermal_capacitance_vector"
5119    "thermal_resistance_vector" "thermal_conductance_vector"
5120    ;; package `fluidic_systems'
5121    "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
5122    "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
5123    "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
5124    "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
5125    "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
5126    "density_vector" "viscosity_vector" "fresistance_vector"
5127    "fconductance_vector" "fcapacitance_vector" "inertance_vector"
5128    "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
5129    "cfinertance_vector"
5130    )
5131  "List of VHDL-AMS standardized types.")
5132
5133(defconst vhdl-math-types
5134  '(
5135    "complex" "complex_polar" "positive_real" "principal_value"
5136    )
5137  "List of Math Packages standardized types.")
5138
5139(defconst vhdl-02-attributes
5140  '(
5141    "base" "left" "right" "high" "low" "pos" "val" "succ"
5142    "pred" "leftof" "rightof" "range" "reverse_range"
5143    "length" "delayed" "stable" "quiet" "transaction"
5144    "event" "active" "last_event" "last_active" "last_value"
5145    "driving" "driving_value" "ascending" "value" "image"
5146    "simple_name" "instance_name" "path_name"
5147    "foreign"
5148    )
5149  "List of VHDL'02 standardized attributes.")
5150
5151(defconst vhdl-08-attributes
5152  '(
5153    "instance_name" "path_name"
5154    )
5155  "List of VHDL'08 standardized attributes.")
5156
5157(defconst vhdl-ams-attributes
5158  '(
5159    "across" "through"
5160    "reference" "contribution" "tolerance"
5161    "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
5162    "ramp" "slew"
5163    )
5164  "List of VHDL-AMS standardized attributes.")
5165
5166(defconst vhdl-02-enum-values
5167  '(
5168    "true" "false"
5169    "note" "warning" "error" "failure"
5170    "read_mode" "write_mode" "append_mode"
5171    "open_ok" "status_error" "name_error" "mode_error"
5172    "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
5173    "right" "left"
5174    )
5175  "List of VHDL'02 standardized enumeration values.")
5176
5177(defconst vhdl-ams-enum-values
5178  '(
5179    "quiescent_domain" "time_domain" "frequency_domain"
5180    ;; from `nature_pkg' package
5181    "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
5182    )
5183  "List of VHDL-AMS standardized enumeration values.")
5184
5185(defconst vhdl-ams-constants
5186  ;; standard: IEEE Std 1076.1.1-2004
5187  '(
5188    ;; package `fundamental_constants'
5189    "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
5190    "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
5191    "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
5192    "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
5193    ;; package `material_constants'
5194    "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
5195    "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
5196    "ambient_temperature" "ambient_pressure" "ambient_illuminance"
5197    )
5198  "List of VHDL-AMS standardized constants.")
5199
5200(defconst vhdl-math-constants
5201  ;; standard: IEEE Std 1076.2-1996
5202  '(
5203    "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
5204    "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
5205    "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
5206    "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
5207    "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
5208    "math_sqrt_pi"
5209    )
5210  "List of Math Packages standardized constants.")
5211
5212(defconst vhdl-02-functions
5213  '(
5214    "now" "resolved" "rising_edge" "falling_edge"
5215    "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
5216    "endfile"
5217    "resize" "is_X" "std_match"
5218    "shift_left" "shift_right" "rotate_left" "rotate_right"
5219    "to_unsigned" "to_signed" "to_integer"
5220    "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
5221    "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
5222    "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
5223    "shl" "shr" "ext" "sxt"
5224    "deallocate"
5225    )
5226  "List of VHDL'02 standardized functions.")
5227
5228(defconst vhdl-08-functions
5229  '(
5230    "finish" "flush" "justify" "maximum" "minimum"
5231    "resolution_limit" "rising_edge" "stop" "swrite"
5232    "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
5233    "to_octalstring" "to_ostring" "to_string"
5234    )
5235  "List of VHDL'08 standardized functions.")
5236
5237(defconst vhdl-ams-functions
5238  '(
5239    ;; package `standard'
5240    "frequency"
5241    )
5242  "List of VHDL-AMS standardized functions.")
5243
5244(defconst vhdl-math-functions
5245  ;; standard: IEEE Std 1076.2-1996
5246  '(
5247    "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
5248    "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
5249    "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
5250    "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
5251    "tan" "tanh" "trunc" "uniform"
5252    )
5253  "List of Math Packages standardized functions.")
5254
5255(defconst vhdl-02-packages
5256  '(
5257    "std_logic_1164" "numeric_std" "numeric_bit"
5258    "standard" "textio"
5259    "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
5260    "std_logic_misc" "std_logic_textio"
5261    "ieee" "std" "work"
5262    )
5263  "List of VHDL'02 standardized packages and libraries.")
5264
5265(defconst vhdl-08-packages
5266  '(
5267    "env" "numeric_std_signed" "numeric_std_unsigned"
5268    "ieee_bit_context" "ieee_std_context"  ;; contexts
5269    )
5270  "List of VHDL'08 standardized packages and libraries.")
5271
5272(defconst vhdl-ams-packages
5273  '(
5274    "fundamental_constants" "material_constants" "energy_systems"
5275    "electrical_systems" "mechanical_systems" "radiant_systems"
5276    "thermal_systems" "fluidic_systems"
5277    )
5278  "List of VHDL-AMS standardized packages and libraries.")
5279
5280(defconst vhdl-math-packages
5281  '(
5282    "math_real" "math_complex"
5283    )
5284  "List of Math Packages standardized packages and libraries.")
5285
5286(defconst vhdl-08-directives
5287  '(
5288    "author" "author_info" "begin" "begin_protected" "comment"
5289    "data_block" "data_keyname" "data_keyowner" "data_method"
5290    "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
5291    "digest_keyowner" "digest_method"
5292    "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
5293    "key_block" "key_keyname" "key_keyowner" "key_method"
5294    "runtime_license" "viewport"
5295    )
5296  "List of VHDL'08 standardized tool directives.")
5297
5298(defvar vhdl-keywords nil
5299  "List of VHDL keywords.")
5300
5301(defvar vhdl-types nil
5302  "List of VHDL standardized types.")
5303
5304(defvar vhdl-attributes nil
5305  "List of VHDL standardized attributes.")
5306
5307(defvar vhdl-enum-values nil
5308  "List of VHDL standardized enumeration values.")
5309
5310(defvar vhdl-constants nil
5311  "List of VHDL standardized constants.")
5312
5313(defvar vhdl-functions nil
5314  "List of VHDL standardized functions.")
5315
5316(defvar vhdl-packages nil
5317  "List of VHDL standardized packages and libraries.")
5318
5319(defvar vhdl-directives nil
5320  "List of VHDL standardized packages and libraries.")
5321
5322(defvar vhdl-reserved-words nil
5323  "List of additional reserved words.")
5324
5325(defvar vhdl-keywords-regexp nil
5326  "Regexp for VHDL keywords.")
5327
5328(defvar vhdl-types-regexp nil
5329  "Regexp for VHDL standardized types.")
5330
5331(defvar vhdl-attributes-regexp nil
5332  "Regexp for VHDL standardized attributes.")
5333
5334(defvar vhdl-enum-values-regexp nil
5335  "Regexp for VHDL standardized enumeration values.")
5336
5337(defvar vhdl-constants-regexp nil
5338  "Regexp for VHDL standardized constants.")
5339
5340(defvar vhdl-functions-regexp nil
5341  "Regexp for VHDL standardized functions.")
5342
5343(defvar vhdl-packages-regexp nil
5344  "Regexp for VHDL standardized packages and libraries.")
5345
5346(defvar vhdl-reserved-words-regexp nil
5347  "Regexp for additional reserved words.")
5348
5349(defun vhdl-upcase-list (condition list)
5350  "Upcase all elements in LIST based on CONDITION."
5351  (when condition
5352    (let ((tmp-list list))
5353      (while tmp-list
5354	(setcar tmp-list (upcase (car tmp-list)))
5355	(setq tmp-list (cdr tmp-list)))))
5356  list)
5357
5358(defun vhdl-words-init ()
5359  "Initialize reserved words."
5360  (setq vhdl-keywords
5361	(vhdl-upcase-list
5362	 (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
5363	 (append vhdl-02-keywords
5364		 (when (vhdl-standard-p '08) vhdl-08-keywords)
5365		 (when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
5366  (setq vhdl-types
5367	(vhdl-upcase-list
5368	 (and vhdl-highlight-case-sensitive vhdl-upper-case-types)
5369	 (append vhdl-02-types
5370		 (when (vhdl-standard-p '08) vhdl-08-types)
5371		 (when (vhdl-standard-p 'ams) vhdl-ams-types)
5372		 (when (vhdl-standard-p 'math) vhdl-math-types))))
5373  (setq vhdl-attributes
5374	(vhdl-upcase-list
5375	 (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
5376	 (append vhdl-02-attributes
5377		 (when (vhdl-standard-p '08) vhdl-08-attributes)
5378		 (when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
5379  (setq vhdl-enum-values
5380	(vhdl-upcase-list
5381	 (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values)
5382	 (append vhdl-02-enum-values
5383		 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))))
5384  (setq vhdl-constants
5385	(vhdl-upcase-list
5386	 (and vhdl-highlight-case-sensitive vhdl-upper-case-constants)
5387	 (append (when (vhdl-standard-p 'ams) vhdl-ams-constants)
5388		 (when (vhdl-standard-p 'math) vhdl-math-constants)
5389		 '(""))))
5390  (setq vhdl-functions
5391	(append vhdl-02-functions
5392		(when (vhdl-standard-p '08) vhdl-08-functions)
5393		(when (vhdl-standard-p 'ams) vhdl-ams-functions)
5394		(when (vhdl-standard-p 'math) vhdl-math-functions)))
5395  (setq vhdl-packages
5396	(append vhdl-02-packages
5397		(when (vhdl-standard-p '08) vhdl-08-packages)
5398		(when (vhdl-standard-p 'ams) vhdl-ams-packages)
5399		(when (vhdl-standard-p 'math) vhdl-math-packages)))
5400  (setq vhdl-directives
5401	(append (when (vhdl-standard-p '08) vhdl-08-directives)))
5402  (setq vhdl-reserved-words
5403	(append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
5404		(when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
5405		'("")))
5406  (setq vhdl-keywords-regexp
5407	(concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>"))
5408  (setq vhdl-types-regexp
5409	(concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>"))
5410  (setq vhdl-attributes-regexp
5411	(concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
5412  (setq vhdl-enum-values-regexp
5413	(concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
5414  (setq vhdl-constants-regexp
5415	(concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>"))
5416  (setq vhdl-functions-regexp
5417	(concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
5418  (setq vhdl-packages-regexp
5419	(concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>"))
5420  (setq vhdl-reserved-words-regexp
5421	(concat "\\<\\("
5422		(unless (equal vhdl-forbidden-syntax "")
5423		  (concat vhdl-forbidden-syntax "\\|"))
5424		(regexp-opt vhdl-reserved-words)
5425		"\\)\\>"))
5426  (vhdl-abbrev-list-init))
5427
5428;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5429;; Words to expand
5430
5431(defvar vhdl-abbrev-list nil
5432  "Predefined abbreviations for VHDL.")
5433
5434(defun vhdl-abbrev-list-init ()
5435  (setq vhdl-abbrev-list
5436	(append
5437	 (list vhdl-upper-case-keywords) vhdl-keywords
5438	 (list vhdl-upper-case-types) vhdl-types
5439	 (list vhdl-upper-case-attributes) vhdl-attributes
5440	 (list vhdl-upper-case-enum-values) vhdl-enum-values
5441	 (list vhdl-upper-case-constants) vhdl-constants
5442	 (list nil) vhdl-functions
5443	 (list nil) vhdl-packages
5444	 (list nil) vhdl-directives)))
5445
5446;; initialize reserved words for VHDL Mode
5447(vhdl-words-init)
5448
5449
5450;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5451;;; Indentation
5452;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5453
5454;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5455;; Syntax analysis
5456
5457;; constant regular expressions for looking at various constructs
5458
5459(defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
5460  "Regexp describing a VHDL symbol.
5461We cannot use just `word' syntax class since `_' cannot be in word
5462class.  Putting underscore in word class breaks forward word movement
5463behavior that users are familiar with.")
5464
5465(defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
5466  "Regexp describing a case statement header key.")
5467
5468(defconst vhdl-label-key
5469  (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]")
5470  "Regexp describing a VHDL label.")
5471
5472;; Macro definitions:
5473
5474(defmacro vhdl-point (position)
5475  "Return the value of point at certain commonly referenced POSITIONs.
5476POSITION can be one of the following symbols:
5477
5478bol  -- beginning of line
5479eol  -- end of line
5480bod  -- beginning of defun
5481boi  -- back to indentation
5482eoi  -- last whitespace on line
5483ionl -- indentation of next line
5484iopl -- indentation of previous line
5485bonl -- beginning of next line
5486bopl -- beginning of previous line
5487
5488This function does not modify point or mark."
5489  (or (and (eq 'quote (car-safe position))
5490	   (null (cddr position)))
5491      (error "ERROR:  Bad buffer position requested: %s" position))
5492  (setq position (nth 1 position))
5493  `(let ((here (point)))
5494     ,@(cond
5495	((eq position 'bol)  '((beginning-of-line)))
5496	((eq position 'eol)  '((end-of-line)))
5497	((eq position 'bod)  '((save-match-data
5498				 (vhdl-beginning-of-defun))))
5499	((eq position 'boi)  '((back-to-indentation)))
5500	((eq position 'eoi)  '((end-of-line) (skip-chars-backward " \t")))
5501	((eq position 'bonl) '((forward-line 1)))
5502	((eq position 'bopl) '((forward-line -1)))
5503	((eq position 'iopl)
5504	 '((forward-line -1)
5505	   (back-to-indentation)))
5506	((eq position 'ionl)
5507	 '((forward-line 1)
5508	   (back-to-indentation)))
5509	(t (error "ERROR:  Unknown buffer position requested: %s" position))
5510	)
5511     (prog1
5512	 (point)
5513       (goto-char here))
5514     ;; workaround for an Emacs18 bug -- blech! Well, at least it
5515     ;; doesn't hurt for v19
5516     ,@nil
5517     ))
5518
5519(defmacro vhdl-safe (&rest body)
5520  "Safely execute BODY, return nil if an error occurred."
5521  `(condition-case nil
5522       (progn ,@body)
5523     (error nil)))
5524
5525(defmacro vhdl-add-syntax (symbol &optional relpos)
5526  "A simple macro to append the syntax in SYMBOL to the syntax list.
5527Try to increase performance by using this macro."
5528  `(setq vhdl-syntactic-context
5529	 (cons (cons ,symbol ,relpos) vhdl-syntactic-context)))
5530
5531(defmacro vhdl-has-syntax (symbol)
5532  "A simple macro to return check the syntax list.
5533Try to increase performance by using this macro."
5534  `(assoc ,symbol vhdl-syntactic-context))
5535
5536;; Syntactic element offset manipulation:
5537
5538(defun vhdl-read-offset (langelem)
5539  "Read new offset value for LANGELEM from minibuffer.
5540Return a valid value only."
5541  (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
5542	(errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5543	(prompt "Offset: ")
5544	offset input interned)
5545    (while (not offset)
5546      (setq input (read-string prompt oldoff)
5547	    offset (cond ((string-equal "+" input) '+)
5548			 ((string-equal "-" input) '-)
5549			 ((string-equal "++" input) '++)
5550			 ((string-equal "--" input) '--)
5551			 ((string-match "^-?[0-9]+$" input)
5552			  (string-to-number input))
5553			 ((fboundp (setq interned (intern input)))
5554			  interned)
5555			 ((boundp interned) interned)
5556			 ;; error, but don't signal one, keep trying
5557			 ;; to read an input value
5558			 (t (ding)
5559			    (setq prompt errmsg)
5560			    nil))))
5561    offset))
5562
5563(defun vhdl-set-offset (symbol offset &optional add-p)
5564  "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5565SYMBOL is the syntactic element symbol to change and OFFSET is the new
5566offset for that syntactic element.  Optional ADD-P says to add SYMBOL to
5567`vhdl-offsets-alist' if it doesn't already appear there."
5568  (interactive
5569   (let* ((langelem
5570	   (intern (completing-read
5571		    (concat "Syntactic symbol to change"
5572			    (if current-prefix-arg " or add" "")
5573			    ": ")
5574		    (mapcar
5575                     (lambda (langelem)
5576                       (cons (format "%s" (car langelem)) nil))
5577		     vhdl-offsets-alist)
5578		    nil (not current-prefix-arg)
5579		    ;; initial contents tries to be the last element
5580		    ;; on the syntactic analysis list for the current
5581		    ;; line
5582		    (let* ((syntax (vhdl-get-syntactic-context))
5583			   (len (length syntax))
5584			   (ic (format "%s" (car (nth (1- len) syntax)))))
5585		      ic)
5586		    )))
5587	  (offset (vhdl-read-offset langelem)))
5588     (list langelem offset current-prefix-arg)))
5589  ;; sanity check offset
5590  (or (eq offset '+)
5591      (eq offset '-)
5592      (eq offset '++)
5593      (eq offset '--)
5594      (integerp offset)
5595      (fboundp offset)
5596      (boundp offset)
5597      (error "ERROR:  Offset must be int, func, var, or one of +, -, ++, --: %s"
5598	     offset))
5599  (let ((entry (assq symbol vhdl-offsets-alist)))
5600    (if entry
5601	(setcdr entry offset)
5602      (if add-p
5603	  (setq vhdl-offsets-alist
5604		(cons (cons symbol offset) vhdl-offsets-alist))
5605	(error "ERROR:  %s is not a valid syntactic symbol" symbol))))
5606  (vhdl-keep-region-active))
5607
5608(defun vhdl-set-style (style &optional local)
5609  "Set `vhdl-mode' variables to use one of several different indentation styles.
5610STYLE is a string representing the desired style and optional LOCAL is
5611a flag which, if non-nil, means to make the style variables being
5612changed buffer local, instead of the default, which is to set the
5613global variables.  Interactively, the flag comes from the prefix
5614argument.  The styles are chosen from the `vhdl-style-alist' variable."
5615  (interactive (list (completing-read "Use which VHDL indentation style? "
5616				      vhdl-style-alist nil t)
5617		     current-prefix-arg))
5618  (let ((vars (cdr (assoc style vhdl-style-alist))))
5619    (or vars
5620	(error "ERROR:  Invalid VHDL indentation style `%s'" style))
5621    ;; set all the variables
5622    (mapc
5623     (lambda (varentry)
5624       (let ((var (car varentry))
5625             (val (cdr varentry)))
5626         ;; special case for vhdl-offsets-alist
5627         (if (not (eq var 'vhdl-offsets-alist))
5628             (set (if local (make-local-variable var) var) val)
5629           ;; reset vhdl-offsets-alist to the default value first
5630           (set (if local (make-local-variable var) var)
5631                (copy-alist vhdl-offsets-alist-default))
5632           ;; now set the langelems that are different
5633           (mapcar
5634            (lambda (langentry)
5635              (let ((langelem (car langentry))
5636                    (offset (cdr langentry)))
5637                (vhdl-set-offset langelem offset)
5638                ))
5639            val))
5640         ))
5641     vars))
5642  (vhdl-keep-region-active))
5643
5644(defun vhdl-get-offset (langelem)
5645  "Get offset from LANGELEM which is a cons cell of the form:
5646\(SYMBOL . RELPOS).  The symbol is matched against
5647vhdl-offsets-alist and the offset found there is either returned,
5648or added to the indentation at RELPOS.  If RELPOS is nil, then
5649the offset is simply returned."
5650  (let* ((symbol (car langelem))
5651	 (relpos (cdr langelem))
5652	 (match  (assq symbol vhdl-offsets-alist))
5653	 (offset (cdr-safe match)))
5654    ;; offset can be a number, a function, a variable, or one of the
5655    ;; symbols + or -
5656    (cond
5657     ((not match)
5658      (if vhdl-strict-syntax-p
5659	  (error "ERROR:  Don't know how to indent a %s" symbol)
5660	(setq offset 0
5661	      relpos 0)))
5662     ((eq offset '+)  (setq offset vhdl-basic-offset))
5663     ((eq offset '-)  (setq offset (- vhdl-basic-offset)))
5664     ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
5665     ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
5666     ((and (not (numberp offset))
5667	   (fboundp offset))
5668      (setq offset (funcall offset langelem)))
5669     ((not (numberp offset))
5670      (setq offset (eval offset)))
5671     )
5672    (+ (if (and relpos
5673		(< relpos (vhdl-point 'bol)))
5674	   (save-excursion
5675	     (goto-char relpos)
5676	     (current-column))
5677	 0)
5678       offset)))
5679
5680;; Syntactic support functions:
5681
5682(defun vhdl-in-comment-p (&optional pos)
5683  "Check if point is in a comment (include multi-line comments)."
5684  (let ((parse (lambda (p)
5685		 (let ((c (char-after p)))
5686		   (or (and c (eq (char-syntax c) ?<))
5687		       (nth 4 (parse-partial-sexp
5688			       (save-excursion
5689				 (beginning-of-defun)
5690				 (point)) p)))))))
5691    (save-excursion
5692      (goto-char (or pos (point)))
5693      (or (funcall parse (point))
5694	  ;; `parse-partial-sexp's notion of comments doesn't span lines
5695	  (progn
5696	    (back-to-indentation)
5697	    (unless (eolp)
5698	      (forward-char)
5699	      (funcall parse (point))))))))
5700
5701(defun vhdl-in-string-p ()
5702  "Check if point is in a string."
5703  (eq (vhdl-in-literal) 'string))
5704
5705(defun vhdl-in-quote-p ()
5706  "Check if point is in a quote ('x')."
5707  (or (and (> (point) (point-min))
5708	   (< (1+ (point)) (point-max))
5709	   (= (char-before (point)) ?\')
5710	   (= (char-after (1+ (point))) ?\'))
5711      (and (> (1- (point)) (point-min))
5712	   (< (point) (point-max))
5713	   (= (char-before (1- (point))) ?\')
5714	   (= (char-after (point)) ?\'))))
5715
5716(defun vhdl-in-literal ()
5717  "Determine if point is in a VHDL literal."
5718  (save-excursion
5719    (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
5720      (cond
5721       ((nth 3 state) 'string)
5722       ((nth 4 state) 'comment)
5723       ((vhdl-beginning-of-macro) 'pound)
5724       ((vhdl-beginning-of-directive) 'directive)
5725       ;; for multi-line comments
5726       ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
5727       (t nil)))))
5728
5729(defun vhdl-in-extended-identifier-p ()
5730  "Determine if point is inside extended identifier (delimited by `\\')."
5731  (save-match-data
5732    (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
5733	 (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
5734
5735(defun vhdl-forward-comment (&optional direction)
5736  "Skip all comments (including whitespace).
5737Skip backwards if DIRECTION is negative, skip forward otherwise."
5738  (interactive "p")
5739  (if (and direction (< direction 0))
5740      ;; skip backwards
5741      (progn
5742	(skip-chars-backward " \t\n\r\f")
5743	(while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5744	  (goto-char (match-beginning 3))
5745	  (skip-chars-backward " \t\n\r\f")))
5746    ;; skip forwards
5747    (skip-chars-forward " \t\n\r\f")
5748    (while (looking-at "--.*")
5749      (goto-char (match-end 0))
5750      (skip-chars-forward " \t\n\r\f"))))
5751
5752;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5753(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
5754  (defalias 'vhdl-forward-comment #'forward-comment))
5755
5756(defun vhdl-back-to-indentation ()
5757  "Move point to the first non-whitespace character on this line."
5758  (interactive)
5759  (beginning-of-line 1)
5760  (skip-syntax-forward " " (vhdl-point 'eol)))
5761
5762;; XEmacs hack: work around old `back-to-indentation' in XEmacs
5763(when (featurep 'xemacs)
5764  (defalias 'back-to-indentation 'vhdl-back-to-indentation))
5765
5766;; This is the best we can do in Win-Emacs.
5767(defun vhdl-win-il (&optional lim)
5768  "Determine if point is in a VHDL literal."
5769  (save-excursion
5770    (let* ((here (point))
5771	   (state nil)
5772	   (match nil)
5773	   (lim  (or lim (vhdl-point 'bod))))
5774      (goto-char lim )
5775      (while (< (point) here)
5776	(setq match
5777	      (and (re-search-forward "--\\|[\"']\\|`"
5778				      here 'move)
5779		   (buffer-substring (match-beginning 0) (match-end 0))))
5780	(setq state
5781	      (cond
5782	       ;; no match
5783	       ((null match) nil)
5784	       ;; looking at the opening of a VHDL style comment
5785	       ((string= "--" match)
5786		(if (<= here (progn (end-of-line) (point))) 'comment))
5787	       ;; looking at a directive
5788	       ((string= "`" match)
5789		(if (<= here (progn (end-of-line) (point))) 'directive))
5790	       ;; looking at the opening of a double quote string
5791	       ((string= "\"" match)
5792		(if (not (save-restriction
5793			   ;; this seems to be necessary since the
5794			   ;; re-search-forward will not work without it
5795			   (narrow-to-region (point) here)
5796			   (re-search-forward
5797			    ;; this regexp matches a double quote
5798			    ;; which is preceded by an even number
5799			    ;; of backslashes, including zero
5800			    "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
5801		    'string))
5802	       ;; looking at the opening of a single quote string
5803	       ((string= "'" match)
5804		(if (not (save-restriction
5805			   ;; see comments from above
5806			   (narrow-to-region (point) here)
5807			   (re-search-forward
5808			    ;; this matches a single quote which is
5809			    ;; preceded by zero or two backslashes.
5810			    "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5811			    here 'move)))
5812		    'string))
5813	       (t nil)))
5814	) ; end-while
5815      state)))
5816
5817(and (string-match "Win-Emacs" emacs-version)
5818     (fset 'vhdl-in-literal #'vhdl-win-il))
5819
5820;; Skipping of "syntactic whitespace".  Syntactic whitespace is
5821;; defined as lexical whitespace or comments.  Search no farther back
5822;; or forward than optional LIM.  If LIM is omitted, (point-min) is
5823;; used for backward skipping, (point-max) is used for forward
5824;; skipping.
5825
5826(defun vhdl-forward-syntactic-ws (&optional lim)
5827  "Forward skip of syntactic whitespace."
5828  (let* ((here (point-max))
5829	 (hugenum (point-max)))
5830    (while (/= here (point))
5831      (setq here (point))
5832      (vhdl-forward-comment hugenum)
5833      ;; skip preprocessor directives
5834      (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
5835		 (= (vhdl-point 'boi) (point)))
5836	(while (and (eq (char-before (vhdl-point 'eol)) ?\\)
5837		    (= (forward-line 1) 0)))
5838	(end-of-line)))
5839    (if lim (goto-char (min (point) lim)))))
5840
5841
5842;; This is the best we can do in Win-Emacs.
5843(defun vhdl-win-fsws (&optional lim)
5844  "Forward skip syntactic whitespace for Win-Emacs."
5845  (let ((lim (or lim (point-max)))
5846	stop)
5847    (while (not stop)
5848      (skip-chars-forward " \t\n\r\f" lim)
5849      (cond
5850       ;; vhdl comment
5851       ((looking-at "--") (end-of-line))
5852       ;; none of the above
5853       (t (setq stop t))))))
5854
5855(and (string-match "Win-Emacs" emacs-version)
5856     (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws))
5857
5858(defun vhdl-beginning-of-macro (&optional _lim)
5859  "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5860  (let ((here (point)))
5861    (beginning-of-line)
5862    (while (eq (char-before (1- (point))) ?\\)
5863      (forward-line -1))
5864    (back-to-indentation)
5865    (if (and (<= (point) here)
5866	     (eq (char-after) ?#))
5867	t
5868      (goto-char here)
5869      nil)))
5870
5871(defun vhdl-beginning-of-directive (&optional _lim)
5872  "Go to the beginning of a directive (nicked from `cc-engine')."
5873  (let ((here (point)))
5874    (beginning-of-line)
5875    (while (eq (char-before (1- (point))) ?\\)
5876      (forward-line -1))
5877    (back-to-indentation)
5878    (if (and (<= (point) here)
5879	     (eq (char-after) ?`))
5880	t
5881      (goto-char here)
5882      nil)))
5883
5884(defun vhdl-backward-syntactic-ws (&optional lim)
5885  "Backward skip over syntactic whitespace."
5886  (let* ((here (point-min))
5887	 (hugenum (- (point-max))))
5888    (while (/= here (point))
5889      (setq here (point))
5890      (vhdl-forward-comment hugenum)
5891      (vhdl-beginning-of-macro))
5892    (if lim (goto-char (max (point) lim)))))
5893
5894;; This is the best we can do in Win-Emacs.
5895(defun vhdl-win-bsws (&optional lim)
5896  "Backward skip syntactic whitespace for Win-Emacs."
5897  (let ((lim (or lim (vhdl-point 'bod)))
5898	stop)
5899    (while (not stop)
5900      (skip-chars-backward " \t\n\r\f" lim)
5901      (cond
5902       ;; vhdl comment
5903       ((eq (vhdl-in-literal) 'comment)
5904	(skip-chars-backward "^-" lim)
5905	(skip-chars-backward "-" lim)
5906	(while (not (or (and (= (following-char) ?-)
5907			     (= (char-after (1+ (point))) ?-))
5908			(<= (point) lim)))
5909	  (skip-chars-backward "^-" lim)
5910	  (skip-chars-backward "-" lim)))
5911       ;; none of the above
5912       (t (setq stop t))))))
5913
5914(and (string-match "Win-Emacs" emacs-version)
5915    (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws))
5916
5917;; Functions to help finding the correct indentation column:
5918
5919(defun vhdl-first-word (point)
5920  "If the keyword at POINT is at boi, return (current-column) at that point.
5921Otherwise return nil."
5922  (save-excursion
5923    (and (goto-char point)
5924	 (eq (point) (vhdl-point 'boi))
5925	 (current-column))))
5926
5927(defun vhdl-last-word (point)
5928  "If keyword at POINT is at eoi, then return (current-column) at that point.
5929Otherwise, return nil."
5930  (save-excursion
5931    (and (goto-char point)
5932	 (save-excursion (or (eq (progn (forward-sexp) (point))
5933				 (vhdl-point 'eoi))
5934			     (looking-at "\\s-*\\(--\\)?")))
5935	 (current-column))))
5936
5937;; Core syntactic evaluation functions:
5938
5939(defconst vhdl-libunit-re
5940  "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
5941
5942(defun vhdl-libunit-p ()
5943  (and
5944   (save-excursion
5945     (forward-sexp)
5946     (skip-chars-forward " \t\n\r\f")
5947     (not (looking-at "is\\b[^_]")))
5948   (save-excursion
5949     (backward-sexp)
5950     (and (not (looking-at "use\\b[^_]"))
5951	  (progn
5952	    (forward-sexp)
5953	    (vhdl-forward-syntactic-ws)
5954	    (/= (following-char) ?:))))
5955   ))
5956
5957(defconst vhdl-defun-re
5958  "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5959
5960(defun vhdl-defun-p ()
5961  (save-excursion
5962    (if (looking-at "block\\|process\\|procedural")
5963	;; "block", "process", "procedural":
5964	(save-excursion
5965	  (backward-sexp)
5966	  (not (looking-at "end\\s-+\\w")))
5967      ;; "architecture", "configuration", "context", "entity",
5968      ;; "package", "procedure", "function":
5969      t)))
5970
5971(defun vhdl-corresponding-defun ()
5972  "If the word at the current position corresponds to a \"defun\"
5973keyword, then return a string that can be used to find the
5974corresponding \"begin\" keyword, else return nil."
5975  (save-excursion
5976    (and (looking-at vhdl-defun-re)
5977	 (vhdl-defun-p)
5978	 (if (looking-at "block\\|process\\|procedural")
5979	     ;; "block", "process". "procedural:
5980	     (buffer-substring (match-beginning 0) (match-end 0))
5981	   ;; "architecture", "configuration", "context", "entity", "package",
5982	   ;; "procedure", "function":
5983	   "is"))))
5984
5985(defconst vhdl-begin-fwd-re
5986  "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
5987  "Regexp for searching forward that matches all known \"begin\" keywords.")
5988
5989(defconst vhdl-begin-bwd-re
5990  "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
5991  "Regexp for searching backward that matches all known \"begin\" keywords.")
5992
5993(defun vhdl-begin-p (&optional lim)
5994  "Return t if we are looking at a real \"begin\" keyword.
5995Assumes that the caller will make sure that we are looking at
5996vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5997the middle of an identifier that just happens to contain a \"begin\"
5998keyword."
5999  (cond
6000   ;; "[architecture|case|configuration|context|entity|package|
6001   ;;   procedure|function] ... is":
6002   ((and (looking-at "i")
6003	 (save-excursion
6004	   ;; Skip backward over first sexp (needed to skip over a
6005	   ;; procedure interface list, and is harmless in other
6006	   ;; situations).  Note that we need "return" in the
6007	   ;; following search list so that we don't run into
6008	   ;; semicolons in the function interface list.
6009	   (backward-sexp)
6010	   (skip-chars-forward "(")
6011	   (let (foundp)
6012	     (while (and (not foundp)
6013			 (re-search-backward
6014			  ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
6015			  lim 'move))
6016	       (if (or (= (preceding-char) ?_)
6017		       (vhdl-in-literal))
6018		   (backward-char)
6019		 (setq foundp t))))
6020	   (and (/= (following-char) ?\;)
6021		(not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
6022    t)
6023   ;; "begin", "then", "use":
6024   ((looking-at "be\\|t\\|use")
6025    t)
6026   ;; "else":
6027   ((and (looking-at "e")
6028	 ;; make sure that the "else" isn't inside a
6029	 ;; conditional signal assignment.
6030	 (save-excursion
6031	   (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6032	   (or (eq (following-char) ?\;)
6033	       (eq (point) lim))))
6034    t)
6035   ;; "block", "generate", "loop", "process", "procedural",
6036   ;; "units", "record", "protected body":
6037   ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
6038	 (save-excursion
6039	   (backward-sexp)
6040	   (not (looking-at "end\\s-+\\w"))))
6041    t)
6042   ;; "component":
6043   ((and (looking-at "c")
6044	 (save-excursion
6045	   (backward-sexp)
6046	   (not (looking-at "end\\s-+\\w")))
6047	 ;; look out for the dreaded entity class in an attribute
6048	 (save-excursion
6049	   (vhdl-backward-syntactic-ws lim)
6050	   (/= (preceding-char) ?:)))
6051    t)
6052   ;; "for" (inside configuration declaration):
6053   ((and (looking-at "f")
6054	 (save-excursion
6055	   (backward-sexp)
6056	   (not (looking-at "end\\s-+\\w")))
6057	 (vhdl-has-syntax 'configuration))
6058    t)
6059   ))
6060
6061(defun vhdl-corresponding-mid (&optional _lim)
6062  (cond
6063   ((looking-at "is\\|block\\|generate\\|process\\|procedural")
6064    "begin")
6065   ((looking-at "then\\|use")
6066    "<else>")
6067   (t
6068    "end")))
6069
6070(defun vhdl-corresponding-end (&optional lim)
6071  "If the word at the current position corresponds to a \"begin\"
6072keyword, then return a vector containing enough information to find
6073the corresponding \"end\" keyword, else return nil.  The keyword to
6074search forward for is aref 0.  The column in which the keyword must
6075appear is aref 1 or nil if any column is suitable.
6076Assumes that the caller will make sure that we are not in the middle
6077of an identifier that just happens to contain a \"begin\" keyword."
6078  (save-excursion
6079    (and (looking-at vhdl-begin-fwd-re)
6080	 (or (not (looking-at "\\<use\\>"))
6081	     (save-excursion (back-to-indentation)
6082			     (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6083	 (/= (preceding-char) ?_)
6084	 (not (vhdl-in-literal))
6085	 (vhdl-begin-p lim)
6086	 (cond
6087	  ;; "is", "generate", "loop":
6088	  ((looking-at "[igl]")
6089	   (vector "end"
6090		   (and (vhdl-last-word (point))
6091			(or (vhdl-first-word (point))
6092			    (save-excursion
6093			      (vhdl-beginning-of-statement-1 lim)
6094			      (vhdl-backward-skip-label lim)
6095			      (vhdl-first-word (point)))))))
6096	  ;; "begin", "else", "for":
6097	  ((looking-at "be\\|[ef]")
6098	   (vector "end"
6099		   (and (vhdl-last-word (point))
6100			(or (vhdl-first-word (point))
6101			    (save-excursion
6102			      (vhdl-beginning-of-statement-1 lim)
6103			      (vhdl-backward-skip-label lim)
6104			      (vhdl-first-word (point)))))))
6105	  ;; "component", "units", "record", "protected body":
6106	  ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
6107	   ;; The first end found will close the block
6108	   (vector "end" nil))
6109	  ;; "block", "process", "procedural":
6110	  ((looking-at "bl\\|p")
6111	   (vector "end"
6112		   (or (vhdl-first-word (point))
6113		       (save-excursion
6114			 (vhdl-beginning-of-statement-1 lim)
6115			 (vhdl-backward-skip-label lim)
6116			 (vhdl-first-word (point))))))
6117	  ;; "then":
6118	  ((looking-at "t\\|use")
6119	   (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
6120		   (and (vhdl-last-word (point))
6121			(or (vhdl-first-word (point))
6122			    (save-excursion
6123			      (vhdl-beginning-of-statement-1 lim)
6124			      (vhdl-backward-skip-label lim)
6125			      (vhdl-first-word (point)))))))
6126	  ))))
6127
6128(defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
6129
6130(defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]")
6131
6132(defun vhdl-end-p (&optional lim)
6133  "Return t if we are looking at a real \"end\" keyword.
6134Assumes that the caller will make sure that we are looking at
6135vhdl-end-fwd-re, and are not inside a literal, and that we are not in
6136the middle of an identifier that just happens to contain an \"end\"
6137keyword."
6138  (or (not (looking-at "else"))
6139      ;; make sure that the "else" isn't inside a conditional signal
6140      ;; assignment.
6141      (save-excursion
6142	(re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6143	(or (eq (following-char) ?\;)
6144	    (eq (point) lim)
6145	    (vhdl-in-literal)))))
6146
6147(defun vhdl-corresponding-begin (&optional lim)
6148  "If the word at the current position corresponds to an \"end\"
6149keyword, then return a vector containing enough information to find
6150the corresponding \"begin\" keyword, else return nil.  The keyword to
6151search backward for is aref 0.  The column in which the keyword must
6152appear is aref 1 or nil if any column is suitable.  The supplementary
6153keyword to search forward for is aref 2 or nil if this is not
6154required.  If aref 3 is t, then the \"begin\" keyword may be found in
6155the middle of a statement.
6156Assumes that the caller will make sure that we are not in the middle
6157of an identifier that just happens to contain an \"end\" keyword."
6158  (save-excursion
6159    (let (pos)
6160      (if (and (looking-at vhdl-end-fwd-re)
6161	       (not (vhdl-in-literal))
6162	       (vhdl-end-p lim))
6163	  (if (looking-at "el")
6164	      ;; "else", "elsif":
6165	      (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
6166	    ;; "end ...":
6167	    (setq pos (point))
6168	    (forward-sexp)
6169	    (skip-chars-forward " \t\n\r\f")
6170	    (cond
6171	     ;; "end if":
6172	     ((looking-at "if\\b[^_]")
6173	      (vector "else\\|elsif\\|if"
6174		      (vhdl-first-word pos)
6175		      "else\\|then\\|use" nil))
6176	     ;; "end component":
6177	     ((looking-at "component\\b[^_]")
6178	      (vector (buffer-substring (match-beginning 1)
6179					(match-end 1))
6180		      (vhdl-first-word pos)
6181		      nil nil))
6182	     ;; "end units", "end record", "end protected":
6183	     ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
6184	      (vector (buffer-substring (match-beginning 1)
6185					(match-end 1))
6186		      (vhdl-first-word pos)
6187		      nil t))
6188	     ;; "end block", "end process", "end procedural":
6189	     ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
6190	      (vector "begin" (vhdl-first-word pos) nil nil))
6191	     ;; "end case":
6192	     ((looking-at "case\\b[^_]")
6193	      (vector "case" (vhdl-first-word pos) "is" nil))
6194	     ;; "end generate":
6195	     ((looking-at "generate\\b[^_]")
6196	      (vector "generate\\|for\\|if"
6197		      (vhdl-first-word pos)
6198		      "generate" nil))
6199	     ;; "end loop":
6200	     ((looking-at "loop\\b[^_]")
6201	      (vector "loop\\|while\\|for"
6202		      (vhdl-first-word pos)
6203		      "loop" nil))
6204	     ;; "end for" (inside configuration declaration):
6205	     ((looking-at "for\\b[^_]")
6206	      (vector "for" (vhdl-first-word pos) nil nil))
6207	     ;; "end [id]":
6208	     (t
6209	      (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
6210		      (vhdl-first-word pos)
6211		      ;; return an alist of (statement . keyword) mappings
6212		      '(
6213			;; "begin ... end [id]":
6214			("begin"	  . nil)
6215			;; "architecture ... is ... begin ... end [id]":
6216			("architecture"	  . "is")
6217			;; "configuration ... is ... end [id]":
6218			("configuration"  . "is")
6219			;; "context ... is ... end [id]":
6220			("context"	  . "is")
6221			;; "entity ... is ... end [id]":
6222			("entity"	  . "is")
6223			;; "package ... is ... end [id]":
6224			("package"	  . "is")
6225			;; "procedure ... is ... begin ... end [id]":
6226			("procedure"      . "is")
6227			;; "function ... is ... begin ... end [id]":
6228			("function"       . "is")
6229			)
6230		      nil))
6231	     ))) ; "end ..."
6232      )))
6233
6234(defconst vhdl-leader-re
6235  "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
6236
6237(defun vhdl-end-of-leader ()
6238  (save-excursion
6239    (cond ((looking-at "block\\|process\\|procedural")
6240	   (if (save-excursion
6241		 (forward-sexp)
6242		 (skip-chars-forward " \t\n\r\f")
6243		 (= (following-char) ?\())
6244	       (forward-sexp 2)
6245	     (forward-sexp))
6246	   (when (looking-at "[ \t\n\r\f]*is")
6247	     (goto-char (match-end 0)))
6248	   (point))
6249	  ((looking-at "component")
6250	   (forward-sexp 2)
6251	   (when (looking-at "[ \t\n\r\f]*is")
6252	     (goto-char (match-end 0)))
6253	   (point))
6254	  ((looking-at "for")
6255	   (forward-sexp 2)
6256	   (skip-chars-forward " \t\n\r\f")
6257	   (while (looking-at "[,:(]")
6258	     (forward-sexp)
6259	     (skip-chars-forward " \t\n\r\f"))
6260	   (point))
6261	  (t nil)
6262	  )))
6263
6264(defconst vhdl-trailer-re
6265  "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
6266
6267(defconst vhdl-statement-fwd-re
6268  "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
6269  "Regexp for searching forward that matches all known \"statement\" keywords.")
6270
6271(defconst vhdl-statement-bwd-re
6272  "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
6273  "Regexp for searching backward that matches all known \"statement\" keywords.")
6274
6275(defun vhdl-statement-p (&optional _lim)
6276  "Return t if we are looking at a real \"statement\" keyword.
6277Assumes that the caller will make sure that we are looking at
6278vhdl-statement-fwd-re, and are not inside a literal, and that we are not
6279in the middle of an identifier that just happens to contain a
6280\"statement\" keyword."
6281  (cond
6282   ;; "for" ... "generate":
6283   ((and (looking-at "f")
6284	 ;; Make sure it's the start of a parameter specification.
6285	 (save-excursion
6286	   (forward-sexp 2)
6287	   (skip-chars-forward " \t\n\r\f")
6288	   (looking-at "in\\b[^_]"))
6289	 ;; Make sure it's not an "end for".
6290	 (save-excursion
6291	   (backward-sexp)
6292	   (not (looking-at "end\\s-+\\w"))))
6293    t)
6294   ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
6295   ((and (looking-at "i")
6296	 ;; Make sure it's not an "end if".
6297	 (save-excursion
6298	   (backward-sexp)
6299	   (not (looking-at "end\\s-+\\w"))))
6300    t)
6301   ;; "while" ... "loop":
6302   ((looking-at "w")
6303    t)
6304   ))
6305
6306(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>"
6307  "Regexp describing a case statement alternative key.")
6308
6309(defun vhdl-case-alternative-p (&optional lim)
6310  "Return t if we are looking at a real case alternative.
6311Assumes that the caller will make sure that we are looking at
6312vhdl-case-alternative-re, and are not inside a literal, and that
6313we are not in the middle of an identifier that just happens to
6314contain a \"when\" keyword."
6315  (save-excursion
6316    (let (foundp)
6317      (while (and (not foundp)
6318		  (re-search-backward ";\\|<=" lim 'move))
6319	(if (or (= (preceding-char) ?_)
6320		(vhdl-in-literal))
6321	    (backward-char)
6322	  (setq foundp t)))
6323      (or (eq (following-char) ?\;)
6324	  (eq (point) lim)))
6325    ))
6326
6327;; Core syntactic movement functions:
6328
6329(defconst vhdl-b-t-b-re
6330  (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
6331
6332(defun vhdl-backward-to-block (&optional lim)
6333  "Move backward to the previous \"begin\" or \"end\" keyword."
6334  (let (foundp)
6335    (while (and (not foundp)
6336		(re-search-backward vhdl-b-t-b-re lim 'move))
6337      (if (or (= (preceding-char) ?_)
6338	      (vhdl-in-literal))
6339	  (backward-char)
6340	(cond
6341	 ;; "begin" keyword:
6342	 ((and (looking-at vhdl-begin-fwd-re)
6343	       (or (not (looking-at "\\<use\\>"))
6344		   (save-excursion (back-to-indentation)
6345				   (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6346	       (/= (preceding-char) ?_)
6347	       (vhdl-begin-p lim))
6348	  (setq foundp 'begin))
6349	 ;; "end" keyword:
6350	 ((and (looking-at vhdl-end-fwd-re)
6351	       (/= (preceding-char) ?_)
6352	       (vhdl-end-p lim))
6353	  (setq foundp 'end))
6354	 ))
6355      )
6356    foundp
6357    ))
6358
6359(defun vhdl-forward-sexp (&optional count lim)
6360  "Move forward across one balanced expression (sexp).
6361With COUNT, do it that many times."
6362  (interactive "p")
6363  (let ((count (or count 1))
6364	(case-fold-search t)
6365	end-vec target)
6366    (save-excursion
6367      (while (> count 0)
6368	;; skip whitespace
6369	(skip-chars-forward " \t\n\r\f")
6370	;; Check for an unbalanced "end" keyword
6371	(if (and (looking-at vhdl-end-fwd-re)
6372		 (/= (preceding-char) ?_)
6373		 (not (vhdl-in-literal))
6374		 (vhdl-end-p lim)
6375		 (not (looking-at "else")))
6376	    (error
6377	     "ERROR:  Containing expression ends prematurely in vhdl-forward-sexp"))
6378	;; If the current keyword is a "begin" keyword, then find the
6379	;; corresponding "end" keyword.
6380	(if (setq end-vec (vhdl-corresponding-end lim))
6381	    (let (
6382		  ;; end-re is the statement keyword to search for
6383		  (end-re
6384		   (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
6385		  ;; column is either the statement keyword target column
6386		  ;; or nil
6387		  (column (aref end-vec 1))
6388		  (eol (vhdl-point 'eol))
6389		  foundp literal placeholder)
6390	      ;; Look for the statement keyword.
6391	      (while (and (not foundp)
6392			  (re-search-forward end-re nil t)
6393			  (setq placeholder (match-end 1))
6394			  (goto-char (match-beginning 0)))
6395		;; If we are in a literal, or not in the right target
6396		;; column and not on the same line as the begin, then
6397		;; try again.
6398		(if (or (and column
6399			     (/= (current-indentation) column)
6400			     (> (point) eol))
6401			(= (preceding-char) ?_)
6402			(setq literal (vhdl-in-literal)))
6403		    (if (eq literal 'comment)
6404			(end-of-line)
6405		      (forward-char))
6406		  ;; An "else" keyword corresponds to both the opening brace
6407		  ;; of the following sexp and the closing brace of the
6408		  ;; previous sexp.
6409		  (if (not (looking-at "else"))
6410		      (goto-char placeholder))
6411		  (setq foundp t))
6412		)
6413	      (if (not foundp)
6414		  (error "ERROR:  Unbalanced keywords in vhdl-forward-sexp"))
6415	      )
6416	  ;; If the current keyword is not a "begin" keyword, then just
6417	  ;; perform the normal forward-sexp.
6418	  (forward-sexp)
6419	  )
6420	(setq count (1- count))
6421	)
6422      (setq target (point)))
6423    (goto-char target)
6424    nil))
6425
6426(defun vhdl-backward-sexp (&optional count lim)
6427  "Move backward across one balanced expression (sexp).
6428With COUNT, do it that many times.  LIM bounds any required backward
6429searches."
6430  (interactive "p")
6431  (let ((count (or count 1))
6432	(case-fold-search t)
6433	begin-vec target)
6434    (save-excursion
6435      (while (> count 0)
6436	;; Perform the normal backward-sexp, unless we are looking at
6437	;; "else" - an "else" keyword corresponds to both the opening brace
6438	;; of the following sexp and the closing brace of the previous sexp.
6439	(if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
6440		 (/= (preceding-char) ?_)
6441		 (not (vhdl-in-literal)))
6442	    nil
6443	  (backward-sexp)
6444	  (if (and (looking-at vhdl-begin-fwd-re)
6445		   (or (not (looking-at "\\<use\\>"))
6446		       (save-excursion
6447			 (back-to-indentation)
6448			 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6449		   (/= (preceding-char) ?_)
6450		   (not (vhdl-in-literal))
6451		   (vhdl-begin-p lim))
6452	      (error "ERROR:  Containing expression ends prematurely in vhdl-backward-sexp")))
6453	;; If the current keyword is an "end" keyword, then find the
6454	;; corresponding "begin" keyword.
6455	(if (and (setq begin-vec (vhdl-corresponding-begin lim))
6456		 (/= (preceding-char) ?_))
6457	    (let (
6458		  ;; begin-re is the statement keyword to search for
6459		  (begin-re
6460		   (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
6461		  ;; column is either the statement keyword target column
6462		  ;; or nil
6463		  (column (aref begin-vec 1))
6464		  ;; internal-p controls where the statement keyword can
6465		  ;; be found.
6466		  (internal-p (aref begin-vec 3))
6467		  (last-backward (point)) ;; last-forward
6468		  foundp literal keyword)
6469	      ;; Look for the statement keyword.
6470	      (while (and (not foundp)
6471			  (re-search-backward begin-re lim t)
6472			  (setq keyword
6473				(buffer-substring (match-beginning 1)
6474						  (match-end 1))))
6475		;; If we are in a literal or in the wrong column,
6476		;; then try again.
6477		(if (or (and column
6478			     (and (/= (current-indentation) column)
6479				  ;; possibly accept current-column as
6480				  ;; well as current-indentation.
6481				  (or (not internal-p)
6482				      (/= (current-column) column))))
6483			(= (preceding-char) ?_)
6484			(vhdl-in-literal))
6485		    (backward-char)
6486		  ;; If there is a supplementary keyword, then
6487		  ;; search forward for it.
6488		  (if (and (setq begin-re (aref begin-vec 2))
6489			   (or (not (listp begin-re))
6490			       ;; If begin-re is an alist, then find the
6491			       ;; element corresponding to the actual
6492			       ;; keyword that we found.
6493			       (progn
6494				 (setq begin-re
6495				       (assoc keyword begin-re))
6496				 (and begin-re
6497				      (setq begin-re (cdr begin-re))))))
6498		      (and
6499		       (setq begin-re
6500			     (concat "\\b\\(" begin-re "\\)\\b[^_]"))
6501		       (save-excursion
6502			 ;; (setq last-forward (point))
6503			 ;; Look for the supplementary keyword
6504			 ;; (bounded by the backward search start
6505			 ;; point).
6506			 (while (and (not foundp)
6507				     (re-search-forward begin-re
6508							last-backward t)
6509				     (goto-char (match-beginning 1)))
6510			   ;; If we are in a literal, then try again.
6511			   (if (or (= (preceding-char) ?_)
6512				   (setq literal
6513					 (vhdl-in-literal)))
6514			       (if (eq literal 'comment)
6515				   (goto-char
6516				    (min (vhdl-point 'eol) last-backward))
6517				 (forward-char))
6518			     ;; We have found the supplementary keyword.
6519			     ;; Save the position of the keyword in foundp.
6520			     (setq foundp (point)))
6521			   )
6522			 foundp)
6523		       ;; If the supplementary keyword was found, then
6524		       ;; move point to the supplementary keyword.
6525		       (goto-char foundp))
6526		    ;; If there was no supplementary keyword, then
6527		    ;; point is already at the statement keyword.
6528		    (setq foundp t)))
6529		) ; end of the search for the statement keyword
6530	      (if (not foundp)
6531		  (error "ERROR:  Unbalanced keywords in vhdl-backward-sexp"))
6532	      ))
6533	(setq count (1- count))
6534	)
6535      (setq target (point)))
6536    (goto-char target)
6537    nil))
6538
6539(defun vhdl-backward-up-list (&optional count limit)
6540  "Move backward out of one level of blocks.
6541With argument, do this that many times."
6542  (interactive "p")
6543  (let ((count (or count 1))
6544	target)
6545    (save-excursion
6546      (while (> count 0)
6547	(if (looking-at vhdl-defun-re)
6548	    (error "ERROR:  Unbalanced blocks"))
6549	(vhdl-backward-to-block limit)
6550	(setq count (1- count)))
6551      (setq target (point)))
6552    (goto-char target)))
6553
6554(defun vhdl-end-of-defun (&optional _count)
6555  "Move forward to the end of a VHDL defun."
6556  (interactive)
6557  (let ((case-fold-search t))
6558    (vhdl-beginning-of-defun)
6559    (if (not (looking-at "block\\|process\\|procedural"))
6560	(re-search-forward "\\bis\\b"))
6561    (vhdl-forward-sexp)))
6562
6563(defun vhdl-mark-defun ()
6564  "Put mark at end of this \"defun\", point at beginning."
6565  (interactive)
6566  (let ((case-fold-search t))
6567    (push-mark)
6568    (vhdl-beginning-of-defun)
6569    (push-mark)
6570    (if (not (looking-at "block\\|process\\|procedural"))
6571	(re-search-forward "\\bis\\b"))
6572    (vhdl-forward-sexp)
6573    (exchange-point-and-mark)))
6574
6575(defun vhdl-beginning-of-libunit ()
6576  "Move backward to the beginning of a VHDL library unit.
6577Returns the location of the corresponding begin keyword, unless search
6578stops due to beginning or end of buffer.
6579Note that if point is between the \"libunit\" keyword and the
6580corresponding \"begin\" keyword, then that libunit will not be
6581recognized, and the search will continue backwards.  If point is
6582at the \"begin\" keyword, then the defun will be recognized.  The
6583returned point is at the first character of the \"libunit\" keyword."
6584  (let ((last-forward (point))
6585	(last-backward
6586	 ;; Just in case we are actually sitting on the "begin"
6587	 ;; keyword, allow for the keyword and an extra character,
6588	 ;; as this will be used when looking forward for the
6589	 ;; "begin" keyword.
6590	 (save-excursion (forward-word-strictly 1) (1+ (point))))
6591	foundp literal placeholder)
6592    ;; Find the "libunit" keyword.
6593    (while (and (not foundp)
6594		(re-search-backward vhdl-libunit-re nil 'move))
6595      ;; If we are in a literal, or not at a real libunit, then try again.
6596      (if (or (= (preceding-char) ?_)
6597	      (vhdl-in-literal)
6598	      (not (vhdl-libunit-p)))
6599	  (backward-char)
6600	;; Find the corresponding "begin" keyword.
6601	(setq last-forward (point))
6602	(while (and (not foundp)
6603		    (re-search-forward "\\bis\\b[^_]" last-backward t)
6604		    (setq placeholder (match-beginning 0)))
6605	  (if (or (= (preceding-char) ?_)
6606		  (setq literal (vhdl-in-literal)))
6607	      ;; It wasn't a real keyword, so keep searching.
6608	      (if (eq literal 'comment)
6609		  (goto-char
6610		   (min (vhdl-point 'eol) last-backward))
6611		(forward-char))
6612	    ;; We have found the begin keyword, loop will exit.
6613	    (setq foundp placeholder)))
6614	;; Go back to the libunit keyword
6615	(goto-char last-forward)))
6616    foundp))
6617
6618(defun vhdl-beginning-of-defun (&optional count)
6619  "Move backward to the beginning of a VHDL defun.
6620With argument, do it that many times.
6621Returns the location of the corresponding begin keyword, unless search
6622stops due to beginning or end of buffer."
6623  ;; Note that if point is between the "defun" keyword and the
6624  ;; corresponding "begin" keyword, then that defun will not be
6625  ;; recognized, and the search will continue backwards.  If point is
6626  ;; at the "begin" keyword, then the defun will be recognized.  The
6627  ;; returned point is at the first character of the "defun" keyword.
6628  (interactive "p")
6629  (let ((count (or count 1))
6630	(case-fold-search t)
6631	(last-forward (point))
6632	foundp)
6633    (while (> count 0)
6634      (setq foundp nil)
6635      (goto-char last-forward)
6636      (let ((last-backward
6637	     ;; Just in case we are actually sitting on the "begin"
6638	     ;; keyword, allow for the keyword and an extra character,
6639	     ;; as this will be used when looking forward for the
6640	     ;; "begin" keyword.
6641	     (save-excursion (forward-word-strictly 1) (1+ (point))))
6642	    begin-string literal)
6643	(while (and (not foundp)
6644		    (re-search-backward vhdl-defun-re nil 'move))
6645	  ;; If we are in a literal, then try again.
6646	  (if (or (= (preceding-char) ?_)
6647		  (vhdl-in-literal))
6648	      (backward-char)
6649	    (if (setq begin-string (vhdl-corresponding-defun))
6650		;; This is a real defun keyword.
6651		;; Find the corresponding "begin" keyword.
6652		;; Look for the begin keyword.
6653		(progn
6654		  ;; Save the search start point.
6655		  (setq last-forward (point))
6656		  (while (and (not foundp)
6657			      (search-forward begin-string last-backward t))
6658		    (if (or (= (preceding-char) ?_)
6659			    (save-match-data
6660			      (setq literal (vhdl-in-literal))))
6661			;; It wasn't a real keyword, so keep searching.
6662			(if (eq literal 'comment)
6663			    (goto-char
6664			     (min (vhdl-point 'eol) last-backward))
6665			  (forward-char))
6666		      ;; We have found the begin keyword, loop will exit.
6667		      (setq foundp (match-beginning 0)))
6668		    )
6669		  ;; Go back to the defun keyword
6670		  (goto-char last-forward)) ; end search for begin keyword
6671	      ))
6672	  ) ; end of the search for the defun keyword
6673	)
6674      (setq count (1- count))
6675      )
6676    (vhdl-keep-region-active)
6677    foundp))
6678
6679(defun vhdl-beginning-of-statement (&optional count lim interactive)
6680  "Go to the beginning of the innermost VHDL statement.
6681With prefix arg, go back N - 1 statements.  If already at the
6682beginning of a statement then go to the beginning of the preceding
6683one.  If within a string or comment, or next to a comment (only
6684whitespace between), move by sentences instead of statements.
6685
6686When called from a program, this function takes 3 optional args: the
6687prefix arg, a buffer position limit which is the farthest back to
6688search, and an argument indicating an interactive call."
6689  (interactive "p\np")
6690  (let ((count (or count 1))
6691	(case-fold-search t)
6692	(lim (or lim (point-min)))
6693	(here (point))
6694	state)
6695    (save-excursion
6696      (goto-char lim)
6697      (setq state (parse-partial-sexp (point) here nil nil)))
6698    (if (and interactive
6699	     (or (nth 3 state)
6700		 (nth 4 state)
6701		 (looking-at (concat "[ \t]*\\(?:" comment-start-skip "\\)"))))
6702	(forward-sentence (- count))
6703      (while (> count 0)
6704	(vhdl-beginning-of-statement-1 lim)
6705	(setq count (1- count))))
6706    ;; its possible we've been left up-buf of lim
6707    (goto-char (max (point) lim))
6708    )
6709  (vhdl-keep-region-active))
6710
6711(defconst vhdl-e-o-s-re
6712  (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re))
6713
6714(defun vhdl-end-of-statement ()
6715  "Very simple implementation."
6716  (interactive)
6717  (re-search-forward vhdl-e-o-s-re))
6718
6719(defconst vhdl-b-o-s-re
6720  (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|"
6721	  vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
6722
6723(defun vhdl-beginning-of-statement-1 (&optional lim)
6724  "Move to the start of the current statement.
6725If already at the beginning of a statement, move to the start of
6726the previous statement instead."
6727  (let ((lim (or lim (point-min)))
6728	(here (point))
6729	(pos (point))
6730	donep)
6731    ;; go backwards one balanced expression, but be careful of
6732    ;; unbalanced paren being reached
6733    (if (not (vhdl-safe (progn (backward-sexp) t)))
6734	(progn
6735	  (backward-up-list 1)
6736	  (forward-char)
6737	  (vhdl-forward-syntactic-ws here)
6738	  (setq donep t)))
6739    (while (and (not donep)
6740		(not (bobp))
6741		;; look backwards for a statement boundary
6742		(progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move)))
6743      (if (or (= (preceding-char) ?_)
6744	      (vhdl-in-literal))
6745	  (backward-char)
6746	(cond
6747	 ;; If we are looking at an open paren, then stop after it
6748	 ((eq (following-char) ?\()
6749	  (forward-char)
6750	  (vhdl-forward-syntactic-ws here)
6751	  (setq donep t))
6752	 ;; If we are looking at a close paren, then skip it
6753	 ((eq (following-char) ?\))
6754	  (forward-char)
6755	  (setq pos (point))
6756	  (backward-sexp)
6757	  (if (< (point) lim)
6758	      (progn (goto-char pos)
6759		     (vhdl-forward-syntactic-ws here)
6760		     (setq donep t))))
6761	 ;; If we are looking at a semicolon, then stop
6762	 ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p)))
6763	  (progn
6764	    (forward-char)
6765	    (vhdl-forward-syntactic-ws here)
6766	    (setq donep t)))
6767	 ;; If we are looking at a "begin", then stop
6768	 ((and (looking-at vhdl-begin-fwd-re)
6769	       (or (not (looking-at "\\<use\\>"))
6770		   (save-excursion
6771		     (back-to-indentation)
6772		     (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6773	       (/= (preceding-char) ?_)
6774	       (vhdl-begin-p nil))
6775	  ;; If it's a leader "begin", then find the
6776	  ;; right place
6777	  (if (looking-at vhdl-leader-re)
6778	      (save-excursion
6779		;; set a default stop point at the begin
6780		(setq pos (point))
6781		;; is the start point inside the leader area ?
6782		(goto-char (vhdl-end-of-leader))
6783		(vhdl-forward-syntactic-ws here)
6784		(if (< (point) here)
6785		    ;; start point was not inside leader area
6786		    ;; set stop point at word after leader
6787		    (setq pos (point))))
6788	    (unless (looking-at "\\<else\\s-+generate\\>")
6789	      (forward-word-strictly 1))
6790	    (vhdl-forward-syntactic-ws here)
6791	    (setq pos (point)))
6792	  (goto-char pos)
6793	  (setq donep t))
6794	 ;; If we are looking at a "statement", then stop
6795	 ((and (looking-at vhdl-statement-fwd-re)
6796	       (/= (preceding-char) ?_)
6797	       (vhdl-statement-p nil))
6798	  (setq donep t))
6799	 ;; If we are looking at a case alternative key, then stop
6800	 ((and (looking-at vhdl-case-alternative-re)
6801	       (vhdl-case-alternative-p lim))
6802	  (save-excursion
6803	    ;; set a default stop point at the when
6804	    (setq pos (point))
6805	    ;; is the start point inside the case alternative key ?
6806	    (looking-at vhdl-case-alternative-re)
6807	    (goto-char (match-end 0))
6808	    (vhdl-forward-syntactic-ws here)
6809	    (if (< (point) here)
6810		;; start point was not inside the case alternative key
6811		;; set stop point at word after case alternative keyleader
6812		(setq pos (point))))
6813	  (goto-char pos)
6814	  (setq donep t))
6815	 ;; Bogus find, continue
6816	 (t
6817	  (backward-char)))))
6818    ))
6819
6820;; Defuns for calculating the current syntactic state:
6821
6822(defun vhdl-get-library-unit (bod placeholder)
6823  "If there is an enclosing library unit at BOD, with its \"begin\"
6824keyword at PLACEHOLDER, then return the library unit type."
6825  (let ((here (vhdl-point 'bol)))
6826    (if (save-excursion
6827	  (goto-char placeholder)
6828	  (vhdl-safe (vhdl-forward-sexp 1 bod))
6829	  (<= here (point)))
6830	(save-excursion
6831	  (goto-char bod)
6832	  (cond
6833	   ((looking-at "e") 'entity)
6834	   ((looking-at "a") 'architecture)
6835	   ((looking-at "conf") 'configuration)
6836	   ((looking-at "cont") 'context)
6837	   ((looking-at "p")
6838	    (save-excursion
6839	      (goto-char bod)
6840	      (forward-sexp)
6841	      (vhdl-forward-syntactic-ws here)
6842	      (if (looking-at "body\\b[^_]")
6843		  'package-body 'package))))))
6844    ))
6845
6846(defun vhdl-get-block-state (&optional lim)
6847  "Find and records all the closest opens.
6848LIM is the furthest back we need to search (it should be the
6849previous libunit keyword)."
6850  (let ((here (point))
6851	(lim (or lim (point-min)))
6852	keyword sexp-start sexp-mid sexp-end
6853	preceding-sexp containing-sexp
6854	containing-begin containing-mid containing-paren)
6855    (save-excursion
6856      ;; Find the containing-paren, and use that as the limit
6857      (if (setq containing-paren
6858		(save-restriction
6859		  (narrow-to-region lim (point))
6860		  (vhdl-safe (scan-lists (point) -1 1))))
6861	  (setq lim containing-paren))
6862      ;; Look backwards for "begin" and "end" keywords.
6863      (while (and (> (point) lim)
6864		  (not containing-sexp))
6865	(setq keyword (vhdl-backward-to-block lim))
6866	(cond
6867	 ((eq keyword 'begin)
6868	  ;; Found a "begin" keyword
6869	  (setq sexp-start (point))
6870	  (setq sexp-mid (vhdl-corresponding-mid lim))
6871	  (setq sexp-end (vhdl-safe
6872			  (save-excursion
6873			    (vhdl-forward-sexp 1 lim) (point))))
6874	  (if (and sexp-end (<= sexp-end here))
6875	      ;; we want to record this sexp, but we only want to
6876	      ;; record the last-most of any of them before here
6877	      (or preceding-sexp
6878		  (setq preceding-sexp sexp-start))
6879	    ;; we're contained in this sexp so put sexp-start on
6880	    ;; front of list
6881	    (setq containing-sexp sexp-start)
6882	    (setq containing-mid sexp-mid)
6883	    (setq containing-begin t)))
6884	 ((eq keyword 'end)
6885	  ;; Found an "end" keyword
6886	  (forward-sexp)
6887	  (setq sexp-end (point))
6888	  (setq sexp-mid nil)
6889	  (setq sexp-start
6890		(or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
6891		    (progn (backward-sexp) (point))))
6892	  ;; we want to record this sexp, but we only want to
6893	  ;; record the last-most of any of them before here
6894	  (or preceding-sexp
6895	      (setq preceding-sexp sexp-start)))
6896	 )))
6897    ;; Check if the containing-paren should be the containing-sexp
6898    (if (and containing-paren
6899	     (or (null containing-sexp)
6900		 (< containing-sexp containing-paren)))
6901	(setq containing-sexp containing-paren
6902	      preceding-sexp nil
6903	      containing-begin nil
6904	      containing-mid nil))
6905    (vector containing-sexp preceding-sexp containing-begin containing-mid)
6906    ))
6907
6908
6909(defconst vhdl-s-c-a-re
6910  (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key))
6911
6912(defun vhdl-skip-case-alternative (&optional lim)
6913  "Skip forward over case/when bodies, with optional maximal limit.
6914If no next case alternative is found, nil is returned and point
6915is not moved."
6916  (let ((lim (or lim (point-max)))
6917	(here (point))
6918	donep foundp)
6919    (while (and (< (point) lim)
6920		(not donep))
6921      (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
6922	       (save-match-data
6923		 (not (vhdl-in-literal)))
6924	       (/= (match-beginning 0) here))
6925	  (progn
6926	    (goto-char (match-beginning 0))
6927	    (cond
6928	     ((and (looking-at "case")
6929		   (re-search-forward "\\bis[^_]" lim t))
6930	      (backward-sexp)
6931	      (vhdl-forward-sexp))
6932	     (t
6933	      (setq donep t
6934		    foundp t))))))
6935    (if (not foundp)
6936	(goto-char here))
6937    foundp))
6938
6939(defun vhdl-backward-skip-label (&optional lim)
6940  "Skip backward over a label, with optional maximal limit.
6941If label is not found, nil is returned and point is not moved."
6942  (let ((lim (or lim (point-min)))
6943	placeholder)
6944    (if (save-excursion
6945	  (vhdl-backward-syntactic-ws lim)
6946	  (and (eq (preceding-char) ?:)
6947	       (progn
6948		 (backward-sexp)
6949		 (setq placeholder (point))
6950		 (looking-at vhdl-label-key))))
6951	(goto-char placeholder))
6952    ))
6953
6954(defun vhdl-forward-skip-label (&optional lim)
6955  "Skip forward over a label, with optional maximal limit.
6956If label is not found, nil is returned and point is not moved."
6957  (let ((lim (or lim (point-max))))
6958    (if (looking-at vhdl-label-key)
6959	(progn
6960	  (goto-char (match-end 0))
6961	  (vhdl-forward-syntactic-ws lim)))
6962    ))
6963
6964(defun vhdl-get-syntactic-context ()
6965  "Guess the syntactic description of the current line of VHDL code."
6966  (save-excursion
6967    (save-restriction
6968      (beginning-of-line)
6969      (let* ((indent-point (point))
6970	     (case-fold-search t)
6971	     vec literal containing-sexp preceding-sexp
6972	     containing-begin containing-mid containing-leader
6973	     char-before-ip char-after-ip begin-after-ip end-after-ip
6974	     placeholder lim library-unit
6975	    )
6976
6977	;; Reset the syntactic context
6978	(setq vhdl-syntactic-context nil)
6979
6980	(save-excursion
6981	  ;; Move to the start of the previous library unit, and
6982	  ;; record the position of the "begin" keyword.
6983	  (setq placeholder (vhdl-beginning-of-libunit))
6984	  ;; The position of the "libunit" keyword gives us a gross
6985	  ;; limit point.
6986	  (setq lim (point))
6987	  )
6988
6989	;; If there is a previous library unit, and we are enclosed by
6990	;; it, then set the syntax accordingly.
6991	(and placeholder
6992	     (setq library-unit (vhdl-get-library-unit lim placeholder))
6993	     (vhdl-add-syntax library-unit lim))
6994
6995	;; Find the surrounding state.
6996	(if (setq vec (vhdl-get-block-state lim))
6997	    (progn
6998	      (setq containing-sexp (aref vec 0))
6999	      (setq preceding-sexp (aref vec 1))
7000	      (setq containing-begin (aref vec 2))
7001	      (setq containing-mid (aref vec 3))
7002	      ))
7003
7004	;; set the limit on the farthest back we need to search
7005	(setq lim (if containing-sexp
7006		      (save-excursion
7007			(goto-char containing-sexp)
7008			;; set containing-leader if required
7009			(if (looking-at vhdl-leader-re)
7010			    (setq containing-leader (vhdl-end-of-leader)))
7011			(vhdl-point 'bol))
7012		    (point-min)))
7013
7014	;; cache char before and after indent point, and move point to
7015	;; the most likely position to perform the majority of tests
7016	(goto-char indent-point)
7017	(skip-chars-forward " \t")
7018	(setq literal (vhdl-in-literal))
7019	(setq char-after-ip (following-char))
7020	(setq begin-after-ip (and
7021			      (not literal)
7022			      (looking-at vhdl-begin-fwd-re)
7023			      (or (not (looking-at "\\<use\\>"))
7024				  (save-excursion
7025				    (back-to-indentation)
7026				    (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
7027			      (vhdl-begin-p)))
7028	(setq end-after-ip (and
7029			    (not literal)
7030			    (looking-at vhdl-end-fwd-re)
7031			    (vhdl-end-p)))
7032	(vhdl-backward-syntactic-ws lim)
7033	(setq char-before-ip (preceding-char))
7034	(goto-char indent-point)
7035	(skip-chars-forward " \t")
7036
7037	;; now figure out syntactic qualities of the current line
7038	(cond
7039	 ;; CASE 1: in a string or comment.
7040	 ((memq literal '(string comment))
7041	  (vhdl-add-syntax literal (vhdl-point 'bopl)))
7042	 ;; CASE 2: Line is at top level.
7043	 ((null containing-sexp)
7044	  ;; Find the point to which indentation will be relative
7045	  (save-excursion
7046	    (if (null preceding-sexp)
7047		;; CASE 2X.1
7048		;; no preceding-sexp -> use the preceding statement
7049		(vhdl-beginning-of-statement-1 lim)
7050	      ;; CASE 2X.2
7051	      ;; if there is a preceding-sexp then indent relative to it
7052	      (goto-char preceding-sexp)
7053	      ;; if not at boi, then the block-opening keyword is
7054	      ;; probably following a label, so we need a different
7055	      ;; relpos
7056	      (if (/= (point) (vhdl-point 'boi))
7057		  ;; CASE 2X.3
7058		  (vhdl-beginning-of-statement-1 lim)))
7059	    ;; v-b-o-s could have left us at point-min
7060	    (and (bobp)
7061		 ;; CASE 2X.4
7062		 (vhdl-forward-syntactic-ws indent-point))
7063	    (setq placeholder (point)))
7064	  (cond
7065	   ;; CASE 2A : we are looking at a block-open
7066	   (begin-after-ip
7067	    (vhdl-add-syntax 'block-open placeholder))
7068	   ;; CASE 2B: we are looking at a block-close
7069	   (end-after-ip
7070	    (vhdl-add-syntax 'block-close placeholder))
7071	   ;; CASE 2C: we are looking at a top-level statement
7072	   ((progn
7073	      (vhdl-backward-syntactic-ws lim)
7074	      (or (bobp)
7075		  (and (= (preceding-char) ?\;)
7076		       (not (vhdl-in-quote-p)))))
7077	    (vhdl-add-syntax 'statement placeholder))
7078	   ;; CASE 2D: we are looking at a top-level statement-cont
7079	   (t
7080	    (vhdl-beginning-of-statement-1 lim)
7081	    ;; v-b-o-s could have left us at point-min
7082	    (and (bobp)
7083		 ;; CASE 2D.1
7084		 (vhdl-forward-syntactic-ws indent-point))
7085	    (vhdl-add-syntax 'statement-cont (point)))
7086	   )) ; end CASE 2
7087	 ;; CASE 3: line is inside parentheses.  Most likely we are
7088	 ;; either in a subprogram argument (interface) list, or a
7089	 ;; continued expression containing parentheses.
7090	 ((null containing-begin)
7091	  (vhdl-backward-syntactic-ws containing-sexp)
7092	  (cond
7093	   ;; CASE 3A: we are looking at the arglist closing paren
7094	   ((eq char-after-ip ?\))
7095	    (goto-char containing-sexp)
7096	    (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
7097	   ;; CASE 3B: we are looking at the first argument in an empty
7098	   ;; argument list.
7099	   ((eq char-before-ip ?\()
7100	    (goto-char containing-sexp)
7101	    (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
7102	   ;; CASE 3C: we are looking at an arglist continuation line,
7103	   ;; but the preceding argument is on the same line as the
7104	   ;; opening paren.  This case includes multi-line
7105	   ;; expression paren groupings.
7106	   ((and (save-excursion
7107		   (goto-char (1+ containing-sexp))
7108		   (skip-chars-forward " \t")
7109		   (not (eolp))
7110		   (not (looking-at "--\\|`")))
7111		 (save-excursion
7112		   (vhdl-beginning-of-statement-1 containing-sexp)
7113		   (skip-chars-backward " \t(")
7114		   (while (and (= (preceding-char) ?\;)
7115			       (not (vhdl-in-quote-p)))
7116		     (vhdl-beginning-of-statement-1 containing-sexp)
7117		     (skip-chars-backward " \t("))
7118		   (<= (point) containing-sexp)))
7119	    (goto-char containing-sexp)
7120	    (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
7121	   ;; CASE 3D: we are looking at just a normal arglist
7122	   ;; continuation line
7123	   (t (vhdl-beginning-of-statement-1 containing-sexp)
7124	      (vhdl-forward-syntactic-ws indent-point)
7125	      (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
7126	   ))
7127	 ;; CASE 4: A block mid open
7128	 ((and begin-after-ip
7129	       (looking-at containing-mid))
7130	  (goto-char containing-sexp)
7131	  ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7132	  (if (looking-at vhdl-trailer-re)
7133	      ;; CASE 4.1
7134	      (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7135	  (vhdl-backward-skip-label (vhdl-point 'boi))
7136	  (vhdl-add-syntax 'block-open (point)))
7137	 ;; CASE 5: block close brace
7138	 (end-after-ip
7139	  (goto-char containing-sexp)
7140	  ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7141	  (if (looking-at vhdl-trailer-re)
7142	      ;; CASE 5.1
7143	      (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7144	  (vhdl-backward-skip-label (vhdl-point 'boi))
7145	  (vhdl-add-syntax 'block-close (point)))
7146	 ;; CASE 6: A continued statement
7147	 ((and (/= char-before-ip ?\;)
7148	       ;; check it's not a trailer begin keyword, or a begin
7149	       ;; keyword immediately following a label.
7150	       (not (and begin-after-ip
7151			 (or (looking-at vhdl-trailer-re)
7152			     (save-excursion
7153			       (vhdl-backward-skip-label containing-sexp)))))
7154	       ;; check it's not a statement keyword
7155	       (not (and (looking-at vhdl-statement-fwd-re)
7156			 (vhdl-statement-p)))
7157	       ;; see if the b-o-s is before the indent point
7158	       (> indent-point
7159		  (save-excursion
7160		    (vhdl-beginning-of-statement-1 containing-sexp)
7161		    ;; If we ended up after a leader, then this will
7162		    ;; move us forward to the start of the first
7163		    ;; statement.  Note that a containing sexp here is
7164		    ;; always a keyword, not a paren, so this will
7165		    ;; have no effect if we hit the containing-sexp.
7166		    (vhdl-forward-syntactic-ws indent-point)
7167		    (setq placeholder (point))))
7168	       ;; check it's not a block-intro
7169	       (/= placeholder containing-sexp)
7170	       ;; check it's not a case block-intro
7171	       (save-excursion
7172		 (goto-char placeholder)
7173		 (or (not (looking-at vhdl-case-alternative-re))
7174		     (> (match-end 0) indent-point))))
7175	  ;; Make placeholder skip a label, but only if it puts us
7176	  ;; before the indent point at the start of a line.
7177	  (let ((new placeholder))
7178	    (if (and (> indent-point
7179			(save-excursion
7180			  (goto-char placeholder)
7181			  (vhdl-forward-skip-label indent-point)
7182			  (setq new (point))))
7183		     (save-excursion
7184		       (goto-char new)
7185		       (eq new (progn (back-to-indentation) (point)))))
7186		(setq placeholder new)))
7187	  (vhdl-add-syntax 'statement-cont placeholder)
7188	  (if begin-after-ip
7189	      (vhdl-add-syntax 'block-open)))
7190	 ;; Statement. But what kind?
7191	 ;; CASE 7: A case alternative key
7192	 ((and (looking-at vhdl-case-alternative-re)
7193	       (vhdl-case-alternative-p containing-sexp))
7194	  ;; for a case alternative key, we set relpos to the first
7195	  ;; non-whitespace char on the line containing the "case"
7196	  ;; keyword.
7197	  (goto-char containing-sexp)
7198	  ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7199	  (if (looking-at vhdl-trailer-re)
7200	      (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7201	  (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
7202	 ;; CASE 8: statement catchall
7203	 (t
7204	  ;; we know its a statement, but we need to find out if it is
7205	  ;; the first statement in a block
7206	  (if containing-leader
7207	      (goto-char containing-leader)
7208	    (goto-char containing-sexp)
7209	    ;; Note that a containing sexp here is always a keyword,
7210	    ;; not a paren, so skip over the keyword.
7211	    (forward-sexp))
7212	  ;; move to the start of the first statement
7213	  (vhdl-forward-syntactic-ws indent-point)
7214	  (setq placeholder (point))
7215	  ;; we want to ignore case alternatives keys when skipping forward
7216	  (let (incase-p)
7217	    (while (looking-at vhdl-case-alternative-re)
7218	      (setq incase-p (point))
7219	      ;; we also want to skip over the body of the
7220	      ;; case/when statement if that doesn't put us at
7221	      ;; after the indent-point
7222	      (while (vhdl-skip-case-alternative indent-point))
7223	      ;; set up the match end
7224	      (looking-at vhdl-case-alternative-re)
7225	      (goto-char (match-end 0))
7226	      ;; move to the start of the first case alternative statement
7227	      (vhdl-forward-syntactic-ws indent-point)
7228	      (setq placeholder (point)))
7229	    (cond
7230	     ;; CASE 8A: we saw a case/when statement so we must be
7231	     ;; in a switch statement.  find out if we are at the
7232	     ;; statement just after a case alternative key
7233	     ((and incase-p
7234		   (= (point) indent-point))
7235	      ;; relpos is the "when" keyword
7236	      (vhdl-add-syntax 'statement-case-intro incase-p))
7237	     ;; CASE 8B: any old statement
7238	     ((< (point) indent-point)
7239	      ;; relpos is the first statement of the block
7240	      (vhdl-add-syntax 'statement placeholder)
7241	      (if begin-after-ip
7242		  (vhdl-add-syntax 'block-open)))
7243	     ;; CASE 8C: first statement in a block
7244	     (t
7245	      (goto-char containing-sexp)
7246	      ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7247	      (if (looking-at vhdl-trailer-re)
7248		  (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7249	      (vhdl-backward-skip-label (vhdl-point 'boi))
7250	      (vhdl-add-syntax 'statement-block-intro (point))
7251	      (if begin-after-ip
7252		  (vhdl-add-syntax 'block-open)))
7253	     )))
7254	 )
7255
7256	;; now we need to look at any modifiers
7257	(goto-char indent-point)
7258	(skip-chars-forward " \t")
7259	(if (or (looking-at "--") (looking-at "/\\*"))
7260	    (vhdl-add-syntax 'comment))
7261	(if (looking-at "`")
7262	    (vhdl-add-syntax 'directive))
7263	(if (eq literal 'pound)
7264	    (vhdl-add-syntax 'cpp-macro))
7265	;; return the syntax
7266	vhdl-syntactic-context))))
7267
7268;; Standard indentation line-ups:
7269
7270(defun vhdl-lineup-arglist (langelem)
7271  "Lineup the current arglist line with the arglist appearing just
7272after the containing paren which starts the arglist."
7273  (save-excursion
7274    (let* ((containing-sexp
7275	    (save-excursion
7276	      ;; arglist-cont-nonempty gives relpos ==
7277	      ;; to boi of containing-sexp paren. This
7278	      ;; is good when offset is +, but bad
7279	      ;; when it is vhdl-lineup-arglist, so we
7280	      ;; have to special case a kludge here.
7281	      (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
7282		  (progn
7283		    (beginning-of-line)
7284		    (backward-up-list 1)
7285		    (skip-chars-forward " \t" (vhdl-point 'eol)))
7286		(goto-char (cdr langelem)))
7287	      (point)))
7288	   (cs-curcol (save-excursion
7289			(goto-char (cdr langelem))
7290			(current-column))))
7291      (if (save-excursion
7292	    (beginning-of-line)
7293	    (looking-at "[ \t]*)"))
7294	  (progn (goto-char (match-end 0))
7295		 (backward-sexp)
7296		 (forward-char)
7297		 (vhdl-forward-syntactic-ws)
7298		 (- (current-column) cs-curcol))
7299	(goto-char containing-sexp)
7300	(or (eolp)
7301	    (let ((eol (vhdl-point 'eol))
7302		  (here (progn
7303			  (forward-char)
7304			  (skip-chars-forward " \t")
7305			  (point))))
7306	      (vhdl-forward-syntactic-ws)
7307	      (if (< (point) eol)
7308		  (goto-char here))))
7309	(- (current-column) cs-curcol)
7310	))))
7311
7312(defun vhdl-lineup-arglist-intro (langelem)
7313  "Lineup an arglist-intro line to just after the open paren."
7314  (save-excursion
7315    (let ((cs-curcol (save-excursion
7316		       (goto-char (cdr langelem))
7317		       (current-column)))
7318	  (ce-curcol (save-excursion
7319		       (beginning-of-line)
7320		       (backward-up-list 1)
7321		       (skip-chars-forward " \t" (vhdl-point 'eol))
7322		       (current-column))))
7323      (- ce-curcol cs-curcol -1))))
7324
7325(defun vhdl-lineup-comment (_langelem)
7326  "Support old behavior for comment indentation.
7327We look at `vhdl-comment-only-line-offset' to decide how to
7328indent comment only-lines."
7329  (save-excursion
7330    (back-to-indentation)
7331    ;; at or to the right of comment-column
7332    (if (>= (current-column) comment-column)
7333	(vhdl-comment-indent)
7334      ;; otherwise, indent as specified by vhdl-comment-only-line-offset
7335      (if (not (bolp))
7336	  ;; inside multi-line comment
7337	  (if (looking-at "\\*")
7338	      1
7339	    ;; otherwise
7340	  (or (car-safe vhdl-comment-only-line-offset)
7341		vhdl-comment-only-line-offset))
7342	(or (cdr-safe vhdl-comment-only-line-offset)
7343	    (car-safe vhdl-comment-only-line-offset)
7344	    -1000			;jam it against the left side
7345	    )))))
7346
7347(defun vhdl-lineup-statement-cont (langelem)
7348  "Line up statement-cont after the assignment operator."
7349  (save-excursion
7350    (let* ((relpos (cdr langelem))
7351	   (assignp (save-excursion
7352		     (goto-char (vhdl-point 'boi))
7353		     (and (re-search-forward "\\(<\\|:\\|=\\)="
7354					     (vhdl-point 'eol) t)
7355			  (- (point) (vhdl-point 'boi)))))
7356	   (curcol (progn
7357		     (goto-char relpos)
7358		     (current-column)))
7359	   foundp)
7360      (while (and (not foundp)
7361		  (< (point) (vhdl-point 'eol)))
7362	(re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move)
7363	(if (vhdl-in-literal)
7364	    (forward-char)
7365	  (if (= (preceding-char) ?\()
7366	      ;; skip over any parenthesized expressions
7367	      (goto-char (min (vhdl-point 'eol)
7368			      (scan-lists (point) 1 1)))
7369	    ;; found an assignment operator (not at eol)
7370	    (setq foundp (not (looking-at "\\s-*$"))))))
7371      (if (not foundp)
7372	  ;; there's no assignment operator on the line
7373	  vhdl-basic-offset
7374	;; calculate indentation column after assign and ws, unless
7375	;; our line contains an assignment operator
7376	(if (not assignp)
7377	    (progn
7378	      (forward-char)
7379	      (skip-chars-forward " \t")
7380	      (setq assignp 0)))
7381	(- (current-column) assignp curcol))
7382      )))
7383
7384;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7385;; Progress reporting
7386
7387(defvar vhdl--progress-reporter nil
7388  "Holds the progress reporter data during long running operations.")
7389
7390;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7391;; Indentation commands
7392
7393(defun vhdl-electric-tab (&optional arg)
7394  "If preceding character is part of a word or a paren then hippie-expand,
7395else if right of non whitespace on line then insert tab,
7396else if last command was a tab or return then dedent one step or if a comment
7397toggle between normal indent and inline comment indent,
7398else indent `correctly'."
7399  (interactive "*P")
7400  (vhdl-prepare-search-2
7401   (cond
7402    ;; indent region if region is active
7403    ((and (not (featurep 'xemacs)) (use-region-p))
7404     (indent-region (region-beginning) (region-end) nil))
7405    ;; expand word
7406    ((= (char-syntax (preceding-char)) ?w)
7407     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7408	   (case-replace nil)
7409	   (hippie-expand-only-buffers
7410	    (or (and (boundp 'hippie-expand-only-buffers)
7411		     hippie-expand-only-buffers)
7412		'(vhdl-mode))))
7413       (vhdl-expand-abbrev arg)))
7414    ;; expand parenthesis
7415    ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
7416     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7417	   (case-replace nil))
7418       (vhdl-expand-paren arg)))
7419    ;; insert tab
7420    ((> (current-column) (current-indentation))
7421     (insert-tab))
7422    ;; toggle comment indent
7423    ((and (looking-at "--")
7424	  (or (eq last-command 'vhdl-electric-tab)
7425	      (eq last-command 'vhdl-electric-return)))
7426     (cond ((= (current-indentation) 0) ; no indent
7427	    (indent-to 1)
7428	    (indent-according-to-mode))
7429	   ((< (current-indentation) comment-column) ; normal indent
7430	    (indent-to comment-column)
7431	    (indent-according-to-mode))
7432	   (t				; inline comment indent
7433	    (delete-region (line-beginning-position) (point)))))
7434    ;; dedent
7435    ((and (>= (current-indentation) vhdl-basic-offset)
7436	  (or (eq last-command 'vhdl-electric-tab)
7437	      (eq last-command 'vhdl-electric-return)))
7438     (backward-delete-char-untabify vhdl-basic-offset nil))
7439    ;; indent line
7440    (t (indent-according-to-mode)))
7441   (setq this-command 'vhdl-electric-tab)))
7442
7443(defun vhdl-electric-return ()
7444  "`newline-and-indent' or `indent-new-comment-line' if in comment and preceding
7445character is a space."
7446  (interactive)
7447  (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
7448      (indent-new-comment-line)
7449    (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)
7450	       (not (vhdl-in-comment-p)))
7451      (vhdl-fix-case-word -1))
7452    (newline-and-indent)))
7453
7454(defun vhdl-indent-line ()
7455  "Indent the current line as VHDL code.
7456Return the amount of indentation change."
7457  (interactive)
7458  (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
7459	 (pos (- (point-max) (point)))
7460	 (is-comment nil)
7461	 (indent
7462	  (if syntax
7463	      ;; indent syntax-based
7464	      (if (and (eq (caar syntax) 'comment)
7465		       (>= (vhdl-get-offset (car syntax)) comment-column))
7466		  ;; special case: comments at or right of comment-column
7467		  (vhdl-get-offset (car syntax))
7468		;; align comments like following code line
7469		(when vhdl-indent-comment-like-next-code-line
7470		  (save-excursion
7471		    (while (eq (caar syntax) 'comment)
7472		      (setq is-comment t)
7473		      (beginning-of-line 2)
7474		      (setq syntax (vhdl-get-syntactic-context)))))
7475		(when is-comment
7476		  (push (cons 'comment nil) syntax))
7477		(apply #'+ (mapcar #'vhdl-get-offset syntax)))
7478	    ;; indent like previous nonblank line
7479	    (save-excursion (beginning-of-line)
7480			    (re-search-backward "^[^\n]" nil t)
7481			    (current-indentation))))
7482	 (shift-amt  (- indent (current-indentation))))
7483    (and vhdl-echo-syntactic-information-p
7484	 (message "syntax: %s, indent= %d" syntax indent))
7485    (let ((has-formfeed
7486	   (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
7487      (when (or (not (zerop shift-amt)) has-formfeed)
7488	(delete-region (vhdl-point 'bol) (vhdl-point 'boi))
7489	(beginning-of-line)
7490	(when has-formfeed (insert "\f"))
7491	(indent-to indent)))
7492    (if (< (point) (vhdl-point 'boi))
7493	(back-to-indentation)
7494      ;; If initial point was within line's indentation, position after
7495      ;; the indentation.  Else stay at same point in text.
7496      (when (> (- (point-max) pos) (point))
7497	(goto-char (- (point-max) pos))))
7498    (run-hooks 'vhdl-special-indent-hook)
7499    (when vhdl--progress-reporter
7500      (progress-reporter-update vhdl--progress-reporter (point)))
7501    shift-amt))
7502
7503(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1")
7504
7505(defun vhdl-indent-buffer ()
7506  "Indent whole buffer as VHDL code.
7507Calls `indent-region' for whole buffer and adds progress reporting."
7508  (interactive)
7509  (indent-region (point-min) (point-max)))
7510
7511(defun vhdl-indent-group ()
7512  "Indent group of lines between empty lines."
7513  (interactive)
7514  (let ((beg (save-excursion
7515	       (if (re-search-backward vhdl-align-group-separate nil t)
7516		   (point-marker)
7517		 (point-min-marker))))
7518	(end (save-excursion
7519	       (if (re-search-forward vhdl-align-group-separate nil t)
7520		   (point-marker)
7521		 (point-max-marker)))))
7522    (indent-region beg end)))
7523
7524(defun vhdl-indent-sexp (&optional endpos)
7525  "Indent each line of the list starting just after point.
7526If optional arg ENDPOS is given, indent each line, stopping when
7527ENDPOS is encountered."
7528  (interactive)
7529  (save-excursion
7530    (let ((beg (point))
7531	  (end (progn (vhdl-forward-sexp nil endpos) (point))))
7532      (indent-region beg end nil))))
7533
7534;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7535;; Miscellaneous commands
7536
7537(defun vhdl-show-syntactic-information ()
7538  "Show syntactic information for current line."
7539  (interactive)
7540  (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
7541  (vhdl-keep-region-active))
7542
7543;; Verification and regression functions:
7544
7545(defun vhdl-regress-line (&optional arg)
7546  "Check syntactic information for current line."
7547  (interactive "P")
7548  (let ((expected (save-excursion
7549		    (end-of-line)
7550		    (when (search-backward " -- ((" (vhdl-point 'bol) t)
7551		      (forward-char 4)
7552		      (read (current-buffer)))))
7553	(actual (vhdl-get-syntactic-context))
7554	(expurgated))
7555    ;; remove the library unit symbols
7556    (mapc
7557     (lambda (elt)
7558       (if (memq (car elt) '(entity configuration context package
7559                                    package-body architecture))
7560           nil
7561         (setq expurgated (append expurgated (list elt)))))
7562     actual)
7563    (if (and (not arg) expected (listp expected))
7564	(if (not (equal expected expurgated))
7565	    (error "ERROR:  Should be: %s, is: %s" expected expurgated))
7566      (save-excursion
7567	(beginning-of-line)
7568	(when (not (looking-at "^\\s-*\\(--.*\\)?$"))
7569	  (end-of-line)
7570	  (if (search-backward " -- ((" (vhdl-point 'bol) t)
7571	      (delete-region (point) (line-end-position)))
7572	  (insert " -- ")
7573	  (insert (format "%s" expurgated))))))
7574  (vhdl-keep-region-active))
7575
7576
7577;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7578;;; Alignment, beautifying
7579;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7580
7581(defconst vhdl-align-alist
7582  '(
7583    ;; after some keywords
7584    (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
7585	       "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
7586    ;; before ':'
7587    (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7588    ;; after direction specifications
7589    (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7590	       ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7591    ;; before "==", ":=", "=>", and "<="
7592    (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
7593    (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7594    (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
7595    ;; before some keywords
7596    (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7597    (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7598    (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7599    (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
7600    (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
7601    ;; before "=>" since "when/else ... =>" can occur
7602    (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7603    )
7604  "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7605It is searched in order.  If REGEXP is found anywhere in the first
7606line of a region to be aligned, ALIGN-PATTERN will be used for that
7607region.  ALIGN-PATTERN must include the whitespace to be expanded or
7608contracted.  It may also provide regexps for the text surrounding the
7609whitespace.  SUBEXP specifies which sub-expression of
7610ALIGN-PATTERN matches the white space to be expanded/contracted.")
7611
7612;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7613;; Align code
7614
7615(defvar vhdl-align-try-all-clauses t
7616  "If REGEXP is not found on the first line of the region that clause is ignored.
7617If this variable is non-nil, then the clause is tried anyway.")
7618
7619(defun vhdl-do-group (function &optional spacing)
7620  "Apply FUNCTION on group of lines between empty lines."
7621  (let
7622      ;; search for group beginning
7623      ((beg (save-excursion
7624	      (if (re-search-backward vhdl-align-group-separate nil t)
7625		  (progn (beginning-of-line 2) (back-to-indentation) (point))
7626		(point-min))))
7627       ;; search for group end
7628       (end (save-excursion
7629	      (if (re-search-forward vhdl-align-group-separate nil t)
7630		  (progn (beginning-of-line) (point))
7631		(point-max)))))
7632    ;; run FUNCTION
7633    (funcall function beg end spacing)))
7634
7635(defun vhdl-do-list (function &optional spacing)
7636  "Apply FUNCTION to lines of a list surrounded by a balanced group of parentheses."
7637  (let (beg end)
7638    (save-excursion
7639      ;; search for beginning of balanced group of parentheses
7640      (setq beg (vhdl-re-search-backward "[()]" nil t))
7641      (while (looking-at ")")
7642	(forward-char) (backward-sexp)
7643	(setq beg (vhdl-re-search-backward "[()]" nil t)))
7644      ;; search for end of balanced group of parentheses
7645      (when beg
7646	(forward-list)
7647	(setq end (point))
7648	(goto-char (1+ beg))
7649	(skip-chars-forward " \t\n\r\f")
7650	(setq beg (point))))
7651    ;; run FUNCTION
7652    (if beg
7653	(funcall function beg end spacing)
7654      (error "ERROR:  Not within a list enclosed by a pair of parentheses"))))
7655
7656(defun vhdl-do-same-indent (function &optional spacing)
7657  "Apply FUNCTION to block of lines with same indent."
7658  (let ((indent (current-indentation))
7659	beg end)
7660    ;; search for first line with same indent
7661    (save-excursion
7662      (while (and (not (bobp))
7663		  (or (looking-at "^\\s-*\\(--.*\\)?$")
7664		      (= (current-indentation) indent)))
7665	(unless (looking-at "^\\s-*$")
7666	  (back-to-indentation) (setq beg (point)))
7667	(beginning-of-line -0)))
7668    ;; search for last line with same indent
7669    (save-excursion
7670      (while (and (not (eobp))
7671		  (or (looking-at "^\\s-*\\(--.*\\)?$")
7672		      (= (current-indentation) indent)))
7673	(if (looking-at "^\\s-*$")
7674	    (beginning-of-line 2)
7675	  (beginning-of-line 2)
7676	  (setq end (point)))))
7677    ;; run FUNCTION
7678    (funcall function beg end spacing)))
7679
7680(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent)
7681  "Attempt to align a range of lines based on the content of the lines.
7682The definition of `alignment-list' determines the matching order
7683and the manner in which the lines are aligned.  If ALIGNMENT-LIST
7684is not specified `vhdl-align-alist' is used.  If INDENT is
7685non-nil, indentation is done before aligning."
7686  (interactive "r\np")
7687  (setq alignment-list (or alignment-list vhdl-align-alist))
7688  (setq spacing (or spacing 1))
7689  (save-excursion
7690    (let (bol) ;; indent
7691      (goto-char end)
7692      (setq end (point-marker))
7693      (goto-char begin)
7694      (setq bol (setq begin (progn (beginning-of-line) (point))))
7695      ;; FIXME: The `indent' arg is not used, and I think it's because
7696      ;; the let binding commented out above `indent' was hiding it, so
7697      ;; the test below should maybe still test `indent'?
7698      (when nil ;; indent
7699	(indent-region bol end nil))))
7700  (let ((copy (copy-alist alignment-list)))
7701    (vhdl-prepare-search-2
7702     (while copy
7703       (save-excursion
7704	 (goto-char begin)
7705	 (let (element
7706	       (eol (point-at-eol)))
7707	   (setq element (nth 0 copy))
7708	   (when (and (or (and (listp (car element))
7709			       (memq major-mode (car element)))
7710			  (eq major-mode (car element)))
7711		      (or vhdl-align-try-all-clauses
7712			  (re-search-forward (car (cdr element)) eol t)))
7713	     (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7714				  (car (cdr (cdr (cdr element)))) spacing))
7715	   (setq copy (cdr copy))))))))
7716
7717(defun vhdl-align-region-2 (begin end match &optional substr spacing)
7718  "Align a range of lines from BEGIN to END.
7719The regular expression MATCH must match exactly one field: the
7720whitespace to be contracted/expanded.  The alignment column will
7721equal the rightmost column of the widest whitespace block.
7722SPACING is the amount of extra spaces to add to the calculated
7723maximum required.  SPACING defaults to 1 so that at least one
7724space is inserted after the token in MATCH."
7725  (setq spacing (or spacing 1))
7726  (setq substr (or substr 1))
7727  (save-excursion
7728    (let (distance (max 0) (lines 0) bol eol width)
7729      ;; Determine the greatest whitespace distance to the alignment
7730      ;; character
7731      (goto-char begin)
7732      (setq eol (point-at-eol)
7733	    bol (setq begin (progn (beginning-of-line) (point))))
7734      (while (< bol end)
7735	(save-excursion
7736	  (when (and (vhdl-re-search-forward match eol t)
7737		     (save-excursion
7738		       (goto-char (match-beginning 0))
7739		       (forward-char)
7740		       (and (not (vhdl-in-literal))
7741			    (not (vhdl-in-quote-p))
7742			    (not (vhdl-in-extended-identifier-p))))
7743		     (not (looking-at "\\s-*$")))
7744	    (setq distance (- (match-beginning substr) bol))
7745	    (when (> distance max)
7746	      (setq max distance))))
7747	(forward-line)
7748	(setq bol (point)
7749	      eol (point-at-eol))
7750	(setq lines (1+ lines)))
7751      ;; Now insert enough maxs to push each assignment operator to
7752      ;; the same column.  We need to use 'lines' as a counter, since
7753      ;; the location of the mark may change
7754      (goto-char (setq bol begin))
7755      (setq eol (point-at-eol))
7756      (while (> lines 0)
7757  	(when (and (vhdl-re-search-forward match eol t)
7758		   (save-excursion
7759		     (goto-char (match-beginning 0))
7760		     (forward-char)
7761		     (and (not (vhdl-in-literal))
7762			  (not (vhdl-in-quote-p))
7763			  (not (vhdl-in-extended-identifier-p))))
7764		   (not (looking-at "\\s-*$"))
7765		   (> (match-beginning 0)  ; not if at boi
7766		      (save-excursion (back-to-indentation) (point))))
7767	  (setq width (- (match-end substr) (match-beginning substr)))
7768	  (setq distance (- (match-beginning substr) bol))
7769	  (goto-char (match-beginning substr))
7770	  (delete-char width)
7771	  (insert-char ?  (+ (- max distance) spacing)))
7772	(beginning-of-line)
7773	(forward-line)
7774	(setq bol (point)
7775	      eol (point-at-eol))
7776	(setq lines (1- lines))))))
7777
7778(defun vhdl-align-region-groups (beg end &optional spacing
7779				     no-message no-comments)
7780  "Align region, treat groups of lines separately."
7781  (interactive "r\nP")
7782  (save-excursion
7783    (goto-char beg)
7784    (beginning-of-line)
7785    (setq beg (point))
7786    (goto-char end)
7787    (setq end (point-marker))
7788    (untabify beg end)
7789    (let ((orig (copy-marker beg))
7790          pos
7791          (vhdl--progress-reporter
7792           (if no-message
7793	       ;; Preserve a potential progress reporter from
7794	       ;; when called from `vhdl-align-region' call.
7795	       vhdl--progress-reporter
7796	     (when vhdl-progress-interval
7797	       (make-progress-reporter "Aligning..." beg (copy-marker end))))))
7798      (when (nth 0 vhdl-beautify-options)
7799	(vhdl-fixup-whitespace-region beg end t))
7800      (goto-char beg)
7801      (if (not vhdl-align-groups)
7802	  ;; align entire region
7803	  (progn (vhdl-align-region-1 beg end spacing)
7804		 (unless no-comments
7805		   (vhdl-align-inline-comment-region-1 beg end)))
7806	;; align groups
7807	(while (and (< beg end)
7808		    (re-search-forward vhdl-align-group-separate end t))
7809	  (setq pos (point-marker))
7810	  (vhdl-align-region-1 beg pos spacing)
7811	  (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7812	  (when vhdl--progress-reporter
7813	    (progress-reporter-update vhdl--progress-reporter (point)))
7814	  (setq beg (1+ pos))
7815	  (goto-char beg))
7816	;; align last group
7817	(when (< beg end)
7818	  (vhdl-align-region-1 beg end spacing)
7819	  (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7820	  (when vhdl--progress-reporter
7821	    (progress-reporter-update vhdl--progress-reporter (point)))))
7822      (when vhdl-indent-tabs-mode
7823	(tabify orig end))
7824      (unless no-message
7825	(when vhdl--progress-reporter
7826	  (progress-reporter-done vhdl--progress-reporter))))))
7827
7828(defun vhdl-align-region (beg end &optional spacing)
7829  "Align region, treat blocks with same indent and argument lists separately."
7830  (interactive "r\nP")
7831  (if (not vhdl-align-same-indent)
7832      ;; align entire region
7833      (vhdl-align-region-groups beg end spacing)
7834    ;; align blocks with same indent and argument lists
7835    (save-excursion
7836      (let ((cur-beg beg)
7837	    indent cur-end
7838	    (vhdl--progress-reporter
7839	     (when vhdl-progress-interval
7840	       (make-progress-reporter "Aligning..." beg (copy-marker end)))))
7841	(goto-char end)
7842	(setq end (point-marker))
7843	(goto-char cur-beg)
7844	(while (< (point) end)
7845	  ;; is argument list opening?
7846	  (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7847						    (point) (vhdl-point 'eol)))))
7848	      ;; determine region for argument list
7849	      (progn (goto-char cur-beg)
7850		     (forward-sexp)
7851		     (setq cur-end (point))
7852		     (beginning-of-line 2))
7853	    ;; determine region with same indent
7854	    (setq indent (current-indentation))
7855	    (setq cur-beg (point))
7856	    (setq cur-end (vhdl-point 'bonl))
7857	    (beginning-of-line 2)
7858	    (while (and (< (point) end)
7859			(or (looking-at "^\\s-*\\(--.*\\)?$")
7860			    (= (current-indentation) indent))
7861			(<= (save-excursion
7862			      (nth 0 (parse-partial-sexp
7863				      (point) (vhdl-point 'eol))))
7864			    0))
7865	      (unless (looking-at "^\\s-*$")
7866		(setq cur-end (vhdl-point 'bonl)))
7867	      (beginning-of-line 2)))
7868	  ;; align region
7869	  (vhdl-align-region-groups cur-beg cur-end spacing t t))
7870	(vhdl-align-inline-comment-region beg end spacing noninteractive)
7871	(when vhdl--progress-reporter
7872	  (progress-reporter-done vhdl--progress-reporter))))))
7873
7874(defun vhdl-align-group (&optional spacing)
7875  "Align group of lines between empty lines."
7876  (interactive)
7877  (vhdl-do-group 'vhdl-align-region spacing))
7878
7879(defun vhdl-align-list (&optional spacing)
7880  "Align the lines of a list surrounded by a balanced group of parentheses."
7881  (interactive)
7882  (vhdl-do-list 'vhdl-align-region-groups spacing))
7883
7884(defun vhdl-align-same-indent (&optional spacing)
7885  "Align block of lines with same indent."
7886  (interactive)
7887  (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7888
7889(defun vhdl-align-declarations (&optional spacing)
7890  "Align the lines within the declarative part of a design unit."
7891  (interactive)
7892  (let (beg end)
7893    (vhdl-prepare-search-2
7894     (save-excursion
7895       ;; search for declarative part
7896       (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
7897		  (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7898	 (setq beg (point))
7899	 (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7900	 (setq end (point)))))
7901    (if beg
7902	(vhdl-align-region-groups beg end spacing)
7903      (error "ERROR:  Not within the declarative part of a design unit"))))
7904
7905(defun vhdl-align-buffer ()
7906  "Align buffer."
7907  (interactive)
7908  (vhdl-align-region (point-min) (point-max)))
7909
7910;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7911;; Align inline comments
7912
7913(defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7914  "Align inline comments in region."
7915  (save-excursion
7916    (let ((start-max comment-column)
7917	  (length-max 0)
7918	  comment-list start-list tmp-list start length
7919	  cur-start prev-start no-code)
7920      (setq spacing (or spacing 2))
7921      (vhdl-prepare-search-2
7922       (goto-char beg)
7923       ;; search for comment start positions and lengths
7924       (while (< (point) end)
7925	 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7926		    (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
7927		    (not (save-excursion (goto-char (match-beginning 2))
7928					 (vhdl-in-literal))))
7929	   (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7930	   (setq length (- (match-end 2) (match-beginning 2)))
7931	   (setq start-max (max start start-max))
7932	   (setq length-max (max length length-max))
7933	   (push (cons start length) comment-list))
7934	 (beginning-of-line 2))
7935       (setq comment-list
7936             (sort comment-list (lambda (a b) (> (car a) (car b)))))
7937       ;; reduce start positions
7938       (setq start-list (list (caar comment-list)))
7939       (setq comment-list (cdr comment-list))
7940       (while comment-list
7941	 (unless (or (= (caar comment-list) (car start-list))
7942		     (<= (+ (car start-list) (cdar comment-list))
7943			    end-comment-column))
7944	   (push (caar comment-list) start-list))
7945	 (setq comment-list (cdr comment-list)))
7946       ;; align lines as nicely as possible
7947       (goto-char beg)
7948       (while (< (point) end)
7949	 (setq cur-start nil)
7950	 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7951		    (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7952			     (not (save-excursion
7953				    (goto-char (match-beginning 3))
7954				    (vhdl-in-literal))))
7955			(and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7956			     (>= (- (match-end 2) (match-beginning 2))
7957				 comment-column))))
7958	   (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7959	   (setq length (- (match-end 3) (match-beginning 3)))
7960	   (setq no-code (= (match-beginning 1) (match-end 1)))
7961	   ;; insert minimum whitespace
7962	   (goto-char (match-end 2))
7963	   (delete-region (match-beginning 2) (match-end 2))
7964	   (insert-char ?\  spacing)
7965	   (setq tmp-list start-list)
7966	   ;; insert additional whitespace to align
7967	   (setq cur-start
7968		 (cond
7969		  ;; align comment-only line to inline comment of previous line
7970		  ((and no-code prev-start
7971			(<= length (- end-comment-column prev-start)))
7972		   prev-start)
7973		  ;; align all comments at `start-max' if this is possible
7974		  ((<= (+ start-max length-max) end-comment-column)
7975		   start-max)
7976		  ;; align at `comment-column' if possible
7977		  ((and (<= start comment-column)
7978			(<= length (- end-comment-column comment-column)))
7979		   comment-column)
7980		  ;; align at left-most possible start position otherwise
7981		  (t
7982		   (while (and tmp-list (< (car tmp-list) start))
7983		     (setq tmp-list (cdr tmp-list)))
7984		   (car tmp-list))))
7985	   (indent-to cur-start))
7986	 (setq prev-start cur-start)
7987	 (beginning-of-line 2))))))
7988
7989(defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7990  "Align inline comments within a region.
7991Groups of code lines separated by empty lines are aligned
7992individually, if `vhdl-align-groups' is non-nil."
7993  (interactive "r\nP")
7994  (save-excursion
7995    (let (orig pos)
7996      (goto-char beg)
7997      (beginning-of-line)
7998      (setq orig (point-marker))
7999      (setq beg (point))
8000      (goto-char end)
8001      (setq end (point-marker))
8002      (untabify beg end)
8003      (unless no-message (message "Aligning inline comments..."))
8004      (goto-char beg)
8005      (if (not vhdl-align-groups)
8006	  ;; align entire region
8007	  (vhdl-align-inline-comment-region-1 beg end spacing)
8008	;; align groups
8009	(while (and (< beg end)
8010		    (re-search-forward vhdl-align-group-separate end t))
8011	  (setq pos (point-marker))
8012	  (vhdl-align-inline-comment-region-1 beg pos spacing)
8013	  (setq beg (1+ pos))
8014	  (goto-char beg))
8015	;; align last group
8016	(when (< beg end)
8017	  (vhdl-align-inline-comment-region-1 beg end spacing)))
8018      (when vhdl-indent-tabs-mode
8019	(tabify orig end))
8020      (unless no-message (message "Aligning inline comments...done")))))
8021
8022(defun vhdl-align-inline-comment-group (&optional _spacing)
8023  "Align inline comments within a group of lines between empty lines."
8024  (interactive)
8025  (save-excursion
8026    (let ((start (point))
8027	  beg end)
8028      (setq end (if (re-search-forward vhdl-align-group-separate nil t)
8029		    (point-marker) (point-max)))
8030      (goto-char start)
8031      (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
8032		    (point) (point-min)))
8033      (untabify beg end)
8034      (message "Aligning inline comments...")
8035      (vhdl-align-inline-comment-region-1 beg end)
8036      (when vhdl-indent-tabs-mode
8037	(tabify beg end))
8038      (message "Aligning inline comments...done"))))
8039
8040(defun vhdl-align-inline-comment-buffer ()
8041  "Align inline comments within buffer.
8042Groups of code lines separated by empty lines are aligned
8043individually, if `vhdl-align-groups' is non-nil."
8044  (interactive)
8045  (vhdl-align-inline-comment-region (point-min) (point-max)))
8046
8047;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8048;; Fixup whitespace
8049
8050(defun vhdl-fixup-whitespace-region (beg end &optional no-message)
8051  "Fixup whitespace in region.
8052Surround operator symbols by one space, eliminate multiple
8053spaces (except at beginning of line), eliminate spaces at end of
8054line, do nothing in comments and strings."
8055  (interactive "r")
8056  (unless no-message (message "Fixing up whitespace..."))
8057  (save-excursion
8058    (goto-char end)
8059    (setq end (point-marker))
8060    ;; have no space before and one space after `,' and ';'
8061    (goto-char beg)
8062    (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
8063      (if (match-string 1)
8064	  (goto-char (match-end 1))
8065	(replace-match "\\3 " nil nil nil 2)))
8066    ;; have no space after `('
8067    (goto-char beg)
8068    (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
8069      (if (match-string 1)
8070	  (goto-char (match-end 1))
8071	(replace-match "\\2")))
8072    ;; have no space before `)'
8073    (goto-char beg)
8074    (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
8075      (if (match-string 1)
8076	  (goto-char (match-end 1))
8077	(replace-match "\\2")))
8078    ;; surround operator symbols by one space
8079    (goto-char beg)
8080    (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
8081      (if (or (match-string 1)
8082	      (<= (match-beginning 0)  ; not if at boi
8083		 (save-excursion (back-to-indentation) (point))))
8084	  (goto-char (match-end 0))
8085	(replace-match "\\3 \\4 \\5")
8086	(goto-char (match-end 2))))
8087    ;; eliminate multiple spaces and spaces at end of line
8088    (goto-char beg)
8089    (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
8090	       (and (looking-at "--.*") (re-search-forward "--.*" end t))
8091	       (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
8092	       (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
8093		    (progn (replace-match "" nil nil) t))
8094	       (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
8095		    (progn (replace-match ";" nil nil) t))
8096	       (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
8097	       (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
8098		    (progn (replace-match "  " nil nil) t))
8099	       (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
8100		    (progn (replace-match " " nil nil) t))
8101	       (and (looking-at "-") (re-search-forward "-" end t))
8102	       (re-search-forward "[^ \t\"-]+" end t))))
8103  (unless no-message (message "Fixing up whitespace...done")))
8104
8105(defun vhdl-fixup-whitespace-buffer ()
8106  "Fixup whitespace in buffer.
8107Surround operator symbols by one space, eliminate multiple
8108spaces (except at beginning of line), eliminate spaces at end of
8109line, do nothing in comments."
8110  (interactive)
8111  (vhdl-fixup-whitespace-region (point-min) (point-max)))
8112
8113;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8114;; Case fixing
8115
8116(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
8117  "Convert all words matching WORD-REGEXP in region to lower or upper case,
8118depending on parameter UPPER-CASE."
8119  (let ((case-replace nil)
8120	(pr (when (and count vhdl-progress-interval (not noninteractive))
8121	      (make-progress-reporter "Fixing case..." beg (copy-marker end)))))
8122    (vhdl-prepare-search-2
8123     (save-excursion
8124       (goto-char end)
8125       (setq end (point-marker))
8126       (goto-char beg)
8127       (while (re-search-forward word-regexp end t)
8128	 (or (vhdl-in-literal)
8129	     (if upper-case
8130		 (upcase-word -1)
8131	       (downcase-word -1)))
8132	 (when pr (progress-reporter-update pr (point))))
8133       (when pr (progress-reporter-done pr))))))
8134
8135(defun vhdl-fix-case-region (beg end &optional _arg)
8136  "Convert all VHDL words in region to lower or upper case, depending on
8137options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8138  (interactive "r")
8139  (vhdl-fix-case-region-1
8140   beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
8141  (vhdl-fix-case-region-1
8142   beg end vhdl-upper-case-types vhdl-types-regexp 1)
8143  (vhdl-fix-case-region-1
8144   beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
8145  (vhdl-fix-case-region-1
8146   beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
8147  (vhdl-fix-case-region-1
8148   beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
8149  (when vhdl-progress-interval (message "Fixing case...done")))
8150
8151(defun vhdl-fix-case-buffer ()
8152  "Convert all VHDL words in buffer to lower or upper case, depending on
8153options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8154  (interactive)
8155  (vhdl-fix-case-region (point-min) (point-max)))
8156
8157(defun vhdl-fix-case-word (&optional arg)
8158  "Convert word after cursor to upper case if necessary."
8159  (interactive "p")
8160  (save-excursion
8161    (when arg (backward-word 1))
8162    (vhdl-prepare-search-1
8163     (when (and vhdl-upper-case-keywords
8164		(looking-at vhdl-keywords-regexp))
8165       (upcase-word 1))
8166     (when (and vhdl-upper-case-types
8167		(looking-at vhdl-types-regexp))
8168       (upcase-word 1))
8169     (when (and vhdl-upper-case-attributes
8170		(looking-at vhdl-attributes-regexp))
8171       (upcase-word 1))
8172     (when (and vhdl-upper-case-enum-values
8173		(looking-at vhdl-enum-values-regexp))
8174       (upcase-word 1))
8175     (when (and vhdl-upper-case-constants
8176		(looking-at vhdl-constants-regexp))
8177       (upcase-word 1)))))
8178
8179;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8180;; Fix statements
8181;; - force each statement to be on a separate line except when on same line
8182;;   with 'end' keyword
8183
8184(defun vhdl-fix-statement-region (beg end &optional _arg)
8185  "Force statements in region on separate line except when on same line
8186with `end' keyword (necessary for correct indentation).
8187Currently supported keywords: `begin', `if'."
8188  (interactive "r")
8189  (vhdl-prepare-search-2
8190   (let (point)
8191     (save-excursion
8192       (goto-char end)
8193       (setq end (point-marker))
8194       (goto-char beg)
8195       ;; `begin' keyword
8196       (while (re-search-forward
8197	       "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t)
8198	 (goto-char (match-end 0))
8199	 (setq point (point-marker))
8200	 (when (and (match-string 1)
8201		    (or (not (match-string 2))
8202			(save-excursion (goto-char (match-end 2))
8203					(vhdl-in-literal)))
8204		    (not (save-excursion (goto-char (match-beginning 1))
8205					 (vhdl-in-literal))))
8206	   (goto-char (match-beginning 1))
8207	   (insert "\n")
8208	   (indent-according-to-mode))
8209	 (goto-char point))
8210       (goto-char beg)
8211       ;; `for', `if' keywords
8212       (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
8213	 (goto-char (match-end 1))
8214	 (setq point (point-marker))
8215	 ;; exception: in literal or preceded by `end', `wait' or label
8216	 (when (and (not (save-excursion (goto-char (match-beginning 1))
8217					 (vhdl-in-literal)))
8218		    (save-excursion
8219		      (beginning-of-line 1)
8220		      (save-match-data
8221			(and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
8222						(match-beginning 1) t)
8223			     (not (string-match
8224				   "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
8225				   (match-string 1)))))))
8226	   (goto-char (match-beginning 1))
8227	   (insert "\n")
8228	   (indent-according-to-mode))
8229	 (goto-char point))))))
8230
8231(defun vhdl-fix-statement-buffer ()
8232  "Force statements in buffer on separate line except when on same line
8233with `end' keyword (necessary for correct indentation)."
8234  (interactive)
8235  (vhdl-fix-statement-region (point-min) (point-max)))
8236
8237;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8238;; Trailing spaces
8239
8240(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg)
8241  "Remove trailing spaces in region."
8242  (interactive "r")
8243  (save-excursion
8244    (goto-char end)
8245    (setq end (point-marker))
8246    (goto-char beg)
8247    (while (re-search-forward "[ \t]+$" end t)
8248      (unless (vhdl-in-literal)
8249	(replace-match "" nil nil)))))
8250
8251(defun vhdl-remove-trailing-spaces ()
8252  "Remove trailing spaces in buffer."
8253  (interactive)
8254  (vhdl-remove-trailing-spaces-region (point-min) (point-max)))
8255
8256;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8257;; Beautify
8258
8259(defun vhdl-beautify-region (beg end)
8260  "Beautify region by applying indentation, whitespace fixup, alignment, and
8261case fixing to a region.  Calls functions `vhdl-indent-buffer',
8262`vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
8263`vhdl-fix-case-buffer'."
8264  (interactive "r")
8265  (setq end (save-excursion (goto-char end) (point-marker)))
8266  (save-excursion ; remove DOS EOL characters in UNIX file
8267    (goto-char beg)
8268    (while (search-forward "\r" nil t)
8269      (replace-match "" nil t)))
8270  (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
8271  (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
8272  (when (nth 2 vhdl-beautify-options) (indent-region beg end))
8273  (when (nth 3 vhdl-beautify-options)
8274    (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
8275  (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
8276  (when (nth 0 vhdl-beautify-options)
8277    (vhdl-remove-trailing-spaces-region beg end)
8278    (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
8279
8280(defun vhdl-beautify-buffer ()
8281  "Beautify buffer by applying indentation, whitespace fixup, alignment, and
8282case fixing to entire buffer.  Calls `vhdl-beautify-region' for the entire
8283buffer."
8284  (interactive)
8285  (vhdl-beautify-region (point-min) (point-max))
8286  (when noninteractive (save-buffer)))
8287
8288;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8289;; Code filling
8290
8291(defun vhdl-fill-region (beg end &optional arg)
8292  "Fill lines for a region of code."
8293  (interactive "r\np")
8294  (save-excursion
8295    (goto-char beg)
8296    (let ((margin (if arg (current-indentation) (current-column))))
8297      (goto-char end)
8298      (setq end (point-marker))
8299      ;; remove inline comments, newlines and whitespace
8300      (vhdl-comment-kill-region beg end)
8301      (vhdl-comment-kill-inline-region beg end)
8302      (subst-char-in-region beg (1- end) ?\n ?\ )
8303      (vhdl-fixup-whitespace-region beg end)
8304      ;; wrap and end-comment-column
8305      (goto-char beg)
8306      (while (re-search-forward "\\s-" end t)
8307	(when(> (current-column) vhdl-end-comment-column)
8308	  (backward-char)
8309	  (when (re-search-backward "\\s-" beg t)
8310	    (replace-match "\n")
8311	    (indent-to margin)))))))
8312
8313(defun vhdl-fill-group ()
8314  "Fill group of lines between empty lines."
8315  (interactive)
8316  (vhdl-do-group 'vhdl-fill-region))
8317
8318(defun vhdl-fill-list ()
8319  "Fill the lines of a list surrounded by a balanced group of parentheses."
8320  (interactive)
8321  (vhdl-do-list 'vhdl-fill-region))
8322
8323(defun vhdl-fill-same-indent ()
8324  "Fill the lines of block of lines with same indent."
8325  (interactive)
8326  (vhdl-do-same-indent 'vhdl-fill-region))
8327
8328
8329;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8330;;; Code updating/fixing
8331;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8332
8333;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8334;; Sensitivity list update
8335
8336;; Strategy:
8337;; - no sensitivity list is generated for processes with wait statements
8338;; - otherwise, do the following:
8339;;   1. scan for all local signals (ports, signals declared in arch./blocks)
8340;;   2. scan for all signals already in the sensitivity list (in order to catch
8341;;      manually entered global signals)
8342;;   3. signals from 1. and 2. form the list of visible signals
8343;;   4. search for if/elsif conditions containing an event (sequential code)
8344;;   5. scan for strings that are within syntactical regions where signals are
8345;;      read but not within sequential code, and that correspond to visible
8346;;      signals
8347;;   6. replace sensitivity list by list of signals from 5.
8348
8349(defun vhdl-update-sensitivity-list-process ()
8350  "Update sensitivity list of current process."
8351  (interactive)
8352  (save-excursion
8353    (vhdl-prepare-search-2
8354     (end-of-line)
8355     ;; look whether in process
8356     (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
8357		   (equal (upcase (match-string 2)) "PROCESS")
8358		   (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
8359	 (error "ERROR:  Not within a process")
8360       (message "Updating sensitivity list...")
8361       (vhdl-update-sensitivity-list)
8362       (message "Updating sensitivity list...done")))))
8363
8364(defun vhdl-update-sensitivity-list-buffer ()
8365  "Update sensitivity list of all processes in current buffer."
8366  (interactive)
8367  (save-excursion
8368    (vhdl-prepare-search-2
8369     (goto-char (point-min))
8370     (message "Updating sensitivity lists...")
8371     (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
8372       (goto-char (match-beginning 0))
8373       (condition-case nil (vhdl-update-sensitivity-list) (error "")))
8374     (message "Updating sensitivity lists...done")))
8375  (when noninteractive (save-buffer)))
8376
8377(defun vhdl-update-sensitivity-list ()
8378  "Update sensitivity list."
8379    (let ((proc-beg (point))
8380	  (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
8381	  (proc-mid (vhdl-re-search-backward
8382		     "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t))
8383	  seq-region-list)
8384      (cond
8385       ;; error if 'begin' keyword missing
8386       ((not (match-string 2))
8387	(error "ERROR:  No 'begin' keyword found"))
8388       ;; search for wait statement (no sensitivity list allowed)
8389       ((progn (goto-char proc-mid)
8390	       (vhdl-re-search-forward "\\<wait\\>" proc-end t))
8391	(error "ERROR:  Process with wait statement, sensitivity list not generated"))
8392       ;; combinational process (update sensitivity list)
8393       (t
8394	(let
8395	    ;; scan for visible signals
8396	    ((visible-list (vhdl-get-visible-signals))
8397	     ;; define syntactic regions where signals are read
8398	     (scan-regions-list
8399	      '(;; right-hand side of signal/variable assignment
8400		;; (special case: "<=" is relational operator in a condition)
8401		((vhdl-re-search-forward "[<:]=" proc-end t)
8402		 (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
8403		;; if condition
8404		((vhdl-re-search-forward "^\\s-*if\\>" proc-end t)
8405		 (vhdl-re-search-forward "\\<then\\>" proc-end t))
8406		;; elsif condition
8407		((vhdl-re-search-forward "\\<elsif\\>" proc-end t)
8408		 (vhdl-re-search-forward "\\<then\\>" proc-end t))
8409		;; while loop condition
8410		((vhdl-re-search-forward "^\\s-*while\\>" proc-end t)
8411		 (vhdl-re-search-forward "\\<loop\\>" proc-end t))
8412		;; exit/next condition
8413		((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
8414		 (vhdl-re-search-forward ";" proc-end t))
8415		;; assert condition
8416		((vhdl-re-search-forward "\\<assert\\>" proc-end t)
8417		 (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
8418		;; case expression
8419		((vhdl-re-search-forward "^\\s-*case\\>" proc-end t)
8420		 (vhdl-re-search-forward "\\<is\\>" proc-end t))
8421		;; parameter list of procedure call, array index
8422		((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
8423		      (1- (point)))
8424		 (progn (backward-char) (forward-sexp)
8425			(while (looking-at "(") (forward-sexp)) (point)))))
8426	     name field read-list sens-list signal-list tmp-list
8427	     sens-beg sens-end beg end margin)
8428	  ;; scan for signals in old sensitivity list
8429	  (goto-char proc-beg)
8430	  (vhdl-re-search-forward "\\<process\\>" proc-mid t)
8431	  (if (not (looking-at "[ \t\n\r\f]*("))
8432	      (setq sens-beg (point))
8433	    (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
8434	    (goto-char (match-end 1))
8435	    (forward-sexp)
8436	    (setq sens-end (1- (point)))
8437	    (goto-char sens-beg)
8438	    (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t)
8439			(setq sens-list
8440			      (cons (downcase (match-string 0)) sens-list))
8441			(vhdl-re-search-forward "\\s-*,\\s-*" sens-end t))))
8442	  (setq signal-list (append visible-list sens-list))
8443	  ;; search for sequential parts
8444	  (goto-char proc-mid)
8445	  (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
8446	    (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t))
8447	    (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
8448	      (goto-char end)
8449	      (backward-word-strictly 1)
8450	      (vhdl-forward-sexp)
8451	      (push (cons end (point)) seq-region-list)
8452	      (beginning-of-line)))
8453	  ;; scan for signals read in process
8454	  (while scan-regions-list
8455	    (goto-char proc-mid)
8456	    (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
8457			(setq end (eval (nth 1 (car scan-regions-list)))))
8458	      (goto-char beg)
8459	      (unless (or (vhdl-in-literal)
8460			  (and seq-region-list
8461			       (let ((tmp-list seq-region-list))
8462				 (while (and tmp-list
8463					     (< (point) (caar tmp-list)))
8464				   (setq tmp-list (cdr tmp-list)))
8465				 (and tmp-list (< (point) (cdar tmp-list))))))
8466		(while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
8467		  (setq name (match-string 1))
8468		  ;; get array index range
8469		  (when vhdl-array-index-record-field-in-sensitivity-list
8470		    (setq field (match-string 2))
8471		    ;; not use if it includes a variable name
8472		    (save-match-data
8473		      (setq tmp-list visible-list)
8474		      (while (and field tmp-list)
8475			(when (string-match
8476			       (concat "\\<" (car tmp-list) "\\>") field)
8477			  (setq field nil))
8478			(setq tmp-list (cdr tmp-list)))))
8479		  (when (and (not (match-string 6)) ; not when formal parameter
8480			     (not (and (match-string 5) ; not event attribute
8481				       (not (member (downcase (match-string 5))
8482						    '("event" "last_event" "transaction")))))
8483			     (member (downcase name) signal-list))
8484		    ;; not add if name or name+field already exists
8485		    (unless
8486			(or (member-ignore-case name read-list)
8487			    (member-ignore-case (concat name field) read-list))
8488		      (push (concat name field) read-list))
8489		    (setq tmp-list read-list)
8490		    ;; remove existing name+field if name is added
8491		    (save-match-data
8492		      (while tmp-list
8493			(when (string-match (concat "^" name field "[(.]")
8494					    (car tmp-list))
8495			  (setq read-list (delete (car tmp-list) read-list)))
8496			(setq tmp-list (cdr tmp-list)))))
8497		  (goto-char (match-end 1)))))
8498	    (setq scan-regions-list (cdr scan-regions-list)))
8499	  ;; update sensitivity list
8500	  (goto-char sens-beg)
8501	  (if sens-end
8502	      (delete-region sens-beg sens-end)
8503	    (when read-list
8504	      (insert " ()") (backward-char)))
8505	  (setq read-list (sort read-list #'string<))
8506	  (when read-list
8507	    (setq margin (current-column))
8508	    (insert (car read-list))
8509	    (setq read-list (cdr read-list))
8510	    (while read-list
8511	      (insert ",")
8512	      (if (<= (+ (current-column) (length (car read-list)) 2)
8513		      end-comment-column)
8514		  (insert " ")
8515		(insert "\n") (indent-to margin))
8516	      (insert (car read-list))
8517	      (setq read-list (cdr read-list)))))))))
8518
8519(defun vhdl-get-visible-signals ()
8520  "Get all signals visible in the current block."
8521  (let (beg end signal-list entity-name file-name)
8522    (vhdl-prepare-search-2
8523     ;; get entity name
8524     (save-excursion
8525       (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
8526		    (not (equal "END" (upcase (match-string 1))))
8527		    (setq entity-name (match-string 2)))
8528	 (error "ERROR:  Not within an architecture")))
8529     ;; search for signals declared in entity port clause
8530     (save-excursion
8531       (goto-char (point-min))
8532       (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
8533	 (setq file-name
8534	       (concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
8535		       "." (file-name-extension (buffer-file-name)))))
8536       (vhdl-visit-file
8537	   file-name t
8538	(vhdl-prepare-search-2
8539	 (goto-char (point-min))
8540	 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
8541	     (error "ERROR:  Entity \"%s\" not found:\n  --> see option `vhdl-entity-file-name'" entity-name)
8542	   (when (setq beg (vhdl-re-search-forward
8543			    "\\<port[ \t\n\r\f]*("
8544			    (save-excursion
8545			      (re-search-forward "^end\\>" nil t))
8546			    t))
8547	     (setq end (save-excursion
8548			 (backward-char) (forward-sexp) (point)))
8549	     (vhdl-forward-syntactic-ws)
8550	     (while (< (point) end)
8551	       (when (looking-at "signal[ \t\n\r\f]+")
8552		 (goto-char (match-end 0)))
8553	       (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+")
8554		 (setq signal-list
8555		       (cons (downcase (match-string 1)) signal-list))
8556		 (goto-char (match-end 0))
8557		 (vhdl-forward-syntactic-ws))
8558	       (re-search-forward ";" end 1)
8559	       (vhdl-forward-syntactic-ws)))))))
8560     ;; search for signals declared in architecture declarative part
8561     (save-excursion
8562       (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
8563		     (not (equal "END" (upcase (match-string 1))))
8564		     (setq end (re-search-forward "^begin\\>" nil t))))
8565	   (error "ERROR:  No architecture declarative part found")
8566	 ;; scan for all declared signal and alias names
8567	 (goto-char beg)
8568	 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8569	   (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8570	     (if (match-string 2)
8571		 ;; scan signal name
8572		 (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)")
8573		   (setq signal-list
8574			 (cons (downcase (match-string 1)) signal-list))
8575		   (goto-char (match-end 0)))
8576	       ;; scan alias name, check is alias of (declared) signal
8577	       (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)")
8578			  (member (downcase (match-string 2)) signal-list))
8579		 (setq signal-list
8580		       (cons (downcase (match-string 1)) signal-list))
8581		 (goto-char (match-end 0))))
8582	     (setq beg (point))))))
8583     ;; search for signals declared in surrounding block declarative parts
8584     (save-excursion
8585       (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
8586				      (match-string 4))
8587			    (goto-char (match-end 4))
8588			    (vhdl-backward-sexp)
8589			    (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
8590			  beg)
8591		   (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
8592	 ;; scan for all declared signal names
8593	 (goto-char beg)
8594	 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8595	   (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8596	     (if (match-string 2)
8597		 ;; scan signal name
8598		 (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8599		   (setq signal-list
8600			 (cons (downcase (match-string 1)) signal-list))
8601		   (goto-char (match-end 0)))
8602	       ;; scan alias name, check is alias of (declared) signal
8603	       (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8604			  (member (downcase (match-string 2)) signal-list))
8605		 (setq signal-list
8606		       (cons (downcase (match-string 1)) signal-list))
8607		 (goto-char (match-end 0))))))
8608	 (goto-char beg)))
8609     signal-list)))
8610
8611;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8612;; Generic/port clause fixing
8613
8614(defun vhdl-fix-clause-buffer ()
8615  "Fix all generic/port clauses in current buffer."
8616  (interactive)
8617  (save-excursion
8618    (vhdl-prepare-search-2
8619     (goto-char (point-min))
8620     (message "Fixing generic/port clauses...")
8621     (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)
8622       (goto-char (match-end 0))
8623       (condition-case nil (vhdl-fix-clause) (error "")))
8624     (message "Fixing generic/port clauses...done"))))
8625
8626(defun vhdl-fix-clause ()
8627  "Fix closing parenthesis within generic/port clause."
8628  (interactive)
8629  (save-excursion
8630    (vhdl-prepare-search-2
8631     (let ((pos (point))
8632	   beg end)
8633       (end-of-line)
8634       (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t))
8635	   (error "ERROR:  Not within a generic/port clause")
8636	 ;; search for end of clause
8637	 (goto-char (match-end 0))
8638	 (setq beg (1- (point)))
8639	 (vhdl-forward-syntactic-ws)
8640	 (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
8641	   (goto-char (1- (match-end 0)))
8642	   (setq end (point-marker))
8643	   (forward-char)
8644	   (vhdl-forward-syntactic-ws))
8645	 (goto-char end)
8646	 (when (> pos (point-at-eol))
8647	   (error "ERROR:  Not within a generic/port clause"))
8648	 ;; delete closing parenthesis on separate line (not supported style)
8649	 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
8650	   (vhdl-line-kill)
8651	   (vhdl-backward-syntactic-ws)
8652	   (setq end (point-marker))
8653	   (insert ";"))
8654	 ;; delete superfluous parentheses
8655	 (while (progn (goto-char beg)
8656		       (condition-case () (forward-sexp)
8657			 (error (goto-char (point-max))))
8658		       (< (point) end))
8659	   (delete-char -1))
8660	 ;; add closing parenthesis
8661	 (when (> (point) end)
8662	   (goto-char end)
8663	   (insert ")")))))))
8664
8665
8666;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8667;;; Electrification
8668;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8669
8670(defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
8671  "Syntax of prompt inserted by template generators.")
8672
8673(defvar vhdl-template-invoked-by-hook nil
8674  "Indicates whether a template has been invoked by a hook or by key or menu.
8675Used for undoing after template abortion.")
8676
8677;; correct different behavior of function `unread-command-events' in XEmacs
8678(defun vhdl-character-to-event (_arg) nil)
8679(defalias 'vhdl-character-to-event
8680  (if (fboundp 'character-to-event) #'character-to-event #'identity))
8681
8682(defun vhdl-work-library ()
8683  "Return the working library name of the current project or \"work\" if no
8684project is defined."
8685  (vhdl-resolve-env-variable
8686   (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
8687       vhdl-default-library)))
8688
8689;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8690;;  Enabling/disabling
8691
8692(define-minor-mode vhdl-electric-mode
8693  "Toggle VHDL electric mode."
8694  :global t :group 'vhdl-mode)
8695
8696(define-minor-mode vhdl-stutter-mode
8697  "Toggle VHDL stuttering mode."
8698  :global t :group 'vhdl-mode)
8699
8700;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8701;; Stuttering
8702
8703(defun vhdl-electric-dash (count)
8704  "-- starts a comment, --- draws a horizontal line,
8705---- starts a display comment."
8706  (interactive "p")
8707  (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
8708      (cond
8709       ((and abbrev-start-location (= abbrev-start-location (point)))
8710	(setq abbrev-start-location nil)
8711	(goto-char last-abbrev-location)
8712	(beginning-of-line nil)
8713	(vhdl-comment-display))
8714       ((/= (preceding-char) ?-)	; standard dash (minus)
8715	(self-insert-command count))
8716       (t (self-insert-command count)
8717	  (message "Enter `-' for horiz. line, RET for commenting-out code, else enter comment")
8718	  (let ((next-input (read-char)))
8719	    (if (= next-input ?-)	; triple dash
8720		(progn
8721		  (vhdl-comment-display-line)
8722		  (message
8723		   "Enter `-' for display comment, else continue coding")
8724		  (let ((next-input (read-char)))
8725		    (if (= next-input ?-) ; four dashes
8726			(vhdl-comment-display t)
8727		      (push (vhdl-character-to-event next-input)
8728                                        ; pushback the char
8729                            unread-command-events))))
8730              (push (vhdl-character-to-event next-input) ; pushback the char
8731                    unread-command-events)
8732	      (vhdl-comment-insert)))))
8733    (self-insert-command count)))
8734
8735(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['"
8736  (interactive "p")
8737  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8738      (if (= (preceding-char) ?\()
8739	  (progn (delete-char -1) (insert-char ?\[ 1))
8740	(insert-char ?\( 1))
8741    (self-insert-command count)))
8742
8743(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'"
8744  (interactive "p")
8745  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8746      (progn
8747	(if (= (preceding-char) ?\))
8748	    (progn (delete-char -1) (insert-char ?\] 1))
8749	  (insert-char ?\) 1))
8750	(blink-matching-open))
8751    (self-insert-command count)))
8752
8753(defun vhdl-electric-quote (count) "\\='\\=' --> \""
8754  (interactive "p")
8755  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8756      (if (= (preceding-char) vhdl-last-input-event)
8757	  (progn (delete-char -1) (insert-char ?\" 1))
8758	(insert-char ?\' 1))
8759    (self-insert-command count)))
8760
8761(defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '"
8762  (interactive "p")
8763  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8764      (cond ((= (preceding-char) vhdl-last-input-event)
8765	     (progn (delete-char -1)
8766		    (unless (eq (preceding-char) ? ) (insert " "))
8767		    (insert ": ")
8768		    (setq this-command 'vhdl-electric-colon)))
8769	    ((and
8770	      (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? ))
8771	     (progn (delete-char -1) (insert "= ")))
8772	    (t (insert-char ?\; 1)))
8773    (self-insert-command count)))
8774
8775(defun vhdl-electric-comma (count) "`,,' --> ` <= '"
8776  (interactive "p")
8777  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8778      (cond ((= (preceding-char) vhdl-last-input-event)
8779	     (progn (delete-char -1)
8780		    (unless (eq (preceding-char) ? ) (insert " "))
8781		    (insert "<= ")))
8782	    (t (insert-char ?\, 1)))
8783    (self-insert-command count)))
8784
8785(defun vhdl-electric-period (count) "`..' --> ` => '"
8786  (interactive "p")
8787  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8788      (cond ((= (preceding-char) vhdl-last-input-event)
8789	     (progn (delete-char -1)
8790		    (unless (eq (preceding-char) ? ) (insert " "))
8791		    (insert "=> ")))
8792	    (t (insert-char ?\. 1)))
8793    (self-insert-command count)))
8794
8795(defun vhdl-electric-equal (count) "`==' --> ` == '"
8796  (interactive "p")
8797  (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8798      (cond ((= (preceding-char) vhdl-last-input-event)
8799	     (progn (delete-char -1)
8800		    (unless (eq (preceding-char) ? ) (insert " "))
8801		    (insert "== ")))
8802	    (t (insert-char ?\= 1)))
8803    (self-insert-command count)))
8804
8805;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8806;;  VHDL templates
8807
8808(defun vhdl-template-paired-parens ()
8809  "Insert a pair of round parentheses, placing point between them."
8810  (interactive)
8811  (insert "()")
8812  (backward-char))
8813
8814(defun vhdl-template-alias ()
8815  "Insert alias declaration."
8816  (interactive)
8817  (let ((start (point)))
8818    (vhdl-insert-keyword "ALIAS ")
8819    (when (vhdl-template-field "name" nil t start (point))
8820      (insert " : ")
8821      (unless (vhdl-template-field
8822	       (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8823	       nil t)
8824	(delete-char -3))
8825      (vhdl-insert-keyword " IS ")
8826      (vhdl-template-field "name" ";")
8827      (vhdl-comment-insert-inline))))
8828
8829(defun vhdl-template-architecture ()
8830  "Insert architecture."
8831  (interactive)
8832  (let ((margin (current-indentation))
8833	(start (point))
8834	arch-name)
8835    (vhdl-insert-keyword "ARCHITECTURE ")
8836    (when (setq arch-name
8837		(vhdl-template-field "name" nil t start (point)))
8838      (vhdl-insert-keyword " OF ")
8839      (if (save-excursion
8840	    (vhdl-prepare-search-1
8841	     (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8842	  (insert (match-string 1))
8843	(vhdl-template-field "entity name"))
8844      (vhdl-insert-keyword " IS\n")
8845      (vhdl-template-begin-end
8846       (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8847       (memq vhdl-insert-empty-lines '(unit all))))))
8848
8849(defun vhdl-template-array (kind &optional secondary)
8850  "Insert array type definition."
8851  (interactive)
8852  (let ((start (point)))
8853    (vhdl-insert-keyword "ARRAY (")
8854    (when (or (vhdl-template-field "range" nil (not secondary) start (point))
8855	      secondary)
8856      (vhdl-insert-keyword ") OF ")
8857      (vhdl-template-field (if (eq kind 'type) "type" "nature"))
8858      (vhdl-insert-keyword ";"))))
8859
8860(defun vhdl-template-assert ()
8861  "Insert an assertion statement."
8862  (interactive)
8863  (let ((start (point)))
8864    (vhdl-insert-keyword "ASSERT ")
8865    (when vhdl-conditions-in-parenthesis (insert "("))
8866    (when (vhdl-template-field "condition (negated)" nil t start (point))
8867      (when vhdl-conditions-in-parenthesis (insert ")"))
8868      (setq start (point))
8869      (vhdl-insert-keyword " REPORT ")
8870      (unless (vhdl-template-field "string expression" nil nil nil nil t)
8871	(delete-region start (point)))
8872      (setq start (point))
8873      (vhdl-insert-keyword " SEVERITY ")
8874      (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
8875	(delete-region start (point)))
8876      (insert ";"))))
8877
8878(defun vhdl-template-attribute ()
8879  "Insert an attribute declaration or specification."
8880  (interactive)
8881  (if (eq (vhdl-decision-query
8882	   "attribute" "(d)eclaration or (s)pecification?" t) ?s)
8883      (vhdl-template-attribute-spec)
8884    (vhdl-template-attribute-decl)))
8885
8886(defun vhdl-template-attribute-decl ()
8887  "Insert an attribute declaration."
8888  (interactive)
8889  (let ((start (point)))
8890    (vhdl-insert-keyword "ATTRIBUTE ")
8891    (when (vhdl-template-field "name" " : " t start (point))
8892      (vhdl-template-field "type" ";")
8893      (vhdl-comment-insert-inline))))
8894
8895(defun vhdl-template-attribute-spec ()
8896  "Insert an attribute specification."
8897  (interactive)
8898  (let ((start (point)))
8899    (vhdl-insert-keyword "ATTRIBUTE ")
8900    (when (vhdl-template-field "name" nil t start (point))
8901      (vhdl-insert-keyword " OF ")
8902      (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8903      (vhdl-template-field "entity class")
8904      (vhdl-insert-keyword " IS ")
8905      (vhdl-template-field "expression" ";"))))
8906
8907(defun vhdl-template-block ()
8908  "Insert a block."
8909  (interactive)
8910  (let ((margin (current-indentation))
8911	(start (point))
8912	label)
8913    (vhdl-insert-keyword ": BLOCK ")
8914    (goto-char start)
8915    (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
8916      (forward-word-strictly 1)
8917      (forward-char 1)
8918      (insert "(")
8919      (if (vhdl-template-field "[guard expression]" nil t)
8920	  (insert ")")
8921	(delete-char -2))
8922      (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8923      (insert "\n")
8924      (vhdl-template-begin-end "BLOCK" label margin)
8925      (vhdl-comment-block))))
8926
8927(defun vhdl-template-block-configuration ()
8928  "Insert a block configuration statement."
8929  (interactive)
8930  (let ((margin (current-indentation))
8931	(start (point)))
8932    (vhdl-insert-keyword "FOR ")
8933    (when (vhdl-template-field "block name" nil t start (point))
8934      (vhdl-insert-keyword "\n\n")
8935      (indent-to margin)
8936      (vhdl-insert-keyword "END FOR;")
8937      (end-of-line 0)
8938      (indent-to (+ margin vhdl-basic-offset)))))
8939
8940(defun vhdl-template-break ()
8941  "Insert a break statement."
8942  (interactive)
8943  (let (position)
8944    (vhdl-insert-keyword "BREAK")
8945    (setq position (point))
8946    (insert " ")
8947    (while (or
8948	    (progn (vhdl-insert-keyword "FOR ")
8949		   (if (vhdl-template-field "[quantity name]" " USE " t)
8950		       (progn (vhdl-template-field "quantity name" " => ") t)
8951		     (delete-region (point)
8952				    (progn (forward-word-strictly -1) (point)))
8953		     nil))
8954	    (vhdl-template-field "[quantity name]" " => " t))
8955      (vhdl-template-field "expression")
8956      (setq position (point))
8957      (insert ", "))
8958    (delete-region position (point))
8959    (unless (vhdl-sequential-statement-p)
8960      (vhdl-insert-keyword " ON ")
8961      (if (vhdl-template-field "[sensitivity list]" nil t)
8962	  (setq position (point))
8963	(delete-region position (point))))
8964    (vhdl-insert-keyword " WHEN ")
8965    (when vhdl-conditions-in-parenthesis (insert "("))
8966    (if (vhdl-template-field "[condition]" nil t)
8967	(when vhdl-conditions-in-parenthesis (insert ")"))
8968      (delete-region position (point)))
8969    (insert ";")))
8970
8971(defun vhdl-template-case (&optional kind)
8972  "Insert a case statement."
8973  (interactive)
8974  (let ((margin (current-indentation))
8975	(start (point))
8976	label)
8977    (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
8978				    (not (vhdl-standard-p 'ams))) 'is 'use)))
8979    (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8980	(vhdl-insert-keyword "CASE ")
8981      (vhdl-insert-keyword ": CASE ")
8982      (goto-char start)
8983      (setq label (vhdl-template-field "[label]" nil t))
8984      (unless label (delete-char 2))
8985      (forward-word-strictly 1)
8986      (forward-char 1))
8987    (when (vhdl-template-field "expression" nil t start (point))
8988      (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
8989      (indent-to margin)
8990      (vhdl-insert-keyword "END CASE")
8991      (when label (insert " " label))
8992      (insert ";")
8993      (forward-line -1)
8994      (indent-to (+ margin vhdl-basic-offset))
8995      (vhdl-insert-keyword "WHEN ")
8996      (let ((position (point)))
8997	(insert " => ;\n")
8998	(indent-to (+ margin vhdl-basic-offset))
8999	(vhdl-insert-keyword "WHEN OTHERS => null;")
9000	(goto-char position)))))
9001
9002(defun vhdl-template-case-is ()
9003  "Insert a sequential case statement."
9004  (interactive)
9005  (vhdl-template-case 'is))
9006
9007(defun vhdl-template-case-use ()
9008  "Insert a simultaneous case statement."
9009  (interactive)
9010  (vhdl-template-case 'use))
9011
9012(defun vhdl-template-component ()
9013  "Insert a component declaration."
9014  (interactive)
9015  (vhdl-template-component-decl))
9016
9017(defun vhdl-template-component-conf ()
9018  "Insert a component configuration (uses `vhdl-template-configuration-spec'
9019since these are almost equivalent)."
9020  (interactive)
9021  (let ((margin (current-indentation))
9022	(result (vhdl-template-configuration-spec t)))
9023    (when result
9024      (insert "\n")
9025      (indent-to margin)
9026      (vhdl-insert-keyword "END FOR;")
9027      (when (eq result 'no-use)
9028	(end-of-line -0)))))
9029
9030(defun vhdl-template-component-decl ()
9031  "Insert a component declaration."
9032  (interactive)
9033  (let ((margin (current-indentation))
9034	(start (point))
9035	name end-column)
9036    (vhdl-insert-keyword "COMPONENT ")
9037    (when (setq name (vhdl-template-field "name" nil t start (point)))
9038      (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9039      (insert "\n\n")
9040      (indent-to margin)
9041      (vhdl-insert-keyword "END COMPONENT")
9042      (unless (vhdl-standard-p '87) (insert " " name))
9043      (insert ";")
9044      (setq end-column (current-column))
9045      (end-of-line -0)
9046      (indent-to (+ margin vhdl-basic-offset))
9047      (vhdl-template-generic-list t t)
9048      (insert "\n")
9049      (indent-to (+ margin vhdl-basic-offset))
9050      (vhdl-template-port-list t)
9051      (beginning-of-line 2)
9052      (forward-char end-column))))
9053
9054(defun vhdl-template-component-inst ()
9055  "Insert a component instantiation statement."
9056  (interactive)
9057  (let ((margin (current-indentation))
9058	(start (point))
9059	unit position)
9060    (when (vhdl-template-field "instance label" nil t start (point))
9061      (insert ": ")
9062      (if (not (vhdl-use-direct-instantiation))
9063	  (vhdl-template-field "component name")
9064	;; direct instantiation
9065	(setq unit (vhdl-template-field
9066		    "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
9067	(setq unit (upcase (or unit "")))
9068	(cond ((equal unit "ENTITY")
9069	       (let ((begin (point)))
9070		 (vhdl-template-field "library name" "." t begin (point) nil
9071				    (vhdl-work-library))
9072	       (vhdl-template-field "entity name" "(")
9073	       (if (vhdl-template-field "[architecture name]" nil t)
9074		   (insert ")")
9075		   (delete-char -1))))
9076	      ((equal unit "CONFIGURATION")
9077	       (vhdl-template-field "library name" "." nil nil nil nil
9078				    (vhdl-work-library))
9079	       (vhdl-template-field "configuration name"))
9080	      (t (vhdl-template-field "component name"))))
9081      (insert "\n")
9082      (indent-to (+ margin vhdl-basic-offset))
9083      (setq position (point))
9084      (vhdl-insert-keyword "GENERIC ")
9085      (when (vhdl-template-map position t t)
9086	(insert "\n")
9087	(indent-to (+ margin vhdl-basic-offset)))
9088      (setq position (point))
9089      (vhdl-insert-keyword "PORT ")
9090      (unless (vhdl-template-map position t t)
9091	(delete-region (line-beginning-position) (point))
9092	(delete-char -1))
9093      (insert ";"))))
9094
9095(defun vhdl-template-conditional-signal-asst ()
9096  "Insert a conditional signal assignment."
9097  (interactive)
9098  (when (vhdl-template-field "target signal")
9099    (insert " <= ")
9100    (let ((margin (current-column))
9101	  (start (point))
9102	  position)
9103      (vhdl-template-field "waveform")
9104      (setq position (point))
9105      (vhdl-insert-keyword " WHEN ")
9106      (when vhdl-conditions-in-parenthesis (insert "("))
9107      (while (and (vhdl-template-field "[condition]" nil t)
9108		  (progn
9109		    (when vhdl-conditions-in-parenthesis (insert ")"))
9110		    (setq position (point))
9111		    (vhdl-insert-keyword " ELSE")
9112		    (insert "\n")
9113		    (indent-to margin)
9114		    (vhdl-template-field "[waveform]" nil t)))
9115	(setq position (point))
9116	(vhdl-insert-keyword " WHEN ")
9117	(when vhdl-conditions-in-parenthesis (insert "(")))
9118      (delete-region position (point))
9119      (insert ";")
9120      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9121
9122(defun vhdl-template-configuration ()
9123  "Insert a configuration specification if within an architecture,
9124a block or component configuration if within a configuration declaration,
9125a configuration declaration if not within a design unit."
9126  (interactive)
9127  (vhdl-prepare-search-1
9128   (cond
9129    ((and (save-excursion		; architecture body
9130	    (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
9131	  (equal "ARCHITECTURE" (upcase (match-string 1))))
9132     (vhdl-template-configuration-spec))
9133    ((and (save-excursion		; configuration declaration
9134	    (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9135	  (equal "CONFIGURATION" (upcase (match-string 1))))
9136     (if (eq (vhdl-decision-query
9137	      "configuration" "(b)lock or (c)omponent configuration?" t)
9138	     ?c)
9139	 (vhdl-template-component-conf)
9140       (vhdl-template-block-configuration)))
9141    (t (vhdl-template-configuration-decl))))) ; otherwise
9142
9143(defun vhdl-template-configuration-spec (&optional optional-use)
9144  "Insert a configuration specification."
9145  (interactive)
9146  (let ((margin (current-indentation))
9147	(start (point))
9148	aspect position)
9149    (vhdl-insert-keyword "FOR ")
9150    (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
9151			       t start (point))
9152      (vhdl-template-field "component name" "\n")
9153      (indent-to (+ margin vhdl-basic-offset))
9154      (setq start (point))
9155      (vhdl-insert-keyword "USE ")
9156      (if (and optional-use
9157	       (not (setq aspect (vhdl-template-field
9158				  "[ENTITY | CONFIGURATION | OPEN]" " " t))))
9159	  (progn (delete-region start (point)) 'no-use)
9160	(unless optional-use
9161	  (setq aspect (vhdl-template-field
9162			"ENTITY | CONFIGURATION | OPEN" " ")))
9163	(setq aspect (upcase (or aspect "")))
9164	(cond ((equal aspect "ENTITY")
9165	       (vhdl-template-field "library name" "." nil nil nil nil
9166				    (vhdl-work-library))
9167	       (vhdl-template-field "entity name" "(")
9168	       (if (vhdl-template-field "[architecture name]" nil t)
9169		   (insert ")")
9170		 (delete-char -1))
9171	       (insert "\n")
9172	       (indent-to (+ margin (* 2 vhdl-basic-offset)))
9173	       (setq position (point))
9174	       (vhdl-insert-keyword "GENERIC ")
9175	       (when (vhdl-template-map position t t)
9176		 (insert "\n")
9177		 (indent-to (+ margin (* 2 vhdl-basic-offset))))
9178	       (setq position (point))
9179	       (vhdl-insert-keyword "PORT ")
9180	       (unless (vhdl-template-map position t t)
9181		 (delete-region (line-beginning-position) (point))
9182		 (delete-char -1))
9183	       (insert ";")
9184	       t)
9185	      ((equal aspect "CONFIGURATION")
9186	       (vhdl-template-field "library name" "." nil nil nil nil
9187				    (vhdl-work-library))
9188	       (vhdl-template-field "configuration name" ";"))
9189	      (t (delete-char -1) (insert ";") t))))))
9190
9191
9192(defun vhdl-template-configuration-decl ()
9193  "Insert a configuration declaration."
9194  (interactive)
9195  (let ((margin (current-indentation))
9196	(start (point))
9197	entity-exists string name position)
9198    (vhdl-insert-keyword "CONFIGURATION ")
9199    (when (setq name (vhdl-template-field "name" nil t start (point)))
9200      (vhdl-insert-keyword " OF ")
9201      (save-excursion
9202	(vhdl-prepare-search-1
9203	 (setq entity-exists (vhdl-re-search-backward
9204			      "\\<entity \\(\\w*\\) is\\>" nil t))
9205	 (setq string (match-string 1))))
9206      (if (and entity-exists (not (equal string "")))
9207	  (insert string)
9208	(vhdl-template-field "entity name"))
9209      (vhdl-insert-keyword " IS\n")
9210      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9211      (indent-to (+ margin vhdl-basic-offset))
9212      (setq position (point))
9213      (insert "\n")
9214      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9215      (indent-to margin)
9216      (vhdl-insert-keyword "END ")
9217      (unless (vhdl-standard-p '87)
9218	(vhdl-insert-keyword "CONFIGURATION "))
9219      (insert name ";")
9220      (goto-char position))))
9221
9222(defun vhdl-template-constant ()
9223  "Insert a constant declaration."
9224  (interactive)
9225  (let ((start (point))
9226	(in-arglist (vhdl-in-argument-list-p)))
9227    (vhdl-insert-keyword "CONSTANT ")
9228    (when (vhdl-template-field "name" nil t start (point))
9229      (insert " : ")
9230      (when in-arglist (vhdl-insert-keyword "IN "))
9231      (vhdl-template-field "type")
9232      (if in-arglist
9233	  (progn (insert ";")
9234		 (vhdl-comment-insert-inline))
9235	(let ((position (point)))
9236	  (insert " := ")
9237	  (unless (vhdl-template-field "[initialization]" nil t)
9238	    (delete-region position (point)))
9239	  (insert ";")
9240	  (vhdl-comment-insert-inline))))))
9241
9242(defun vhdl-template-context ()
9243  "Insert a context declaration."
9244  (interactive)
9245  (let ((margin (current-indentation))
9246	(start (point))
9247	name position) ;; entity-exists string
9248    (vhdl-insert-keyword "CONTEXT ")
9249    (when (setq name (vhdl-template-field "name" nil t start (point)))
9250      (vhdl-insert-keyword " IS\n")
9251      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9252      (indent-to (+ margin vhdl-basic-offset))
9253      (setq position (point))
9254      (insert "\n")
9255      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9256      (indent-to margin)
9257      (vhdl-insert-keyword "END ")
9258      (unless (vhdl-standard-p '87)
9259	(vhdl-insert-keyword "CONTEXT "))
9260      (insert name ";")
9261      (goto-char position))))
9262
9263(defun vhdl-template-default ()
9264  "Insert nothing."
9265  (interactive)
9266  (insert " ")
9267  (unexpand-abbrev)
9268  (backward-word-strictly 1)
9269  (vhdl-case-word 1)
9270  (forward-char 1))
9271
9272(defun vhdl-template-default-indent ()
9273  "Insert nothing and indent."
9274  (interactive)
9275  (insert " ")
9276  (unexpand-abbrev)
9277  (backward-word-strictly 1)
9278  (vhdl-case-word 1)
9279  (forward-char 1)
9280  (indent-according-to-mode))
9281
9282(defun vhdl-template-disconnect ()
9283  "Insert a disconnect statement."
9284  (interactive)
9285  (let ((start (point)))
9286    (vhdl-insert-keyword "DISCONNECT ")
9287    (when (vhdl-template-field "signal names | OTHERS | ALL"
9288			       " : " t start (point))
9289      (vhdl-template-field "type")
9290      (vhdl-insert-keyword " AFTER ")
9291      (vhdl-template-field "time expression" ";"))))
9292
9293(defun vhdl-template-else ()
9294  "Insert an else statement."
9295  (interactive)
9296  (let (margin)
9297    (vhdl-prepare-search-1
9298     (vhdl-insert-keyword "ELSE")
9299     (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t))
9300	      (match-string 2))
9301	 (insert " ")
9302       (unless (vhdl-sequential-statement-p)
9303 	 (vhdl-insert-keyword " GENERATE"))
9304       (indent-according-to-mode)
9305       (setq margin (current-indentation))
9306       (insert "\n")
9307       (indent-to (+ margin vhdl-basic-offset))))))
9308
9309(defun vhdl-template-elsif ()
9310  "Insert an elsif statement."
9311  (interactive)
9312  (let ((start (point))
9313	margin)
9314    (vhdl-insert-keyword "ELSIF ")
9315      (when vhdl-conditions-in-parenthesis (insert "("))
9316      (when (vhdl-template-field "condition" nil t start (point))
9317	(when vhdl-conditions-in-parenthesis (insert ")"))
9318	(indent-according-to-mode)
9319	(setq margin (current-indentation))
9320	(vhdl-insert-keyword
9321       (concat " " (cond ((vhdl-sequential-statement-p) "THEN")
9322			 ((vhdl-standard-p 'ams) "USE")
9323			 (t "GENERATE")) "\n"))
9324      (indent-to (+ margin vhdl-basic-offset)))))
9325
9326(defun vhdl-template-entity ()
9327  "Insert an entity."
9328  (interactive)
9329  (let ((margin (current-indentation))
9330	(start (point))
9331	name end-column)
9332    (vhdl-insert-keyword "ENTITY ")
9333    (when (setq name (vhdl-template-field "name" nil t start (point)))
9334      (vhdl-insert-keyword " IS\n\n")
9335      (indent-to margin)
9336      (vhdl-insert-keyword "END ")
9337      (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
9338      (insert name ";")
9339      (setq end-column (current-column))
9340      (end-of-line -0)
9341      (indent-to (+ margin vhdl-basic-offset))
9342      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9343      (indent-to (+ margin vhdl-basic-offset))
9344      (when (vhdl-template-generic-list t)
9345	(when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9346      (insert "\n")
9347      (indent-to (+ margin vhdl-basic-offset))
9348      (when (vhdl-template-port-list t)
9349	(when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9350      (beginning-of-line 2)
9351      (forward-char end-column))))
9352
9353(defun vhdl-template-exit ()
9354  "Insert an exit statement."
9355  (interactive)
9356  (let ((start (point)))
9357    (vhdl-insert-keyword "EXIT ")
9358    (if (vhdl-template-field "[loop label]" nil t start (point))
9359	(let ((position (point)))
9360	  (vhdl-insert-keyword " WHEN ")
9361	  (when vhdl-conditions-in-parenthesis (insert "("))
9362	  (if (vhdl-template-field "[condition]" nil t)
9363	      (when vhdl-conditions-in-parenthesis (insert ")"))
9364	    (delete-region position (point))))
9365      (delete-char -1))
9366    (insert ";")))
9367
9368(defun vhdl-template-file ()
9369  "Insert a file declaration."
9370  (interactive)
9371  (let ((start (point)))
9372    (vhdl-insert-keyword "FILE ")
9373    (when (vhdl-template-field "name" nil t start (point))
9374      (insert " : ")
9375      (vhdl-template-field "type")
9376      (unless (vhdl-standard-p '87)
9377	(vhdl-insert-keyword " OPEN ")
9378	(unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
9379				     nil t)
9380	  (delete-char -6)))
9381      (vhdl-insert-keyword " IS ")
9382      (when (vhdl-standard-p '87)
9383	(vhdl-template-field "[IN | OUT]" " " t))
9384      (vhdl-template-field "filename-string" nil nil nil nil t)
9385      (insert ";")
9386      (vhdl-comment-insert-inline))))
9387
9388(defun vhdl-template-for ()
9389  "Insert a block or component configuration if within a configuration
9390declaration, a configuration specification if within an architecture
9391declarative part (and not within a subprogram), a for-loop if within a
9392sequential statement part (subprogram or process), and a for-generate
9393otherwise."
9394  (interactive)
9395  (vhdl-prepare-search-1
9396   (cond
9397    ((vhdl-sequential-statement-p)	; sequential statement
9398     (vhdl-template-for-loop))
9399    ((and (save-excursion		; configuration declaration
9400	    (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9401	  (equal "CONFIGURATION" (upcase (match-string 1))))
9402     (if (eq (vhdl-decision-query
9403	      "for" "(b)lock or (c)omponent configuration?" t)
9404	     ?c)
9405	 (vhdl-template-component-conf)
9406       (vhdl-template-block-configuration)))
9407    ((and (save-excursion
9408	    (re-search-backward		; architecture declarative part
9409	     "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
9410	  (equal "ARCHITECTURE" (upcase (match-string 1))))
9411     (vhdl-template-configuration-spec))
9412    (t (vhdl-template-for-generate))))) ; concurrent statement
9413
9414(defun vhdl-template-for-generate ()
9415  "Insert a for-generate."
9416  (interactive)
9417  (let ((margin (current-indentation))
9418	(start (point))
9419	label position)
9420    (vhdl-insert-keyword ": FOR ")
9421    (setq position (point-marker))
9422    (goto-char start)
9423    (when (setq label (vhdl-template-field "label" nil t start position))
9424      (goto-char position)
9425      (vhdl-template-field "loop variable")
9426      (vhdl-insert-keyword " IN ")
9427      (vhdl-template-field "range")
9428      (vhdl-template-generate-body margin label))))
9429
9430(defun vhdl-template-for-loop ()
9431  "Insert a for loop."
9432  (interactive)
9433  (let ((margin (current-indentation))
9434	(start (point))
9435	label index)
9436    (if (not (eq vhdl-optional-labels 'all))
9437	(vhdl-insert-keyword "FOR ")
9438      (vhdl-insert-keyword ": FOR ")
9439      (goto-char start)
9440      (setq label (vhdl-template-field "[label]" nil t))
9441      (unless label (delete-char 2))
9442      (forward-word-strictly 1)
9443      (forward-char 1))
9444    (when (setq index (vhdl-template-field "loop variable"
9445					   nil t start (point)))
9446      (vhdl-insert-keyword " IN ")
9447      (vhdl-template-field "range")
9448      (vhdl-insert-keyword " LOOP\n\n")
9449      (indent-to margin)
9450      (vhdl-insert-keyword "END LOOP")
9451      (if label
9452	  (insert " " label ";")
9453	(insert ";")
9454	(when vhdl-self-insert-comments (insert "  -- " index)))
9455      (forward-line -1)
9456      (indent-to (+ margin vhdl-basic-offset)))))
9457
9458(defun vhdl-template-function (&optional kind)
9459  "Insert a function declaration or body."
9460  (interactive)
9461  (let ((margin (current-indentation))
9462	(start (point))
9463	name)
9464    (vhdl-insert-keyword "FUNCTION ")
9465    (when (setq name (vhdl-template-field "name" nil t start (point)))
9466      (vhdl-template-argument-list t)
9467      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9468      (end-of-line)
9469      (insert "\n")
9470      (indent-to (+ margin vhdl-basic-offset))
9471      (vhdl-insert-keyword "RETURN ")
9472      (vhdl-template-field "type")
9473      (if (if kind (eq kind 'body)
9474	    (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9475	  (progn (vhdl-insert-keyword " IS\n")
9476		 (vhdl-template-begin-end
9477		  (unless (vhdl-standard-p '87) "FUNCTION") name margin)
9478		 (vhdl-comment-block))
9479	(insert ";")))))
9480
9481(defun vhdl-template-function-decl ()
9482  "Insert a function declaration."
9483  (interactive)
9484  (vhdl-template-function 'decl))
9485
9486(defun vhdl-template-function-body ()
9487  "Insert a function declaration."
9488  (interactive)
9489  (vhdl-template-function 'body))
9490
9491(defun vhdl-template-generate ()
9492  "Insert a generation scheme."
9493  (interactive)
9494  (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i)
9495      (vhdl-template-if-generate)
9496    (vhdl-template-for-generate)))
9497
9498(defun vhdl-template-generic ()
9499  "Insert generic declaration, or generic map in instantiation statements."
9500  (interactive)
9501  (let ((start (point)))
9502    (vhdl-prepare-search-1
9503     (cond
9504      ((and (save-excursion		; entity declaration
9505	      (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9506	    (equal "ENTITY" (upcase (match-string 1))))
9507       (vhdl-template-generic-list nil))
9508      ((or (save-excursion
9509	     (or (beginning-of-line)
9510		 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9511	   (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9512       (vhdl-insert-keyword "GENERIC ")
9513       (vhdl-template-map start))
9514      (t (vhdl-template-generic-list nil t))))))
9515
9516(defun vhdl-template-group ()
9517  "Insert group or group template declaration."
9518  (interactive)
9519  ;; (let ((start (point)))
9520  (if (eq (vhdl-decision-query
9521	   "group" "(d)eclaration or (t)emplate declaration?" t)
9522	  ?t)
9523      (vhdl-template-group-template)
9524    (vhdl-template-group-decl))) ;; )
9525
9526(defun vhdl-template-group-decl ()
9527  "Insert group declaration."
9528  (interactive)
9529  (let ((start (point)))
9530    (vhdl-insert-keyword "GROUP ")
9531    (when (vhdl-template-field "name" " : " t start (point))
9532      (vhdl-template-field "template name" " (")
9533      (vhdl-template-field "constituent list" ");")
9534      (vhdl-comment-insert-inline))))
9535
9536(defun vhdl-template-group-template ()
9537  "Insert group template declaration."
9538  (interactive)
9539  (let ((start (point)))
9540    (vhdl-insert-keyword "GROUP ")
9541    (when (vhdl-template-field "template name" nil t start (point))
9542      (vhdl-insert-keyword " IS (")
9543      (vhdl-template-field "entity class list" ");")
9544      (vhdl-comment-insert-inline))))
9545
9546(defun vhdl-template-if ()
9547  "Insert a sequential if statement or an if-generate statement."
9548  (interactive)
9549  (if (vhdl-sequential-statement-p)
9550      (vhdl-template-if-then)
9551    (if (and (vhdl-standard-p 'ams)
9552	     (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u))
9553	(vhdl-template-if-use)
9554      (vhdl-template-if-generate))))
9555
9556(defun vhdl-template-if-generate ()
9557  "Insert an if-generate."
9558  (interactive)
9559  (let ((margin (current-indentation))
9560	(start (point))
9561	label position)
9562    (vhdl-insert-keyword ": IF ")
9563    (setq position (point-marker))
9564    (goto-char start)
9565    (when (setq label (vhdl-template-field "label" nil t start position))
9566      (goto-char position)
9567      (when vhdl-conditions-in-parenthesis (insert "("))
9568      (vhdl-template-field "condition")
9569      (when vhdl-conditions-in-parenthesis (insert ")"))
9570      (vhdl-template-generate-body margin label))))
9571
9572(defun vhdl-template-if-then-use (kind)
9573  "Insert a sequential if statement."
9574  (interactive)
9575  (let ((margin (current-indentation))
9576	(start (point))
9577	label)
9578    (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
9579	(vhdl-insert-keyword "IF ")
9580      (vhdl-insert-keyword ": IF ")
9581      (goto-char start)
9582      (setq label (vhdl-template-field "[label]" nil t))
9583      (unless label (delete-char 2))
9584      (forward-word-strictly 1)
9585      (forward-char 1))
9586    (when vhdl-conditions-in-parenthesis (insert "("))
9587    (when (vhdl-template-field "condition" nil t start (point))
9588      (when vhdl-conditions-in-parenthesis (insert ")"))
9589      (vhdl-insert-keyword
9590       (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
9591      (indent-to margin)
9592      (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
9593      (when label (insert " " label))
9594      (insert ";")
9595      (forward-line -1)
9596      (indent-to (+ margin vhdl-basic-offset)))))
9597
9598(defun vhdl-template-if-then ()
9599  "Insert a sequential if statement."
9600  (interactive)
9601  (vhdl-template-if-then-use 'then))
9602
9603(defun vhdl-template-if-use ()
9604  "Insert a simultaneous if statement."
9605  (interactive)
9606  (vhdl-template-if-then-use 'use))
9607
9608(defun vhdl-template-instance ()
9609  "Insert a component instantiation statement."
9610  (interactive)
9611  (vhdl-template-component-inst))
9612
9613(defun vhdl-template-library ()
9614  "Insert a library specification."
9615  (interactive)
9616  (let ((margin (current-indentation))
9617	(start (point))
9618	name end-pos)
9619    (vhdl-insert-keyword "LIBRARY ")
9620    (when (setq name (vhdl-template-field "names" nil t start (point)))
9621      (insert ";")
9622      (unless (string-match "," name)
9623	(setq end-pos (point))
9624	(insert "\n")
9625	(indent-to margin)
9626	(vhdl-insert-keyword "USE ")
9627	(insert name)
9628	(vhdl-insert-keyword "..ALL;")
9629	(backward-char 5)
9630	(if (vhdl-template-field "package name")
9631	    (forward-char 5)
9632	  (delete-region end-pos (+ (point) 5)))))))
9633
9634(defun vhdl-template-limit ()
9635  "Insert a limit."
9636  (interactive)
9637  (let ((start (point)))
9638    (vhdl-insert-keyword "LIMIT ")
9639    (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
9640			       t start (point))
9641      (vhdl-template-field "type")
9642      (vhdl-insert-keyword " WITH ")
9643      (vhdl-template-field "real expression" ";"))))
9644
9645(defun vhdl-template-loop ()
9646  "Insert a loop."
9647  (interactive)
9648  (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t)))
9649    (cond ((eq char ?w)
9650	   (vhdl-template-while-loop))
9651	  ((eq char ?f)
9652	   (vhdl-template-for-loop))
9653	  (t (vhdl-template-bare-loop)))))
9654
9655(defun vhdl-template-bare-loop ()
9656  "Insert a loop."
9657  (interactive)
9658  (let ((margin (current-indentation))
9659	(start (point))
9660	label)
9661    (if (not (eq vhdl-optional-labels 'all))
9662	(vhdl-insert-keyword "LOOP ")
9663      (vhdl-insert-keyword ": LOOP ")
9664      (goto-char start)
9665      (setq label (vhdl-template-field "[label]" nil t))
9666      (unless label (delete-char 2))
9667      (forward-word-strictly 1)
9668      (delete-char 1))
9669    (insert "\n\n")
9670    (indent-to margin)
9671    (vhdl-insert-keyword "END LOOP")
9672    (insert (if label (concat " " label ";") ";"))
9673    (forward-line -1)
9674    (indent-to (+ margin vhdl-basic-offset))))
9675
9676(defun vhdl-template-map (&optional start optional secondary)
9677  "Insert a map specification with association list."
9678  (interactive)
9679  (let ((start (or start (point)))
9680	margin end-pos)
9681    (vhdl-insert-keyword "MAP (")
9682    (if (not vhdl-association-list-with-formals)
9683	(if (vhdl-template-field
9684	     (concat (and optional "[") "association list" (and optional "]"))
9685	     ")" (or (not secondary) optional)
9686	     (and (not secondary) start) (point))
9687	    t
9688	  (if (and optional secondary) (delete-region start (point)))
9689	  nil)
9690      (if vhdl-argument-list-indent
9691	  (setq margin (current-column))
9692	(setq margin (+ (current-indentation) vhdl-basic-offset))
9693	(insert "\n")
9694	(indent-to margin))
9695      (if (vhdl-template-field
9696	   (concat (and optional "[") "formal" (and optional "]"))
9697	   " => " (or (not secondary) optional)
9698	   (and (not secondary) start) (point))
9699	  (progn
9700	    (vhdl-template-field "actual" ",")
9701	    (setq end-pos (point))
9702	    (insert "\n")
9703	    (indent-to margin)
9704	    (while (vhdl-template-field "[formal]" " => " t)
9705	      (vhdl-template-field "actual" ",")
9706	      (setq end-pos (point))
9707	      (insert "\n")
9708	      (indent-to margin))
9709	    (delete-region end-pos (point))
9710	    (delete-char -1)
9711	    (insert ")")
9712	    (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9713	    t)
9714	(when (and optional secondary) (delete-region start (point)))
9715	nil))))
9716
9717(defun vhdl-template-modify (&optional noerror)
9718  "Actualize modification date."
9719  (interactive)
9720  (vhdl-prepare-search-2
9721   (save-excursion
9722     (goto-char (point-min))
9723     (if (re-search-forward vhdl-modify-date-prefix-string nil t)
9724	 (progn (delete-region (point) (progn (end-of-line) (point)))
9725		(vhdl-template-insert-date))
9726       (unless noerror
9727	 (error "ERROR:  Modification date prefix string \"%s\" not found"
9728			vhdl-modify-date-prefix-string))))))
9729
9730
9731(defun vhdl-template-modify-noerror ()
9732  "Call `vhdl-template-modify' with NOERROR non-nil."
9733  (vhdl-template-modify t))
9734
9735(defun vhdl-template-nature ()
9736  "Insert a nature declaration."
9737  (interactive)
9738  (let ((start (point))
9739	name mid-pos end-pos)
9740    (vhdl-insert-keyword "NATURE ")
9741    (when (setq name (vhdl-template-field "name" nil t start (point)))
9742      (vhdl-insert-keyword " IS ")
9743      (let ((definition
9744	      (upcase
9745	       (or (vhdl-template-field
9746		    "across type | ARRAY | RECORD")
9747		   ""))))
9748	(cond ((equal definition "")
9749	       (insert ";"))
9750	      ((equal definition "ARRAY")
9751	       (delete-region (point) (progn (forward-word-strictly -1)
9752                                             (point)))
9753	       (vhdl-template-array 'nature t))
9754	      ((equal definition "RECORD")
9755	       (setq mid-pos (point-marker))
9756	       (delete-region (point) (progn (forward-word-strictly -1)
9757                                             (point)))
9758	       (vhdl-template-record 'nature name t))
9759	      (t
9760	       (vhdl-insert-keyword " ACROSS ")
9761	       (vhdl-template-field "through type")
9762	       (vhdl-insert-keyword " THROUGH ")
9763	       (vhdl-template-field "reference name")
9764	       (vhdl-insert-keyword " REFERENCE;")))
9765	(when mid-pos
9766	  (setq end-pos (point-marker))
9767	  (goto-char mid-pos)
9768	  (end-of-line))
9769	(vhdl-comment-insert-inline)
9770	(when end-pos (goto-char end-pos))))))
9771
9772(defun vhdl-template-next ()
9773  "Insert a next statement."
9774  (interactive)
9775  (let ((start (point)))
9776    (vhdl-insert-keyword "NEXT ")
9777    (if (vhdl-template-field "[loop label]" nil t start (point))
9778	(let ((position (point)))
9779	  (vhdl-insert-keyword " WHEN ")
9780	  (when vhdl-conditions-in-parenthesis (insert "("))
9781	  (if (vhdl-template-field "[condition]" nil t)
9782	      (when vhdl-conditions-in-parenthesis (insert ")"))
9783	    (delete-region position (point))))
9784      (delete-char -1))
9785    (insert ";")))
9786
9787(defun vhdl-template-others ()
9788  "Insert an others aggregate."
9789  (interactive)
9790  (let ((start (point)))
9791    (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
9792	(progn (unless vhdl-template-invoked-by-hook (insert "("))
9793	       (vhdl-insert-keyword "OTHERS => '")
9794	       (when (vhdl-template-field "value" nil t start (point))
9795		 (insert "')")))
9796      (vhdl-insert-keyword "OTHERS "))))
9797
9798(defun vhdl-template-package (&optional kind)
9799  "Insert a package specification or body."
9800  (interactive)
9801  (let ((margin (current-indentation))
9802	(start (point))
9803	name body position)
9804    (vhdl-insert-keyword "PACKAGE ")
9805    (setq body (if kind (eq kind 'body)
9806		 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
9807    (when body
9808      (vhdl-insert-keyword "BODY ")
9809      (when (save-excursion
9810	      (vhdl-prepare-search-1
9811	       (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
9812	(insert (setq name (match-string 1)))))
9813    (when (or name
9814	      (setq name (vhdl-template-field "name" nil t start (point))))
9815      (vhdl-insert-keyword " IS\n")
9816      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9817      (indent-to (+ margin vhdl-basic-offset))
9818      (setq position (point))
9819      (insert "\n")
9820      (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9821      (indent-to margin)
9822      (vhdl-insert-keyword "END ")
9823      (unless (vhdl-standard-p '87)
9824	(vhdl-insert-keyword (concat "PACKAGE " (and body "BODY "))))
9825      (insert (or name "") ";")
9826      (goto-char position))))
9827
9828(defun vhdl-template-package-decl ()
9829  "Insert a package specification."
9830  (interactive)
9831  (vhdl-template-package 'decl))
9832
9833(defun vhdl-template-package-body ()
9834  "Insert a package body."
9835  (interactive)
9836  (vhdl-template-package 'body))
9837
9838(defun vhdl-template-port ()
9839  "Insert a port declaration, or port map in instantiation statements."
9840  (interactive)
9841  (let ((start (point)))
9842    (vhdl-prepare-search-1
9843     (cond
9844      ((and (save-excursion		; entity declaration
9845	      (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9846	    (equal "ENTITY" (upcase (match-string 1))))
9847       (vhdl-template-port-list nil))
9848      ((or (save-excursion
9849	     (or (beginning-of-line)
9850		 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9851	   (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9852       (vhdl-insert-keyword "PORT ")
9853       (vhdl-template-map start))
9854      (t (vhdl-template-port-list nil))))))
9855
9856(defun vhdl-template-procedural ()
9857  "Insert a procedural."
9858  (interactive)
9859  (let ((margin (current-indentation))
9860	(start (point))
9861	(case-fold-search t)
9862	label)
9863    (vhdl-insert-keyword "PROCEDURAL ")
9864    (when (memq vhdl-optional-labels '(process all))
9865      (goto-char start)
9866      (insert ": ")
9867      (goto-char start)
9868      (setq label (vhdl-template-field "[label]" nil t))
9869      (unless label (delete-char 2))
9870      (forward-word-strictly 1)
9871      (forward-char 1))
9872    (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9873    (insert "\n")
9874    (vhdl-template-begin-end "PROCEDURAL" label margin)
9875    (vhdl-comment-block)))
9876
9877(defun vhdl-template-procedure (&optional kind)
9878  "Insert a procedure declaration or body."
9879  (interactive)
9880  (let ((margin (current-indentation))
9881	(start (point))
9882	name)
9883    (vhdl-insert-keyword "PROCEDURE ")
9884    (when (setq name (vhdl-template-field "name" nil t start (point)))
9885      (vhdl-template-argument-list)
9886      (if (if kind (eq kind 'body)
9887	    (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9888	  (progn (vhdl-insert-keyword " IS")
9889		 (when vhdl-auto-align
9890		   (vhdl-align-region-groups start (point) 1))
9891		 (end-of-line) (insert "\n")
9892		 (vhdl-template-begin-end
9893		  (unless (vhdl-standard-p '87) "PROCEDURE")
9894		  name margin)
9895		 (vhdl-comment-block))
9896	(insert ";")
9897	(when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9898	(end-of-line)))))
9899
9900(defun vhdl-template-procedure-decl ()
9901  "Insert a procedure declaration."
9902  (interactive)
9903  (vhdl-template-procedure 'decl))
9904
9905(defun vhdl-template-procedure-body ()
9906  "Insert a procedure body."
9907  (interactive)
9908  (vhdl-template-procedure 'body))
9909
9910(defun vhdl-template-process (&optional kind)
9911  "Insert a process."
9912  (interactive)
9913  (let ((margin (current-indentation))
9914	(start (point))
9915	(reset-kind vhdl-reset-kind)
9916	label seq input-signals clock reset final-pos)
9917    (setq seq (if kind (eq kind 'seq)
9918		(eq (vhdl-decision-query
9919		     "process" "(c)ombinational or (s)equential?" t) ?s)))
9920    (vhdl-insert-keyword "PROCESS ")
9921    (when (memq vhdl-optional-labels '(process all))
9922      (goto-char start)
9923      (insert ": ")
9924      (goto-char start)
9925      (setq label (vhdl-template-field "[label]" nil t))
9926      (unless label (delete-char 2))
9927      (forward-word-strictly 1)
9928      (forward-char 1))
9929    (insert "(")
9930    (if (not seq)
9931	(unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
9932			 (progn (insert "all)") (setq input-signals "all")))
9933		    (setq input-signals
9934			  (vhdl-template-field "[sensitivity list]" ")" t)))
9935	  (setq input-signals "")
9936	  (delete-char -2))
9937      (setq clock (or (and (not (equal "" vhdl-clock-name))
9938			   (progn (insert vhdl-clock-name) vhdl-clock-name))
9939		      (vhdl-template-field "clock name") "<clock>"))
9940      (when (eq reset-kind 'query)
9941	(setq reset-kind
9942	      (if (eq (vhdl-decision-query
9943		       "" "(a)synchronous or (s)ynchronous reset?" t) ?a)
9944		  'async
9945		'sync)))
9946      (when (eq reset-kind 'async)
9947	(insert ", ")
9948	(setq reset (or (and (not (equal "" vhdl-reset-name))
9949			     (progn (insert vhdl-reset-name) vhdl-reset-name))
9950			(vhdl-template-field "reset name") "<reset>")))
9951      (insert ")"))
9952    (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9953    (insert "\n")
9954    (vhdl-template-begin-end "PROCESS" label margin)
9955    (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind)))
9956    (when vhdl-prompt-for-comments
9957      (setq final-pos (point-marker))
9958      (vhdl-prepare-search-2
9959       (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9960		  (vhdl-re-search-backward "\\<process\\>" nil t))
9961	 (end-of-line -0)
9962	 (if (bobp)
9963	     (progn (insert "\n") (forward-line -1))
9964	   (insert "\n"))
9965	 (indent-to margin)
9966	 (insert "-- purpose: ")
9967	 (if (not (vhdl-template-field "[description]" nil t))
9968	     (vhdl-line-kill-entire)
9969	   (insert "\n")
9970	   (indent-to margin)
9971	   (insert "-- type   : ")
9972	   (insert (if seq "sequential" "combinational") "\n")
9973	   (indent-to margin)
9974	   (insert "-- inputs : ")
9975	   (if (not seq)
9976	       (insert input-signals)
9977	     (insert clock ", ")
9978	     (when reset (insert reset ", "))
9979	     (unless (vhdl-template-field "[signal names]" nil t)
9980	       (delete-char -2)))
9981	   (insert "\n")
9982	   (indent-to margin)
9983	   (insert "-- outputs: ")
9984	   (vhdl-template-field "[signal names]" nil t))))
9985      (goto-char final-pos))))
9986
9987(defun vhdl-template-process-comb ()
9988  "Insert a combinational process."
9989  (interactive)
9990  (vhdl-template-process 'comb))
9991
9992(defun vhdl-template-process-seq ()
9993  "Insert a sequential process."
9994  (interactive)
9995  (vhdl-template-process 'seq))
9996
9997(defun vhdl-template-quantity ()
9998  "Insert a quantity declaration."
9999  (interactive)
10000  (if (vhdl-in-argument-list-p)
10001      (let ((start (point)))
10002	(vhdl-insert-keyword "QUANTITY ")
10003	(when (vhdl-template-field "names" nil t start (point))
10004	  (insert " : ")
10005	  (vhdl-template-field "[IN | OUT]" " " t)
10006	  (vhdl-template-field "type")
10007	  (insert ";")
10008	  (vhdl-comment-insert-inline)))
10009    (let ((char (vhdl-decision-query
10010		 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
10011      (cond ((eq char ?f) (vhdl-template-quantity-free))
10012	    ((eq char ?b) (vhdl-template-quantity-branch))
10013	    ((eq char ?s) (vhdl-template-quantity-source))
10014	    (t (vhdl-template-undo (point) (point)))))))
10015
10016(defun vhdl-template-quantity-free ()
10017  "Insert a free quantity declaration."
10018  (interactive)
10019  (vhdl-insert-keyword "QUANTITY ")
10020  (vhdl-template-field "names")
10021  (insert " : ")
10022  (vhdl-template-field "type")
10023  (let ((position (point)))
10024    (insert " := ")
10025    (unless (vhdl-template-field "[initialization]" nil t)
10026      (delete-region position (point)))
10027    (insert ";")
10028    (vhdl-comment-insert-inline)))
10029
10030(defun vhdl-template-quantity-branch ()
10031  "Insert a branch quantity declaration."
10032  (interactive)
10033  (let (position)
10034    (vhdl-insert-keyword "QUANTITY ")
10035    (when (vhdl-template-field "[across names]" " " t)
10036      (vhdl-insert-keyword "ACROSS "))
10037    (when (vhdl-template-field "[through names]" " " t)
10038      (vhdl-insert-keyword "THROUGH "))
10039    (vhdl-template-field "plus terminal name")
10040    (setq position (point))
10041    (vhdl-insert-keyword " TO ")
10042    (unless (vhdl-template-field "[minus terminal name]" nil t)
10043      (delete-region position (point)))
10044    (insert ";")
10045    (vhdl-comment-insert-inline)))
10046
10047(defun vhdl-template-quantity-source ()
10048  "Insert a source quantity declaration."
10049  (interactive)
10050  (vhdl-insert-keyword "QUANTITY ")
10051  (vhdl-template-field "names")
10052  (insert " : ")
10053  (vhdl-template-field "type" " ")
10054  (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n)
10055      (progn (vhdl-insert-keyword "NOISE ")
10056	     (vhdl-template-field "power expression"))
10057    (vhdl-insert-keyword "SPECTRUM ")
10058    (vhdl-template-field "magnitude expression" ", ")
10059    (vhdl-template-field "phase expression"))
10060  (insert ";")
10061  (vhdl-comment-insert-inline))
10062
10063(defun vhdl-template-record (kind &optional name secondary)
10064  "Insert a record type declaration."
10065  (interactive)
10066  (let ((margin (current-indentation))
10067	(start (point))
10068	(first t))
10069    (vhdl-insert-keyword "RECORD\n")
10070    (indent-to (+ margin vhdl-basic-offset))
10071    (when (or (vhdl-template-field "element names"
10072				   nil (not secondary) start (point))
10073	      secondary)
10074      (while (or first (vhdl-template-field "[element names]" nil t))
10075	(insert " : ")
10076	(vhdl-template-field (if (eq kind 'type) "type" "nature") ";")
10077	(vhdl-comment-insert-inline)
10078	(insert "\n")
10079	(indent-to (+ margin vhdl-basic-offset))
10080	(setq first nil))
10081      (delete-region (line-beginning-position) (point))
10082      (indent-to margin)
10083      (vhdl-insert-keyword "END RECORD")
10084      (unless (vhdl-standard-p '87) (and name (insert " " name)))
10085      (insert ";")
10086      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10087
10088(defun vhdl-template-report ()
10089  "Insert a report statement."
10090  (interactive)
10091  (let ((start (point)))
10092    (vhdl-insert-keyword "REPORT ")
10093    (if (equal "\"\"" (vhdl-template-field
10094		       "string expression" nil t start (point) t))
10095	(delete-char -2)
10096      (setq start (point))
10097      (vhdl-insert-keyword " SEVERITY ")
10098      (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
10099	(delete-region start (point)))
10100      (insert ";"))))
10101
10102(defun vhdl-template-return ()
10103  "Insert a return statement."
10104  (interactive)
10105  (let ((start (point)))
10106    (vhdl-insert-keyword "RETURN ")
10107    (unless (vhdl-template-field "[expression]" nil t start (point))
10108      (delete-char -1))
10109    (insert ";")))
10110
10111(defun vhdl-template-selected-signal-asst ()
10112  "Insert a selected signal assignment."
10113  (interactive)
10114  (let ((margin (current-indentation))
10115	(start (point))
10116	(choices t))
10117    (let ((position (point)))
10118      (vhdl-insert-keyword " SELECT ")
10119      (goto-char position))
10120    (vhdl-insert-keyword "WITH ")
10121    (when (vhdl-template-field "selector expression"
10122			       nil t start (+ (point) 7))
10123      (forward-word-strictly 1)
10124      (delete-char 1)
10125      (insert "\n")
10126      (indent-to (+ margin vhdl-basic-offset))
10127      (vhdl-template-field "target signal" " <= ")
10128      (insert "\n")
10129      (indent-to (+ margin vhdl-basic-offset))
10130      (vhdl-template-field "waveform")
10131      (vhdl-insert-keyword " WHEN ")
10132      (vhdl-template-field "choices" ",")
10133      (insert "\n")
10134      (indent-to (+ margin vhdl-basic-offset))
10135      (while (and choices (vhdl-template-field "[waveform]" nil t))
10136	(vhdl-insert-keyword " WHEN ")
10137	(if (setq choices (vhdl-template-field "[choices]" "," t))
10138	    (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10139	  (vhdl-insert-keyword "OTHERS")))
10140      (when choices
10141	(fixup-whitespace)
10142	(delete-char -2))
10143      (insert ";")
10144      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10145
10146(defun vhdl-template-signal ()
10147  "Insert a signal declaration."
10148  (interactive)
10149  (let ((start (point))
10150	(in-arglist (vhdl-in-argument-list-p)))
10151    (vhdl-insert-keyword "SIGNAL ")
10152    (when (vhdl-template-field "names" nil t start (point))
10153      (insert " : ")
10154      (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10155      (vhdl-template-field "type")
10156      (if in-arglist
10157	  (progn (insert ";")
10158		 (vhdl-comment-insert-inline))
10159	(let ((position (point)))
10160	  (insert " := ")
10161	  (unless (vhdl-template-field "[initialization]" nil t)
10162	    (delete-region position (point)))
10163	  (insert ";")
10164	  (vhdl-comment-insert-inline))))))
10165
10166(defun vhdl-template-subnature ()
10167  "Insert a subnature declaration."
10168  (interactive)
10169  (let ((start (point))
10170	position)
10171    (vhdl-insert-keyword "SUBNATURE ")
10172    (when (vhdl-template-field "name" nil t start (point))
10173      (vhdl-insert-keyword " IS ")
10174      (vhdl-template-field "nature" " (")
10175      (if (vhdl-template-field "[index range]" nil t)
10176	  (insert ")")
10177	(delete-char -2))
10178      (setq position (point))
10179      (vhdl-insert-keyword " TOLERANCE ")
10180      (if (equal "\"\"" (vhdl-template-field "[string expression]"
10181					     nil t nil nil t))
10182	  (delete-region position (point))
10183	(vhdl-insert-keyword " ACROSS ")
10184	(vhdl-template-field "string expression" nil nil nil nil t)
10185	(vhdl-insert-keyword " THROUGH"))
10186      (insert ";")
10187      (vhdl-comment-insert-inline))))
10188
10189(defun vhdl-template-subprogram-body ()
10190  "Insert a subprogram body."
10191  (interactive)
10192  (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10193      (vhdl-template-function-body)
10194    (vhdl-template-procedure-body)))
10195
10196(defun vhdl-template-subprogram-decl ()
10197  "Insert a subprogram declaration."
10198  (interactive)
10199  (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10200      (vhdl-template-function-decl)
10201    (vhdl-template-procedure-decl)))
10202
10203(defun vhdl-template-subtype ()
10204  "Insert a subtype declaration."
10205  (interactive)
10206  (let ((start (point)))
10207    (vhdl-insert-keyword "SUBTYPE ")
10208    (when (vhdl-template-field "name" nil t start (point))
10209      (vhdl-insert-keyword " IS ")
10210      (vhdl-template-field "type" " ")
10211      (unless
10212	  (vhdl-template-field "[RANGE value range | ( index range )]" nil t)
10213	(delete-char -1))
10214      (insert ";")
10215      (vhdl-comment-insert-inline))))
10216
10217(defun vhdl-template-terminal ()
10218  "Insert a terminal declaration."
10219  (interactive)
10220  (let ((start (point)))
10221    (vhdl-insert-keyword "TERMINAL ")
10222    (when (vhdl-template-field "names" nil t start (point))
10223      (insert " : ")
10224      (vhdl-template-field "nature")
10225      (insert ";")
10226      (vhdl-comment-insert-inline))))
10227
10228(defun vhdl-template-type ()
10229  "Insert a type declaration."
10230  (interactive)
10231  (let ((start (point))
10232	name mid-pos end-pos)
10233    (vhdl-insert-keyword "TYPE ")
10234    (when (setq name (vhdl-template-field "name" nil t start (point)))
10235      (vhdl-insert-keyword " IS ")
10236      (let ((definition
10237	      (upcase
10238	       (or (vhdl-template-field
10239		    "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t)
10240		   ""))))
10241	(cond ((equal definition "")
10242	       (delete-char -4)
10243	       (insert ";"))
10244	      ((equal definition "ARRAY")
10245	       (delete-region (point) (progn (forward-word-strictly -1)
10246                                             (point)))
10247	       (vhdl-template-array 'type t))
10248	      ((equal definition "RECORD")
10249	       (setq mid-pos (point-marker))
10250	       (delete-region (point) (progn (forward-word-strictly -1)
10251                                             (point)))
10252	       (vhdl-template-record 'type name t))
10253	      ((equal definition "ACCESS")
10254	       (insert " ")
10255	       (vhdl-template-field "type" ";"))
10256	      ((equal definition "FILE")
10257	       (vhdl-insert-keyword " OF ")
10258	       (vhdl-template-field "type" ";"))
10259	      ((equal definition "ENUM")
10260	       (kill-word -1)
10261	       (insert "(")
10262	       (setq end-pos (point-marker))
10263	       (insert ");"))
10264	      (t (insert ";")))
10265	(when mid-pos
10266	  (setq end-pos (point-marker))
10267	  (goto-char mid-pos)
10268	  (end-of-line))
10269	(vhdl-comment-insert-inline)
10270	(when end-pos (goto-char end-pos))))))
10271
10272(defun vhdl-template-use ()
10273  "Insert a use clause."
10274  (interactive)
10275  (let ((start (point)))
10276    (vhdl-prepare-search-1
10277     (vhdl-insert-keyword "USE ")
10278     (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
10279       (vhdl-insert-keyword "..ALL;")
10280       (backward-char 6)
10281       (when (vhdl-template-field "library name" nil t start (+ (point) 6))
10282	 (forward-char 1)
10283	 (vhdl-template-field "package name")
10284	 (forward-char 5))))))
10285
10286(defun vhdl-template-variable ()
10287  "Insert a variable declaration."
10288  (interactive)
10289  (let ((start (point))
10290	(in-arglist (vhdl-in-argument-list-p)))
10291    (vhdl-prepare-search-2
10292     (if (or (save-excursion
10293	       (progn (vhdl-beginning-of-block)
10294		      (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
10295	     (save-excursion (backward-word-strictly 1)
10296                             (looking-at "\\<shared\\>")))
10297	 (vhdl-insert-keyword "VARIABLE ")
10298       (if (vhdl-standard-p '87)
10299	   (error "ERROR:  Not within sequential block")
10300	 (vhdl-insert-keyword "SHARED VARIABLE "))))
10301    (when (vhdl-template-field "names" nil t start (point))
10302      (insert " : ")
10303      (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10304      (vhdl-template-field "type")
10305      (if in-arglist
10306	  (progn (insert ";")
10307		 (vhdl-comment-insert-inline))
10308	(let ((position (point)))
10309	  (insert " := ")
10310	  (unless (vhdl-template-field "[initialization]" nil t)
10311	    (delete-region position (point)))
10312	  (insert ";")
10313	  (vhdl-comment-insert-inline))))))
10314
10315(defun vhdl-template-wait ()
10316  "Insert a wait statement."
10317  (interactive)
10318  (vhdl-insert-keyword "WAIT ")
10319  (unless (vhdl-template-field
10320	   "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
10321	   nil t)
10322    (delete-char -1))
10323  (insert ";"))
10324
10325(defun vhdl-template-when ()
10326  "Indent correctly if within a case statement."
10327  (interactive)
10328  (let ((position (point))
10329	margin)
10330    (vhdl-prepare-search-2
10331     (if (and (= (current-column) (current-indentation))
10332	      (vhdl-re-search-forward "\\<end\\>" nil t)
10333	      (looking-at "\\s-*\\<case\\>"))
10334	 (progn
10335	   (setq margin (current-indentation))
10336	   (goto-char position)
10337	   (delete-horizontal-space)
10338	   (indent-to (+ margin vhdl-basic-offset)))
10339       (goto-char position)))
10340    (vhdl-insert-keyword "WHEN ")))
10341
10342(defun vhdl-template-while-loop ()
10343  "Insert a while loop."
10344  (interactive)
10345  (let* ((margin (current-indentation))
10346	 (start (point))
10347	 label)
10348    (if (not (eq vhdl-optional-labels 'all))
10349	(vhdl-insert-keyword "WHILE ")
10350      (vhdl-insert-keyword ": WHILE ")
10351      (goto-char start)
10352      (setq label (vhdl-template-field "[label]" nil t))
10353      (unless label (delete-char 2))
10354      (forward-word-strictly 1)
10355      (forward-char 1))
10356    (when vhdl-conditions-in-parenthesis (insert "("))
10357    (when (vhdl-template-field "condition" nil t start (point))
10358      (when vhdl-conditions-in-parenthesis (insert ")"))
10359      (vhdl-insert-keyword " LOOP\n\n")
10360      (indent-to margin)
10361      (vhdl-insert-keyword "END LOOP")
10362      (insert (if label (concat " " label ";") ";"))
10363      (forward-line -1)
10364      (indent-to (+ margin vhdl-basic-offset)))))
10365
10366(defun vhdl-template-with ()
10367  "Insert a with statement (i.e. selected signal assignment)."
10368  (interactive)
10369  (vhdl-prepare-search-1
10370   (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
10371	    (equal ";" (match-string 1)))
10372       (vhdl-template-selected-signal-asst)
10373     (vhdl-insert-keyword "WITH "))))
10374
10375;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10376;; Special templates
10377
10378(defun vhdl-template-clocked-wait ()
10379  "Insert a wait statement for rising/falling clock edge."
10380  (interactive)
10381  (let ((start (point))
10382	clock)
10383    (vhdl-insert-keyword "WAIT UNTIL ")
10384    (when (setq clock
10385		(or (and (not (equal "" vhdl-clock-name))
10386			 (progn (insert vhdl-clock-name) vhdl-clock-name))
10387		    (vhdl-template-field "clock name" nil t start (point))))
10388      (insert "'event")
10389      (vhdl-insert-keyword " AND ")
10390      (insert clock)
10391      (insert
10392       " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";")
10393      (vhdl-comment-insert-inline
10394       (concat (if vhdl-clock-rising-edge "rising" "falling")
10395	       " clock edge")))))
10396
10397(defun vhdl-template-seq-process (clock reset reset-kind)
10398  "Insert a template for the body of a sequential process."
10399  (let ((margin (current-indentation))
10400	position)
10401    (vhdl-insert-keyword "IF ")
10402    (when vhdl-conditions-in-parenthesis (insert "("))
10403    (when (eq reset-kind 'async)
10404      (insert reset " = "
10405	      (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10406      (when vhdl-conditions-in-parenthesis (insert ")"))
10407      (vhdl-insert-keyword " THEN")
10408      (vhdl-comment-insert-inline
10409       (concat "asynchronous reset (active "
10410	       (if vhdl-reset-active-high "high" "low") ")"))
10411      (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10412      (setq position (point))
10413      (insert "\n") (indent-to margin)
10414      (vhdl-insert-keyword "ELSIF ")
10415      (when vhdl-conditions-in-parenthesis (insert "(")))
10416    (if (eq vhdl-clock-edge-condition 'function)
10417	(insert (if vhdl-clock-rising-edge "rising" "falling")
10418		"_edge(" clock ")")
10419      (insert clock "'event")
10420      (vhdl-insert-keyword " AND ")
10421      (insert clock " = "
10422	      (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
10423    (when vhdl-conditions-in-parenthesis (insert ")"))
10424    (vhdl-insert-keyword " THEN")
10425    (vhdl-comment-insert-inline
10426     (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
10427    (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10428    (when (eq reset-kind 'sync)
10429      (vhdl-insert-keyword "IF ")
10430      (when vhdl-conditions-in-parenthesis (insert "("))
10431      (setq reset (or (and (not (equal "" vhdl-reset-name))
10432			   (progn (insert vhdl-reset-name) vhdl-reset-name))
10433		      (vhdl-template-field "reset name") "<reset>"))
10434      (insert " = "
10435	      (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10436      (when vhdl-conditions-in-parenthesis (insert ")"))
10437      (vhdl-insert-keyword " THEN")
10438      (vhdl-comment-insert-inline
10439       (concat "synchronous reset (active "
10440	       (if vhdl-reset-active-high "high" "low") ")"))
10441      (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10442      (setq position (point))
10443      (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10444      (vhdl-insert-keyword "ELSE")
10445      (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10446      (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10447      (vhdl-insert-keyword "END IF;"))
10448    (when (eq reset-kind 'none)
10449      (setq position (point)))
10450    (insert "\n") (indent-to margin)
10451    (vhdl-insert-keyword "END IF;")
10452    (goto-char position)
10453    reset))
10454
10455(defun vhdl-template-standard-package (library package)
10456  "Insert specification of a standard package.
10457Include a library specification, if not already there."
10458  (let ((margin (current-indentation)))
10459    (unless (equal library "std")
10460      (unless (or (save-excursion
10461		    (vhdl-prepare-search-1
10462		     (and (not (bobp))
10463			  (re-search-backward
10464			   (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
10465				   library "\\|end\\)\\>")
10466			   nil t)
10467			  (match-string 2))))
10468		  (equal (downcase library) "work"))
10469	(vhdl-insert-keyword "LIBRARY ")
10470	(insert library ";")
10471	(when package
10472	  (insert "\n")
10473	  (indent-to margin))))
10474    (when package
10475      (vhdl-insert-keyword "USE ")
10476      (insert library "." package)
10477      (vhdl-insert-keyword ".ALL;"))))
10478
10479(defun vhdl-template-package-numeric-bit ()
10480  "Insert specification of `numeric_bit' package."
10481  (interactive)
10482  (vhdl-template-standard-package "ieee" "numeric_bit"))
10483
10484(defun vhdl-template-package-numeric-std ()
10485  "Insert specification of `numeric_std' package."
10486  (interactive)
10487  (vhdl-template-standard-package "ieee" "numeric_std"))
10488
10489(defun vhdl-template-package-std-logic-1164 ()
10490  "Insert specification of `std_logic_1164' package."
10491  (interactive)
10492  (vhdl-template-standard-package "ieee" "std_logic_1164"))
10493
10494(defun vhdl-template-package-std-logic-arith ()
10495  "Insert specification of `std_logic_arith' package."
10496  (interactive)
10497  (vhdl-template-standard-package "ieee" "std_logic_arith"))
10498
10499(defun vhdl-template-package-std-logic-misc ()
10500  "Insert specification of `std_logic_misc' package."
10501  (interactive)
10502  (vhdl-template-standard-package "ieee" "std_logic_misc"))
10503
10504(defun vhdl-template-package-std-logic-signed ()
10505  "Insert specification of `std_logic_signed' package."
10506  (interactive)
10507  (vhdl-template-standard-package "ieee" "std_logic_signed"))
10508
10509(defun vhdl-template-package-std-logic-textio ()
10510  "Insert specification of `std_logic_textio' package."
10511  (interactive)
10512  (vhdl-template-standard-package "ieee" "std_logic_textio"))
10513
10514(defun vhdl-template-package-std-logic-unsigned ()
10515  "Insert specification of `std_logic_unsigned' package."
10516  (interactive)
10517  (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
10518
10519(defun vhdl-template-package-textio ()
10520  "Insert specification of `textio' package."
10521  (interactive)
10522  (vhdl-template-standard-package "std" "textio"))
10523
10524(defun vhdl-template-package-fundamental-constants ()
10525  "Insert specification of `fundamental_constants' package."
10526  (interactive)
10527  (vhdl-template-standard-package "ieee" "fundamental_constants"))
10528
10529(defun vhdl-template-package-material-constants ()
10530  "Insert specification of `material_constants' package."
10531  (interactive)
10532  (vhdl-template-standard-package "ieee" "material_constants"))
10533
10534(defun vhdl-template-package-energy-systems ()
10535  "Insert specification of `energy_systems' package."
10536  (interactive)
10537  (vhdl-template-standard-package "ieee" "energy_systems"))
10538
10539(defun vhdl-template-package-electrical-systems ()
10540  "Insert specification of `electrical_systems' package."
10541  (interactive)
10542  (vhdl-template-standard-package "ieee" "electrical_systems"))
10543
10544(defun vhdl-template-package-mechanical-systems ()
10545  "Insert specification of `mechanical_systems' package."
10546  (interactive)
10547  (vhdl-template-standard-package "ieee" "mechanical_systems"))
10548
10549(defun vhdl-template-package-radiant-systems ()
10550  "Insert specification of `radiant_systems' package."
10551  (interactive)
10552  (vhdl-template-standard-package "ieee" "radiant_systems"))
10553
10554(defun vhdl-template-package-thermal-systems ()
10555  "Insert specification of `thermal_systems' package."
10556  (interactive)
10557  (vhdl-template-standard-package "ieee" "thermal_systems"))
10558
10559(defun vhdl-template-package-fluidic-systems ()
10560  "Insert specification of `fluidic_systems' package."
10561  (interactive)
10562  (vhdl-template-standard-package "ieee" "fluidic_systems"))
10563
10564(defun vhdl-template-package-math-complex ()
10565  "Insert specification of `math_complex' package."
10566  (interactive)
10567  (vhdl-template-standard-package "ieee" "math_complex"))
10568
10569(defun vhdl-template-package-math-real ()
10570  "Insert specification of `math_real' package."
10571  (interactive)
10572  (vhdl-template-standard-package "ieee" "math_real"))
10573
10574(defun vhdl-template-directive (directive)
10575  "Insert directive."
10576  (unless (= (current-indentation) (current-column))
10577    (delete-horizontal-space)
10578    (insert "  "))
10579  (insert "-- pragma " directive))
10580
10581(defun vhdl-template-directive-translate-on ()
10582  "Insert directive `translate_on'."
10583  (interactive)
10584  (vhdl-template-directive "translate_on"))
10585
10586(defun vhdl-template-directive-translate-off ()
10587  "Insert directive `translate_off'."
10588  (interactive)
10589  (vhdl-template-directive "translate_off"))
10590
10591(defun vhdl-template-directive-synthesis-on ()
10592  "Insert directive `synthesis_on'."
10593  (interactive)
10594  (vhdl-template-directive "synthesis_on"))
10595
10596(defun vhdl-template-directive-synthesis-off ()
10597  "Insert directive `synthesis_off'."
10598  (interactive)
10599  (vhdl-template-directive "synthesis_off"))
10600
10601;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10602;; Header and footer templates
10603
10604(defun vhdl-template-header (&optional file-title)
10605  "Insert a VHDL file header."
10606  (interactive)
10607  (unless (equal vhdl-file-header "")
10608    (let (pos)
10609      (save-excursion
10610	(goto-char (point-min))
10611	(vhdl-insert-string-or-file vhdl-file-header)
10612	(setq pos (point-marker)))
10613      (vhdl-template-replace-header-keywords
10614       (point-min-marker) pos file-title))))
10615
10616(defun vhdl-template-footer ()
10617  "Insert a VHDL file footer."
10618  (interactive)
10619  (unless (equal vhdl-file-footer "")
10620    (let (pos)
10621      (save-excursion
10622	(goto-char (point-max))
10623	(setq pos (point-marker))
10624	(vhdl-insert-string-or-file vhdl-file-footer)
10625	(unless (= (preceding-char) ?\n)
10626	  (insert "\n")))
10627      (vhdl-template-replace-header-keywords pos (point-max-marker)))))
10628
10629(defun vhdl-template-replace-header-keywords (beg end &optional file-title
10630						  is-model)
10631  "Replace keywords in header and footer."
10632  (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
10633			   ""))
10634	(project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
10635			  ""))
10636	pos)
10637    (vhdl-prepare-search-2
10638     (save-excursion
10639       (goto-char beg)
10640       (while (search-forward "<projectdesc>" end t)
10641	 (replace-match project-desc t t))
10642       (goto-char beg)
10643       (while (search-forward "<filename>" end t)
10644	 (replace-match (buffer-name) t t))
10645       (goto-char beg)
10646       (while (search-forward "<copyright>" end t)
10647	 (replace-match vhdl-copyright-string t t))
10648       (goto-char beg)
10649       (while (search-forward "<author>" end t)
10650	 (replace-match "" t t)
10651	 (insert (user-full-name))
10652	 (when user-mail-address (insert "  <" user-mail-address ">")))
10653       (goto-char beg)
10654       (while (search-forward "<authorfull>" end t)
10655	 (replace-match (user-full-name) t t))
10656       (goto-char beg)
10657       (while (search-forward "<login>" end t)
10658	 (replace-match (user-login-name) t t))
10659       (goto-char beg)
10660       (while (search-forward "<project>" end t)
10661	 (replace-match project-title t t))
10662       (goto-char beg)
10663       (while (search-forward "<company>" end t)
10664	 (replace-match vhdl-company-name t t))
10665       (goto-char beg)
10666       (while (search-forward "<platform>" end t)
10667	 (replace-match vhdl-platform-spec t t))
10668       (goto-char beg)
10669       (while (search-forward "<standard>" end t)
10670	 (replace-match
10671	  (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
10672			       ((vhdl-standard-p '93) "'93/02")
10673			       ((vhdl-standard-p '08) "'08"))
10674		  (when (vhdl-standard-p 'ams) ", VHDL-AMS")
10675		  (when (vhdl-standard-p 'math) ", Math Packages")) t t))
10676       (goto-char beg)
10677       ;; Replace <RCS> with $, so that RCS for the source is
10678       ;; not over-enthusiastic with replacements
10679       (while (search-forward "<RCS>" end t)
10680	 (replace-match "$" nil t))
10681       (goto-char beg)
10682       (while (search-forward "<date>" end t)
10683	 (replace-match "" t t)
10684	 (vhdl-template-insert-date))
10685       (goto-char beg)
10686       (let ((year (format-time-string "%Y")))
10687	 (while (search-forward "<year>" end t)
10688	   (replace-match year t t)))
10689       (goto-char beg)
10690       (when file-title
10691	 (while (search-forward "<title string>" end t)
10692	   (replace-match file-title t t))
10693	 (goto-char beg))
10694       (let (string)
10695	 (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
10696	   (save-match-data
10697	     (setq string (read-string (concat (match-string 1) ": "))))
10698	   (replace-match string t t)))
10699       (goto-char beg)
10700       (when (and (not is-model) (search-forward "<cursor>" end t))
10701	 (replace-match "" t t)
10702	 (setq pos (point))))
10703     (when pos (goto-char pos))
10704     (unless is-model
10705       (when (or (not project-title) (equal project-title ""))
10706	 (message "You can specify a project title in user option `vhdl-project-alist'"))
10707       (when (or (not project-desc) (equal project-desc ""))
10708	 (message "You can specify a project description in user option `vhdl-project-alist'"))
10709       (when (equal vhdl-platform-spec "")
10710	 (message "You can specify a platform in user option `vhdl-platform-spec'"))
10711       (when (equal vhdl-company-name "")
10712	 (message "You can specify a company name in user option `vhdl-company-name'"))))))
10713
10714;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10715;; Comment templates and functions
10716
10717(defun vhdl-comment-indent ()
10718  "Indent comments."
10719  (let* ((position (point))
10720	 (col
10721	  (progn
10722	    (forward-line -1)
10723	    (if (re-search-forward "--" position t)
10724		(- (current-column) 2)	; existing comment at bol stays there
10725	      (goto-char position)
10726	      (skip-chars-backward " \t")
10727	      (max comment-column	; else indent to comment column
10728		   (1+ (current-column))))))) ; except leave at least one space
10729    (goto-char position)
10730    col))
10731
10732(defun vhdl-comment-insert ()
10733  "Start a comment at the end of the line.
10734If on line with code, indent at least `comment-column'.
10735If starting after end-comment-column, start a new line."
10736  (interactive)
10737  (when (> (current-column) end-comment-column) (newline-and-indent))
10738  (if (or (looking-at "\\s-*$") ; end of line
10739	  (and (not unread-command-events) ; called with key binding or menu
10740	       (not (end-of-line))))
10741      (let (margin)
10742	(while (= (preceding-char) ?-) (delete-char -1))
10743	(setq margin (current-column))
10744	(delete-horizontal-space)
10745	(if (bolp)
10746	    (progn (indent-to margin) (insert "--"))
10747	  (insert "  ")
10748	  (indent-to comment-column)
10749	  (insert "--"))
10750	(if (not unread-command-events) (insert " ")))
10751    ;; else code following current point implies commenting out code
10752    (let (next-input code)
10753      (while (= (preceding-char) ?-) (delete-char -2))
10754      (while (= (setq next-input (read-char)) 13) ; CR
10755	(insert "--") ; or have a space after it?
10756	(forward-char -2)
10757	(forward-line 1)
10758	(message "Enter CR if commenting out a line of code.")
10759	(setq code t))
10760      (unless code
10761	(insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
10762      (push (vhdl-character-to-event next-input) ; pushback the char
10763            unread-command-events))))
10764
10765(defun vhdl-comment-display (&optional line-exists)
10766  "Add 2 comment lines at the current indent, making a display comment."
10767  (interactive)
10768  (let ((margin (current-indentation)))
10769    (unless line-exists (vhdl-comment-display-line))
10770    (insert "\n") (indent-to margin)
10771    (insert "\n") (indent-to margin)
10772    (vhdl-comment-display-line)
10773    (end-of-line -0)
10774    (insert "-- ")))
10775
10776(defun vhdl-comment-display-line ()
10777  "Displays one line of dashes."
10778  (interactive)
10779  (while (= (preceding-char) ?-) (delete-char -2))
10780  (insert "--")
10781  (let* ((col (current-column))
10782	 (len (- end-comment-column col)))
10783    (insert-char vhdl-comment-display-line-char len)))
10784
10785(defun vhdl-comment-append-inline ()
10786  "Append empty inline comment to current line."
10787  (interactive)
10788  (end-of-line)
10789  (delete-horizontal-space)
10790  (insert "  ")
10791  (indent-to comment-column)
10792  (insert "-- "))
10793
10794(defun vhdl-comment-insert-inline (&optional string always-insert)
10795  "Insert inline comment."
10796  (when (or (and string (or vhdl-self-insert-comments always-insert))
10797	    (and (not string) vhdl-prompt-for-comments))
10798    (let ((position (point)))
10799      (insert "  ")
10800      (indent-to comment-column)
10801      (insert "-- ")
10802      (if (not (or (and string (progn (insert string) t))
10803		   (vhdl-template-field "[comment]" nil t)))
10804	  (delete-region position (point))
10805	(while (= (preceding-char) ?\ ) (delete-char -1))))))
10806
10807(defun vhdl-comment-block ()
10808  "Insert comment for code block."
10809  (when vhdl-prompt-for-comments
10810    (let ((final-pos (point-marker)))
10811      (vhdl-prepare-search-2
10812       (when (and (re-search-backward "^\\s-*begin\\>" nil t)
10813		  (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
10814	 (let (margin)
10815	   (back-to-indentation)
10816	   (setq margin (current-column))
10817	   (end-of-line -0)
10818	   (if (bobp)
10819	       (progn (insert "\n") (forward-line -1))
10820	     (insert "\n"))
10821	   (indent-to margin)
10822	   (insert "-- purpose: ")
10823	   (unless (vhdl-template-field "[description]" nil t)
10824	     (vhdl-line-kill-entire)))))
10825      (goto-char final-pos))))
10826
10827(defun vhdl-comment-uncomment-region (beg end &optional _arg)
10828  "Comment out region if not commented out, uncomment otherwise."
10829  (interactive "r")
10830  (save-excursion
10831    (goto-char (1- end))
10832    (end-of-line)
10833    (setq end (point-marker))
10834    (goto-char beg)
10835    (beginning-of-line)
10836    (setq beg (point))
10837    (if (looking-at (concat "\\s-*" comment-start))
10838	(comment-region beg end '(4))
10839      (comment-region beg end))))
10840
10841(defun vhdl-comment-uncomment-line (&optional arg)
10842  "Comment out line if not commented out, uncomment otherwise."
10843  (interactive "p")
10844  (save-excursion
10845    (beginning-of-line)
10846    (let ((position (point)))
10847      (forward-line (or arg 1))
10848      (vhdl-comment-uncomment-region position (point)))))
10849
10850(defun vhdl-comment-kill-region (beg end)
10851  "Kill comments in region."
10852  (interactive "r")
10853  (save-excursion
10854    (goto-char end)
10855    (setq end (point-marker))
10856    (goto-char beg)
10857    (beginning-of-line)
10858    (while (< (point) end)
10859      (if (looking-at "^\\(\\s-*--.*\n\\)")
10860	  (progn (delete-region (match-beginning 1) (match-end 1)))
10861	(beginning-of-line 2)))))
10862
10863(defun vhdl-comment-kill-inline-region (beg end)
10864  "Kill inline comments in region."
10865  (interactive "r")
10866  (save-excursion
10867    (goto-char end)
10868    (setq end (point-marker))
10869    (goto-char beg)
10870    (beginning-of-line)
10871    (while (< (point) end)
10872      (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
10873	(delete-region (match-beginning 1) (match-end 1)))
10874      (beginning-of-line 2))))
10875
10876;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10877;; Subtemplates
10878
10879(defun vhdl-template-begin-end (construct name margin &optional empty-lines)
10880  "Insert a begin ... end pair with optional name after the end.
10881Point is left between them."
10882  (let (position)
10883    (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10884    (indent-to margin)
10885    (vhdl-insert-keyword "BEGIN")
10886    (when (and (or construct name) vhdl-self-insert-comments)
10887      (insert "  --")
10888      (when construct (insert " ") (vhdl-insert-keyword construct))
10889      (when name (insert " " name)))
10890    (insert "\n")
10891    (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10892    (indent-to (+ margin vhdl-basic-offset))
10893    (setq position (point))
10894    (insert "\n")
10895    (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10896    (indent-to margin)
10897    (vhdl-insert-keyword "END")
10898    (when construct (insert " ") (vhdl-insert-keyword construct))
10899    (insert (if name (concat " " name) "") ";")
10900    (goto-char position)))
10901
10902(defun vhdl-template-argument-list (&optional is-function)
10903  "Read from user a procedure or function argument list."
10904  (insert " (")
10905  (let ((margin (current-column))
10906	;; (start (point))
10907	(end-pos (point))
10908	not-empty interface semicolon-pos)
10909    (unless vhdl-argument-list-indent
10910      (setq margin (+ (current-indentation) vhdl-basic-offset))
10911      (insert "\n")
10912      (indent-to margin))
10913    (setq interface (vhdl-template-field
10914		     (concat "[CONSTANT | SIGNAL"
10915			     (unless is-function " | VARIABLE") "]")
10916		     " " t))
10917    (while (vhdl-template-field "[names]" nil t)
10918      (setq not-empty t)
10919      (insert " : ")
10920      (unless is-function
10921	(if (and interface (equal (upcase interface) "CONSTANT"))
10922	    (vhdl-insert-keyword "IN ")
10923	  (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
10924      (vhdl-template-field "type")
10925      (setq semicolon-pos (point))
10926      (insert ";")
10927      (vhdl-comment-insert-inline)
10928      (setq end-pos (point))
10929      (insert "\n")
10930      (indent-to margin)
10931      (setq interface (vhdl-template-field
10932		       (concat "[CONSTANT | SIGNAL"
10933			       (unless is-function " | VARIABLE") "]")
10934		       " " t)))
10935    (delete-region end-pos (point))
10936    (when semicolon-pos (goto-char semicolon-pos))
10937    (if not-empty
10938	(progn (delete-char 1) (insert ")"))
10939      (delete-char -2))))
10940
10941(defun vhdl-template-generic-list (optional &optional no-value)
10942  "Read from user a generic spec argument list."
10943  (let (margin
10944	(start (point)))
10945    (vhdl-insert-keyword "GENERIC (")
10946    (setq margin (current-column))
10947    (unless vhdl-argument-list-indent
10948      (let ((position (point)))
10949	(back-to-indentation)
10950	(setq margin (+ (current-column) vhdl-basic-offset))
10951	(goto-char position)
10952	(insert "\n")
10953	(indent-to margin)))
10954    (let ((vhdl-generics (vhdl-template-field
10955			  (concat (and optional "[") "name"
10956				  (and no-value "s") (and optional "]"))
10957			  nil optional)))
10958      (if (not vhdl-generics)
10959	  (if optional
10960	      (progn (vhdl-line-kill-entire) (end-of-line -0)
10961		     (unless vhdl-argument-list-indent
10962		       (vhdl-line-kill-entire) (end-of-line -0)))
10963	    (vhdl-template-undo start (point))
10964	    nil )
10965	(insert " : ")
10966	(let (semicolon-pos end-pos)
10967	  (while vhdl-generics
10968	    (vhdl-template-field "type")
10969	    (if no-value
10970		(progn (setq semicolon-pos (point))
10971		       (insert ";"))
10972	      (insert " := ")
10973	      (unless (vhdl-template-field "[value]" nil t)
10974		(delete-char -4))
10975	      (setq semicolon-pos (point))
10976	      (insert ";"))
10977	    (vhdl-comment-insert-inline)
10978	    (setq end-pos (point))
10979 	    (insert "\n")
10980	    (indent-to margin)
10981	    (setq vhdl-generics (vhdl-template-field
10982				 (concat "[name" (and no-value "s") "]")
10983				 " : " t)))
10984	  (delete-region end-pos (point))
10985	  (goto-char semicolon-pos)
10986	  (insert ")")
10987	  (end-of-line)
10988	  (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10989	  t)))))
10990
10991(defun vhdl-template-port-list (optional)
10992  "Read from user a port spec argument list."
10993  (let ((start (point))
10994	margin vhdl-ports object)
10995    (vhdl-insert-keyword "PORT (")
10996    (setq margin (current-column))
10997    (unless vhdl-argument-list-indent
10998      (let ((position (point)))
10999	(back-to-indentation)
11000	(setq margin (+ (current-column) vhdl-basic-offset))
11001	(goto-char position)
11002	(insert "\n")
11003	(indent-to margin)))
11004    (when (vhdl-standard-p 'ams)
11005      (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11006					" " t)))
11007    (setq vhdl-ports (vhdl-template-field
11008		      (concat (and optional "[") "names" (and optional "]"))
11009		      nil optional))
11010    (if (not vhdl-ports)
11011	(if optional
11012	    (progn (vhdl-line-kill-entire) (end-of-line -0)
11013		   (unless vhdl-argument-list-indent
11014		     (vhdl-line-kill-entire) (end-of-line -0)))
11015	  (vhdl-template-undo start (point))
11016	  nil)
11017      (insert " : ")
11018      (let (semicolon-pos end-pos)
11019	(while vhdl-ports
11020	  (cond ((or (null object) (equal "SIGNAL" (upcase object)))
11021		 (vhdl-template-field "IN | OUT | INOUT" " "))
11022		((equal "QUANTITY" (upcase object))
11023		 (vhdl-template-field "[IN | OUT]" " " t)))
11024	  (vhdl-template-field
11025	   (if (and object (equal "TERMINAL" (upcase object)))
11026		    "nature" "type"))
11027	  (setq semicolon-pos (point))
11028	  (insert ";")
11029	  (vhdl-comment-insert-inline)
11030	  (setq end-pos (point))
11031	  (insert "\n")
11032	  (indent-to margin)
11033	  (when (vhdl-standard-p 'ams)
11034	    (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11035					      " " t)))
11036	  (setq vhdl-ports (vhdl-template-field "[names]" " : " t)))
11037	(delete-region end-pos (point))
11038	(goto-char semicolon-pos)
11039	(insert ")")
11040	(end-of-line)
11041	(when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
11042	t))))
11043
11044(defun vhdl-template-generate-body (margin label)
11045  "Insert body for generate template."
11046  (vhdl-insert-keyword " GENERATE")
11047  (insert "\n\n")
11048  (indent-to margin)
11049  (vhdl-insert-keyword "END GENERATE ")
11050  (insert label ";")
11051  (end-of-line 0)
11052  (indent-to (+ margin vhdl-basic-offset)))
11053
11054(defun vhdl-template-insert-date ()
11055  "Insert date in appropriate format."
11056  (interactive)
11057  (insert
11058   (cond
11059    ;; 'american, 'european, 'scientific kept for backward compatibility
11060    ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
11061    ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
11062    ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
11063    (t (format-time-string vhdl-date-format nil)))))
11064
11065;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11066;; Help functions
11067
11068(defun vhdl-electric-space (count)
11069  "Expand abbreviations and self-insert space(s), do `indent-new-comment-line'
11070if in comment and past end-comment-column."
11071  (interactive "p")
11072  (cond ((vhdl-in-comment-p)
11073	 (self-insert-command count)
11074	 (cond ((>= (current-column) (+ 2 end-comment-column))
11075		(backward-char 1)
11076		(skip-chars-backward "^ \t\n\r\f")
11077		(indent-new-comment-line)
11078		(skip-chars-forward "^ \t\n\r\f")
11079		(forward-char 1))
11080	       ((>= (current-column) end-comment-column)
11081		(indent-new-comment-line))
11082	       (t nil)))
11083	((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
11084	     (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
11085	 (vhdl-prepare-search-1
11086	  (or (expand-abbrev) (vhdl-fix-case-word -1)))
11087	 (self-insert-command count))
11088	(t (self-insert-command count))))
11089
11090(defun vhdl-template-field (prompt &optional follow-string optional
11091				   begin end is-string default)
11092  "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
11093If OPTIONAL is nil, the prompt is left if an empty string is inserted.  If
11094an empty string is inserted, return nil and call `vhdl-template-undo' for
11095the region between BEGIN and END.  IS-STRING indicates whether a string
11096with double-quotes is to be inserted.  DEFAULT specifies a default string."
11097  (let ((position (point))
11098	string)
11099    (insert "<" prompt ">")
11100    (setq string
11101	  (condition-case ()
11102	      (read-from-minibuffer (concat prompt ": ")
11103				    (or (and is-string '("\"\"" . 2)) default)
11104				    vhdl-minibuffer-local-map)
11105	    (quit (if (and optional begin end)
11106		      (progn (beep) "")
11107		    (keyboard-quit)))))
11108    (when (or (not (equal string "")) optional)
11109      (delete-region position (point)))
11110    (when (and (equal string "") optional begin end)
11111      (vhdl-template-undo begin end)
11112      (message "Template aborted"))
11113    (unless (equal string "")
11114      (insert string)
11115      (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
11116			      vhdl-keywords-regexp)
11117      (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
11118			      vhdl-types-regexp)
11119      (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
11120			      (concat "'" vhdl-attributes-regexp))
11121      (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
11122			      vhdl-enum-values-regexp)
11123      (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants
11124			      vhdl-constants-regexp))
11125    (when (or (not (equal string "")) (not optional))
11126      (insert (or follow-string "")))
11127    (if (equal string "") nil string)))
11128
11129(defun vhdl-decision-query (string prompt &optional optional)
11130  "Query a decision from the user."
11131  (let ((start (point)))
11132    (when string (vhdl-insert-keyword (concat string " ")))
11133    (message "%s" (or prompt ""))
11134    (let ((char (read-char)))
11135      (delete-region start (point))
11136      (if (and optional (eq char ?\r))
11137	  (progn (insert " ")
11138		 (unexpand-abbrev)
11139		 (throw 'abort "ERROR:  Template aborted"))
11140	char))))
11141
11142(defun vhdl-insert-keyword (keyword)
11143  "Insert KEYWORD and adjust case."
11144  (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))))
11145
11146(defun vhdl-case-keyword (keyword)
11147  "Adjust case of KEYWORD."
11148  (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
11149
11150(defun vhdl-case-word (num)
11151  "Adjust case of following NUM words."
11152  (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
11153
11154(defun vhdl-minibuffer-tab (&optional arg)
11155  "If preceding character is part of a word or a paren then hippie-expand,
11156else insert tab (used for word completion in VHDL minibuffer)."
11157  (interactive "P")
11158  (cond
11159   ;; expand word
11160   ((= (char-syntax (preceding-char)) ?w)
11161    (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11162	  (case-replace nil)
11163	  (hippie-expand-only-buffers
11164	   (or (and (boundp 'hippie-expand-only-buffers)
11165		    hippie-expand-only-buffers)
11166	       '(vhdl-mode))))
11167      (vhdl-expand-abbrev arg)))
11168   ;; expand parenthesis
11169   ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
11170    (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11171	  (case-replace nil))
11172      (vhdl-expand-paren arg)))
11173   ;; insert tab
11174   (t (insert-tab))))
11175
11176(defun vhdl-template-search-prompt ()
11177  "Search for left out template prompts and query again."
11178  (interactive)
11179  (vhdl-prepare-search-2
11180   (when (or (re-search-forward
11181	      (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
11182	     (re-search-backward
11183	      (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
11184     (let ((string (match-string 1)))
11185       (replace-match "")
11186       (vhdl-template-field string)))))
11187
11188(defun vhdl-template-undo (begin end)
11189  "Undo aborted template by deleting region and unexpanding the keyword."
11190  (cond (vhdl-template-invoked-by-hook
11191	 (goto-char end)
11192	 (insert " ")
11193	 (delete-region begin end)
11194	 (unexpand-abbrev))
11195	(t (delete-region begin end))))
11196
11197(defun vhdl-insert-string-or-file (string)
11198  "Insert STRING or file contents if STRING is an existing file name."
11199  (unless (equal string "")
11200    (let ((file-name
11201	   (progn (string-match "^\\([^\n]+\\)" string)
11202		  (vhdl-resolve-env-variable (match-string 1 string)))))
11203      (if (file-exists-p file-name)
11204	   (forward-char (cadr (insert-file-contents file-name)))
11205	(insert string)))))
11206
11207(defun vhdl-beginning-of-block ()
11208  "Move cursor to the beginning of the enclosing block."
11209  (let (pos)
11210    (vhdl-prepare-search-2
11211     (save-excursion
11212       (beginning-of-line)
11213       ;; search backward for block beginning or end
11214       (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|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))
11215			      ;; not consider subprogram declarations
11216			      (or (and (match-string 5)
11217				       (save-match-data
11218					 (save-excursion
11219					   (goto-char (match-end 5))
11220					   (forward-word-strictly 1)
11221					   (vhdl-forward-syntactic-ws)
11222					   (when (looking-at "(")
11223					     (forward-sexp))
11224					   (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11225					 (match-string 1)))
11226				  ;; not consider configuration specifications
11227				  (and (match-string 6)
11228				       (save-match-data
11229					 (save-excursion
11230					   (vhdl-end-of-block)
11231					   (beginning-of-line)
11232					   (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11233		  (match-string 2))
11234	 ;; skip subblock if block end found
11235	 (vhdl-beginning-of-block))))
11236    (when pos (goto-char pos))))
11237
11238(defun vhdl-end-of-block ()
11239  "Move cursor to the end of the enclosing block."
11240  (let (pos)
11241    (vhdl-prepare-search-2
11242     (save-excursion
11243       (end-of-line)
11244       ;; search forward for block beginning or end
11245       (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|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))
11246			      ;; not consider subprogram declarations
11247			      (or (and (match-string 5)
11248				       (save-match-data
11249					 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11250					 (match-string 1)))
11251				  ;; not consider configuration specifications
11252				  (and (match-string 6)
11253				       (save-match-data
11254					 (save-excursion
11255					   (vhdl-end-of-block)
11256					   (beginning-of-line)
11257					   (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11258		  (not (match-string 2)))
11259	 ;; skip subblock if block beginning found
11260	 (vhdl-end-of-block))))
11261    (when pos (goto-char pos))))
11262
11263(defun vhdl-sequential-statement-p ()
11264  "Check if point is within sequential statement part."
11265  (let ((start (point)))
11266    (save-excursion
11267      (vhdl-prepare-search-2
11268       ;; is sequential statement if ...
11269       (and (re-search-backward "^\\s-*begin\\>" nil t)
11270	    ;; ... point is between "begin" and "end" of ...
11271	    (progn (vhdl-end-of-block)
11272		   (< start (point)))
11273	    ;; ... a sequential block
11274	    (progn (vhdl-beginning-of-block)
11275		   (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\\)\\)\\>")))))))
11276
11277(defun vhdl-in-argument-list-p ()
11278  "Check if within an argument list."
11279  (save-excursion
11280    (vhdl-prepare-search-2
11281     (or (string-match "arglist"
11282		       (format "%s" (caar (vhdl-get-syntactic-context))))
11283	 (progn (beginning-of-line)
11284		(looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
11285
11286;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11287;; Abbrev hooks
11288
11289(defun vhdl-hooked-abbrev (func)
11290  "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
11291but not if inside a comment or quote."
11292  (if (or (vhdl-in-literal)
11293	  (save-excursion
11294	    (forward-word-strictly -1)
11295	    (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
11296      (progn
11297	(insert " ")
11298	(unexpand-abbrev)
11299	(backward-word-strictly 1)
11300	(vhdl-case-word 1)
11301	(delete-char 1))
11302    (if (not vhdl-electric-mode)
11303	(progn
11304	  (insert " ")
11305	  (unexpand-abbrev)
11306	  (backward-word-strictly 1)
11307	  (vhdl-case-word 1)
11308	  (delete-char 1))
11309      (let ((invoke-char vhdl-last-input-event)
11310	    (abbrev-mode -1)
11311	    (vhdl-template-invoked-by-hook t))
11312	(let ((caught (catch 'abort
11313			(funcall func))))
11314	  (when (stringp caught) (message "%s" caught)))
11315	(when (= invoke-char ?-) (setq abbrev-start-location (point)))
11316	;; delete CR which is still in event queue
11317	(if (fboundp 'enqueue-eval-event)
11318	    (enqueue-eval-event 'delete-char -1)
11319	  (push (vhdl-character-to-event ?\177)	; push back a delete char
11320                unread-command-events))))))
11321
11322(defun vhdl-template-alias-hook ()
11323  (vhdl-hooked-abbrev 'vhdl-template-alias))
11324(defun vhdl-template-architecture-hook ()
11325  (vhdl-hooked-abbrev 'vhdl-template-architecture))
11326(defun vhdl-template-assert-hook ()
11327  (vhdl-hooked-abbrev 'vhdl-template-assert))
11328(defun vhdl-template-attribute-hook ()
11329  (vhdl-hooked-abbrev 'vhdl-template-attribute))
11330(defun vhdl-template-block-hook ()
11331  (vhdl-hooked-abbrev 'vhdl-template-block))
11332(defun vhdl-template-break-hook ()
11333  (vhdl-hooked-abbrev 'vhdl-template-break))
11334(defun vhdl-template-case-hook ()
11335  (vhdl-hooked-abbrev 'vhdl-template-case))
11336(defun vhdl-template-component-hook ()
11337  (vhdl-hooked-abbrev 'vhdl-template-component))
11338(defun vhdl-template-instance-hook ()
11339  (vhdl-hooked-abbrev 'vhdl-template-instance))
11340(defun vhdl-template-conditional-signal-asst-hook ()
11341  (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
11342(defun vhdl-template-configuration-hook ()
11343  (vhdl-hooked-abbrev 'vhdl-template-configuration))
11344(defun vhdl-template-constant-hook ()
11345  (vhdl-hooked-abbrev 'vhdl-template-constant))
11346(defun vhdl-template-context-hook ()
11347  (vhdl-hooked-abbrev 'vhdl-template-context))
11348(defun vhdl-template-disconnect-hook ()
11349  (vhdl-hooked-abbrev 'vhdl-template-disconnect))
11350(defun vhdl-template-display-comment-hook ()
11351  (vhdl-hooked-abbrev 'vhdl-comment-display))
11352(defun vhdl-template-else-hook ()
11353  (vhdl-hooked-abbrev 'vhdl-template-else))
11354(defun vhdl-template-elsif-hook ()
11355  (vhdl-hooked-abbrev 'vhdl-template-elsif))
11356(defun vhdl-template-entity-hook ()
11357  (vhdl-hooked-abbrev 'vhdl-template-entity))
11358(defun vhdl-template-exit-hook ()
11359  (vhdl-hooked-abbrev 'vhdl-template-exit))
11360(defun vhdl-template-file-hook ()
11361  (vhdl-hooked-abbrev 'vhdl-template-file))
11362(defun vhdl-template-for-hook ()
11363  (vhdl-hooked-abbrev 'vhdl-template-for))
11364(defun vhdl-template-function-hook ()
11365  (vhdl-hooked-abbrev 'vhdl-template-function))
11366(defun vhdl-template-generic-hook ()
11367  (vhdl-hooked-abbrev 'vhdl-template-generic))
11368(defun vhdl-template-group-hook ()
11369  (vhdl-hooked-abbrev 'vhdl-template-group))
11370(defun vhdl-template-library-hook ()
11371  (vhdl-hooked-abbrev 'vhdl-template-library))
11372(defun vhdl-template-limit-hook ()
11373  (vhdl-hooked-abbrev 'vhdl-template-limit))
11374(defun vhdl-template-if-hook ()
11375  (vhdl-hooked-abbrev 'vhdl-template-if))
11376(defun vhdl-template-bare-loop-hook ()
11377  (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
11378(defun vhdl-template-map-hook ()
11379  (vhdl-hooked-abbrev 'vhdl-template-map))
11380(defun vhdl-template-nature-hook ()
11381  (vhdl-hooked-abbrev 'vhdl-template-nature))
11382(defun vhdl-template-next-hook ()
11383  (vhdl-hooked-abbrev 'vhdl-template-next))
11384(defun vhdl-template-others-hook ()
11385  (vhdl-hooked-abbrev 'vhdl-template-others))
11386(defun vhdl-template-package-hook ()
11387  (vhdl-hooked-abbrev 'vhdl-template-package))
11388(defun vhdl-template-port-hook ()
11389  (vhdl-hooked-abbrev 'vhdl-template-port))
11390(defun vhdl-template-procedural-hook ()
11391  (vhdl-hooked-abbrev 'vhdl-template-procedural))
11392(defun vhdl-template-procedure-hook ()
11393  (vhdl-hooked-abbrev 'vhdl-template-procedure))
11394(defun vhdl-template-process-hook ()
11395  (vhdl-hooked-abbrev 'vhdl-template-process))
11396(defun vhdl-template-quantity-hook ()
11397  (vhdl-hooked-abbrev 'vhdl-template-quantity))
11398(defun vhdl-template-report-hook ()
11399  (vhdl-hooked-abbrev 'vhdl-template-report))
11400(defun vhdl-template-return-hook ()
11401  (vhdl-hooked-abbrev 'vhdl-template-return))
11402(defun vhdl-template-selected-signal-asst-hook ()
11403  (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
11404(defun vhdl-template-signal-hook ()
11405  (vhdl-hooked-abbrev 'vhdl-template-signal))
11406(defun vhdl-template-subnature-hook ()
11407  (vhdl-hooked-abbrev 'vhdl-template-subnature))
11408(defun vhdl-template-subtype-hook ()
11409  (vhdl-hooked-abbrev 'vhdl-template-subtype))
11410(defun vhdl-template-terminal-hook ()
11411  (vhdl-hooked-abbrev 'vhdl-template-terminal))
11412(defun vhdl-template-type-hook ()
11413  (vhdl-hooked-abbrev 'vhdl-template-type))
11414(defun vhdl-template-use-hook ()
11415  (vhdl-hooked-abbrev 'vhdl-template-use))
11416(defun vhdl-template-variable-hook ()
11417  (vhdl-hooked-abbrev 'vhdl-template-variable))
11418(defun vhdl-template-wait-hook ()
11419  (vhdl-hooked-abbrev 'vhdl-template-wait))
11420(defun vhdl-template-when-hook ()
11421  (vhdl-hooked-abbrev 'vhdl-template-when))
11422(defun vhdl-template-while-loop-hook ()
11423  (vhdl-hooked-abbrev 'vhdl-template-while-loop))
11424(defun vhdl-template-with-hook ()
11425  (vhdl-hooked-abbrev 'vhdl-template-with))
11426(defun vhdl-template-and-hook ()
11427  (vhdl-hooked-abbrev 'vhdl-template-and))
11428(defun vhdl-template-or-hook ()
11429  (vhdl-hooked-abbrev 'vhdl-template-or))
11430(defun vhdl-template-nand-hook ()
11431  (vhdl-hooked-abbrev 'vhdl-template-nand))
11432(defun vhdl-template-nor-hook ()
11433  (vhdl-hooked-abbrev 'vhdl-template-nor))
11434(defun vhdl-template-xor-hook ()
11435  (vhdl-hooked-abbrev 'vhdl-template-xor))
11436(defun vhdl-template-xnor-hook ()
11437  (vhdl-hooked-abbrev 'vhdl-template-xnor))
11438(defun vhdl-template-not-hook ()
11439  (vhdl-hooked-abbrev 'vhdl-template-not))
11440
11441(defun vhdl-template-default-hook ()
11442  (vhdl-hooked-abbrev 'vhdl-template-default))
11443(defun vhdl-template-default-indent-hook ()
11444  (vhdl-hooked-abbrev 'vhdl-template-default-indent))
11445
11446;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11447;; Template insertion from completion list
11448
11449(defun vhdl-template-insert-construct (name)
11450  "Insert the built-in construct template with NAME."
11451  (interactive
11452   (list (let ((completion-ignore-case t))
11453	   (completing-read "Construct name: "
11454			    vhdl-template-construct-alist nil t))))
11455  (vhdl-template-insert-fun
11456   (cadr (assoc name vhdl-template-construct-alist))))
11457
11458(defun vhdl-template-insert-package (name)
11459  "Insert the built-in package template with NAME."
11460  (interactive
11461   (list (let ((completion-ignore-case t))
11462	   (completing-read "Package name: "
11463			    vhdl-template-package-alist nil t))))
11464  (vhdl-template-insert-fun
11465   (cadr (assoc name vhdl-template-package-alist))))
11466
11467(defun vhdl-template-insert-directive (name)
11468  "Insert the built-in directive template with NAME."
11469  (interactive
11470   (list (let ((completion-ignore-case t))
11471	   (completing-read "Directive name: "
11472			    vhdl-template-directive-alist nil t))))
11473  (vhdl-template-insert-fun
11474   (cadr (assoc name vhdl-template-directive-alist))))
11475
11476(defun vhdl-template-insert-fun (fun)
11477  "Call FUN to insert a built-in template."
11478  (let ((caught (catch 'abort (when fun (funcall fun)))))
11479    (when (stringp caught) (message "%s" caught))))
11480
11481
11482;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11483;;; Models
11484;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11485
11486(defun vhdl-model-insert (model-name)
11487  "Insert the user model with name MODEL-NAME."
11488  (interactive
11489   (let ((completion-ignore-case t))
11490     (list (completing-read "Model name: " vhdl-model-alist))))
11491  (indent-according-to-mode)
11492  (let ((start (point-marker))
11493	(margin (current-indentation))
11494	model position prompt string end)
11495    (vhdl-prepare-search-2
11496     (when (setq model (assoc model-name vhdl-model-alist))
11497       ;; insert model
11498       (beginning-of-line)
11499       (delete-horizontal-space)
11500       (goto-char start)
11501       (vhdl-insert-string-or-file (nth 1 model))
11502       (setq end (point-marker))
11503       ;; indent code
11504       (goto-char start)
11505       (beginning-of-line)
11506       (while (< (point) end)
11507	 (unless (looking-at "^$")
11508	   (insert-char ?  margin))
11509	 (beginning-of-line 2))
11510       (goto-char start)
11511       ;; insert clock
11512       (unless (equal "" vhdl-clock-name)
11513	 (while (re-search-forward "<clock>" end t)
11514	   (replace-match vhdl-clock-name)))
11515       (goto-char start)
11516       ;; insert reset
11517       (unless (equal "" vhdl-reset-name)
11518	 (while (re-search-forward "<reset>" end t)
11519	   (replace-match vhdl-reset-name)))
11520       ;; replace header prompts
11521       (vhdl-template-replace-header-keywords start end nil t)
11522       (goto-char start)
11523       ;; query other prompts
11524       (while (re-search-forward
11525	       (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
11526	 (unless (equal "cursor" (match-string 1))
11527	   (setq position (match-beginning 1))
11528	   (setq prompt (match-string 1))
11529	   (replace-match "")
11530	   (setq string (vhdl-template-field prompt nil t))
11531	   ;; replace occurrences of same prompt
11532	   (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
11533	     (replace-match (or string "")))
11534	   (goto-char position)))
11535       (goto-char start)
11536       ;; goto final position
11537       (if (re-search-forward "<cursor>" end t)
11538	   (replace-match "")
11539	 (goto-char end))))))
11540
11541(defun vhdl-model-defun ()
11542  "Define help and hook functions for user models."
11543  (let ((model-alist vhdl-model-alist)
11544	model-name model-keyword)
11545    (while model-alist
11546      ;; define functions for user models that can be invoked from menu and key
11547      ;; bindings and which themselves call `vhdl-model-insert' with the model
11548      ;; name as argument
11549      (setq model-name (nth 0 (car model-alist)))
11550      (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
11551	       ,(concat "Insert model for \"" model-name "\".")
11552	       (interactive)
11553	       (vhdl-model-insert ,model-name)))
11554      ;; define hooks for user models that are invoked from keyword abbrevs
11555      (setq model-keyword (nth 3 (car model-alist)))
11556      (unless (equal model-keyword "")
11557	(eval `(defun
11558		 ,(vhdl-function-name
11559		   "vhdl-model" model-name "hook")
11560		   ()
11561		 (vhdl-hooked-abbrev
11562		  ',(vhdl-function-name "vhdl-model" model-name)))))
11563      (setq model-alist (cdr model-alist)))))
11564
11565(vhdl-model-defun)
11566
11567
11568;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11569;;; Port translation
11570;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11571
11572(defvar vhdl-port-list nil
11573  "Variable to hold last port map parsed.")
11574;; structure: (parenthesized expression means list of such entries)
11575;; (ent-name
11576;;  ((generic-names) generic-type generic-init generic-comment group-comment)
11577;;  ((port-names) port-object port-direct port-type port-comment group-comment)
11578;;  (lib-name pack-key))
11579
11580(defun vhdl-parse-string (string &optional optional)
11581  "Check that the text following point matches the regexp in STRING."
11582  (if (looking-at string)
11583      (progn (goto-char (match-end 0))
11584	     (when (vhdl-in-literal)
11585	       (end-of-line))
11586	     (point))
11587    (unless optional
11588      (throw 'parse (format "ERROR:  Syntax error near line %s, expecting \"%s\""
11589			    (vhdl-current-line) string)))
11590    nil))
11591
11592(defun vhdl-replace-string (regexp-cons string &optional adjust-case)
11593  "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
11594  (vhdl-prepare-search-1
11595   (if (string-match (car regexp-cons) string)
11596       (if adjust-case
11597	   (funcall vhdl-file-name-case
11598		    (replace-match (cdr regexp-cons) t nil string))
11599	 (replace-match (cdr regexp-cons) t nil string))
11600     string)))
11601
11602(defun vhdl-parse-group-comment ()
11603  "Parse comment and empty lines between groups of lines."
11604  (let ((start (point))
11605	string)
11606    (vhdl-forward-comment (point-max))
11607    (setq string (buffer-substring-no-properties start (point)))
11608    (vhdl-forward-syntactic-ws)
11609    ;; strip off leading blanks and first newline
11610    (while (string-match "^\\(\\s-+\\)" string)
11611      (setq string (concat (substring string 0 (match-beginning 1))
11612			   (substring string (match-end 1)))))
11613    (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
11614	(substring string 1)
11615      string)))
11616
11617(defun vhdl-paste-group-comment (string indent)
11618  "Paste comment and empty lines from STRING between groups of lines with INDENT."
11619  (let ((pos (point-marker)))
11620    (when (> indent 0)
11621      (while (string-match "^\\(--\\)" string)
11622	(setq string (concat (substring string 0 (match-beginning 1))
11623			     (make-string indent ? )
11624			     (substring string (match-beginning 1))))))
11625    (beginning-of-line)
11626    (insert string)
11627    (goto-char pos)))
11628
11629(defvar vhdl-port-flattened nil
11630  "Indicates whether a port has been flattened.")
11631
11632(defun vhdl-port-flatten (&optional as-alist)
11633  "Flatten port list so that only one generic/port exists per line.
11634This operation is performed on an internally stored port and is only
11635reflected in a subsequent paste operation."
11636  (interactive)
11637  (if (not vhdl-port-list)
11638      (error "ERROR:  No port has been read")
11639    (message "Flattening port for next paste...")
11640    (let ((new-vhdl-port-list (list (car vhdl-port-list)))
11641	  (old-vhdl-port-list (cdr vhdl-port-list))
11642	  old-port-list new-port-list old-port new-port names)
11643      ;; traverse port list and flatten entries
11644      (while (cdr old-vhdl-port-list)
11645	(setq old-port-list (car old-vhdl-port-list))
11646	(setq new-port-list nil)
11647	(while old-port-list
11648	  (setq old-port (car old-port-list))
11649	  (setq names (car old-port))
11650	  (while names
11651	    (setq new-port (cons (if as-alist (car names) (list (car names)))
11652				 (cdr old-port)))
11653	    (setq new-port-list (append new-port-list (list new-port)))
11654	    (setq names (cdr names)))
11655	  (setq old-port-list (cdr old-port-list)))
11656	(setq old-vhdl-port-list (cdr old-vhdl-port-list))
11657	(setq new-vhdl-port-list (append new-vhdl-port-list
11658					 (list new-port-list))))
11659      (setq vhdl-port-list
11660	    (append new-vhdl-port-list (list old-vhdl-port-list))
11661	    vhdl-port-flattened t)
11662      (message "Flattening port for next paste...done"))))
11663
11664(defvar vhdl-port-reversed-direction nil
11665  "Indicates whether port directions are reversed.")
11666
11667(defun vhdl-port-reverse-direction ()
11668  "Reverse direction for all ports (useful in testbenches).
11669This operation is performed on an internally stored port and is only
11670reflected in a subsequent paste operation."
11671  (interactive)
11672  (if (not vhdl-port-list)
11673      (error "ERROR:  No port has been read")
11674    (message "Reversing port directions for next paste...")
11675    (let ((port-list (nth 2 vhdl-port-list))
11676	  port-dir-car port-dir)
11677      ;; traverse port list and reverse directions
11678      (while port-list
11679	(setq port-dir-car (cddr (car port-list))
11680	      port-dir (car port-dir-car))
11681	(setcar port-dir-car
11682		(cond ((equal port-dir "in") "out")
11683		      ((equal port-dir "IN") "OUT")
11684		      ((equal port-dir "out") "in")
11685		      ((equal port-dir "OUT") "IN")
11686		      (t port-dir)))
11687	(setq port-list (cdr port-list)))
11688      (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
11689      (message "Reversing port directions for next paste...done"))))
11690
11691(defun vhdl-port-copy ()
11692  "Get generic and port information from an entity or component declaration."
11693  (interactive)
11694  (save-excursion
11695    (let (parse-error end-of-list
11696	  decl-type name generic-list port-list context-clause
11697	  object names direct type init comment group-comment)
11698      (vhdl-prepare-search-2
11699       (setq
11700	parse-error
11701	(catch 'parse
11702	  ;; check if within entity or component declaration
11703	  (end-of-line)
11704	  (when (or (not (re-search-backward
11705			  "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
11706		    (equal "END" (upcase (match-string 1))))
11707	    (throw 'parse "ERROR:  Not within an entity or component declaration"))
11708	  (setq decl-type (downcase (match-string-no-properties 1)))
11709	  (forward-word-strictly 1)
11710	  (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
11711	  (setq name (match-string-no-properties 1))
11712	  (message "Reading port of %s \"%s\"..." decl-type name)
11713	  (vhdl-forward-syntactic-ws)
11714	  ;; parse generic clause
11715	  (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t)
11716	    ;; parse group comment and spacing
11717	    (setq group-comment (vhdl-parse-group-comment))
11718	    (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11719	    (while (not end-of-list)
11720	      ;; parse names (accept extended identifiers)
11721	      (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11722	      (setq names (list (match-string-no-properties 1)))
11723	      (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11724		(setq names
11725		      (append names (list (match-string-no-properties 1)))))
11726	      ;; parse type
11727	      (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
11728	      (setq type (match-string-no-properties 1))
11729	      (when (vhdl-in-comment-p) ; if stuck in comment
11730		(setq type (concat type (and (vhdl-parse-string ".*")
11731					     (match-string-no-properties 0)))))
11732	      (setq comment nil)
11733	      (while (looking-at "(")
11734		(setq type
11735		      (concat type
11736			      (buffer-substring-no-properties
11737			       (point) (progn (forward-sexp) (point)))
11738			      (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11739				   (match-string-no-properties 1)))))
11740	      ;; special case: closing parenthesis is on separate line
11741	      (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11742		(setq comment (substring type (match-beginning 2)))
11743		(setq type (substring type 0 (match-beginning 1))))
11744	      ;; strip of trailing group-comment
11745	      (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11746	      (setq type (substring type 0 (match-end 1)))
11747	      ;; parse initialization expression
11748	      (setq init nil)
11749	      (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
11750		(vhdl-parse-string "\\([^();\n]*\\)")
11751		(setq init (match-string-no-properties 1))
11752		(while (looking-at "(")
11753		  (setq init
11754			(concat init
11755				(buffer-substring-no-properties
11756				 (point) (progn (forward-sexp) (point)))
11757				(and (vhdl-parse-string "\\([^();\n]*\\)" t)
11758				     (match-string-no-properties 1))))))
11759	      ;; special case: closing parenthesis is on separate line
11760	      (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11761		(setq comment (substring init (match-beginning 2)))
11762		(setq init (substring init 0 (match-beginning 1)))
11763		(vhdl-forward-syntactic-ws))
11764	      (skip-chars-forward " \t")
11765	      ;; parse inline comment, special case: as above, no initial.
11766	      (unless comment
11767		(setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11768				   (match-string-no-properties 1))))
11769	      (vhdl-forward-syntactic-ws)
11770	      (setq end-of-list (vhdl-parse-string ")" t))
11771	      (vhdl-parse-string "\\s-*;\\s-*")
11772	      ;; parse inline comment
11773	      (unless comment
11774		(setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11775				   (match-string-no-properties 1))))
11776	      ;; save everything in list
11777	      (setq generic-list (append generic-list
11778					 (list (list names type init
11779						     comment group-comment))))
11780	      ;; parse group comment and spacing
11781	      (setq group-comment (vhdl-parse-group-comment))))
11782	  ;; parse port clause
11783	  (when (vhdl-parse-string "port[ \t\n\r\f]*(" t)
11784	    ;; parse group comment and spacing
11785	    (setq group-comment (vhdl-parse-group-comment))
11786	    (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11787	    (while (not end-of-list)
11788	      ;; parse object
11789	      (setq object
11790		    (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t)
11791			 (match-string-no-properties 1)))
11792	      ;; parse names (accept extended identifiers)
11793	      (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11794	      (setq names (list (match-string-no-properties 1)))
11795	      (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11796		(setq names (append names (list (match-string-no-properties 1)))))
11797	      ;; parse direction
11798	      (vhdl-parse-string ":[ \t\n\r\f]*")
11799	      (setq direct
11800		    (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t)
11801			 (match-string-no-properties 1)))
11802	      ;; parse type
11803	      (vhdl-parse-string "\\([^();\n]+\\)")
11804	      (setq type (match-string-no-properties 1))
11805	      (when (vhdl-in-comment-p) ; if stuck in comment
11806		(setq type (concat type (and (vhdl-parse-string ".*")
11807					     (match-string-no-properties 0)))))
11808	      (setq comment nil)
11809	      (while (looking-at "(")
11810		(setq type (concat type
11811				   (buffer-substring-no-properties
11812				    (point) (progn (forward-sexp) (point)))
11813				   (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11814					(match-string-no-properties 1)))))
11815	      ;; special case: closing parenthesis is on separate line
11816	      (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11817		(setq comment (substring type (match-beginning 2)))
11818		(setq type (substring type 0 (match-beginning 1))))
11819	      ;; strip of trailing group-comment
11820	      (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11821	      (setq type (substring type 0 (match-end 1)))
11822	      (vhdl-forward-syntactic-ws)
11823	      (setq end-of-list (vhdl-parse-string ")" t))
11824	      (vhdl-parse-string "\\s-*;\\s-*")
11825	      ;; parse inline comment
11826	      (unless comment
11827		(setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11828				   (match-string-no-properties 1))))
11829	      ;; save everything in list
11830	      (setq port-list (append port-list
11831				      (list (list names object direct type
11832						  comment group-comment))))
11833	      ;; parse group comment and spacing
11834	      (setq group-comment (vhdl-parse-group-comment))))
11835	  ;; parse context clause
11836	  (setq context-clause (vhdl-scan-context-clause))
11837;	  ;; add surrounding package to context clause
11838;	  (when (and (equal decl-type "component")
11839;		     (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
11840;	    (setq context-clause
11841;		  (append context-clause
11842;			  (list (cons (vhdl-work-library)
11843;				      (match-string-no-properties 1))))))
11844	  (message "Reading port of %s \"%s\"...done" decl-type name)
11845	  nil)))
11846      ;; finish parsing
11847      (if parse-error
11848	  (error parse-error)
11849	(setq vhdl-port-list (list name generic-list port-list context-clause)
11850	      vhdl-port-reversed-direction nil
11851	      vhdl-port-flattened nil)))))
11852
11853(defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
11854  "Paste a context clause."
11855  (let (;; (margin (current-indentation))
11856	(clause-list (nth 3 vhdl-port-list))
11857	clause)
11858    (while clause-list
11859      (setq clause (car clause-list))
11860      (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
11861						(downcase exclude-pack-name)))
11862		  (save-excursion
11863		    (re-search-backward
11864		     (concat "^\\s-*use\\s-+" (car clause)
11865			     "." (cdr clause) "\\>")
11866		     nil t)))
11867	(vhdl-template-standard-package (car clause) (cdr clause))
11868	(insert "\n"))
11869      (setq clause-list (cdr clause-list)))))
11870
11871(defun vhdl-port-paste-generic (&optional no-init)
11872  "Paste a generic clause."
11873  (let ((margin (current-indentation))
11874	(generic-list (nth 1 vhdl-port-list))
11875	list-margin start names generic)
11876    ;; paste generic clause
11877    (when generic-list
11878      (setq start (point))
11879      (vhdl-insert-keyword "GENERIC (")
11880      (unless vhdl-argument-list-indent
11881	(insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11882      (setq list-margin (current-column))
11883      (while generic-list
11884	(setq generic (car generic-list))
11885	;; paste group comment and spacing
11886	(when (memq vhdl-include-group-comments '(decl always))
11887	  (vhdl-paste-group-comment (nth 4 generic) list-margin))
11888	;; paste names
11889	(setq names (nth 0 generic))
11890	(while names
11891	  (insert (car names))
11892	  (setq names (cdr names))
11893	  (when names (insert ", ")))
11894	;; paste type
11895	(insert " : " (nth 1 generic))
11896	;; paste initialization
11897	(when (and (not no-init) (nth 2 generic))
11898	  (insert " := " (nth 2 generic)))
11899	(unless (cdr generic-list) (insert ")"))
11900	(insert ";")
11901	;; paste comment
11902	(when (and vhdl-include-port-comments (nth 3 generic))
11903	  (vhdl-comment-insert-inline (nth 3 generic) t))
11904	(setq generic-list (cdr generic-list))
11905	(when generic-list (insert "\n") (indent-to list-margin)))
11906      ;; align generic clause
11907      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
11908
11909(defun vhdl-port-paste-port ()
11910  "Paste a port clause."
11911  (let ((margin (current-indentation))
11912	(port-list (nth 2 vhdl-port-list))
11913	list-margin start names port)
11914    ;; paste port clause
11915    (when port-list
11916      (setq start (point))
11917      (vhdl-insert-keyword "PORT (")
11918      (unless vhdl-argument-list-indent
11919	(insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11920      (setq list-margin (current-column))
11921      (while port-list
11922	(setq port (car port-list))
11923	;; paste group comment and spacing
11924	(when (memq vhdl-include-group-comments '(decl always))
11925	  (vhdl-paste-group-comment (nth 5 port) list-margin))
11926	;; paste object
11927	(when (nth 1 port) (insert (nth 1 port) " "))
11928	;; paste names
11929	(setq names (nth 0 port))
11930	(while names
11931	  (insert (car names))
11932	  (setq names (cdr names))
11933	  (when names (insert ", ")))
11934	;; paste direction
11935	(insert " : ")
11936	(when (nth 2 port) (insert (nth 2 port) " "))
11937	;; paste type
11938	(insert (nth 3 port))
11939	(unless (cdr port-list) (insert ")"))
11940	(insert ";")
11941	;; paste comment
11942	(when (and vhdl-include-port-comments (nth 4 port))
11943	  (vhdl-comment-insert-inline (nth 4 port) t))
11944	(setq port-list (cdr port-list))
11945	(when port-list (insert "\n") (indent-to list-margin)))
11946      ;; align port clause
11947      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11948
11949(defun vhdl-port-paste-declaration (kind &optional no-indent)
11950  "Paste as an entity or component declaration."
11951  (unless no-indent (indent-according-to-mode))
11952  (let ((margin (current-indentation))
11953	(name (nth 0 vhdl-port-list)))
11954    (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11955    (insert name)
11956    (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11957	(vhdl-insert-keyword " IS"))
11958    ;; paste generic and port clause
11959    (when (nth 1 vhdl-port-list)
11960      (insert "\n")
11961      (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11962	(insert "\n"))
11963      (indent-to (+ margin vhdl-basic-offset))
11964      (vhdl-port-paste-generic (eq kind 'component)))
11965    (when (nth 2 vhdl-port-list)
11966      (insert "\n")
11967      (when (and (memq vhdl-insert-empty-lines '(unit all))
11968		 (eq kind 'entity))
11969	(insert "\n"))
11970      (indent-to (+ margin vhdl-basic-offset)))
11971    (vhdl-port-paste-port)
11972    (insert "\n")
11973    (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11974      (insert "\n"))
11975    (indent-to margin)
11976    (vhdl-insert-keyword "END")
11977    (if (eq kind 'entity)
11978	(progn
11979	  (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11980	  (insert " " name))
11981      (vhdl-insert-keyword " COMPONENT")
11982      (unless (vhdl-standard-p '87) (insert " " name)))
11983    (insert ";")))
11984
11985(defun vhdl-port-paste-entity (&optional no-indent)
11986  "Paste as an entity declaration."
11987  (interactive)
11988  (if (not vhdl-port-list)
11989      (error "ERROR:  No port read")
11990    (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11991    (vhdl-port-paste-declaration 'entity no-indent)
11992    (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11993
11994(defun vhdl-port-paste-component (&optional no-indent)
11995  "Paste as a component declaration."
11996  (interactive)
11997  (if (not vhdl-port-list)
11998      (error "ERROR:  No port read")
11999    (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
12000    (vhdl-port-paste-declaration 'component no-indent)
12001    (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
12002
12003(defun vhdl-port-paste-generic-map (&optional secondary no-constants)
12004  "Paste as a generic map."
12005  (interactive)
12006  (unless secondary (indent-according-to-mode))
12007  (let ((margin (current-indentation))
12008	list-margin start generic
12009	(generic-list (nth 1 vhdl-port-list)))
12010    (when generic-list
12011      (setq start (point))
12012      (vhdl-insert-keyword "GENERIC MAP (")
12013      (if (not vhdl-association-list-with-formals)
12014	  ;; paste list of actual generics
12015	  (while generic-list
12016	    (insert (if no-constants
12017		      (car (nth 0 (car generic-list)))
12018		    (or (nth 2 (car generic-list)) " ")))
12019	    (setq generic-list (cdr generic-list))
12020	    (insert (if generic-list ", " ")"))
12021	    (when (and (not generic-list) secondary
12022		       (null (nth 2 vhdl-port-list)))
12023	      (insert ";")))
12024	(unless vhdl-argument-list-indent
12025	  (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12026	(setq list-margin (current-column))
12027	(while generic-list
12028	  (setq generic (car generic-list))
12029	  ;; paste group comment and spacing
12030	  (when (eq vhdl-include-group-comments 'always)
12031	    (vhdl-paste-group-comment (nth 4 generic) list-margin))
12032	  ;; paste formal and actual generic
12033	  (insert (car (nth 0 generic)) " => "
12034		  (if no-constants
12035		      (vhdl-replace-string vhdl-actual-generic-name
12036					   (car (nth 0 generic)))
12037		    (or (nth 2 generic) "")))
12038	  (setq generic-list (cdr generic-list))
12039	  (insert (if generic-list "," ")"))
12040	  (when (and (not generic-list) secondary
12041		     (null (nth 2 vhdl-port-list)))
12042	    (insert ";"))
12043	  ;; paste comment
12044	  (when (or vhdl-include-type-comments
12045		    (and vhdl-include-port-comments (nth 3 generic)))
12046	    (vhdl-comment-insert-inline
12047	     (concat
12048	      (when vhdl-include-type-comments
12049		(concat "[" (nth 1 generic) "] "))
12050	      (when vhdl-include-port-comments (nth 3 generic))) t))
12051	  (when generic-list (insert "\n") (indent-to list-margin)))
12052	;; align generic map
12053	(when vhdl-auto-align
12054	  (vhdl-align-region-groups start (point) 1 t))))))
12055
12056(defun vhdl-port-paste-port-map ()
12057  "Paste as a port map."
12058  (let ((margin (current-indentation))
12059	list-margin start port
12060	(port-list (nth 2 vhdl-port-list)))
12061    (when port-list
12062      (setq start (point))
12063      (vhdl-insert-keyword "PORT MAP (")
12064      (if (not vhdl-association-list-with-formals)
12065	  ;; paste list of actual ports
12066	  (while port-list
12067	    (insert (vhdl-replace-string vhdl-actual-port-name
12068					 (car (nth 0 (car port-list)))))
12069	    (setq port-list (cdr port-list))
12070	    (insert (if port-list ", " ")")))
12071	(unless vhdl-argument-list-indent
12072	  (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12073	(setq list-margin (current-column))
12074	(while port-list
12075	  (setq port (car port-list))
12076	  ;; paste group comment and spacing
12077	  (when (eq vhdl-include-group-comments 'always)
12078	    (vhdl-paste-group-comment (nth 5 port) list-margin))
12079	  ;; paste formal and actual port
12080	  (insert (car (nth 0 port)) " => ")
12081	  (insert (vhdl-replace-string vhdl-actual-port-name
12082				       (car (nth 0 port))))
12083	  (setq port-list (cdr port-list))
12084	  (insert (if port-list "," ");"))
12085	  ;; paste comment
12086	  (when (or (and vhdl-include-direction-comments (nth 2 port))
12087		    vhdl-include-type-comments
12088		    (and vhdl-include-port-comments (nth 4 port)))
12089	    (vhdl-comment-insert-inline
12090	     (concat
12091	      (cond ((and vhdl-include-direction-comments
12092			  vhdl-include-type-comments)
12093		     (concat "[" (format "%-4s" (concat (nth 2 port) " "))
12094			     (nth 3 port) "] "))
12095		    ((and vhdl-include-direction-comments (nth 2 port))
12096		     (format "%-6s" (concat "[" (nth 2 port) "] ")))
12097		    (vhdl-include-direction-comments "      ")
12098		    (vhdl-include-type-comments
12099		     (concat "[" (nth 3 port) "] ")))
12100	      (when vhdl-include-port-comments (nth 4 port))) t))
12101	  (when port-list (insert "\n") (indent-to list-margin)))
12102	;; align port clause
12103	(when vhdl-auto-align
12104	  (vhdl-align-region-groups start (point) 1))))))
12105
12106(defun vhdl-port-paste-instance (&optional name no-indent title)
12107  "Paste as an instantiation."
12108  (interactive)
12109  (if (not vhdl-port-list)
12110      (error "ERROR:  No port read")
12111    (let ((orig-vhdl-port-list vhdl-port-list))
12112      ;; flatten local copy of port list (must be flat for port mapping)
12113      (vhdl-port-flatten)
12114      (unless no-indent (indent-according-to-mode))
12115      (let ((margin (current-indentation)))
12116	;; paste instantiation
12117	(cond (name
12118	       (insert name))
12119	      ((equal (cdr vhdl-instance-name) "")
12120	       (setq name (vhdl-template-field "instance name")))
12121	      ((string-match "%d" (cdr vhdl-instance-name))
12122	       (let ((n 1))
12123		 (while (save-excursion
12124			  (setq name (format (vhdl-replace-string
12125					      vhdl-instance-name
12126					      (nth 0 vhdl-port-list)) n))
12127			  (goto-char (point-min))
12128			  (vhdl-re-search-forward name nil t))
12129		   (setq n (1+ n)))
12130		 (insert name)))
12131	      (t (insert (vhdl-replace-string vhdl-instance-name
12132					      (nth 0 vhdl-port-list)))))
12133	(message "Pasting port as instantiation \"%s\"..." name)
12134	(insert ": ")
12135	(when title
12136	  (save-excursion
12137	    (beginning-of-line)
12138	    (indent-to vhdl-basic-offset)
12139	    (insert "-- instance \"" name "\"\n")))
12140	(if (not (vhdl-use-direct-instantiation))
12141	    (insert (nth 0 vhdl-port-list))
12142	  (vhdl-insert-keyword "ENTITY ")
12143	  (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
12144	(when (nth 1 vhdl-port-list)
12145	  (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12146	  (vhdl-port-paste-generic-map t t))
12147	(when (nth 2 vhdl-port-list)
12148	  (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12149	  (vhdl-port-paste-port-map))
12150	(unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list))
12151	  (insert ";"))
12152	(message "Pasting port as instantiation \"%s\"...done" name))
12153      (setq vhdl-port-list orig-vhdl-port-list))))
12154
12155(defun vhdl-port-paste-constants (&optional no-indent)
12156  "Paste generics as constants."
12157  (interactive)
12158  (if (not vhdl-port-list)
12159      (error "ERROR:  No port read")
12160    (let ((orig-vhdl-port-list vhdl-port-list))
12161      (message "Pasting port as constants...")
12162      ;; flatten local copy of port list (must be flat for constant initial.)
12163      (vhdl-port-flatten)
12164      (unless no-indent (indent-according-to-mode))
12165      (let ((margin (current-indentation))
12166	    start generic name
12167	    (generic-list (nth 1 vhdl-port-list)))
12168	(when generic-list
12169	  (setq start (point))
12170	  (while generic-list
12171	    (setq generic (car generic-list))
12172	    ;; paste group comment and spacing
12173	    (when (memq vhdl-include-group-comments '(decl always))
12174	      (vhdl-paste-group-comment (nth 4 generic) margin))
12175	    (vhdl-insert-keyword "CONSTANT ")
12176	    ;; paste generic constants
12177	    (setq name (nth 0 generic))
12178	    (when name
12179	      (insert (vhdl-replace-string vhdl-actual-generic-name (car name)))
12180	      ;; paste type
12181	      (insert " : " (nth 1 generic))
12182	      ;; paste initialization
12183	      (when (nth 2 generic)
12184		(insert " := " (nth 2 generic)))
12185	      (insert ";")
12186	      ;; paste comment
12187	      (when (and vhdl-include-port-comments (nth 3 generic))
12188		(vhdl-comment-insert-inline (nth 3 generic) t))
12189	      (setq generic-list (cdr generic-list))
12190	      (when generic-list (insert "\n") (indent-to margin))))
12191	    ;; align signal list
12192	  (when vhdl-auto-align
12193	    (vhdl-align-region-groups start (point) 1))))
12194      (message "Pasting port as constants...done")
12195      (setq vhdl-port-list orig-vhdl-port-list))))
12196
12197(defun vhdl-port-paste-signals (&optional initialize no-indent)
12198  "Paste ports as internal signals."
12199  (interactive)
12200  (if (not vhdl-port-list)
12201      (error "ERROR:  No port read")
12202    (message "Pasting port as signals...")
12203    (unless no-indent (indent-according-to-mode))
12204    (let ((margin (current-indentation))
12205	  start port names type generic-list port-name constant-name pos
12206	  (port-list (nth 2 vhdl-port-list)))
12207      (when port-list
12208	(setq start (point))
12209	(while port-list
12210	  (setq port (car port-list))
12211	  ;; paste group comment and spacing
12212	  (when (memq vhdl-include-group-comments '(decl always))
12213	    (vhdl-paste-group-comment (nth 5 port) margin))
12214	  ;; paste object
12215	  (if (nth 1 port)
12216	      (insert (nth 1 port) " ")
12217	    (vhdl-insert-keyword "SIGNAL "))
12218	  ;; paste actual port signals
12219	  (setq names (nth 0 port))
12220	  (while names
12221	    (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
12222	    (setq names (cdr names))
12223	    (when names (insert ", ")))
12224	  ;; paste type
12225	  (setq type (nth 3 port))
12226	  (setq generic-list (nth 1 vhdl-port-list))
12227	  (vhdl-prepare-search-1
12228	   (setq pos 0)
12229	   ;; replace formal by actual generics
12230	   (while generic-list
12231	     (setq port-name (car (nth 0 (car generic-list))))
12232	     (while (string-match (concat "\\<" port-name "\\>") type pos)
12233	       (setq constant-name
12234		     (save-match-data (vhdl-replace-string
12235				       vhdl-actual-generic-name port-name)))
12236	       (setq type (replace-match constant-name t nil type))
12237	       (setq pos (match-end 0)))
12238	     (setq generic-list (cdr generic-list))))
12239	  (insert " : " type)
12240	  ;; paste initialization (inputs only)
12241	  (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
12242	    (insert " := "
12243		    (cond ((string-match "integer" (nth 3 port)) "0")
12244			  ((string-match "natural" (nth 3 port)) "0")
12245			  ((string-match "positive" (nth 3 port)) "0")
12246			  ((string-match "real" (nth 3 port)) "0.0")
12247			  ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12248			  (t "'0'"))))
12249	  (insert ";")
12250	  ;; paste comment
12251	  (when (or (and vhdl-include-direction-comments (nth 2 port))
12252		    (and vhdl-include-port-comments (nth 4 port)))
12253	    (vhdl-comment-insert-inline
12254	     (concat
12255	      (cond ((and vhdl-include-direction-comments (nth 2 port))
12256		     (format "%-6s" (concat "[" (nth 2 port) "] ")))
12257		    (vhdl-include-direction-comments "      "))
12258	      (when vhdl-include-port-comments (nth 4 port)))
12259	     t))
12260	  (setq port-list (cdr port-list))
12261	  (when port-list (insert "\n") (indent-to margin)))
12262	;; align signal list
12263	(when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12264    (message "Pasting port as signals...done")))
12265
12266(defun vhdl-port-paste-initializations (&optional no-indent)
12267  "Paste ports as signal initializations."
12268  (interactive)
12269  (if (not vhdl-port-list)
12270      (error "ERROR:  No port read")
12271    (let ((orig-vhdl-port-list vhdl-port-list))
12272      (message "Pasting port as initializations...")
12273      ;; flatten local copy of port list (must be flat for signal initial.)
12274      (vhdl-port-flatten)
12275      (unless no-indent (indent-according-to-mode))
12276      (let ((margin (current-indentation))
12277	    start port name
12278	    (port-list (nth 2 vhdl-port-list)))
12279	(when port-list
12280	  (setq start (point))
12281	  (while port-list
12282	    (setq port (car port-list))
12283	    ;; paste actual port signal (inputs only)
12284	    (when (equal "IN" (upcase (nth 2 port)))
12285	      (setq name (car (nth 0 port)))
12286	      (insert (vhdl-replace-string vhdl-actual-port-name name))
12287	      ;; paste initialization
12288	      (insert " <= "
12289		      (cond ((string-match "integer" (nth 3 port)) "0")
12290			    ((string-match "natural" (nth 3 port)) "0")
12291			    ((string-match "positive" (nth 3 port)) "0")
12292			    ((string-match "real" (nth 3 port)) "0.0")
12293			    ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12294			    (t "'0'"))
12295		      ";"))
12296	    (setq port-list (cdr port-list))
12297	    (when (and port-list
12298		       (equal "IN" (upcase (nth 2 (car port-list)))))
12299	      (insert "\n") (indent-to margin)))
12300	  ;; align signal list
12301	  (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12302      (message "Pasting port as initializations...done")
12303      (setq vhdl-port-list orig-vhdl-port-list))))
12304
12305(defun vhdl-port-paste-testbench ()
12306  "Paste as a bare-bones testbench."
12307  (interactive)
12308  (if (not vhdl-port-list)
12309      (error "ERROR:  No port read")
12310    (let ((case-fold-search t)
12311	  (ent-name (vhdl-replace-string vhdl-testbench-entity-name
12312					 (nth 0 vhdl-port-list)))
12313	  ;; (source-buffer (current-buffer))
12314	  arch-name config-name ent-file-name arch-file-name
12315	  ent-buffer arch-buffer position)
12316      ;; open entity file
12317      (unless (eq vhdl-testbench-create-files 'none)
12318	(setq ent-file-name
12319	      (concat (vhdl-replace-string vhdl-testbench-entity-file-name
12320					   ent-name t)
12321		      "." (file-name-extension (buffer-file-name))))
12322	(if (file-exists-p ent-file-name)
12323	    (if (y-or-n-p
12324		 (concat "File \"" ent-file-name "\" exists; overwrite? "))
12325		(progn (find-file ent-file-name)
12326		       (erase-buffer)
12327		       (set-buffer-modified-p nil))
12328	      (if (eq vhdl-testbench-create-files 'separate)
12329		  (setq ent-file-name nil)
12330		(error "ERROR:  Pasting port as testbench...aborted")))
12331	  (find-file ent-file-name)))
12332      (unless (and (eq vhdl-testbench-create-files 'separate)
12333		   (null ent-file-name))
12334	;; paste entity header
12335	(if vhdl-testbench-include-header
12336	    (progn (vhdl-template-header
12337		    (concat "Testbench for design \""
12338			    (nth 0 vhdl-port-list) "\""))
12339		   (goto-char (point-max)))
12340	  (vhdl-comment-display-line) (insert "\n\n"))
12341	;; paste std_logic_1164 package
12342	(when vhdl-testbench-include-library
12343	  (vhdl-template-package-std-logic-1164)
12344	  (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
12345	;; paste entity declaration
12346	(vhdl-insert-keyword "ENTITY ")
12347	(insert ent-name)
12348	(vhdl-insert-keyword " IS")
12349	(when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
12350	(insert "\n")
12351	(vhdl-insert-keyword "END ")
12352	(unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
12353	(insert ent-name ";")
12354	(insert "\n\n")
12355	(vhdl-comment-display-line) (insert "\n"))
12356      ;; get architecture name
12357      (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
12358			  (read-from-minibuffer "architecture name: "
12359						nil vhdl-minibuffer-local-map)
12360			(vhdl-replace-string vhdl-testbench-architecture-name
12361					     (nth 0 vhdl-port-list))))
12362      (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
12363      ;; open architecture file
12364      (if (not (eq vhdl-testbench-create-files 'separate))
12365	  (insert "\n")
12366	(setq ent-buffer (current-buffer))
12367	(setq arch-file-name
12368	      (concat (vhdl-replace-string vhdl-testbench-architecture-file-name
12369					   (concat ent-name " " arch-name) t)
12370		      "." (file-name-extension (buffer-file-name))))
12371	(when (and (file-exists-p arch-file-name)
12372		   (not (y-or-n-p (concat "File \"" arch-file-name
12373					  "\" exists; overwrite? "))))
12374	  (error "ERROR:  Pasting port as testbench...aborted"))
12375	(find-file arch-file-name)
12376	(erase-buffer)
12377	(set-buffer-modified-p nil)
12378	;; paste architecture header
12379	(if vhdl-testbench-include-header
12380	    (progn (vhdl-template-header
12381		    (concat "Testbench architecture for design \""
12382			    (nth 0 vhdl-port-list) "\""))
12383		   (goto-char (point-max)))
12384	  (vhdl-comment-display-line) (insert "\n\n")))
12385      ;; paste architecture body
12386      (vhdl-insert-keyword "ARCHITECTURE ")
12387      (insert arch-name)
12388      (vhdl-insert-keyword " OF ")
12389      (insert ent-name)
12390      (vhdl-insert-keyword " IS")
12391      (insert "\n\n") (indent-to vhdl-basic-offset)
12392      ;; paste component declaration
12393      (unless (vhdl-use-direct-instantiation)
12394	(vhdl-port-paste-component t)
12395	(insert "\n\n") (indent-to vhdl-basic-offset))
12396      ;; paste constants
12397      (when (nth 1 vhdl-port-list)
12398	(insert "-- component generics\n") (indent-to vhdl-basic-offset)
12399	(vhdl-port-paste-constants t)
12400	(insert "\n\n") (indent-to vhdl-basic-offset))
12401      ;; paste internal signals
12402      (insert "-- component ports\n") (indent-to vhdl-basic-offset)
12403      (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
12404      (insert "\n")
12405      ;; paste custom declarations
12406      (unless (equal "" vhdl-testbench-declarations)
12407	(insert "\n")
12408	(setq position (point))
12409	(vhdl-insert-string-or-file vhdl-testbench-declarations)
12410	(indent-region position (point)))
12411      (setq position (point))
12412      (insert "\n\n")
12413      (vhdl-comment-display-line) (insert "\n")
12414      (when vhdl-testbench-include-configuration
12415	(setq config-name (vhdl-replace-string
12416			   vhdl-testbench-configuration-name
12417			   (concat ent-name " " arch-name)))
12418	(insert "\n")
12419	(vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
12420	(vhdl-insert-keyword " OF ") (insert ent-name)
12421	(vhdl-insert-keyword " IS\n")
12422	(indent-to vhdl-basic-offset)
12423	(vhdl-insert-keyword "FOR ") (insert arch-name "\n")
12424	(indent-to vhdl-basic-offset)
12425	(vhdl-insert-keyword "END FOR;\n")
12426	(vhdl-insert-keyword "END ") (insert config-name ";\n\n")
12427	(vhdl-comment-display-line) (insert "\n"))
12428      (goto-char position)
12429      (vhdl-template-begin-end
12430       (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
12431      ;; paste instantiation
12432      (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
12433      (vhdl-port-paste-instance
12434       (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
12435      (insert "\n")
12436      ;; paste custom statements
12437      (unless (equal "" vhdl-testbench-statements)
12438	(insert "\n")
12439	(setq position (point))
12440	(vhdl-insert-string-or-file vhdl-testbench-statements)
12441	(indent-region position (point)))
12442      (insert "\n")
12443      (indent-to vhdl-basic-offset)
12444      (unless (eq vhdl-testbench-create-files 'none)
12445	(setq arch-buffer (current-buffer))
12446	(when ent-buffer (set-buffer ent-buffer) (save-buffer))
12447	(set-buffer arch-buffer) (save-buffer))
12448      (message "%s"
12449       (concat (format "Pasting port as testbench \"%s(%s)\"...done"
12450		       ent-name arch-name)
12451	       (and ent-file-name
12452		    (format "\n  File created: \"%s\"" ent-file-name))
12453	       (and arch-file-name
12454		    (format "\n  File created: \"%s\"" arch-file-name)))))))
12455
12456
12457;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12458;;; Subprogram interface translation
12459;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12460
12461(defvar vhdl-subprog-list nil
12462  "Variable to hold last subprogram interface parsed.")
12463;; structure: (parenthesized expression means list of such entries)
12464;; (subprog-name kind
12465;;  ((names) object direct type init comment group-comment)
12466;;  return-type return-comment group-comment)
12467
12468(defvar vhdl-subprog-flattened nil
12469  "Indicates whether an subprogram interface has been flattened.")
12470
12471(defun vhdl-subprog-flatten ()
12472  "Flatten interface list so that only one parameter exists per line."
12473  (interactive)
12474  (if (not vhdl-subprog-list)
12475      (error "ERROR:  No subprogram interface has been read")
12476    (message "Flattening subprogram interface...")
12477    (let ((old-subprog-list (nth 2 vhdl-subprog-list))
12478	  new-subprog-list old-subprog new-subprog names)
12479      ;; traverse parameter list and flatten entries
12480      (while old-subprog-list
12481	(setq old-subprog (car old-subprog-list))
12482	(setq names (car old-subprog))
12483	(while names
12484	  (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
12485	  (setq new-subprog-list (append new-subprog-list (list new-subprog)))
12486	  (setq names (cdr names)))
12487	(setq old-subprog-list (cdr old-subprog-list)))
12488      (setq vhdl-subprog-list
12489	    (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
12490		  new-subprog-list (nth 3 vhdl-subprog-list)
12491		  (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
12492	    vhdl-subprog-flattened t)
12493    (message "Flattening subprogram interface...done"))))
12494
12495(defun vhdl-subprog-copy ()
12496  "Get interface information from a subprogram specification."
12497  (interactive)
12498  (save-excursion
12499    (let (parse-error pos end-of-list
12500	  name kind param-list object names direct type init
12501	  comment group-comment
12502	  return-type return-comment return-group-comment)
12503      (vhdl-prepare-search-2
12504       (setq
12505	parse-error
12506	(catch 'parse
12507	  ;; check if within function declaration
12508	  (setq pos (point))
12509	  (end-of-line)
12510	  (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
12511	  (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
12512		       (goto-char (match-end 0))
12513		       (save-excursion (backward-char)
12514				    (forward-sexp)
12515				    (<= pos (point))))
12516	    (throw 'parse "ERROR:  Not within a subprogram specification"))
12517	  (setq name (match-string-no-properties 5))
12518	  (setq kind (if (match-string 2) 'procedure 'function))
12519	  (setq end-of-list (not (match-string 7)))
12520	  (message "Reading interface of subprogram \"%s\"..." name)
12521	  ;; parse parameter list
12522	  (setq group-comment (vhdl-parse-group-comment))
12523	  (setq end-of-list (or end-of-list
12524				(vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
12525	  (while (not end-of-list)
12526	    ;; parse object
12527	    (setq object
12528		  (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
12529			 (match-string-no-properties 1)))
12530	    ;; parse names (accept extended identifiers)
12531	    (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
12532	    (setq names (list (match-string-no-properties 1)))
12533	    (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
12534	      (setq names (append names (list (match-string-no-properties 1)))))
12535	    ;; parse direction
12536	    (vhdl-parse-string ":[ \t\n\r\f]*")
12537	    (setq direct
12538		  (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t)
12539		       (match-string-no-properties 1)))
12540	    ;; parse type
12541	    (vhdl-parse-string "\\([^():;\n]+\\)")
12542	    (setq type (match-string-no-properties 1))
12543	    (setq comment nil)
12544	    (while (looking-at "(")
12545	      (setq type
12546		    (concat type
12547			    (buffer-substring-no-properties
12548			     (point) (progn (forward-sexp) (point)))
12549			    (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
12550				 (match-string-no-properties 1)))))
12551	    ;; special case: closing parenthesis is on separate line
12552	    (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
12553	      (setq comment (substring type (match-beginning 2)))
12554	      (setq type (substring type 0 (match-beginning 1))))
12555	    ;; strip off trailing group-comment
12556	    (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
12557	    (setq type (substring type 0 (match-end 1)))
12558	    ;; parse initialization expression
12559	    (setq init nil)
12560	    (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
12561	      (vhdl-parse-string "\\([^();\n]*\\)")
12562	      (setq init (match-string-no-properties 1))
12563	      (while (looking-at "(")
12564		(setq init
12565		      (concat init
12566			      (buffer-substring-no-properties
12567			       (point) (progn (forward-sexp) (point)))
12568			      (and (vhdl-parse-string "\\([^();\n]*\\)" t)
12569				   (match-string-no-properties 1))))))
12570	    ;; special case: closing parenthesis is on separate line
12571	    (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
12572	      (setq comment (substring init (match-beginning 2)))
12573	      (setq init (substring init 0 (match-beginning 1)))
12574	      (vhdl-forward-syntactic-ws))
12575	    (skip-chars-forward " \t")
12576	    ;; parse inline comment, special case: as above, no initial.
12577	    (unless comment
12578	      (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12579				 (match-string-no-properties 1))))
12580	    (vhdl-forward-syntactic-ws)
12581	    (setq end-of-list (vhdl-parse-string ")\\s-*" t))
12582	    ;; parse inline comment
12583	    (unless comment
12584	      (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12585				 (match-string-no-properties 1))))
12586	    (setq return-group-comment (vhdl-parse-group-comment))
12587	    (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
12588	    ;; parse return type
12589	    (when (match-string 3)
12590	      (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
12591	      (setq return-type (match-string-no-properties 1))
12592	      (when (and return-type
12593			 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
12594		(setq return-comment (substring return-type (match-beginning 2)))
12595		(setq return-type (substring return-type 0 (match-beginning 1))))
12596	      ;; strip of trailing group-comment
12597	      (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
12598	      (setq return-type (substring return-type 0 (match-end 1)))
12599	      ;; parse return comment
12600	      (unless return-comment
12601		(setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12602					  (match-string-no-properties 1)))))
12603	    ;; parse inline comment
12604	    (unless comment
12605	      (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12606				 (match-string-no-properties 1))))
12607	    ;; save everything in list
12608	    (setq param-list (append param-list
12609				     (list (list names object direct type init
12610						 comment group-comment))))
12611	    ;; parse group comment and spacing
12612	    (setq group-comment (vhdl-parse-group-comment)))
12613	  (message "Reading interface of subprogram \"%s\"...done" name)
12614	  nil)))
12615      ;; finish parsing
12616      (if parse-error
12617	  (error parse-error)
12618	(setq vhdl-subprog-list
12619	      (list name kind param-list return-type return-comment
12620		    return-group-comment)
12621	      vhdl-subprog-flattened nil)))))
12622
12623(defun vhdl-subprog-paste-specification (kind)
12624  "Paste as a subprogram specification."
12625  (indent-according-to-mode)
12626  (let ((margin (current-column))
12627	(param-list (nth 2 vhdl-subprog-list))
12628	list-margin start names param)
12629    ;; paste keyword and name
12630    (vhdl-insert-keyword
12631     (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
12632    (insert (nth 0 vhdl-subprog-list))
12633    (if (not param-list)
12634	(if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12635      (setq start (point))
12636      ;; paste parameter list
12637      (insert " (")
12638      (unless vhdl-argument-list-indent
12639	(insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12640      (setq list-margin (current-column))
12641      (while param-list
12642	(setq param (car param-list))
12643	;; paste group comment and spacing
12644	(when (memq vhdl-include-group-comments (list kind 'always))
12645	  (vhdl-paste-group-comment (nth 6 param) list-margin))
12646	;; paste object
12647	(when (nth 1 param) (insert (nth 1 param) " "))
12648	;; paste names
12649	(setq names (nth 0 param))
12650	(while names
12651	  (insert (car names))
12652	  (setq names (cdr names))
12653	  (when names (insert ", ")))
12654	;; paste direction
12655	(insert " : ")
12656	(when (nth 2 param) (insert (nth 2 param) " "))
12657	;; paste type
12658	(insert (nth 3 param))
12659	;; paste initialization
12660	(when (nth 4 param) (insert " := " (nth 4 param)))
12661	;; terminate line
12662	(if (cdr param-list)
12663	    (insert ";")
12664	  (insert ")")
12665	  (when (null (nth 3 vhdl-subprog-list))
12666	    (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
12667	;; paste comment
12668	(when (and vhdl-include-port-comments (nth 5 param))
12669	  (vhdl-comment-insert-inline (nth 5 param) t))
12670	(setq param-list (cdr param-list))
12671	(when param-list (insert "\n") (indent-to list-margin)))
12672      (when (nth 3 vhdl-subprog-list)
12673	(insert "\n") (indent-to list-margin)
12674	;; paste group comment and spacing
12675	(when (memq vhdl-include-group-comments (list kind 'always))
12676	  (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
12677	;; paste return type
12678	(insert "return " (nth 3 vhdl-subprog-list))
12679	(if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12680	(when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
12681	  (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
12682      ;; align parameter list
12683      (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
12684    ;; paste body
12685    (when (eq kind 'body)
12686      (insert "\n")
12687      (vhdl-template-begin-end
12688       (unless (vhdl-standard-p '87)
12689	 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
12690       (nth 0 vhdl-subprog-list) margin))))
12691
12692(defun vhdl-subprog-paste-declaration ()
12693  "Paste as a subprogram declaration."
12694  (interactive)
12695  (if (not vhdl-subprog-list)
12696      (error "ERROR:  No subprogram interface read")
12697    (message "Pasting interface as subprogram declaration \"%s\"..."
12698	     (car vhdl-subprog-list))
12699    ;; paste specification
12700    (vhdl-subprog-paste-specification 'decl)
12701    (message "Pasting interface as subprogram declaration \"%s\"...done"
12702	     (car vhdl-subprog-list))))
12703
12704(defun vhdl-subprog-paste-body ()
12705  "Paste as a subprogram body."
12706  (interactive)
12707  (if (not vhdl-subprog-list)
12708      (error "ERROR:  No subprogram interface read")
12709    (message "Pasting interface as subprogram body \"%s\"..."
12710	     (car vhdl-subprog-list))
12711    ;; paste specification and body
12712    (vhdl-subprog-paste-specification 'body)
12713    (message "Pasting interface as subprogram body \"%s\"...done"
12714	     (car vhdl-subprog-list))))
12715
12716(defun vhdl-subprog-paste-call ()
12717  "Paste as a subprogram call."
12718  (interactive)
12719  (if (not vhdl-subprog-list)
12720      (error "ERROR:  No subprogram interface read")
12721    (let ((orig-vhdl-subprog-list vhdl-subprog-list)
12722	  param-list margin list-margin param start)
12723      ;; flatten local copy of interface list (must be flat for parameter mapping)
12724      (vhdl-subprog-flatten)
12725      (setq param-list (nth 2 vhdl-subprog-list))
12726      (indent-according-to-mode)
12727      (setq margin (current-indentation))
12728      (message "Pasting interface as subprogram call \"%s\"..."
12729	       (car vhdl-subprog-list))
12730      ;; paste name
12731      (insert (nth 0 vhdl-subprog-list))
12732      (if (not param-list)
12733	  (insert ";")
12734	(setq start (point))
12735	;; paste parameter list
12736	(insert " (")
12737	(unless vhdl-argument-list-indent
12738	  (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12739	(setq list-margin (current-column))
12740	(while param-list
12741	  (setq param (car param-list))
12742	  ;; paste group comment and spacing
12743	  (when (eq vhdl-include-group-comments 'always)
12744	    (vhdl-paste-group-comment (nth 6 param) list-margin))
12745	  ;; paste formal port
12746	  (insert (car (nth 0 param)) " => ")
12747	  (setq param-list (cdr param-list))
12748	  (insert (if param-list "," ");"))
12749	  ;; paste comment
12750	  (when (and vhdl-include-port-comments (nth 5 param))
12751	    (vhdl-comment-insert-inline (nth 5 param)))
12752	  (when param-list (insert "\n") (indent-to list-margin)))
12753	;; align parameter list
12754	(when vhdl-auto-align
12755	  (vhdl-align-region-groups start (point) 1)))
12756      (message "Pasting interface as subprogram call \"%s\"...done"
12757	       (car vhdl-subprog-list))
12758      (setq vhdl-subprog-list orig-vhdl-subprog-list))))
12759
12760
12761;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12762;;; Miscellaneous
12763;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12764
12765;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12766;; Hippie expand customization
12767
12768(defvar vhdl-expand-upper-case nil)
12769
12770(defun vhdl-try-expand-abbrev (old)
12771  "Try expanding abbreviations from `vhdl-abbrev-list'."
12772  (unless old
12773    (he-init-string (he-dabbrev-beg) (point))
12774    (setq he-expand-list
12775	  (let ((abbrev-list vhdl-abbrev-list)
12776		(sel-abbrev-list '()))
12777	    (while abbrev-list
12778	      (when (or (not (stringp (car abbrev-list)))
12779			(string-match
12780			 (concat "^" he-search-string) (car abbrev-list)))
12781		(setq sel-abbrev-list
12782		      (cons (car abbrev-list) sel-abbrev-list)))
12783	      (setq abbrev-list (cdr abbrev-list)))
12784	    (nreverse sel-abbrev-list))))
12785  (while (and he-expand-list
12786	      (or (not (stringp (car he-expand-list)))
12787		  (he-string-member (car he-expand-list) he-tried-table t)))
12788    (unless (stringp (car he-expand-list))
12789      (setq vhdl-expand-upper-case (car he-expand-list)))
12790    (setq he-expand-list (cdr he-expand-list)))
12791  (if (null he-expand-list)
12792      (progn (when old (he-reset-string))
12793	     nil)
12794    (he-substitute-string
12795     (if vhdl-expand-upper-case
12796	 (upcase (car he-expand-list))
12797       (car he-expand-list))
12798     t)
12799    (setq he-expand-list (cdr he-expand-list))
12800    t))
12801
12802(defun vhdl-he-list-beg ()
12803  "Also looks at the word before `(' in order to better match parenthesized
12804expressions (e.g. for index ranges of types and signals)."
12805  (save-excursion
12806    (condition-case ()
12807	(progn (backward-up-list 1)
12808 	       (skip-syntax-backward "w_")) ; crashes in `viper-mode'
12809      (error ()))
12810    (point)))
12811
12812;; override `he-list-beg' from `hippie-exp'
12813(unless (and (boundp 'viper-mode) viper-mode)
12814 (defalias 'he-list-beg #'vhdl-he-list-beg))
12815
12816;; function for expanding abbrevs and dabbrevs
12817(defalias 'vhdl-expand-abbrev (make-hippie-expand-function
12818			       '(try-expand-dabbrev
12819				 try-expand-dabbrev-all-buffers
12820				 vhdl-try-expand-abbrev)))
12821
12822;; function for expanding parenthesis
12823(defalias 'vhdl-expand-paren (make-hippie-expand-function
12824			      '(try-expand-list
12825				try-expand-list-all-buffers)))
12826
12827;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12828;; Line handling functions
12829
12830(defun vhdl-current-line ()
12831  "Return the line number of the line containing point."
12832  (save-restriction
12833    (widen)
12834    (1+ (count-lines (point-min) (point-at-bol)))))
12835
12836(defun vhdl-line-kill-entire (&optional arg)
12837  "Delete entire line."
12838  (interactive "p")
12839  (beginning-of-line)
12840  (kill-line (or arg 1)))
12841
12842(defun vhdl-line-kill (&optional arg)
12843  "Kill current line."
12844  (interactive "p")
12845  (vhdl-line-kill-entire arg))
12846
12847(defun vhdl-line-copy (&optional arg)
12848  "Copy current line."
12849  (interactive "p")
12850  (save-excursion
12851    (let ((position (point-at-bol)))
12852      (forward-line (or arg 1))
12853      (copy-region-as-kill position (point)))))
12854
12855(defun vhdl-line-yank ()
12856  "Yank entire line."
12857  (interactive)
12858  (beginning-of-line)
12859  (yank))
12860
12861(defun vhdl-line-expand (&optional arg)
12862  "Hippie-expand current line."
12863  (interactive "P")
12864  (require 'hippie-exp)
12865  (let ((case-fold-search t) (case-replace nil)
12866	(hippie-expand-try-functions-list
12867	 '(try-expand-line try-expand-line-all-buffers)))
12868    (hippie-expand arg)))
12869
12870(defun vhdl-line-transpose-next (&optional arg)
12871  "Interchange this line with next line."
12872  (interactive "p")
12873  (forward-line 1)
12874  (transpose-lines (or arg 1))
12875  (forward-line -1))
12876
12877(defun vhdl-line-transpose-previous (&optional arg)
12878  "Interchange this line with previous line."
12879  (interactive "p")
12880  (forward-line 1)
12881  (transpose-lines (- 0 (or arg 0)))
12882  (forward-line -1))
12883
12884(defun vhdl-line-open ()
12885  "Open a new line and indent."
12886  (interactive)
12887  (end-of-line -0)
12888  (newline-and-indent))
12889
12890(defun vhdl-delete-indentation ()
12891  "Join lines.  That is, call `delete-indentation' with `fill-prefix' so that
12892it works within comments too."
12893  (interactive)
12894  (let ((fill-prefix "-- "))
12895    (delete-indentation)))
12896
12897;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12898;; Move functions
12899
12900(defun vhdl-forward-same-indent ()
12901  "Move forward to next line with same indent."
12902  (interactive)
12903  (let ((pos (point))
12904	(indent (current-indentation)))
12905    (beginning-of-line 2)
12906    (while (and (not (eobp))
12907		(or (looking-at "^\\s-*\\(--.*\\)?$")
12908		    (> (current-indentation) indent)))
12909      (beginning-of-line 2))
12910    (if (= (current-indentation) indent)
12911	(back-to-indentation)
12912      (message "No following line with same indent found in this block")
12913      (goto-char pos)
12914      nil)))
12915
12916(defun vhdl-backward-same-indent ()
12917  "Move backward to previous line with same indent."
12918  (interactive)
12919  (let ((pos (point))
12920	(indent (current-indentation)))
12921    (beginning-of-line -0)
12922    (while (and (not (bobp))
12923		(or (looking-at "^\\s-*\\(--.*\\)?$")
12924		    (> (current-indentation) indent)))
12925      (beginning-of-line -0))
12926    (if (= (current-indentation) indent)
12927	(back-to-indentation)
12928      (message "No preceding line with same indent found in this block")
12929      (goto-char pos)
12930      nil)))
12931
12932;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12933;; Statistics
12934
12935(defun vhdl-statistics-buffer ()
12936  "Get some file statistics."
12937  (interactive)
12938  (let ((no-stats 0)
12939	(no-code-lines 0)
12940	(no-empty-lines 0)
12941	(no-comm-lines 0)
12942	(no-comments 0)
12943	(no-lines (count-lines (point-min) (point-max))))
12944    (save-excursion
12945      ;; count statements
12946      (goto-char (point-min))
12947      (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12948	(if (match-string 1)
12949	    (goto-char (match-end 1))
12950	  (setq no-stats (1+ no-stats))))
12951      ;; count code lines
12952      (goto-char (point-min))
12953      (while (not (eobp))
12954	(unless (looking-at "^\\s-*\\(--.*\\)?$")
12955	  (setq no-code-lines (1+ no-code-lines)))
12956	(beginning-of-line 2))
12957      ;; count empty lines
12958      (goto-char (point-min))
12959      (while (and (re-search-forward "^\\s-*$" nil t)
12960		  (not (eq (point) (point-max))))
12961	(if (match-string 1)
12962	    (goto-char (match-end 1))
12963	  (setq no-empty-lines (1+ no-empty-lines))
12964	  (unless (eq (point) (point-max))
12965	    (forward-char))))
12966      ;; count comment-only lines
12967      (goto-char (point-min))
12968      (while (re-search-forward "^\\s-*--.*" nil t)
12969	(if (match-string 1)
12970	    (goto-char (match-end 1))
12971	  (setq no-comm-lines (1+ no-comm-lines))))
12972      ;; count comments
12973      (goto-char (point-min))
12974      (while (re-search-forward "--.*" nil t)
12975	(if (match-string 1)
12976	    (goto-char (match-end 1))
12977	  (setq no-comments (1+ no-comments)))))
12978    ;; print results
12979    (message "\n\
12980File statistics: \"%s\"\n\
12981-----------------------\n\
12982# statements    : %5d\n\
12983# code lines    : %5d\n\
12984# empty lines   : %5d\n\
12985# comment lines : %5d\n\
12986# comments      : %5d\n\
12987# total lines   : %5d\n"
12988	     (buffer-file-name) no-stats no-code-lines no-empty-lines
12989	     no-comm-lines no-comments no-lines)
12990    (when (featurep 'xemacs) (vhdl-show-messages))))
12991
12992;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12993;; Help functions
12994
12995(defun vhdl-re-search-forward (regexp &optional bound noerror count)
12996  "Like `re-search-forward', but does not match within literals."
12997  (let (pos)
12998    (save-excursion
12999      (while (and (setq pos (re-search-forward regexp bound noerror count))
13000		  (save-match-data (vhdl-in-literal)))))
13001    (when pos (goto-char pos))
13002    pos))
13003
13004(defun vhdl-re-search-backward (regexp &optional bound noerror count)
13005  "Like `re-search-backward', but does not match within literals."
13006  (let (pos)
13007    (save-excursion
13008      (while (and (setq pos (re-search-backward regexp bound noerror count))
13009		  (save-match-data (vhdl-in-literal)))))
13010    (when pos (goto-char pos))
13011    pos))
13012
13013
13014;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13015;;; Project
13016;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13017
13018(defun vhdl-set-project (name)
13019  "Set current project to NAME."
13020  (interactive
13021   (list (let ((completion-ignore-case t))
13022	   (completing-read "Project name: " vhdl-project-alist nil t))))
13023  (cond ((equal name "")
13024	 (setq vhdl-project nil)
13025	 (message "Current VHDL project: None"))
13026	((assoc name vhdl-project-alist)
13027	 (setq vhdl-project name)
13028	 (message "Current VHDL project: \"%s\"" name))
13029	(t
13030	 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
13031  (vhdl-speedbar-update-current-project))
13032
13033(defun vhdl-set-default-project ()
13034  "Set current project as default on startup."
13035  (interactive)
13036  (customize-set-variable 'vhdl-project vhdl-project)
13037  (customize-save-customized))
13038
13039(defun vhdl-toggle-project (name _token _indent)
13040  "Set current project to NAME or unset if NAME is current project."
13041  (vhdl-set-project (if (equal name vhdl-project) "" name)))
13042
13043(defun vhdl-export-project (file-name)
13044  "Write project setup for current project."
13045  (interactive
13046   (let ((name (vhdl-resolve-env-variable
13047		(vhdl-replace-string
13048		 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13049		 (concat (subst-char-in-string
13050			  ?  ?_ (or (vhdl-project-p)
13051				    (error "ERROR:  No current project")))
13052			 " " (user-login-name))))))
13053     (list (read-file-name
13054	    "Write project file: "
13055	    (when (file-name-absolute-p name) "") nil nil name))))
13056  (setq file-name (abbreviate-file-name file-name))
13057  (let ((orig-buffer (current-buffer)))
13058    (unless (file-exists-p (file-name-directory file-name))
13059      (make-directory (file-name-directory file-name) t))
13060    (if (not (file-writable-p file-name))
13061	(error "ERROR:  File not writable: \"%s\"" file-name)
13062      (set-buffer (find-file-noselect file-name t t))
13063      (erase-buffer)
13064      (insert ";; -*- Emacs-Lisp -*-\n\n"
13065	      ";;; " (file-name-nondirectory file-name)
13066	      " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
13067	      ";; Project : " vhdl-project "\n"
13068	      ";; Saved   : " (format-time-string "%Y-%m-%d %T ")
13069	      (user-login-name) "\n\n\n"
13070	      ";; project name\n"
13071	      "(setq vhdl-project \"" vhdl-project "\")\n\n"
13072	      ";; project setup\n"
13073	      "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
13074      (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
13075      (insert ")\n")
13076      (save-buffer)
13077      (kill-buffer (current-buffer))
13078      (set-buffer orig-buffer))))
13079
13080(defun vhdl-import-project (file-name &optional auto not-make-current)
13081  "Read project setup and set current project."
13082  (interactive
13083   (let ((name (vhdl-resolve-env-variable
13084		(vhdl-replace-string
13085		 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13086		 (concat "" " " (user-login-name))))))
13087     (list (read-file-name
13088	    "Read project file: " (when (file-name-absolute-p name) "") nil t
13089	    (file-name-directory name)))))
13090  (when (file-exists-p file-name)
13091    (condition-case ()
13092	(let ((current-project vhdl-project))
13093	  (load-file file-name)
13094	  (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10)
13095	    (vhdl-adelete 'vhdl-project-alist vhdl-project)
13096	    (error ""))
13097	  (if not-make-current
13098	      (setq vhdl-project current-project)
13099	    (setq vhdl-compiler
13100 		  (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project)))))
13101	  (vhdl-update-mode-menu)
13102	  (vhdl-speedbar-refresh)
13103	  (unless not-make-current
13104	    (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s"
13105		     vhdl-project vhdl-compiler (if auto " (auto-loaded)" ""))))
13106      (error (vhdl-warning
13107	      (format "ERROR:  Invalid project setup file: \"%s\"" file-name))))))
13108
13109(defun vhdl-duplicate-project ()
13110  "Duplicate setup of current project."
13111  (interactive)
13112  (let ((new-name (read-from-minibuffer "New project name: "))
13113	(project-entry (vhdl-aget vhdl-project-alist vhdl-project)))
13114    (setq vhdl-project-alist
13115	  (append vhdl-project-alist
13116		  (list (cons new-name project-entry))))
13117    (vhdl-update-mode-menu)))
13118
13119(defun vhdl-autoload-project ()
13120  "Automatically load project setup at startup."
13121  (let ((file-name-list vhdl-project-file-name)
13122	file-list list-length)
13123    (while file-name-list
13124      (setq file-list
13125	    (append file-list
13126		    (file-expand-wildcards
13127		     (vhdl-resolve-env-variable
13128		      (vhdl-replace-string
13129		       (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
13130		       (concat "* " (user-login-name)))))))
13131      (setq list-length (or list-length (length file-list)))
13132      (setq file-name-list (cdr file-name-list)))
13133    (while file-list
13134      (vhdl-import-project (expand-file-name (car file-list)) t
13135			   (not (> list-length 0)))
13136      (setq list-length (1- list-length))
13137      (setq file-list (cdr file-list)))))
13138(define-obsolete-function-alias 'vhdl-auto-load-project
13139  #'vhdl-autoload-project "27.1")
13140
13141;; automatically load project setup when idle after startup
13142(when (memq 'startup vhdl-project-autoload)
13143  (if noninteractive
13144      (vhdl-autoload-project)
13145    (vhdl-run-when-idle .1 nil 'vhdl-autoload-project)))
13146
13147
13148;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13149;;; Hideshow
13150;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13151;; (using `hideshow.el')
13152
13153(defconst vhdl-hs-start-regexp
13154  (concat
13155   "\\(^\\)\\s-*\\("
13156   ;; generic/port clause
13157   "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
13158   ;; component
13159   "component\\>\\|"
13160   ;; component instantiation
13161   "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
13162   "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13163   "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
13164   "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
13165   ;; subprogram
13166   "\\(function\\|procedure\\)\\>\\|"
13167   ;; process, block
13168   "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
13169   ;; configuration declaration
13170   "configuration\\>"
13171   "\\)")
13172  "Regexp to match start of construct to hide.")
13173
13174(defun vhdl-hs-forward-sexp-func (count)
13175  "Find end of construct to hide (for hideshow).  Only search forward."
13176  (let ((pos (point)))
13177    (vhdl-prepare-search-2
13178     (beginning-of-line)
13179     (cond
13180      ;; generic/port clause
13181      ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
13182       (goto-char (match-end 0))
13183       (backward-char)
13184       (forward-sexp))
13185      ;; component declaration
13186      ((looking-at "^\\s-*component\\>")
13187       (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
13188      ;; component instantiation
13189      ((looking-at
13190	(concat
13191	 "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
13192	 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13193	 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
13194	 "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
13195       (goto-char (match-end 0))
13196       (backward-char)
13197       (forward-sexp)
13198       (setq pos (point))
13199       (vhdl-forward-syntactic-ws)
13200       (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
13201	 (goto-char (match-end 0))
13202	 (backward-char)
13203	 (forward-sexp)
13204	 (setq pos (point)))
13205       (goto-char pos))
13206      ;; subprogram declaration/body
13207      ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
13208       (goto-char (match-end 0))
13209       (vhdl-forward-syntactic-ws)
13210       (when (looking-at "(")
13211	 (forward-sexp))
13212       (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
13213		   (vhdl-in-literal)))
13214       ;; subprogram body
13215       (when (match-string 2)
13216	 (re-search-forward "^\\s-*\\<begin\\>" nil t)
13217	 (backward-word-strictly 1)
13218	 (vhdl-forward-sexp)))
13219      ;; block (recursive)
13220      ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
13221       (goto-char (match-end 0))
13222       (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
13223		   (match-beginning 2))
13224	 (vhdl-hs-forward-sexp-func count)))
13225      ;; process
13226      ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
13227       (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
13228      ;; configuration declaration
13229      ((looking-at "^\\s-*configuration\\>")
13230       (forward-word-strictly 4)
13231       (vhdl-forward-sexp))
13232      (t (goto-char pos))))))
13233
13234(defun vhdl-hideshow-init ()
13235  "Initialize `hideshow'."
13236  (when vhdl-hideshow-menu
13237    (vhdl-hs-minor-mode 1)))
13238
13239(defun vhdl-hs-minor-mode (&optional arg)
13240  "Toggle hideshow minor mode and update menu bar."
13241  (interactive "P")
13242  (require 'hideshow)
13243  (declare-function hs-hide-all "hideshow" ())
13244  ;; check for hideshow version 5.x
13245  (if (not (boundp 'hs-block-start-mdata-select))
13246      (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
13247    ;; initialize hideshow
13248    (unless (assoc 'vhdl-mode hs-special-modes-alist)
13249      (setq hs-special-modes-alist
13250	    (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
13251			'vhdl-hs-forward-sexp-func nil)
13252		  hs-special-modes-alist)))
13253    (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
13254    (if vhdl-hide-all-init
13255	(add-hook 'hs-minor-mode-hook #'hs-hide-all nil t)
13256      (remove-hook 'hs-minor-mode-hook #'hs-hide-all t))
13257    (hs-minor-mode arg)
13258    (force-mode-line-update)))		; hack to update menu bar
13259
13260
13261;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13262;;; Font locking
13263;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13264;; (using `font-lock.el')
13265
13266;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13267;; Help functions
13268
13269(defun vhdl-within-translate-off ()
13270  "Return point if within translate-off region, else nil."
13271  (and (save-excursion
13272	 (re-search-backward
13273	  "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t))
13274       (equal "off" (match-string 1))
13275       (point)))
13276
13277(defun vhdl-start-translate-off (limit)
13278  "Return point before translate-off pragma if before LIMIT, else nil."
13279  (when (re-search-forward
13280	 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t)
13281    (match-beginning 0)))
13282
13283(defun vhdl-end-translate-off (limit)
13284  "Return point after translate-on pragma if before LIMIT, else nil."
13285  (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t))
13286
13287(defun vhdl-match-translate-off (limit)
13288  "Match a translate-off block, setting match-data and returning t, else nil."
13289  (when (< (point) limit)
13290    (let ((start (or (vhdl-within-translate-off)
13291		     (vhdl-start-translate-off limit)))
13292	  (case-fold-search t))
13293      (when start
13294	(let ((end (or (vhdl-end-translate-off limit) limit)))
13295	  (set-match-data (list start end))
13296	  (goto-char end))))))
13297
13298(defun vhdl-font-lock-match-item (limit)
13299  "Match, and move over, any declaration item after point.
13300Adapted from
13301`font-lock-match-c-style-declaration-item-and-skip-to-next'."
13302  (condition-case nil
13303      (save-restriction
13304	(narrow-to-region (point-min) limit)
13305	;; match item
13306	(when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
13307	  (save-match-data
13308	    (goto-char (match-end 1))
13309	    ;; move to next item
13310	    (if (looking-at "\\(\\s-*,\\)")
13311		(goto-char (match-end 1))
13312	      (end-of-line) t))))
13313    (error t)))
13314
13315;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13316;; Syntax definitions
13317
13318(defconst vhdl-font-lock-syntactic-keywords
13319  '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
13320  "Mark single quotes as having string quote syntax in `c' instances.")
13321
13322(defvar vhdl-font-lock-keywords nil
13323  "Regular expressions to highlight in VHDL Mode.")
13324
13325(defvar vhdl-font-lock-keywords-0 nil
13326  ;; set in `vhdl-font-lock-init' because dependent on user options
13327  "For consideration as a value of `vhdl-font-lock-keywords'.
13328This does highlighting of template prompts and directives (pragmas).")
13329
13330(defvar vhdl-font-lock-keywords-1 nil
13331  ;; set in `vhdl-font-lock-init' because dependent on user options
13332  "For consideration as a value of `vhdl-font-lock-keywords'.
13333This does highlighting of keywords and standard identifiers.")
13334
13335(defconst vhdl-font-lock-keywords-2
13336  (list
13337   ;; highlight names of units, subprograms, and components when declared
13338   (list
13339    (concat
13340     "^\\s-*\\("
13341     "architecture\\|configuration\\|context\\|entity\\|package"
13342     "\\(\\s-+body\\)?\\|"
13343     "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
13344     "\\)\\s-+\\(\\w+\\)")
13345    5 'font-lock-function-name-face)
13346
13347   ;; highlight entity names of architectures and configurations
13348   (list
13349    "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
13350    2 'font-lock-function-name-face)
13351
13352   ;; highlight labels of common constructs
13353   (list
13354    (concat
13355     "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
13356     "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
13357     "postponed\\|process\\|"
13358     (when (vhdl-standard-p 'ams) "procedural\\|")
13359     "with\\|while"
13360     "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)")
13361    1 'font-lock-function-name-face)
13362
13363   ;; highlight label and component name of component instantiations
13364   (list
13365    (concat
13366     "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
13367     "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
13368    '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
13369
13370   ;; highlight label and instantiated unit of component instantiations
13371   (list
13372    (concat
13373     "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
13374     "\\(component\\|configuration\\|entity\\)\\s-+"
13375     "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
13376    '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
13377    '(5 font-lock-function-name-face nil t)
13378    '(7 font-lock-function-name-face nil t))
13379
13380   ;; highlight names and labels at end of constructs
13381   (list
13382    (concat
13383     "^\\s-*end\\s-+\\(\\("
13384     "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
13385     "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
13386     "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
13387     (when (vhdl-standard-p 'ams) "procedural\\|")
13388     "units"
13389     "\\)\\s-+\\)?\\(\\w*\\)")
13390    5 'font-lock-function-name-face)
13391
13392   ;; highlight labels in exit and next statements
13393   (list
13394    (concat
13395     "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
13396    3 'font-lock-function-name-face)
13397
13398   ;; highlight entity name in attribute specifications
13399   (list
13400    (concat
13401     "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
13402    1 'font-lock-function-name-face)
13403
13404   ;; highlight labels in block and component specifications
13405   (list
13406    (concat
13407     "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
13408     "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
13409    '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
13410
13411   ;; highlight names in library clauses
13412   (list "^\\s-*library\\>"
13413	 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
13414
13415   ;; highlight names in use clauses
13416   (list
13417    (concat
13418     "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
13419     "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
13420    '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
13421    '(8 font-lock-function-name-face nil t))
13422
13423   ;; highlight attribute name in attribute declarations/specifications
13424   (list
13425    (concat
13426     "^\\s-*attribute\\s-+\\(\\w+\\)")
13427    1 'vhdl-font-lock-attribute-face)
13428
13429   ;; highlight type/nature name in (sub)type/(sub)nature declarations
13430   (list
13431    (concat
13432     "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
13433    5 'font-lock-type-face)
13434
13435   ;; highlight signal/variable/constant declaration names
13436   (list "\\(:[^=]\\)"
13437	 '(vhdl-font-lock-match-item
13438	   (progn (goto-char (match-beginning 1))
13439		  (skip-syntax-backward " ")
13440		  (skip-syntax-backward "w_")
13441		  (skip-syntax-backward " ")
13442		  (while (= (preceding-char) ?,)
13443		    (backward-char 1)
13444		    (skip-syntax-backward " ")
13445		    (skip-syntax-backward "w_")
13446		    (skip-syntax-backward " ")))
13447	   (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13448
13449   ;; highlight formal parameters in component instantiations and subprogram
13450   ;; calls
13451   (list "\\(=>\\)"
13452	 '(vhdl-font-lock-match-item
13453	   (progn (goto-char (match-beginning 1))
13454		  (skip-syntax-backward " ")
13455		  (while (= (preceding-char) ?\)) (backward-sexp))
13456		  (skip-syntax-backward "w_")
13457		  (skip-syntax-backward " ")
13458		  (when (memq (preceding-char) '(?n ?N ?|))
13459		    (goto-char (point-max))))
13460	   (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13461
13462   ;; highlight alias/group/quantity declaration names and for-loop/-generate
13463   ;; variables
13464   (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
13465	 '(vhdl-font-lock-match-item
13466	   (progn (goto-char (match-end 1)) (match-beginning 2))
13467	   nil (1 font-lock-variable-name-face)))
13468
13469   ;; highlight tool directives
13470   (list
13471    (concat
13472     "^\\s-*\\(`\\w+\\)")
13473    1 'font-lock-preprocessor-face)
13474   )
13475  "For consideration as a value of `vhdl-font-lock-keywords'.
13476This does context sensitive highlighting of names and labels.")
13477
13478(defvar vhdl-font-lock-keywords-3 nil
13479  ;; set in `vhdl-font-lock-init' because dependent on user options
13480  "For consideration as a value of `vhdl-font-lock-keywords'.
13481This does highlighting of words with special syntax.")
13482
13483(defvar vhdl-font-lock-keywords-4 nil
13484  ;; set in `vhdl-font-lock-init' because dependent on user options
13485  "For consideration as a value of `vhdl-font-lock-keywords'.
13486This does highlighting of additional reserved words.")
13487
13488(defconst vhdl-font-lock-keywords-5
13489  ;; background highlight translate-off regions
13490  '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append)))
13491  "For consideration as a value of `vhdl-font-lock-keywords'.
13492This does background highlighting of translate-off regions.")
13493
13494;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13495;; Font and color definitions
13496
13497(defvar vhdl-font-lock-prompt-face	   'vhdl-font-lock-prompt-face
13498  "Face name to use for prompts.")
13499
13500(defvar vhdl-font-lock-attribute-face      'vhdl-font-lock-attribute-face
13501  "Face name to use for standardized attributes.")
13502
13503(defvar vhdl-font-lock-enumvalue-face      'vhdl-font-lock-enumvalue-face
13504  "Face name to use for standardized enumeration values.")
13505
13506(defvar vhdl-font-lock-function-face       'vhdl-font-lock-function-face
13507  "Face name to use for standardized functions and packages.")
13508
13509(defvar vhdl-font-lock-directive-face      'vhdl-font-lock-directive-face
13510  "Face name to use for directives.")
13511
13512(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face
13513  "Face name to use for additional reserved words.")
13514
13515(defvar vhdl-font-lock-translate-off-face  'vhdl-font-lock-translate-off-face
13516  "Face name to use for translate-off regions.")
13517
13518;; face names to use for words with special syntax.
13519(let ((syntax-alist vhdl-special-syntax-alist)
13520      name)
13521  (while syntax-alist
13522    (setq name (vhdl-function-name
13523		"vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
13524    ;; FIXME: This `defvar' shouldn't be needed: just quote the face
13525    ;; name when you use it.
13526    (eval `(defvar ,name ',name
13527	     ,(concat "Face name to use for "
13528		      (nth 0 (car syntax-alist)) ".")))
13529    (setq syntax-alist (cdr syntax-alist))))
13530
13531(defgroup vhdl-highlight-faces nil
13532  "Faces for highlighting."
13533  :group 'vhdl-highlight)
13534
13535;; add faces used from `font-lock'
13536(custom-add-to-group
13537 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face)
13538(custom-add-to-group
13539 'vhdl-highlight-faces 'font-lock-string-face 'custom-face)
13540(custom-add-to-group
13541 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face)
13542(custom-add-to-group
13543 'vhdl-highlight-faces 'font-lock-type-face 'custom-face)
13544(custom-add-to-group
13545 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face)
13546(custom-add-to-group
13547 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
13548
13549(defface vhdl-font-lock-prompt-face
13550  '((((min-colors 88) (class color) (background light))
13551     (:foreground "Red1" :bold t))
13552    (((class color) (background light)) (:foreground "Red" :bold t))
13553    (((class color) (background dark)) (:foreground "Pink" :bold t))
13554    (t (:inverse-video t)))
13555  "Font lock mode face used to highlight prompts."
13556  :group 'vhdl-highlight-faces)
13557
13558(defface vhdl-font-lock-attribute-face
13559  '((((class color) (background light)) (:foreground "Orchid"))
13560    (((class color) (background dark)) (:foreground "LightSteelBlue"))
13561    (t (:italic t :bold t)))
13562  "Font lock mode face used to highlight standardized attributes."
13563  :group 'vhdl-highlight-faces)
13564
13565(defface vhdl-font-lock-enumvalue-face
13566  '((((class color) (background light)) (:foreground "SaddleBrown"))
13567    (((class color) (background dark)) (:foreground "BurlyWood"))
13568    (t (:italic t :bold t)))
13569  "Font lock mode face used to highlight standardized enumeration values."
13570  :group 'vhdl-highlight-faces)
13571
13572(defface vhdl-font-lock-function-face
13573  '((((class color) (background light)) (:foreground "Cyan4"))
13574    (((class color) (background dark)) (:foreground "Orchid1"))
13575    (t (:italic t :bold t)))
13576  "Font lock mode face used to highlight standardized functions and packages."
13577  :group 'vhdl-highlight-faces)
13578
13579(defface vhdl-font-lock-directive-face
13580  '((((class color) (background light)) (:foreground "CadetBlue"))
13581    (((class color) (background dark)) (:foreground "Aquamarine"))
13582    (t (:italic t :bold t)))
13583  "Font lock mode face used to highlight directives."
13584  :group 'vhdl-highlight-faces)
13585
13586(defface vhdl-font-lock-reserved-words-face
13587  '((((class color) (background light)) (:foreground "Orange" :bold t))
13588    (((min-colors 88) (class color) (background dark))
13589     (:foreground "Yellow1" :bold t))
13590    (((class color) (background dark)) (:foreground "Yellow" :bold t))
13591    (t ()))
13592  "Font lock mode face used to highlight additional reserved words."
13593  :group 'vhdl-highlight-faces)
13594
13595(defface vhdl-font-lock-translate-off-face
13596  '((((class color) (background light)) (:background "LightGray"))
13597    (((class color) (background dark)) (:background "DimGray"))
13598    (t ()))
13599  "Font lock mode face used to background highlight translate-off regions."
13600  :group 'vhdl-highlight-faces)
13601
13602;; font lock mode faces used to highlight words with special syntax.
13603(let ((syntax-alist vhdl-special-syntax-alist))
13604  (while syntax-alist
13605    (eval `(defface ,(vhdl-function-name
13606		      "vhdl-font-lock" (caar syntax-alist) "face")
13607	     '((((class color) (background light))
13608		(:foreground ,(nth 2 (car syntax-alist))))
13609	       (((class color) (background dark))
13610		(:foreground ,(nth 3 (car syntax-alist))))
13611	       (t ()))
13612	     ,(concat "Font lock mode face used to highlight "
13613		      (nth 0 (car syntax-alist)) ".")
13614	     :group 'vhdl-highlight-faces))
13615    (setq syntax-alist (cdr syntax-alist))))
13616
13617;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13618;; Font lock initialization
13619
13620(defun vhdl-font-lock-init ()
13621  "Initialize fontification."
13622  ;; highlight template prompts and directives
13623  (setq vhdl-font-lock-keywords-0
13624	(list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
13625			    vhdl-template-prompt-syntax ">\\)")
13626		    2 'vhdl-font-lock-prompt-face t)
13627	      (list (concat "--\\s-*"
13628                            "\\<"
13629                            (regexp-opt vhdl-directive-keywords t)
13630                            "\\>"
13631			     "\\s-+\\(.*\\)$")
13632		    2 'vhdl-font-lock-directive-face t)
13633	      ;; highlight c-preprocessor directives
13634	      (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
13635		    '(1 font-lock-builtin-face)
13636		    '(3 font-lock-variable-name-face nil t))))
13637  ;; highlight keywords and standardized types, attributes, enumeration
13638  ;; values, and subprograms
13639  (setq vhdl-font-lock-keywords-1
13640	(list
13641	 (list (concat "'" vhdl-attributes-regexp)
13642	       1 'vhdl-font-lock-attribute-face)
13643	 (list vhdl-types-regexp       1 'font-lock-type-face)
13644	 (list vhdl-functions-regexp   1 'vhdl-font-lock-function-face)
13645	 (list vhdl-packages-regexp    1 'vhdl-font-lock-function-face)
13646	 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
13647	 (list vhdl-constants-regexp   1 'font-lock-constant-face)
13648	 (list vhdl-keywords-regexp    1 'font-lock-keyword-face)))
13649  ;; highlight words with special syntax.
13650  (setq vhdl-font-lock-keywords-3
13651	(let ((syntax-alist vhdl-special-syntax-alist)
13652	      keywords)
13653	  (while syntax-alist
13654	    (setq keywords
13655		  (cons
13656		   (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1
13657			 (vhdl-function-name
13658			  "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")
13659			 (nth 4 (car syntax-alist)))
13660		   keywords))
13661	    (setq syntax-alist (cdr syntax-alist)))
13662	  keywords))
13663  ;; highlight additional reserved words
13664  (setq vhdl-font-lock-keywords-4
13665	(list (list vhdl-reserved-words-regexp 1
13666		    'vhdl-font-lock-reserved-words-face)))
13667  ;; highlight everything together
13668  (setq vhdl-font-lock-keywords
13669	(append
13670	 vhdl-font-lock-keywords-0
13671	 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1)
13672	 (when (or vhdl-highlight-forbidden-words
13673		   vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4)
13674	 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3)
13675	 (when vhdl-highlight-names vhdl-font-lock-keywords-2)
13676	 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5))))
13677
13678;; initialize fontification for VHDL Mode
13679(vhdl-font-lock-init)
13680
13681(defun vhdl-fontify-buffer ()
13682  "Re-initialize fontification and fontify buffer."
13683  (interactive)
13684  (setq font-lock-defaults
13685	`(vhdl-font-lock-keywords
13686          nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
13687          beginning-of-line))
13688  (when (fboundp 'font-lock-unset-defaults)
13689    (font-lock-unset-defaults))		; not implemented in XEmacs
13690  (font-lock-set-defaults)
13691  (font-lock-mode nil)
13692  (font-lock-mode t))
13693
13694;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13695;; Initialization for PostScript printing
13696
13697(defun vhdl-ps-print-settings ()
13698  "Initialize custom face and page settings for PostScript printing."
13699  ;; define custom face settings
13700  (unless (or (not vhdl-print-customize-faces)
13701	      ps-print-color-p)
13702    (set (make-local-variable 'ps-bold-faces)
13703	 '(font-lock-keyword-face
13704	   font-lock-type-face
13705	   vhdl-font-lock-attribute-face
13706	   vhdl-font-lock-enumvalue-face
13707	   vhdl-font-lock-directive-face))
13708    (set (make-local-variable 'ps-italic-faces)
13709	 '(font-lock-comment-face
13710	   font-lock-function-name-face
13711	   font-lock-type-face
13712	   vhdl-font-lock-attribute-face
13713	   vhdl-font-lock-enumvalue-face
13714	   vhdl-font-lock-directive-face))
13715    (set (make-local-variable 'ps-underlined-faces)
13716	 '(font-lock-string-face))
13717    (setq ps-always-build-face-reference t))
13718  ;; define page settings, so that a line containing 79 characters (default)
13719  ;; fits into one column
13720  (when vhdl-print-two-column
13721    (set (make-local-variable 'ps-landscape-mode) t)
13722    (set (make-local-variable 'ps-number-of-columns) 2)
13723    (set (make-local-variable 'ps-font-size) 7.0)
13724    (set (make-local-variable 'ps-header-title-font-size) 10.0)
13725    (set (make-local-variable 'ps-header-font-size) 9.0)
13726    (set (make-local-variable 'ps-header-offset) 12.0)
13727    (when (eq ps-paper-type 'letter)
13728      (set (make-local-variable 'ps-inter-column) 40.0)
13729      (set (make-local-variable 'ps-left-margin) 40.0)
13730      (set (make-local-variable 'ps-right-margin) 40.0))))
13731
13732(defun vhdl-ps-print-init ()
13733  "Initialize PostScript printing."
13734  (if (featurep 'xemacs)
13735      (when (boundp 'ps-print-color-p)
13736	(vhdl-ps-print-settings))
13737    (if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
13738    (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t)))
13739
13740
13741;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13742;;; Hierarchy browser (using `speedbar.el')
13743;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13744;; Allows displaying the hierarchy of all VHDL design units contained in a
13745;; directory by using the speedbar.
13746
13747;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13748;; Variables
13749
13750(defvar vhdl-entity-alist nil
13751  "Cache with entities and corresponding architectures for each project/directory.")
13752;; structure: (parenthesized expression means list of such entries)
13753;; (cache-key
13754;;   (ent-key ent-name ent-file ent-line
13755;;     (arch-key arch-name arch-file arch-line
13756;;       (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
13757;;		   inst-arch-key inst-conf-key inst-lib-key inst-path)
13758;;	 (lib-name pack-key))
13759;;     mra-key (lib-name pack-key))
13760
13761(defvar vhdl-config-alist nil
13762  "Cache with configurations for each project/directory.")
13763;; structure: (parenthesized expression means list of such entries)
13764;; (cache-key
13765;;   (conf-key conf-name conf-file conf-line ent-key arch-key
13766;;     (inst-key inst-comp-name inst-ent-key inst-arch-key
13767;;		 inst-conf-key inst-lib-key)
13768;;     (lib-name pack-key)))
13769
13770(defvar vhdl-package-alist nil
13771  "Cache with packages for each project/directory.")
13772;; structure: (parenthesized expression means list of such entries)
13773;; (cache-key
13774;;   (pack-key pack-name pack-file pack-line
13775;;     (comp-key comp-name comp-file comp-line)
13776;;     (func-key func-name func-file func-line)
13777;;     (lib-name pack-key)
13778;;     pack-body-file pack-body-line
13779;;     (func-key func-name func-body-file func-body-line)
13780;;     (lib-name pack-key)))
13781
13782(defvar vhdl-ent-inst-alist nil
13783  "Cache with instantiated entities for each project/directory.")
13784;; structure: (parenthesized expression means list of such entries)
13785;; (cache-key (inst-ent-key))
13786
13787(defvar vhdl-file-alist nil
13788  "Cache with design units in each file for each project/directory.")
13789;; structure: (parenthesized expression means list of such entries)
13790;; (cache-key
13791;;   (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
13792;;		(pack-list) (pack-body-list) (inst-list) (inst-ent-list))
13793
13794(defvar vhdl-directory-alist nil
13795  "Cache with source directories for each project.")
13796;; structure: (parenthesized expression means list of such entries)
13797;; (cache-key (directory))
13798
13799(defvar vhdl-speedbar-shown-unit-alist nil
13800  "Alist of design units simultaneously open in the current speedbar for each
13801directory and project.")
13802
13803(defvar vhdl-speedbar-shown-project-list nil
13804  "List of projects simultaneously open in the current speedbar.")
13805
13806(defvar vhdl-updated-project-list nil
13807  "List of projects and directories with updated files.")
13808
13809(defvar vhdl-modified-file-list nil
13810  "List of modified files to be rescanned for hierarchy updating.")
13811
13812(defvar vhdl-speedbar-hierarchy-depth 0
13813  "Depth of instantiation hierarchy to display.")
13814
13815(defvar vhdl-speedbar-show-projects nil
13816  "Non-nil means project hierarchy is displayed in speedbar, directory
13817hierarchy otherwise.")
13818
13819(defun vhdl-get-end-of-unit ()
13820  "Return position of end of current unit."
13821  (let ((pos (point)))
13822    (save-excursion
13823      (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
13824		  (save-excursion
13825		    (goto-char (match-beginning 0))
13826		    (vhdl-backward-syntactic-ws)
13827		    (and (/= (preceding-char) ?\;) (not (bobp))))))
13828      (re-search-backward "^[ \t]*end\\>" pos 1)
13829      (point))))
13830
13831(defun vhdl-match-string-downcase (num &optional string)
13832  "Like `match-string-no-properties' with down-casing."
13833  (let ((match (match-string-no-properties num string)))
13834    (and match (downcase match))))
13835
13836
13837;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13838;; Scan functions
13839
13840(defun vhdl-scan-context-clause ()
13841  "Scan the context clause that precedes a design unit."
13842  (let (lib-alist)
13843    (save-excursion
13844      (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t)
13845	(while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
13846		    (equal "USE" (upcase (match-string 1))))
13847	  (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
13848	    (push (cons (match-string-no-properties 1)
13849					(vhdl-match-string-downcase 2))
13850		  lib-alist)))))
13851    lib-alist))
13852
13853(defun vhdl-scan-directory-contents (name &optional project update num-string
13854					  non-final)
13855  "Scan contents of VHDL files in directory or file pattern NAME."
13856  (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
13857  (let* ((dir-name (match-string 1 name))
13858	 (file-pattern (match-string 2 name))
13859	 (is-directory (= 0 (length file-pattern)))
13860	 (file-list
13861	  (if update
13862	      (list name)
13863	    (if is-directory
13864		(vhdl-get-source-files t dir-name)
13865	      (vhdl-directory-files
13866	       dir-name t (wildcard-to-regexp file-pattern)))))
13867	 (key (or project dir-name))
13868	 (file-exclude-regexp
13869	  (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
13870	 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
13871	 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
13872	 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
13873	 ent-alist conf-alist pack-alist ent-inst-list file-alist
13874	 tmp-list tmp-entry no-files files-exist big-files)
13875    (when (or project update)
13876      (setq ent-alist (vhdl-aget vhdl-entity-alist key)
13877	    conf-alist (vhdl-aget vhdl-config-alist key)
13878	    pack-alist (vhdl-aget vhdl-package-alist key)
13879	    ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key))
13880	    file-alist (vhdl-aget vhdl-file-alist key)))
13881    (when (and (not is-directory) (null file-list))
13882      (message "No such file: \"%s\"" name))
13883    (setq files-exist file-list)
13884    (when file-list
13885      (setq no-files (length file-list))
13886      (message "Scanning %s %s\"%s\"..."
13887	       (if is-directory "directory" "files") (or num-string "") name)
13888      ;; exclude files
13889      (unless (equal file-exclude-regexp "")
13890	(let ((case-fold-search nil)
13891	      file-tmp-list)
13892	  (while file-list
13893	    (unless (string-match file-exclude-regexp (car file-list))
13894	      (push (car file-list) file-tmp-list))
13895	    (setq file-list (cdr file-list)))
13896	  (setq file-list (nreverse file-tmp-list))))
13897      ;; do for all files
13898      (while file-list
13899	(unless noninteractive
13900	  (message "Scanning %s %s\"%s\"... (%2d%%)"
13901		   (if is-directory "directory" "files")
13902		   (or num-string "") name
13903		   (floor (* 100.0 (- no-files (length file-list))) no-files)))
13904	(let ((file-name (abbreviate-file-name (car file-list)))
13905	      ent-list arch-list arch-ent-list conf-list
13906	      pack-list pack-body-list inst-list inst-ent-list)
13907	  ;; scan file
13908	  (vhdl-visit-file
13909	      file-name nil
13910	   (vhdl-prepare-search-2
13911	    (save-excursion
13912	      ;; scan for design units
13913	      (if (and limit-design-file-size
13914		       (< limit-design-file-size (buffer-size)))
13915		  (progn (message "WARNING:  Scan limit (design units: file size) reached in file:\n  \"%s\"" file-name)
13916			 (setq big-files t))
13917		;; scan for entities
13918		(goto-char (point-min))
13919		(while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13920		  (let* ((ent-name (match-string-no-properties 1))
13921			 (ent-key (downcase ent-name))
13922			 (ent-entry (vhdl-aget ent-alist ent-key))
13923			 (lib-alist (vhdl-scan-context-clause)))
13924		    (if (nth 1 ent-entry)
13925			(vhdl-warning-when-idle
13926			 "Entity declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13927			 ent-name  (nth 1 ent-entry) (nth 2 ent-entry)
13928			 file-name (vhdl-current-line))
13929		      (push ent-key ent-list)
13930		      (vhdl-aput 'ent-alist ent-key
13931				 (list ent-name file-name (vhdl-current-line)
13932				       (nth 3 ent-entry) (nth 4 ent-entry)
13933				       lib-alist)))))
13934		;; scan for architectures
13935		(goto-char (point-min))
13936		(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)
13937		  (let* ((arch-name (match-string-no-properties 1))
13938			 (arch-key (downcase arch-name))
13939			 (ent-name (match-string-no-properties 2))
13940			 (ent-key (downcase ent-name))
13941			 (ent-entry (vhdl-aget ent-alist ent-key))
13942			 (arch-alist (nth 3 ent-entry))
13943			 (arch-entry (vhdl-aget arch-alist arch-key))
13944			 (lib-arch-alist (vhdl-scan-context-clause)))
13945		    (if arch-entry
13946			(vhdl-warning-when-idle
13947			 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13948			 arch-name ent-name (nth 1 arch-entry)
13949			 (nth 2 arch-entry) file-name (vhdl-current-line))
13950		      (setq arch-list (cons arch-key arch-list)
13951			    arch-ent-list (cons ent-key arch-ent-list))
13952		      (vhdl-aput 'arch-alist arch-key
13953				 (list arch-name file-name (vhdl-current-line)
13954				       nil lib-arch-alist))
13955		      (vhdl-aput 'ent-alist ent-key
13956				 (list (or (nth 0 ent-entry) ent-name)
13957				       (nth 1 ent-entry) (nth 2 ent-entry)
13958				       (vhdl-sort-alist arch-alist)
13959				       arch-key (nth 5 ent-entry))))))
13960		;; scan for configurations
13961		(goto-char (point-min))
13962		(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)
13963		  (let* ((conf-name (match-string-no-properties 1))
13964			 (conf-key (downcase conf-name))
13965			 (conf-entry (vhdl-aget conf-alist conf-key))
13966			 (ent-name (match-string-no-properties 2))
13967			 (ent-key (downcase ent-name))
13968			 (lib-alist (vhdl-scan-context-clause))
13969			 (conf-line (vhdl-current-line))
13970			 (end-of-unit (vhdl-get-end-of-unit))
13971			 arch-key comp-conf-list inst-key-list
13972			 inst-comp-key inst-ent-key inst-arch-key
13973			 inst-conf-key inst-lib-key)
13974		    (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
13975		      (setq arch-key (vhdl-match-string-downcase 1)))
13976		    (if conf-entry
13977			(vhdl-warning-when-idle
13978			 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13979			 conf-name ent-name (nth 1 conf-entry)
13980			 (nth 2 conf-entry) file-name conf-line)
13981		      (push conf-key conf-list)
13982		      ;; scan for subconfigurations and subentities
13983		      (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)
13984			(setq inst-comp-key (vhdl-match-string-downcase 3)
13985			      inst-key-list (split-string
13986					     (vhdl-match-string-downcase 1)
13987					     "[ \t\n\r\f]*,[ \t\n\r\f]*"))
13988			(vhdl-forward-syntactic-ws)
13989			(when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
13990			  (setq
13991			   inst-lib-key (vhdl-match-string-downcase 3)
13992			   inst-ent-key (and (match-string 2)
13993					     (vhdl-match-string-downcase 4))
13994			   inst-arch-key (and (match-string 2)
13995					      (vhdl-match-string-downcase 6))
13996			   inst-conf-key (and (not (match-string 2))
13997					      (vhdl-match-string-downcase 4)))
13998			  (while inst-key-list
13999			    (setq comp-conf-list
14000				  (cons (list (car inst-key-list)
14001					      inst-comp-key inst-ent-key
14002					      inst-arch-key inst-conf-key
14003					      inst-lib-key)
14004					comp-conf-list))
14005			    (setq inst-key-list (cdr inst-key-list)))))
14006		      (vhdl-aput 'conf-alist conf-key
14007				 (list conf-name file-name conf-line ent-key
14008				       arch-key comp-conf-list lib-alist)))))
14009		;; scan for packages
14010		(goto-char (point-min))
14011		(while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
14012		  (let* ((pack-name (match-string-no-properties 2))
14013			 (pack-key (downcase pack-name))
14014			 (is-body (match-string-no-properties 1))
14015			 (pack-entry (vhdl-aget pack-alist pack-key))
14016			 (pack-line (vhdl-current-line))
14017			 (end-of-unit (vhdl-get-end-of-unit))
14018			 comp-name func-name comp-alist func-alist lib-alist)
14019		    (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14020			(vhdl-warning-when-idle
14021			 "Package%s declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
14022			 (if is-body " body" "") pack-name
14023			 (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14024			 (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
14025			 file-name (vhdl-current-line))
14026		      ;; scan for context clauses
14027		      (setq lib-alist (vhdl-scan-context-clause))
14028		      ;; scan for component and subprogram declarations/bodies
14029		      (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
14030			(if (equal (upcase (match-string 1)) "COMPONENT")
14031			    (setq comp-name (match-string-no-properties 2)
14032				  comp-alist
14033				  (cons (list (downcase comp-name) comp-name
14034					      file-name (vhdl-current-line))
14035					comp-alist))
14036			  (setq func-name (match-string-no-properties 2)
14037				func-alist
14038				(cons (list (downcase func-name) func-name
14039					    file-name (vhdl-current-line))
14040				      func-alist))))
14041		      (setq func-alist (nreverse func-alist))
14042		      (setq comp-alist (nreverse comp-alist))
14043		      (if is-body
14044			  (push pack-key pack-body-list)
14045			(push pack-key pack-list))
14046		      (vhdl-aput
14047		       'pack-alist pack-key
14048		       (if is-body
14049			   (list (or (nth 0 pack-entry) pack-name)
14050				 (nth 1 pack-entry) (nth 2 pack-entry)
14051				 (nth 3 pack-entry) (nth 4 pack-entry)
14052				 (nth 5 pack-entry)
14053				 file-name pack-line func-alist lib-alist)
14054			 (list pack-name file-name pack-line
14055			       comp-alist func-alist lib-alist
14056			       (nth 6 pack-entry) (nth 7 pack-entry)
14057			       (nth 8 pack-entry) (nth 9 pack-entry))))))))
14058	      ;; scan for hierarchy
14059	      (if (and limit-hier-file-size
14060		       (< limit-hier-file-size (buffer-size)))
14061		  (progn (message "WARNING:  Scan limit (hierarchy: file size) reached in file:\n  \"%s\"" file-name)
14062			 (setq big-files t))
14063		;; scan for architectures
14064		(goto-char (point-min))
14065		(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)
14066		  (let* ((ent-name (match-string-no-properties 2))
14067			 (ent-key (downcase ent-name))
14068			 (arch-name (match-string-no-properties 1))
14069			 (arch-key (downcase arch-name))
14070			 (ent-entry (vhdl-aget ent-alist ent-key))
14071			 (arch-alist (nth 3 ent-entry))
14072			 (arch-entry (vhdl-aget arch-alist arch-key))
14073			 (beg-of-unit (point))
14074			 (end-of-unit (vhdl-get-end-of-unit))
14075			 (inst-no 0)
14076			 inst-alist inst-path)
14077		    ;; scan for contained instantiations
14078		    (while (and (re-search-forward
14079				 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
14080					 "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
14081					 "component[ \t\n\r\f]+\\(\\w+\\)\\|"
14082					 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
14083					 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
14084					 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)")
14085				 end-of-unit t)
14086				(or (not limit-hier-inst-no)
14087				    (<= (if (or (match-string 14)
14088						(match-string 16))
14089					    inst-no
14090					  (setq inst-no (1+ inst-no)))
14091					limit-hier-inst-no)))
14092		      (cond
14093		       ;; block/generate beginning found
14094		       ((match-string 14)
14095			(setq inst-path
14096			      (cons (match-string-no-properties 1) inst-path)))
14097		       ;; block/generate end found
14098		       ((match-string 16)
14099			(setq inst-path (cdr inst-path)))
14100		       ;; instantiation found
14101		       (t
14102			(let* ((inst-name (match-string-no-properties 1))
14103			       (inst-key (downcase inst-name))
14104			       (inst-comp-name
14105				(or (match-string-no-properties 3)
14106				    (match-string-no-properties 6)))
14107			       (inst-ent-key
14108				(or (and (match-string 8)
14109					 (vhdl-match-string-downcase 11))
14110				    (and inst-comp-name
14111					 (downcase inst-comp-name))))
14112			       (inst-arch-key (vhdl-match-string-downcase 13))
14113			       (inst-conf-key
14114				(and (not (match-string 8))
14115				     (vhdl-match-string-downcase 11)))
14116			       (inst-lib-key (vhdl-match-string-downcase 10)))
14117			  (goto-char (match-end 1))
14118			  (setq inst-list (cons inst-key inst-list)
14119				inst-ent-list
14120				(cons inst-ent-key inst-ent-list))
14121			  (setq inst-alist
14122				(append
14123				 inst-alist
14124				 (list (list inst-key inst-name file-name
14125					     (vhdl-current-line) inst-comp-name
14126					     inst-ent-key inst-arch-key
14127					     inst-conf-key inst-lib-key
14128					     (reverse inst-path)))))))))
14129		    ;; scan for contained configuration specifications
14130		    (goto-char beg-of-unit)
14131		    (while (re-search-forward
14132			    (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]*\\)*"
14133				    "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t)
14134		      (let* ((inst-comp-name (match-string-no-properties 3))
14135			     (inst-ent-key
14136			      (and (match-string 6)
14137				   (vhdl-match-string-downcase 9)))
14138			     (inst-arch-key (vhdl-match-string-downcase 11))
14139			     (inst-conf-key
14140			      (and (not (match-string 6))
14141				   (vhdl-match-string-downcase 9)))
14142			     (inst-lib-key (vhdl-match-string-downcase 8))
14143			     (inst-key-list
14144			      (split-string (vhdl-match-string-downcase 1)
14145					    "[ \t\n\r\f]*,[ \t\n\r\f]*"))
14146			     (tmp-inst-alist inst-alist)
14147			     inst-entry)
14148			(while tmp-inst-alist
14149			  (when (and (or (equal "all" (car inst-key-list))
14150					 (member (nth 0 (car tmp-inst-alist))
14151						 inst-key-list))
14152				     (equal
14153				      (downcase
14154				       (or (nth 4 (car tmp-inst-alist)) ""))
14155				      (downcase inst-comp-name)))
14156			    (setq inst-entry (car tmp-inst-alist))
14157			    (setq inst-ent-list
14158				  (cons (or inst-ent-key (nth 5 inst-entry))
14159					(vhdl-delete
14160					 (nth 5 inst-entry) inst-ent-list)))
14161			    (setq inst-entry
14162				  (list (nth 0 inst-entry) (nth 1 inst-entry)
14163					(nth 2 inst-entry) (nth 3 inst-entry)
14164					(nth 4 inst-entry)
14165					(or inst-ent-key (nth 5 inst-entry))
14166					(or inst-arch-key (nth 6 inst-entry))
14167					inst-conf-key inst-lib-key))
14168			    (setcar tmp-inst-alist inst-entry))
14169			  (setq tmp-inst-alist (cdr tmp-inst-alist)))))
14170		    ;; save in cache
14171		    (vhdl-aput 'arch-alist arch-key
14172			       (list (nth 0 arch-entry) (nth 1 arch-entry)
14173				     (nth 2 arch-entry) inst-alist
14174				     (nth 4 arch-entry)))
14175		    (vhdl-aput 'ent-alist ent-key
14176			       (list (nth 0 ent-entry) (nth 1 ent-entry)
14177				     (nth 2 ent-entry)
14178				     (vhdl-sort-alist arch-alist)
14179				     (nth 4 ent-entry) (nth 5 ent-entry)))
14180		    (when (and limit-hier-inst-no
14181			       (> inst-no limit-hier-inst-no))
14182		      (message "WARNING:  Scan limit (hierarchy: instances per architecture) reached in file:\n  \"%s\"" file-name)
14183		      (setq big-files t))
14184		    (goto-char end-of-unit))))
14185	      ;; remember design units for this file
14186	      (vhdl-aput 'file-alist file-name
14187			 (list ent-list arch-list arch-ent-list conf-list
14188			       pack-list pack-body-list
14189			       inst-list inst-ent-list))
14190	      (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
14191	(setq file-list (cdr file-list))))
14192    (when (or (and (not project) files-exist)
14193	      (and project (not non-final)))
14194      ;; consistency checks:
14195      ;; check whether each architecture has a corresponding entity
14196      (setq tmp-list ent-alist)
14197      (while tmp-list
14198	(when (null (nth 2 (car tmp-list)))
14199	  (setq tmp-entry (car (nth 4 (car tmp-list))))
14200	  (vhdl-warning-when-idle
14201	   "Architecture of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14202	   (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
14203	   (nth 3 tmp-entry)))
14204	(setq tmp-list (cdr tmp-list)))
14205      ;; check whether configuration has a corresponding entity/architecture
14206      (setq tmp-list conf-alist)
14207      (while tmp-list
14208	(if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list))))
14209	    (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)))
14210	      (setq tmp-entry (car tmp-list))
14211	      (vhdl-warning-when-idle
14212	       "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n  in \"%s\" (line %d)"
14213	       (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
14214	       (nth 2 tmp-entry) (nth 3 tmp-entry)))
14215	  (setq tmp-entry (car tmp-list))
14216	  (vhdl-warning-when-idle
14217	   "Configuration of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14218	   (nth 1 tmp-entry) (nth 4 tmp-entry)
14219	   (nth 2 tmp-entry) (nth 3 tmp-entry)))
14220	(setq tmp-list (cdr tmp-list)))
14221      ;; check whether each package body has a package declaration
14222      (setq tmp-list pack-alist)
14223      (while tmp-list
14224	(when (null (nth 2 (car tmp-list)))
14225	  (setq tmp-entry (car tmp-list))
14226	  (vhdl-warning-when-idle
14227	   "Package body of non-existing package: \"%s\"\n  in \"%s\" (line %d)"
14228	   (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
14229	(setq tmp-list (cdr tmp-list)))
14230      ;; sort lists
14231      (setq ent-alist (vhdl-sort-alist ent-alist))
14232      (setq conf-alist (vhdl-sort-alist conf-alist))
14233      (setq pack-alist (vhdl-sort-alist pack-alist))
14234      ;; remember updated directory/project
14235      (add-to-list 'vhdl-updated-project-list (or project dir-name)))
14236    ;; clear directory alists
14237    (unless project
14238      (vhdl-adelete 'vhdl-entity-alist key)
14239      (vhdl-adelete 'vhdl-config-alist key)
14240      (vhdl-adelete 'vhdl-package-alist key)
14241      (vhdl-adelete 'vhdl-ent-inst-alist key)
14242      (vhdl-adelete 'vhdl-file-alist key))
14243    ;; put directory contents into cache
14244    (vhdl-aput 'vhdl-entity-alist key ent-alist)
14245    (vhdl-aput 'vhdl-config-alist key conf-alist)
14246    (vhdl-aput 'vhdl-package-alist key pack-alist)
14247    (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
14248    (vhdl-aput 'vhdl-file-alist key file-alist)
14249    ;; final messages
14250    (message "Scanning %s %s\"%s\"...done"
14251	     (if is-directory "directory" "files") (or num-string "") name)
14252    (unless project (message "Scanning directory...done"))
14253    (when big-files
14254      (vhdl-warning-when-idle "Scanning is incomplete.\n  --> see user option `vhdl-speedbar-scan-limit'"))
14255    ;; save cache when scanned non-interactively
14256    (when (or (not project) (not non-final))
14257      (when (and noninteractive vhdl-speedbar-save-cache)
14258	(vhdl-save-cache key)))
14259    t))
14260
14261(defun vhdl-scan-project-contents (project)
14262  "Scan the contents of all VHDL files found in the directories and files
14263of PROJECT."
14264  (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
14265	(default-dir (vhdl-resolve-env-variable
14266		      (nth 1 (vhdl-aget vhdl-project-alist project))))
14267	(file-exclude-regexp
14268	 (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
14269	dir-list-tmp dir dir-name num-dir act-dir recursive)
14270    ;; clear project alists
14271    (vhdl-adelete 'vhdl-entity-alist project)
14272    (vhdl-adelete 'vhdl-config-alist project)
14273    (vhdl-adelete 'vhdl-package-alist project)
14274    (vhdl-adelete 'vhdl-ent-inst-alist project)
14275    (vhdl-adelete 'vhdl-file-alist project)
14276    ;; expand directory names by default-directory
14277    (message "Collecting source files...")
14278    (while dir-list
14279      (setq dir (vhdl-resolve-env-variable (car dir-list)))
14280      (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
14281      (setq recursive (match-string 1 dir)
14282	    dir-name (match-string 3 dir))
14283      (setq dir-list-tmp
14284	    (cons (concat recursive
14285			  (if (file-name-absolute-p dir-name) "" default-dir)
14286			  dir-name)
14287		  dir-list-tmp))
14288      (setq dir-list (cdr dir-list)))
14289    ;; resolve path wildcards
14290    (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
14291    ;; expand directories
14292    (while dir-list-tmp
14293      (setq dir (car dir-list-tmp))
14294      ;; get subdirectories
14295      (if (string-match "-r \\(.*[/\\]\\)" dir)
14296	  (setq dir-list (append dir-list (vhdl-get-subdirs
14297					   (match-string 1 dir))))
14298	(setq dir-list (append dir-list (list dir))))
14299      (setq dir-list-tmp (cdr dir-list-tmp)))
14300    ;; exclude files
14301    (unless (equal file-exclude-regexp "")
14302      (let ((case-fold-search nil))
14303	(while dir-list
14304	  (unless (string-match file-exclude-regexp (car dir-list))
14305	    (push (car dir-list) dir-list-tmp))
14306	  (setq dir-list (cdr dir-list)))
14307	(setq dir-list (nreverse dir-list-tmp))))
14308    (message "Collecting source files...done")
14309    ;; scan for design units for each directory in DIR-LIST
14310    (setq dir-list-tmp nil
14311	  num-dir (length dir-list)
14312	  act-dir 1)
14313    (while dir-list
14314      (setq dir-name (abbreviate-file-name
14315		      (expand-file-name (car dir-list))))
14316      (vhdl-scan-directory-contents dir-name project nil
14317				    (format "(%s/%s) " act-dir num-dir)
14318				    (cdr dir-list))
14319      (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal)
14320      (setq dir-list (cdr dir-list)
14321	    act-dir (1+ act-dir)))
14322    (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
14323    (message "Scanning project \"%s\"...done" project)))
14324
14325(defun vhdl-update-file-contents (file-name)
14326  "Update hierarchy information by contents of current buffer."
14327  (setq file-name (abbreviate-file-name file-name))
14328  (let* ((dir-name (file-name-directory file-name))
14329	 (directory-alist vhdl-directory-alist)
14330	 updated)
14331    (while directory-alist
14332      (when (member dir-name (nth 1 (car directory-alist)))
14333	(let* ((vhdl-project (nth 0 (car directory-alist)))
14334	       (project (vhdl-project-p))
14335	       (ent-alist (vhdl-aget vhdl-entity-alist
14336				     (or project dir-name)))
14337	       (conf-alist (vhdl-aget vhdl-config-alist
14338				      (or project dir-name)))
14339	       (pack-alist (vhdl-aget vhdl-package-alist
14340				      (or project dir-name)))
14341	       (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
14342					 (or project dir-name))))
14343	       (file-alist (vhdl-aget vhdl-file-alist (or project dir-name)))
14344	       (file-entry (vhdl-aget file-alist file-name))
14345	       (ent-list (nth 0 file-entry))
14346	       (arch-list (nth 1 file-entry))
14347	       (arch-ent-list (nth 2 file-entry))
14348	       (conf-list (nth 3 file-entry))
14349	       (pack-list (nth 4 file-entry))
14350	       (pack-body-list (nth 5 file-entry))
14351	       (inst-ent-list (nth 7 file-entry))
14352	       (cache-key (or project dir-name))
14353	       arch-alist key ent-key entry)
14354	  ;; delete design units previously contained in this file:
14355	  ;; entities
14356	  (while ent-list
14357	    (setq key (car ent-list)
14358		  entry (vhdl-aget ent-alist key))
14359	    (when (equal file-name (nth 1 entry))
14360	      (if (nth 3 entry)
14361		  (vhdl-aput 'ent-alist key
14362			     (list (nth 0 entry) nil nil (nth 3 entry) nil))
14363		(vhdl-adelete 'ent-alist key)))
14364	    (setq ent-list (cdr ent-list)))
14365	  ;; architectures
14366	  (while arch-list
14367	    (setq key (car arch-list)
14368		  ent-key (car arch-ent-list)
14369		  entry (vhdl-aget ent-alist ent-key)
14370		  arch-alist (nth 3 entry))
14371	    (when (equal file-name (nth 1 (vhdl-aget arch-alist key)))
14372	      (vhdl-adelete 'arch-alist key)
14373	      (if (or (nth 1 entry) arch-alist)
14374		  (vhdl-aput 'ent-alist ent-key
14375			     (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14376				   arch-alist (nth 4 entry) (nth 5 entry)))
14377		(vhdl-adelete 'ent-alist ent-key)))
14378	    (setq arch-list (cdr arch-list)
14379		  arch-ent-list (cdr arch-ent-list)))
14380	  ;; configurations
14381	  (while conf-list
14382	    (setq key (car conf-list))
14383	    (when (equal file-name (nth 1 (vhdl-aget conf-alist key)))
14384	      (vhdl-adelete 'conf-alist key))
14385	    (setq conf-list (cdr conf-list)))
14386	  ;; package declarations
14387	  (while pack-list
14388	    (setq key (car pack-list)
14389		  entry (vhdl-aget pack-alist key))
14390	    (when (equal file-name (nth 1 entry))
14391	      (if (nth 6 entry)
14392		  (vhdl-aput 'pack-alist key
14393			     (list (nth 0 entry) nil nil nil nil nil
14394				   (nth 6 entry) (nth 7 entry) (nth 8 entry)
14395				   (nth 9 entry)))
14396		(vhdl-adelete 'pack-alist key)))
14397	    (setq pack-list (cdr pack-list)))
14398	  ;; package bodies
14399	  (while pack-body-list
14400	    (setq key (car pack-body-list)
14401		  entry (vhdl-aget pack-alist key))
14402	    (when (equal file-name (nth 6 entry))
14403	      (if (nth 1 entry)
14404		  (vhdl-aput 'pack-alist key
14405			     (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14406				   (nth 3 entry) (nth 4 entry) (nth 5 entry)
14407				   nil nil nil nil))
14408		(vhdl-adelete 'pack-alist key)))
14409	    (setq pack-body-list (cdr pack-body-list)))
14410	  ;; instantiated entities
14411	  (while inst-ent-list
14412	    (setq ent-inst-list
14413		  (vhdl-delete (car inst-ent-list) ent-inst-list))
14414	    (setq inst-ent-list (cdr inst-ent-list)))
14415	  ;; update caches
14416	  (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
14417	  (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
14418	  (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
14419	  (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
14420	  ;; scan file
14421	  (vhdl-scan-directory-contents file-name project t)
14422	  (when (or (and vhdl-speedbar-show-projects project)
14423		    (and (not vhdl-speedbar-show-projects) (not project)))
14424	    (vhdl-speedbar-refresh project))
14425	  (setq updated t)))
14426      (setq directory-alist (cdr directory-alist)))
14427    updated))
14428
14429(defun vhdl-update-hierarchy ()
14430  "Update directory and hierarchy information in speedbar."
14431  (let ((file-list (reverse vhdl-modified-file-list))
14432	updated)
14433    (when (and vhdl-speedbar-update-on-saving file-list)
14434      (while file-list
14435	(setq updated
14436	      (or (vhdl-update-file-contents (car file-list))
14437		  updated))
14438	(setq file-list (cdr file-list)))
14439      (setq vhdl-modified-file-list nil)
14440      (vhdl-speedbar-update-current-unit)
14441      (when updated (message "Updating hierarchy...done")))))
14442
14443;; structure (parenthesized expression means list of such entries)
14444;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
14445;;  comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
14446;;  comp-lib-name level)
14447(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key
14448			    conf-key-arg conf-inst-alist level indent
14449			    &optional include-top ent-hier)
14450  "Get instantiation hierarchy beginning in architecture ARCH-KEY of
14451entity ENT-KEY."
14452  (let* ((ent-alist ent-alist-arg)
14453	 (conf-alist conf-alist-arg)
14454	 (conf-key conf-key-arg)
14455	 (ent-entry (vhdl-aget ent-alist ent-key))
14456	 (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
14457		       (cdar (last (nth 3 ent-entry)))))
14458	 (inst-alist (nth 3 arch-entry))
14459	 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
14460	 hier-list subcomp-list tmp-list inst-key inst-comp-name
14461	 inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
14462    (when (= level 0) (message "Extract design hierarchy..."))
14463    (when include-top
14464      (setq level (1+ level)))
14465    (when (member ent-key ent-hier)
14466      (error "ERROR:  Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
14467    ;; process all instances
14468    (while inst-alist
14469      (setq inst-entry (car inst-alist)
14470	    inst-key (nth 0 inst-entry)
14471	    inst-comp-name (nth 4 inst-entry)
14472	    inst-conf-key (nth 7 inst-entry))
14473      ;; search entry in configuration's instantiations list
14474      (setq tmp-list conf-inst-alist)
14475      (while (and tmp-list
14476		  (not (and (member (nth 0 (car tmp-list))
14477				    (list "all" inst-key))
14478			    (equal (nth 1 (car tmp-list))
14479				   (downcase (or inst-comp-name ""))))))
14480	(setq tmp-list (cdr tmp-list)))
14481      (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
14482      (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key))
14483      (when (and inst-conf-key (not inst-conf-entry))
14484	(vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
14485      ;; determine entity
14486      (setq inst-ent-key
14487	    (or (nth 2 (car tmp-list))	; from configuration
14488		(nth 3 inst-conf-entry) ; from subconfiguration
14489		(nth 3 (vhdl-aget conf-alist (nth 7 inst-entry)))
14490					; from configuration spec.
14491		(nth 5 inst-entry)))	; from direct instantiation
14492      (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key))
14493      ;; determine architecture
14494      (setq inst-arch-key
14495	    (or (nth 3 (car tmp-list))		; from configuration
14496		(nth 4 inst-conf-entry)		; from subconfiguration
14497		(nth 6 inst-entry)		; from direct instantiation
14498		(nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
14499						; from configuration spec.
14500		(nth 4 inst-ent-entry)		; MRA
14501		(caar (nth 3 inst-ent-entry))))	; first alphabetically
14502      (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key))
14503      ;; set library
14504      (setq inst-lib-key
14505	    (or (nth 5 (car tmp-list))		; from configuration
14506		(nth 8 inst-entry)))		; from direct instantiation
14507      ;; gather information for this instance
14508      (setq comp-entry
14509	    (list (nth 1 inst-entry)
14510		  (cons (nth 2 inst-entry) (nth 3 inst-entry))
14511		  (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
14512		  (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
14513		  (or (nth 0 inst-arch-entry) inst-arch-key)
14514		  (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
14515		  (or (nth 0 inst-conf-entry) inst-conf-key)
14516		  (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
14517		  inst-lib-key level))
14518      ;; get subcomponent hierarchy
14519      (setq subcomp-list (vhdl-get-hierarchy
14520			  ent-alist conf-alist
14521			  inst-ent-key inst-arch-key inst-conf-key
14522			  (nth 5 inst-conf-entry)
14523			  (1+ level) indent nil (cons ent-key ent-hier)))
14524      ;; add to list
14525      (setq hier-list (append hier-list (list comp-entry) subcomp-list))
14526      (setq inst-alist (cdr inst-alist)))
14527    (when include-top
14528      (setq hier-list
14529	    (cons (list nil nil (nth 0 ent-entry)
14530			(cons (nth 1 ent-entry) (nth 2 ent-entry))
14531			(nth 0 arch-entry)
14532			(cons (nth 1 arch-entry) (nth 2 arch-entry))
14533			nil nil
14534			nil (1- level))
14535		  hier-list)))
14536    (when (or (= level 0) (and include-top (= level 1))) (message ""))
14537    hier-list))
14538
14539(defun vhdl-get-instantiations (ent-key indent)
14540  "Get all instantiations of entity ENT-KEY."
14541  (let ((ent-alist (vhdl-aget vhdl-entity-alist
14542			      (vhdl-speedbar-line-key indent)))
14543	arch-alist inst-alist ent-inst-list
14544	ent-entry arch-entry inst-entry)
14545    (while ent-alist
14546      (setq ent-entry (car ent-alist))
14547      (setq arch-alist (nth 4 ent-entry))
14548      (while arch-alist
14549	(setq arch-entry (car arch-alist))
14550	(setq inst-alist (nth 4 arch-entry))
14551	(while inst-alist
14552	  (setq inst-entry (car inst-alist))
14553	  (when (equal ent-key (nth 5 inst-entry))
14554	    (setq ent-inst-list
14555		  (cons (list (nth 1 inst-entry)
14556			      (cons (nth 2 inst-entry) (nth 3 inst-entry))
14557			      (nth 1 ent-entry)
14558			      (cons (nth 2 ent-entry) (nth 3 ent-entry))
14559			      (nth 1 arch-entry)
14560			      (cons (nth 2 arch-entry) (nth 3 arch-entry)))
14561			ent-inst-list)))
14562	  (setq inst-alist (cdr inst-alist)))
14563	(setq arch-alist (cdr arch-alist)))
14564      (setq ent-alist (cdr ent-alist)))
14565    (nreverse ent-inst-list)))
14566
14567;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14568;; Caching in file
14569
14570(defun vhdl-save-caches ()
14571  "Save all updated hierarchy caches to file."
14572  (interactive)
14573  (condition-case nil
14574      (when vhdl-speedbar-save-cache
14575	;; update hierarchy
14576	(vhdl-update-hierarchy)
14577	(let ((project-list vhdl-updated-project-list))
14578	  (message "Saving hierarchy caches...")
14579	  ;; write updated project caches
14580	  (while project-list
14581	    (vhdl-save-cache (car project-list))
14582	    (setq project-list (cdr project-list)))
14583	  (message "Saving hierarchy caches...done")))
14584    (error (progn (vhdl-warning "ERROR:  An error occurred while saving the hierarchy caches")
14585		  (sit-for 2)))))
14586
14587(defvar vhdl-cache-version)
14588
14589(defun vhdl-save-cache (key)
14590  "Save current hierarchy cache to file."
14591  (let* ((orig-buffer (current-buffer))
14592	 (vhdl-project key)
14593	 (project (vhdl-project-p))
14594	 (default-directory key)
14595	 (directory (abbreviate-file-name (vhdl-default-directory)))
14596	 (file-name (vhdl-resolve-env-variable
14597		     (vhdl-replace-string
14598		      (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14599		      (concat
14600		       (subst-char-in-string ?  ?_ (or project "dir"))
14601		       " " (user-login-name)))))
14602	 (file-dir-name (expand-file-name file-name directory))
14603	 (cache-key (or project directory))
14604	 (key (if project "project" "directory")))
14605    (unless (file-exists-p (file-name-directory file-dir-name))
14606      (make-directory (file-name-directory file-dir-name) t))
14607    (if (not (file-writable-p file-dir-name))
14608	(progn (vhdl-warning (format "File not writable: \"%s\""
14609				     (abbreviate-file-name file-dir-name)))
14610	       (sit-for 2))
14611      (message "Saving cache: \"%s\"" file-dir-name)
14612      (set-buffer (find-file-noselect file-dir-name t t))
14613      (erase-buffer)
14614      (insert ";; -*- Emacs-Lisp -*-\n\n"
14615	      ";;; " (file-name-nondirectory file-name)
14616	      " - design hierarchy cache file for Emacs VHDL Mode "
14617	      vhdl-version "\n")
14618      (insert "\n;; " (if project "Project  " "Directory") " : ")
14619      (if project (insert project) (prin1 directory (current-buffer)))
14620      (insert "\n;; Saved     : " (format-time-string "%Y-%m-%d %T ")
14621	      (user-login-name) "\n\n"
14622	      "\n;; version number\n"
14623	      "(setq vhdl-cache-version \"" vhdl-version "\")\n"
14624	      "\n;; " (if project "project" "directory") " name"
14625	      "\n(setq " key " ")
14626      (prin1 (or project directory) (current-buffer))
14627      (insert ")\n")
14628      (when (member 'hierarchy vhdl-speedbar-save-cache)
14629	(insert "\n;; entity and architecture cache\n"
14630		"(vhdl-aput 'vhdl-entity-alist " key " '")
14631	(print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
14632	(insert ")\n\n;; configuration cache\n"
14633		"(vhdl-aput 'vhdl-config-alist " key " '")
14634	(print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
14635	(insert ")\n\n;; package cache\n"
14636		"(vhdl-aput 'vhdl-package-alist " key " '")
14637	(print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
14638	(insert ")\n\n;; instantiated entities cache\n"
14639		"(vhdl-aput 'vhdl-ent-inst-alist " key " '")
14640	(print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
14641	(insert ")\n\n;; design units per file cache\n"
14642		"(vhdl-aput 'vhdl-file-alist " key " '")
14643	(print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
14644	(when project
14645	  (insert ")\n\n;; source directories in project cache\n"
14646		  "(vhdl-aput 'vhdl-directory-alist " key " '")
14647	  (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
14648	(insert ")\n"))
14649      (when (member 'display vhdl-speedbar-save-cache)
14650	(insert "\n;; shown design units cache\n"
14651		"(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
14652	(print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
14653	       (current-buffer))
14654	(insert ")\n"))
14655      (setq vhdl-updated-project-list
14656	    (delete cache-key vhdl-updated-project-list))
14657      (save-buffer)
14658      (kill-buffer (current-buffer))
14659      (set-buffer orig-buffer))))
14660
14661(defun vhdl-load-cache (key)
14662  "Load hierarchy cache information from file."
14663  (let* ((vhdl-project key)
14664	 (default-directory key)
14665	 (directory (vhdl-default-directory))
14666	 (file-name (vhdl-resolve-env-variable
14667		     (vhdl-replace-string
14668		      (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14669		      (concat
14670		       (subst-char-in-string ?  ?_ (or (vhdl-project-p) "dir"))
14671		       " " (user-login-name)))))
14672	 (file-dir-name (expand-file-name file-name directory))
14673	 vhdl-cache-version)
14674    (unless (memq 'vhdl-save-caches kill-emacs-hook)
14675      (add-hook 'kill-emacs-hook #'vhdl-save-caches))
14676    (when (file-exists-p file-dir-name)
14677      (condition-case ()
14678	  (progn (load-file file-dir-name)
14679		 (string< (mapconcat
14680			   (lambda (a) (format "%3d" (string-to-number a)))
14681			   (split-string "3.33" "\\.") "")
14682			  (mapconcat
14683			   (lambda (a) (format "%3d" (string-to-number a)))
14684			   (split-string vhdl-cache-version "\\.") "")))
14685	(error (progn (vhdl-warning (format "ERROR:  Corrupted cache file: \"%s\"" file-dir-name))
14686		      nil))))))
14687
14688(defun vhdl-require-hierarchy-info ()
14689  "Make sure that hierarchy information is available.  Load cache or scan files
14690if required."
14691  (if (vhdl-project-p)
14692      (unless (or (assoc vhdl-project vhdl-file-alist)
14693		  (vhdl-load-cache vhdl-project))
14694	(vhdl-scan-project-contents vhdl-project))
14695    (let ((directory (abbreviate-file-name default-directory)))
14696      (unless (or (assoc directory vhdl-file-alist)
14697		  (vhdl-load-cache directory))
14698	(vhdl-scan-directory-contents directory)))))
14699
14700;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14701;; Add hierarchy browser functionality to speedbar
14702
14703(defvar vhdl-speedbar-mode-map nil
14704  "Keymap used when in the VHDL hierarchy browser mode.")
14705
14706(defvar vhdl-speedbar-menu-items nil
14707  "Additional menu-items to add to speedbar frame.")
14708
14709(declare-function speedbar-add-supported-extension "speedbar" (extension))
14710(declare-function speedbar-add-mode-functions-list "speedbar" (new-list))
14711(declare-function speedbar-make-specialized-keymap "speedbar" ())
14712(declare-function speedbar-change-initial-expansion-list "speedbar"
14713		  (new-default))
14714(declare-function speedbar-add-expansion-list "speedbar" (new-list))
14715(declare-function speedbar-expand-line "speedbar" (&optional arg))
14716(declare-function speedbar-edit-line "speedbar" ())
14717
14718(defun vhdl-speedbar-initialize ()
14719  "Initialize speedbar."
14720  ;; general settings
14721  ;; VHDL file extensions (extracted from `auto-mode-alist')
14722  (let ((mode-alist auto-mode-alist))
14723    (while mode-alist
14724      (when (eq (cdar mode-alist) 'vhdl-mode)
14725	(speedbar-add-supported-extension (caar mode-alist)))
14726      (setq mode-alist (cdr mode-alist))))
14727  ;; hierarchy browser settings
14728  (when (boundp 'speedbar-mode-functions-list)
14729    ;; special functions
14730    (speedbar-add-mode-functions-list
14731     '("vhdl directory"
14732       (speedbar-item-info . vhdl-speedbar-item-info)
14733       (speedbar-line-directory . speedbar-files-line-directory)))
14734    (speedbar-add-mode-functions-list
14735     '("vhdl project"
14736       (speedbar-item-info . vhdl-speedbar-item-info)
14737       (speedbar-line-directory . vhdl-speedbar-line-project)))
14738    ;; keymap
14739    (unless vhdl-speedbar-mode-map
14740      (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
14741      (define-key vhdl-speedbar-mode-map "e" #'speedbar-edit-line)
14742      (define-key vhdl-speedbar-mode-map "\C-m" #'speedbar-edit-line)
14743      (define-key vhdl-speedbar-mode-map "+" #'speedbar-expand-line)
14744      (define-key vhdl-speedbar-mode-map "=" #'speedbar-expand-line)
14745      (define-key vhdl-speedbar-mode-map "-" #'vhdl-speedbar-contract-level)
14746      (define-key vhdl-speedbar-mode-map "_" #'vhdl-speedbar-contract-all)
14747      (define-key vhdl-speedbar-mode-map "C" #'vhdl-speedbar-port-copy)
14748      (define-key vhdl-speedbar-mode-map "P" #'vhdl-speedbar-place-component)
14749      (define-key vhdl-speedbar-mode-map "F" #'vhdl-speedbar-configuration)
14750      (define-key vhdl-speedbar-mode-map "A" #'vhdl-speedbar-select-mra)
14751      (define-key vhdl-speedbar-mode-map "K" #'vhdl-speedbar-make-design)
14752      (define-key vhdl-speedbar-mode-map "R" #'vhdl-speedbar-rescan-hierarchy)
14753      (define-key vhdl-speedbar-mode-map "S" #'vhdl-save-caches)
14754      (let ((key 0))
14755	(while (<= key 9)
14756	  (define-key vhdl-speedbar-mode-map (int-to-string key)
14757	    `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
14758	  (setq key (1+ key)))))
14759    (define-key speedbar-mode-map "h"
14760      (lambda () (interactive)
14761	(speedbar-change-initial-expansion-list "vhdl directory")))
14762    (define-key speedbar-mode-map "H"
14763      (lambda () (interactive)
14764	(speedbar-change-initial-expansion-list "vhdl project")))
14765    ;; menu
14766    (unless vhdl-speedbar-menu-items
14767      (setq
14768       vhdl-speedbar-menu-items
14769       `(["Edit" speedbar-edit-line t]
14770	 ["Expand" speedbar-expand-line
14771	  (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
14772	 ["Contract" vhdl-speedbar-contract-level t]
14773	 ["Expand All" vhdl-speedbar-expand-all t]
14774	 ["Contract All" vhdl-speedbar-contract-all t]
14775	 ,(let ((key 0) (menu-list '("Hierarchy Depth")))
14776	    (while (<= key 9)
14777	      (setq menu-list
14778		    (cons `[,(if (= key 0) "All" (int-to-string key))
14779			    (vhdl-speedbar-set-depth ,key)
14780			    :style radio
14781			    :selected (= vhdl-speedbar-hierarchy-depth ,key)
14782			    :keys ,(int-to-string key)]
14783			  menu-list))
14784	      (setq key (1+ key)))
14785	    (nreverse menu-list))
14786	 "--"
14787	 ["Copy Port/Subprogram" vhdl-speedbar-port-copy
14788	  (or (vhdl-speedbar-check-unit 'entity)
14789	      (vhdl-speedbar-check-unit 'subprogram))]
14790	 ["Place Component" vhdl-speedbar-place-component
14791	  (vhdl-speedbar-check-unit 'entity)]
14792	 ["Generate Configuration" vhdl-speedbar-configuration
14793	  (vhdl-speedbar-check-unit 'architecture)]
14794	 ["Select as MRA" vhdl-speedbar-select-mra
14795	  (vhdl-speedbar-check-unit 'architecture)]
14796	 ["Make" vhdl-speedbar-make-design
14797	  (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
14798	 ["Generate Makefile" vhdl-speedbar-generate-makefile
14799	  (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
14800	 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
14801	  :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14802	  ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)]
14803	 ["Rescan Project" vhdl-speedbar-rescan-hierarchy
14804	  :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14805	  ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects]
14806	 ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
14807    ;; hook-ups
14808    (speedbar-add-expansion-list
14809     '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14810       vhdl-speedbar-display-directory))
14811    (speedbar-add-expansion-list
14812     '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14813       vhdl-speedbar-display-projects))
14814    (setq speedbar-stealthy-function-list
14815	  (append
14816	   '(("vhdl directory" vhdl-speedbar-update-current-unit)
14817	     ("vhdl project" vhdl-speedbar-update-current-project
14818	      vhdl-speedbar-update-current-unit))
14819	   speedbar-stealthy-function-list))
14820    (when (eq vhdl-speedbar-display-mode 'directory)
14821      (setq speedbar-initial-expansion-list-name "vhdl directory"))
14822    (when (eq vhdl-speedbar-display-mode 'project)
14823      (setq speedbar-initial-expansion-list-name "vhdl project"))
14824    (add-hook 'speedbar-timer-hook #'vhdl-update-hierarchy)))
14825
14826(defun vhdl-speedbar (&optional arg)
14827  "Open/close speedbar."
14828  (interactive)
14829  (if (not (fboundp 'speedbar))
14830      (error "WARNING:  Speedbar is not available or not installed")
14831    (condition-case ()
14832	(speedbar-frame-mode arg)
14833      (error (error "WARNING:  An error occurred while opening speedbar")))))
14834
14835;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14836;; Display functions
14837
14838(defvar vhdl-speedbar-last-selected-project nil
14839  "Name of last selected project.")
14840
14841;; macros must be defined in the file they are used (copied from `speedbar.el')
14842;; (defmacro speedbar-with-writable (&rest forms)
14843;;   "Allow the buffer to be writable and evaluate FORMS."
14844;;   (declare (indent 0) (debug t))
14845;;   (list 'let '((inhibit-read-only t))
14846;; 	(cons 'progn forms)))
14847
14848(declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
14849(declare-function speedbar-directory-buttons "speedbar" (directory _index))
14850(declare-function speedbar-file-lists "speedbar" (directory))
14851
14852(defun vhdl-speedbar-display-directory (directory depth &optional _rescan)
14853  "Display directory and hierarchy information in speedbar."
14854  (setq vhdl-speedbar-show-projects nil)
14855  (setq speedbar-ignored-directory-regexp
14856	(speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))
14857  (setq directory (abbreviate-file-name (file-name-as-directory directory)))
14858  (setq speedbar-last-selected-file nil)
14859  (speedbar-with-writable
14860    (condition-case nil
14861	(progn
14862	  ;; insert directory path
14863	  (speedbar-directory-buttons directory depth)
14864	  ;; insert subdirectories
14865	  (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
14866	  ;; scan and insert hierarchy of current directory
14867	  (vhdl-speedbar-insert-dir-hierarchy directory depth
14868					      speedbar-power-click)
14869	  ;; expand subdirectories
14870	  (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
14871      (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly")))))
14872
14873(defun vhdl-speedbar-display-projects (_project _depth &optional _rescan)
14874  "Display projects and hierarchy information in speedbar."
14875  (setq vhdl-speedbar-show-projects t)
14876  (setq speedbar-ignored-directory-regexp ".")
14877  (setq speedbar-last-selected-file nil)
14878  (setq vhdl-speedbar-last-selected-project nil)
14879  (speedbar-with-writable
14880    (condition-case nil
14881	;; insert projects
14882	(vhdl-speedbar-insert-projects)
14883      (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly"))))
14884  (setq speedbar-full-text-cache nil)) ; prevent caching
14885
14886(declare-function speedbar-make-tag-line "speedbar"
14887		  (type char func data tag tfunc tdata tface depth))
14888
14889(defvar vhdl-speedbar-update-current-unit)
14890
14891(defun vhdl-speedbar-insert-projects ()
14892  "Insert all projects in speedbar."
14893  (vhdl-speedbar-make-title-line "Projects:")
14894  (let ((project-alist (if vhdl-project-sort
14895			   (vhdl-sort-alist (copy-alist vhdl-project-alist))
14896			 vhdl-project-alist))
14897	(vhdl-speedbar-update-current-unit nil))
14898    ;; insert projects
14899    (while project-alist
14900      (speedbar-make-tag-line
14901       'angle ?+ #'vhdl-speedbar-expand-project
14902       (caar project-alist) (caar project-alist)
14903       #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
14904      (setq project-alist (cdr project-alist)))
14905    (setq project-alist vhdl-project-alist)
14906    ;; expand projects
14907    (while project-alist
14908      (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
14909	(goto-char (point-min))
14910	(when (re-search-forward
14911	       (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
14912	  (goto-char (match-end 1))
14913	  (speedbar-do-function-pointer)))
14914      (setq project-alist (cdr project-alist)))))
14915
14916(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
14917  "Insert hierarchy of PROJECT.
14918Rescan directories if optional argument RESCAN is non-nil,
14919otherwise use cached data."
14920  (when (or rescan (and (not (assoc project vhdl-file-alist))
14921			(not (vhdl-load-cache project))))
14922    (vhdl-scan-project-contents project))
14923  ;; insert design hierarchy
14924  (vhdl-speedbar-insert-hierarchy
14925   (vhdl-aget vhdl-entity-alist project)
14926   (vhdl-aget vhdl-config-alist project)
14927   (vhdl-aget vhdl-package-alist project)
14928   (car (vhdl-aget vhdl-ent-inst-alist project)) indent)
14929  (insert (int-to-string indent) ":\n")
14930  (put-text-property (- (point) 3) (1- (point)) 'invisible t)
14931  (put-text-property (1- (point)) (point) 'invisible nil)
14932  ;; expand design units
14933  (vhdl-speedbar-expand-units project))
14934
14935(defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
14936  "Insert hierarchy of DIRECTORY.
14937Rescan directory if optional argument RESCAN is non-nil,
14938otherwise use cached data."
14939  (when (or rescan (and (not (assoc directory vhdl-file-alist))
14940			(not (vhdl-load-cache directory))))
14941    (vhdl-scan-directory-contents directory))
14942  ;; insert design hierarchy
14943  (vhdl-speedbar-insert-hierarchy
14944   (vhdl-aget vhdl-entity-alist directory)
14945   (vhdl-aget vhdl-config-alist directory)
14946   (vhdl-aget vhdl-package-alist directory)
14947   (car (vhdl-aget vhdl-ent-inst-alist directory)) depth)
14948  ;; expand design units
14949  (vhdl-speedbar-expand-units directory)
14950  (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
14951
14952(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist
14953					ent-inst-list depth)
14954  "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14955  (if (not (or ent-alist conf-alist pack-alist))
14956      (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
14957    (let ((ent-alist ent-alist-arg)
14958          (conf-alist conf-alist-arg)
14959          ent-entry conf-entry pack-entry)
14960      ;; insert entities
14961      (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
14962      (while ent-alist
14963	(setq ent-entry (car ent-alist))
14964	(speedbar-make-tag-line
14965	 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
14966	 (nth 1 ent-entry) 'vhdl-speedbar-find-file
14967	 (cons (nth 2 ent-entry) (nth 3 ent-entry))
14968	 'vhdl-speedbar-entity-face depth)
14969	(unless (nth 2 ent-entry)
14970	  (end-of-line 0) (insert "!") (forward-char 1))
14971	(unless (member (nth 0 ent-entry) ent-inst-list)
14972	  (end-of-line 0) (insert " (top)") (forward-char 1))
14973	(setq ent-alist (cdr ent-alist)))
14974      ;; insert configurations
14975      (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
14976      (while conf-alist
14977	(setq conf-entry (car conf-alist))
14978	(speedbar-make-tag-line
14979	 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
14980	 (nth 1 conf-entry) 'vhdl-speedbar-find-file
14981	 (cons (nth 2 conf-entry) (nth 3 conf-entry))
14982	 'vhdl-speedbar-configuration-face depth)
14983	(setq conf-alist (cdr conf-alist)))
14984      ;; insert packages
14985      (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
14986      (while pack-alist
14987	(setq pack-entry (car pack-alist))
14988	(vhdl-speedbar-make-pack-line
14989	 (nth 0 pack-entry) (nth 1 pack-entry)
14990	 (cons (nth 2 pack-entry) (nth 3 pack-entry))
14991	 (cons (nth 7 pack-entry) (nth 8 pack-entry))
14992	 depth)
14993	(setq pack-alist (cdr pack-alist))))))
14994
14995(declare-function speedbar-line-directory "speedbar" (&optional depth))
14996
14997(defun vhdl-speedbar-rescan-hierarchy ()
14998  "Rescan hierarchy for the directory or project under the cursor."
14999  (interactive)
15000  (let (key path)
15001    (cond
15002     ;; current project
15003     (vhdl-speedbar-show-projects
15004      (setq key (vhdl-speedbar-line-project))
15005      (vhdl-scan-project-contents key))
15006     ;; top-level directory
15007     ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
15008      (re-search-forward "[0-9]+:" nil t)
15009      (vhdl-scan-directory-contents
15010       (abbreviate-file-name (speedbar-line-directory))))
15011     ;; current directory
15012     (t (setq path (speedbar-line-directory))
15013	(string-match "^\\(.+[/\\]\\)" path)
15014	(vhdl-scan-directory-contents
15015	 (abbreviate-file-name (match-string 1 path)))))
15016    (vhdl-speedbar-refresh key)))
15017
15018(declare-function speedbar-goto-this-file "speedbar" (file))
15019
15020(defun vhdl-speedbar-expand-dirs (_directory)
15021  "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'."
15022  ;; (nicked from `speedbar-default-directory-list')
15023  (let ((sf (cdr (reverse speedbar-shown-directories)))
15024	(vhdl-speedbar-update-current-unit nil))
15025    (setq speedbar-shown-directories
15026	  (list (expand-file-name default-directory)))
15027    (while sf
15028      (when (speedbar-goto-this-file (car sf))
15029	(beginning-of-line)
15030	(when (looking-at "[0-9]+:\\s-*<")
15031	  (goto-char (match-end 0))
15032	  (speedbar-do-function-pointer)))
15033      (setq sf (cdr sf))))
15034  (vhdl-speedbar-update-current-unit nil t))
15035
15036(defun vhdl-speedbar-expand-units (key)
15037  "Expand design units in directory/project KEY according to
15038`vhdl-speedbar-shown-unit-alist'."
15039  (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15040	(vhdl-speedbar-update-current-unit nil)
15041	vhdl-updated-project-list)
15042    (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15043    (vhdl-prepare-search-1
15044     (while unit-alist			; expand units
15045       (vhdl-speedbar-goto-this-unit key (caar unit-alist))
15046       (beginning-of-line)
15047       (let ((arch-alist (nth 1 (car unit-alist)))
15048	     position)
15049	 (when (looking-at "^[0-9]+:\\s-*\\[")
15050	   (goto-char (match-end 0))
15051	   (setq position (point))
15052	   (speedbar-do-function-pointer)
15053	   (select-frame speedbar-frame)
15054	   (while arch-alist		; expand architectures
15055	     (goto-char position)
15056	     (when (re-search-forward
15057		    (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
15058			    (car arch-alist) "\\>\\)")
15059		    nil t)
15060	       (beginning-of-line)
15061	       (when (looking-at "^[0-9]+:\\s-*{")
15062		 (goto-char (match-end 0))
15063		 (speedbar-do-function-pointer)
15064		 (select-frame speedbar-frame)))
15065	     (setq arch-alist (cdr arch-alist))))
15066	 (setq unit-alist (cdr unit-alist))))))
15067  (vhdl-speedbar-update-current-unit nil t))
15068
15069(declare-function speedbar-center-buffer-smartly "speedbar" ())
15070
15071(defun vhdl-speedbar-contract-level ()
15072  "Contract current level in current directory/project."
15073  (interactive)
15074  (when (or (save-excursion
15075	      (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
15076	    (and (save-excursion
15077		   (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
15078		 (re-search-backward
15079		  (format "^[0-%d]:\\s-*[[{<]-"
15080			  (max (1- (string-to-number (match-string 1))) 0)) nil t)))
15081    (goto-char (match-end 0))
15082    (speedbar-do-function-pointer)
15083    (speedbar-center-buffer-smartly)))
15084
15085(defun vhdl-speedbar-contract-all ()
15086  "Contract all expanded design units in current directory/project."
15087  (interactive)
15088  (if (and vhdl-speedbar-show-projects
15089	   (save-excursion (beginning-of-line) (looking-at "^0:")))
15090      (progn (setq vhdl-speedbar-shown-project-list nil)
15091	     (vhdl-speedbar-refresh))
15092    (let ((key (vhdl-speedbar-line-key)))
15093      (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15094      (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
15095      (when (memq 'display vhdl-speedbar-save-cache)
15096	(add-to-list 'vhdl-updated-project-list key)))))
15097
15098(defun vhdl-speedbar-expand-all ()
15099  "Expand all design units in current directory/project."
15100  (interactive)
15101  (let* ((key (vhdl-speedbar-line-key))
15102	 (ent-alist (vhdl-aget vhdl-entity-alist key))
15103	 (conf-alist (vhdl-aget vhdl-config-alist key))
15104	 (pack-alist (vhdl-aget vhdl-package-alist key))
15105	 arch-alist unit-alist subunit-alist)
15106    (add-to-list 'vhdl-speedbar-shown-project-list key)
15107    (while ent-alist
15108      (setq arch-alist (nth 4 (car ent-alist)))
15109      (setq subunit-alist nil)
15110      (while arch-alist
15111	(push (caar arch-alist) subunit-alist)
15112	(setq arch-alist (cdr arch-alist)))
15113      (push (list (caar ent-alist) subunit-alist) unit-alist)
15114      (setq ent-alist (cdr ent-alist)))
15115    (while conf-alist
15116      (push (list (caar conf-alist)) unit-alist)
15117      (setq conf-alist (cdr conf-alist)))
15118    (while pack-alist
15119      (push (list (caar pack-alist)) unit-alist)
15120      (setq pack-alist (cdr pack-alist)))
15121    (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15122    (vhdl-speedbar-refresh)
15123    (when (memq 'display vhdl-speedbar-save-cache)
15124      (add-to-list 'vhdl-updated-project-list key))))
15125
15126(declare-function speedbar-change-expand-button-char "speedbar" (char))
15127(declare-function speedbar-delete-subblock "speedbar" (indent))
15128
15129(defun vhdl-speedbar-expand-project (text token indent)
15130  "Expand/contract the project under the cursor."
15131  (cond
15132   ((string-match "\\+" text)		; expand project
15133    (speedbar-change-expand-button-char ?-)
15134    (unless (member token vhdl-speedbar-shown-project-list)
15135      (setq vhdl-speedbar-shown-project-list
15136	    (cons token vhdl-speedbar-shown-project-list)))
15137    (speedbar-with-writable
15138      (save-excursion
15139	(end-of-line) (forward-char 1)
15140	(vhdl-speedbar-insert-project-hierarchy token (1+ indent)
15141						speedbar-power-click))))
15142   ((string-match "-" text)		; contract project
15143    (speedbar-change-expand-button-char ?+)
15144    (setq vhdl-speedbar-shown-project-list
15145	  (delete token vhdl-speedbar-shown-project-list))
15146    (speedbar-delete-subblock indent))
15147   (t (error "Nothing to display")))
15148  (when (equal (selected-frame) speedbar-frame)
15149    (speedbar-center-buffer-smartly)))
15150
15151(defun vhdl-speedbar-expand-entity (text token indent)
15152  "Expand/contract the entity under the cursor."
15153  (cond
15154   ((string-match "\\+" text)		; expand entity
15155    (let* ((key (vhdl-speedbar-line-key indent))
15156	   (ent-alist (vhdl-aget vhdl-entity-alist key))
15157	   (ent-entry (vhdl-aget ent-alist token))
15158	   (arch-alist (nth 3 ent-entry))
15159	   (inst-alist (vhdl-get-instantiations token indent))
15160	   (subpack-alist (nth 5 ent-entry))
15161	   (multiple-arch (> (length arch-alist) 1))
15162	   arch-entry inst-entry)
15163      (if (not (or arch-alist inst-alist subpack-alist))
15164	  (speedbar-change-expand-button-char ??)
15165	(speedbar-change-expand-button-char ?-)
15166	;; add entity to `vhdl-speedbar-shown-unit-alist'
15167	(let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15168	  (vhdl-aput 'unit-alist token nil)
15169	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15170	(speedbar-with-writable
15171	 (save-excursion
15172	   (end-of-line) (forward-char 1)
15173	   ;; insert architectures
15174	   (when arch-alist
15175	     (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
15176	   (while arch-alist
15177	     (setq arch-entry (car arch-alist))
15178	     (speedbar-make-tag-line
15179	      'curly ?+ 'vhdl-speedbar-expand-architecture
15180	      (cons token (nth 0 arch-entry))
15181	      (nth 1 arch-entry) 'vhdl-speedbar-find-file
15182	      (cons (nth 2 arch-entry) (nth 3 arch-entry))
15183	      'vhdl-speedbar-architecture-face (1+ indent))
15184	     (when (and multiple-arch
15185			(equal (nth 0 arch-entry) (nth 4 ent-entry)))
15186	       (end-of-line 0) (insert " (mra)") (forward-char 1))
15187	     (setq arch-alist (cdr arch-alist)))
15188	   ;; insert instantiations
15189	   (when inst-alist
15190	     (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
15191	   (while inst-alist
15192	     (setq inst-entry (car inst-alist))
15193	     (vhdl-speedbar-make-inst-line
15194	      (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
15195	      (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
15196	      nil nil nil (1+ indent) 0 " in ")
15197	     (setq inst-alist (cdr inst-alist)))
15198	   ;; insert required packages
15199	   (vhdl-speedbar-insert-subpackages
15200	    subpack-alist (1+ indent) indent)))
15201	(when (memq 'display vhdl-speedbar-save-cache)
15202	  (add-to-list 'vhdl-updated-project-list key))
15203	(vhdl-speedbar-update-current-unit t t))))
15204   ((string-match "-" text)		; contract entity
15205    (speedbar-change-expand-button-char ?+)
15206    ;; remove entity from `vhdl-speedbar-shown-unit-alist'
15207    (let* ((key (vhdl-speedbar-line-key indent))
15208	   (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15209      (vhdl-adelete 'unit-alist token)
15210      (if unit-alist
15211	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15212	(vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15213      (speedbar-delete-subblock indent)
15214      (when (memq 'display vhdl-speedbar-save-cache)
15215	(add-to-list 'vhdl-updated-project-list key))))
15216   (t (error "Nothing to display")))
15217  (when (equal (selected-frame) speedbar-frame)
15218    (speedbar-center-buffer-smartly)))
15219
15220(defun vhdl-speedbar-expand-architecture (text token indent)
15221  "Expand/contract the architecture under the cursor."
15222  (cond
15223   ((string-match "\\+" text)		; expand architecture
15224    (let* ((key (vhdl-speedbar-line-key (1- indent)))
15225	   (ent-alist (vhdl-aget vhdl-entity-alist key))
15226	   (conf-alist (vhdl-aget vhdl-config-alist key))
15227	   (hier-alist (vhdl-get-hierarchy
15228			ent-alist conf-alist (car token) (cdr token) nil nil
15229			0 (1- indent)))
15230	   (ent-entry (vhdl-aget ent-alist (car token)))
15231	   (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token)))
15232	   (subpack-alist (nth 4 arch-entry))
15233	   entry)
15234      (if (not (or hier-alist subpack-alist))
15235	  (speedbar-change-expand-button-char ??)
15236	(speedbar-change-expand-button-char ?-)
15237	;; add architecture to `vhdl-speedbar-shown-unit-alist'
15238	(let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15239	       (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15240	  (vhdl-aput 'unit-alist (car token)
15241		     (list (cons (cdr token) arch-alist)))
15242	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15243	(speedbar-with-writable
15244	  (save-excursion
15245	    (end-of-line) (forward-char 1)
15246	    ;; insert instance hierarchy
15247	    (when hier-alist
15248	      (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
15249					     (1+ indent)))
15250	    (while hier-alist
15251	      (setq entry (car hier-alist))
15252	      (when (or (= vhdl-speedbar-hierarchy-depth 0)
15253			(< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15254		(vhdl-speedbar-make-inst-line
15255		 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15256		 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15257		 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
15258	      (setq hier-alist (cdr hier-alist)))
15259	    ;; insert required packages
15260	    (vhdl-speedbar-insert-subpackages
15261	     subpack-alist (1+ indent) (1- indent))))
15262	(when (memq 'display vhdl-speedbar-save-cache)
15263	  (add-to-list 'vhdl-updated-project-list key))
15264	(vhdl-speedbar-update-current-unit t t))))
15265   ((string-match "-" text)		; contract architecture
15266    (speedbar-change-expand-button-char ?+)
15267    ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
15268    (let* ((key (vhdl-speedbar-line-key (1- indent)))
15269	   (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15270	   (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15271      (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
15272      (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15273      (speedbar-delete-subblock indent)
15274      (when (memq 'display vhdl-speedbar-save-cache)
15275	(add-to-list 'vhdl-updated-project-list key))))
15276   (t (error "Nothing to display")))
15277  (when (equal (selected-frame) speedbar-frame)
15278    (speedbar-center-buffer-smartly)))
15279
15280(defun vhdl-speedbar-expand-config (text token indent)
15281  "Expand/contract the configuration under the cursor."
15282  (cond
15283   ((string-match "\\+" text)		; expand configuration
15284    (let* ((key (vhdl-speedbar-line-key indent))
15285	   (conf-alist (vhdl-aget vhdl-config-alist key))
15286	   (conf-entry (vhdl-aget conf-alist token))
15287	   (ent-alist (vhdl-aget vhdl-entity-alist key))
15288	   (hier-alist (vhdl-get-hierarchy
15289			ent-alist conf-alist (nth 3 conf-entry)
15290			(nth 4 conf-entry) token (nth 5 conf-entry)
15291			0 indent t))
15292	   (subpack-alist (nth 6 conf-entry))
15293	   entry)
15294      (if (not (or hier-alist subpack-alist))
15295	  (speedbar-change-expand-button-char ??)
15296	(speedbar-change-expand-button-char ?-)
15297	;; add configuration to `vhdl-speedbar-shown-unit-alist'
15298	(let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15299	  (vhdl-aput 'unit-alist token nil)
15300	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15301	(speedbar-with-writable
15302	 (save-excursion
15303	   (end-of-line) (forward-char 1)
15304	   ;; insert instance hierarchy
15305	   (when hier-alist
15306	     (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
15307	   (while hier-alist
15308	     (setq entry (car hier-alist))
15309	     (when (or (= vhdl-speedbar-hierarchy-depth 0)
15310		       (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15311	       (vhdl-speedbar-make-inst-line
15312		(nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15313		(nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15314		(nth 8 entry) (1+ indent) (nth 9 entry) ": "))
15315	     (setq hier-alist (cdr hier-alist)))
15316	   ;; insert required packages
15317	   (vhdl-speedbar-insert-subpackages
15318	    subpack-alist (1+ indent) indent)))
15319	(when (memq 'display vhdl-speedbar-save-cache)
15320	  (add-to-list 'vhdl-updated-project-list key))
15321	(vhdl-speedbar-update-current-unit t t))))
15322   ((string-match "-" text)		; contract configuration
15323    (speedbar-change-expand-button-char ?+)
15324    ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
15325    (let* ((key (vhdl-speedbar-line-key indent))
15326	   (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15327      (vhdl-adelete 'unit-alist token)
15328      (if unit-alist
15329	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15330	(vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15331      (speedbar-delete-subblock indent)
15332      (when (memq 'display vhdl-speedbar-save-cache)
15333	(add-to-list 'vhdl-updated-project-list key))))
15334   (t (error "Nothing to display")))
15335  (when (equal (selected-frame) speedbar-frame)
15336    (speedbar-center-buffer-smartly)))
15337
15338(defun vhdl-speedbar-expand-package (text token indent)
15339  "Expand/contract the package under the cursor."
15340  (cond
15341   ((string-match "\\+" text)		; expand package
15342    (let* ((key (vhdl-speedbar-line-key indent))
15343	   (pack-alist (vhdl-aget vhdl-package-alist key))
15344	   (pack-entry (vhdl-aget pack-alist token))
15345	   (comp-alist (nth 3 pack-entry))
15346	   (func-alist (nth 4 pack-entry))
15347	   (func-body-alist (nth 8 pack-entry))
15348	   (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
15349	   comp-entry func-entry func-body-entry)
15350      (if (not (or comp-alist func-alist subpack-alist))
15351	  (speedbar-change-expand-button-char ??)
15352	(speedbar-change-expand-button-char ?-)
15353	;; add package to `vhdl-speedbar-shown-unit-alist'
15354	(let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15355	  (vhdl-aput 'unit-alist token nil)
15356	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15357	(speedbar-with-writable
15358	  (save-excursion
15359	    (end-of-line) (forward-char 1)
15360	    ;; insert components
15361	    (when comp-alist
15362	      (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
15363	    (while comp-alist
15364	      (setq comp-entry (car comp-alist))
15365	      (speedbar-make-tag-line
15366	       nil nil nil
15367	       (cons token (nth 0 comp-entry))
15368	       (nth 1 comp-entry) 'vhdl-speedbar-find-file
15369	       (cons (nth 2 comp-entry) (nth 3 comp-entry))
15370	       'vhdl-speedbar-entity-face (1+ indent))
15371	      (setq comp-alist (cdr comp-alist)))
15372	    ;; insert subprograms
15373	    (when func-alist
15374	      (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
15375	    (while func-alist
15376	      (setq func-entry (car func-alist)
15377		    func-body-entry (vhdl-aget func-body-alist
15378					       (car func-entry)))
15379	      (when (nth 2 func-entry)
15380		(vhdl-speedbar-make-subprogram-line
15381		 (nth 1 func-entry)
15382		 (cons (nth 2 func-entry) (nth 3 func-entry))
15383		 (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
15384		 (1+ indent)))
15385	      (setq func-alist (cdr func-alist)))
15386	   ;; insert required packages
15387	   (vhdl-speedbar-insert-subpackages
15388	    subpack-alist (1+ indent) indent)))
15389	(when (memq 'display vhdl-speedbar-save-cache)
15390	  (add-to-list 'vhdl-updated-project-list key))
15391	(vhdl-speedbar-update-current-unit t t))))
15392   ((string-match "-" text)		; contract package
15393    (speedbar-change-expand-button-char ?+)
15394    ;; remove package from `vhdl-speedbar-shown-unit-alist'
15395    (let* ((key (vhdl-speedbar-line-key indent))
15396	   (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15397      (vhdl-adelete 'unit-alist token)
15398      (if unit-alist
15399	  (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15400	(vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15401      (speedbar-delete-subblock indent)
15402      (when (memq 'display vhdl-speedbar-save-cache)
15403	(add-to-list 'vhdl-updated-project-list key))))
15404   (t (error "Nothing to display")))
15405  (when (equal (selected-frame) speedbar-frame)
15406    (speedbar-center-buffer-smartly)))
15407
15408(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
15409  "Insert required packages."
15410  (let* ((pack-alist (vhdl-aget vhdl-package-alist
15411				(vhdl-speedbar-line-key dir-indent)))
15412	 pack-key lib-name pack-entry)
15413    (when subpack-alist
15414      (vhdl-speedbar-make-title-line "Packages Used:" indent))
15415    (while subpack-alist
15416      (setq pack-key (cdar subpack-alist)
15417	    lib-name (caar subpack-alist))
15418      (setq pack-entry (vhdl-aget pack-alist pack-key))
15419      (vhdl-speedbar-make-subpack-line
15420       (or (nth 0 pack-entry) pack-key) lib-name
15421       (cons (nth 1 pack-entry) (nth 2 pack-entry))
15422       (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent)
15423      (setq subpack-alist (cdr subpack-alist)))))
15424
15425;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15426;; Display help functions
15427
15428;; FIXME: This `defvar' should be moved before its first use.
15429(defvar vhdl-speedbar-update-current-unit t
15430  "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
15431
15432(defun vhdl-speedbar-update-current-project ()
15433  "Highlight project that is currently active."
15434  (when (and vhdl-speedbar-show-projects
15435	     (not (equal vhdl-speedbar-last-selected-project vhdl-project))
15436	     (and (boundp 'speedbar-frame)
15437		  (frame-live-p speedbar-frame)))
15438    (let ((last-frame (selected-frame))
15439	  (project-alist vhdl-project-alist)
15440	  pos)
15441      (select-frame speedbar-frame)
15442      (speedbar-with-writable
15443       (save-excursion
15444	 (while project-alist
15445	   (goto-char (point-min))
15446	   (when (re-search-forward
15447		  (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
15448	     (put-text-property (match-beginning 1) (match-end 1) 'face
15449				(if (equal (caar project-alist) vhdl-project)
15450				    'speedbar-selected-face
15451				  'speedbar-directory-face))
15452	     (when (equal (caar project-alist) vhdl-project)
15453	       (setq pos (1- (match-beginning 1)))))
15454	   (setq project-alist (cdr project-alist))))
15455       (when pos (goto-char pos)))
15456      (select-frame last-frame)
15457      (setq vhdl-speedbar-last-selected-project vhdl-project)))
15458  t)
15459
15460(declare-function speedbar-position-cursor-on-line "speedbar" ())
15461
15462(defun vhdl-speedbar-update-current-unit (&optional no-position always)
15463  "Highlight all design units that are contained in the current file.
15464NO-POSITION non-nil means do not re-position cursor."
15465  (let ((last-frame (selected-frame))
15466	(project-list vhdl-speedbar-shown-project-list)
15467	file-alist pos file-name)
15468    ;; get current file name
15469    (if (fboundp 'speedbar-select-attached-frame)
15470	(speedbar-select-attached-frame)
15471      (select-frame speedbar-attached-frame))
15472    (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
15473    (when (and vhdl-speedbar-update-current-unit
15474	       (or always (not (equal file-name speedbar-last-selected-file))))
15475      (if vhdl-speedbar-show-projects
15476	  (while project-list
15477	    (setq file-alist (append file-alist
15478				     (vhdl-aget vhdl-file-alist
15479						(car project-list))))
15480	    (setq project-list (cdr project-list)))
15481	(setq file-alist
15482	      (vhdl-aget vhdl-file-alist
15483			 (abbreviate-file-name default-directory))))
15484      (select-frame speedbar-frame)
15485      (set-buffer speedbar-buffer)
15486      (speedbar-with-writable
15487       (vhdl-prepare-search-1
15488	(save-excursion
15489	  ;; unhighlight last units
15490	  (let* ((file-entry (vhdl-aget file-alist
15491					speedbar-last-selected-file)))
15492	    (vhdl-speedbar-update-units
15493	     "\\[.] " (nth 0 file-entry)
15494	     speedbar-last-selected-file 'vhdl-speedbar-entity-face)
15495	    (vhdl-speedbar-update-units
15496	     "{.} " (nth 1 file-entry)
15497	     speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
15498	    (vhdl-speedbar-update-units
15499	     "\\[.] " (nth 3 file-entry)
15500	     speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
15501	    (vhdl-speedbar-update-units
15502	     "[]>] " (nth 4 file-entry)
15503	     speedbar-last-selected-file 'vhdl-speedbar-package-face)
15504	    (vhdl-speedbar-update-units
15505	     "\\[.].+(" '("body")
15506	     speedbar-last-selected-file 'vhdl-speedbar-package-face)
15507	    (vhdl-speedbar-update-units
15508	     "> " (nth 6 file-entry)
15509	     speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
15510	  ;; highlight current units
15511	  (let* ((file-entry (vhdl-aget file-alist file-name)))
15512	    (setq
15513	     pos (vhdl-speedbar-update-units
15514		  "\\[.] " (nth 0 file-entry)
15515		  file-name 'vhdl-speedbar-entity-selected-face pos)
15516	     pos (vhdl-speedbar-update-units
15517		  "{.} " (nth 1 file-entry)
15518		  file-name 'vhdl-speedbar-architecture-selected-face pos)
15519	     pos (vhdl-speedbar-update-units
15520		  "\\[.] " (nth 3 file-entry)
15521		  file-name 'vhdl-speedbar-configuration-selected-face pos)
15522	     pos (vhdl-speedbar-update-units
15523		  "[]>] " (nth 4 file-entry)
15524		  file-name 'vhdl-speedbar-package-selected-face pos)
15525	     pos (vhdl-speedbar-update-units
15526		  "\\[.].+(" '("body")
15527		  file-name 'vhdl-speedbar-package-selected-face pos)
15528	     pos (vhdl-speedbar-update-units
15529		  "> " (nth 6 file-entry)
15530		  file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
15531      ;; move speedbar so the first highlighted unit is visible
15532      (when (and pos (not no-position))
15533	(goto-char pos)
15534 	(speedbar-center-buffer-smartly)
15535	(speedbar-position-cursor-on-line))
15536      (setq speedbar-last-selected-file file-name))
15537    (select-frame last-frame)
15538    t))
15539
15540(defun vhdl-speedbar-update-units (text unit-list file-name face
15541					&optional pos)
15542  "Help function to highlight design units."
15543  (while unit-list
15544    (goto-char (point-min))
15545    (while (re-search-forward
15546	    (concat text "\\(" (car unit-list) "\\)\\>") nil t)
15547      (when (equal file-name (car (get-text-property
15548				   (match-beginning 1) 'speedbar-token)))
15549	(setq pos (or pos (point-marker)))
15550	(put-text-property (match-beginning 1) (match-end 1) 'face face)))
15551    (setq unit-list (cdr unit-list)))
15552  pos)
15553
15554(declare-function speedbar-make-button "speedbar"
15555		  (start end face mouse function &optional token))
15556
15557(defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
15558					       ent-name ent-file-marker
15559					       arch-name arch-file-marker
15560					       conf-name conf-file-marker
15561					       lib-name depth offset delimiter)
15562  "Insert instantiation entry."
15563  (let ((start (point))
15564	visible-start)
15565    (insert (int-to-string depth) ":")
15566    (put-text-property start (point) 'invisible t)
15567    (setq visible-start (point))
15568    (insert-char ?  (* depth speedbar-indentation-width))
15569    (while (> offset 0)
15570      (insert "|")
15571      (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
15572      (setq offset (1- offset)))
15573    (put-text-property visible-start (point) 'invisible nil)
15574    (setq start (point))
15575    (insert ">")
15576    (speedbar-make-button start (point) nil nil nil)
15577    (setq visible-start (point))
15578    (insert " ")
15579    (setq start (point))
15580    (if (not inst-name)
15581	(insert "(top)")
15582      (insert inst-name)
15583      (speedbar-make-button
15584       start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
15585       'vhdl-speedbar-find-file inst-file-marker))
15586    (insert delimiter)
15587    (when ent-name
15588      (setq start (point))
15589      (insert ent-name)
15590      (speedbar-make-button
15591       start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
15592       'vhdl-speedbar-find-file ent-file-marker)
15593      (when arch-name
15594	(insert " (")
15595	(setq start (point))
15596	(insert arch-name)
15597	(speedbar-make-button
15598	 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
15599	 'vhdl-speedbar-find-file arch-file-marker)
15600	(insert ")"))
15601      (when conf-name
15602	(insert " (")
15603	(setq start (point))
15604	(insert conf-name)
15605	(speedbar-make-button
15606	 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
15607	 'vhdl-speedbar-find-file conf-file-marker)
15608	(insert ")")))
15609    (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
15610      (setq start (point))
15611      (insert " (" lib-name ")")
15612      (put-text-property (+ 2 start) (1- (point)) 'face
15613			 'vhdl-speedbar-library-face))
15614    (insert-char ?\n 1)
15615    (put-text-property visible-start (point) 'invisible nil)))
15616
15617(defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
15618					      body-file-marker depth)
15619  "Insert package entry."
15620  (let ((start (point))
15621	visible-start)
15622    (insert (int-to-string depth) ":")
15623    (put-text-property start (point) 'invisible t)
15624    (setq visible-start (point))
15625    (insert-char ?  (* depth speedbar-indentation-width))
15626    (put-text-property visible-start (point) 'invisible nil)
15627    (setq start (point))
15628    (insert "[+]")
15629    (speedbar-make-button
15630     start (point) 'speedbar-button-face 'speedbar-highlight-face
15631     'vhdl-speedbar-expand-package pack-key)
15632    (setq visible-start (point))
15633    (insert-char ?  1 nil)
15634    (setq start (point))
15635    (insert pack-name)
15636    (speedbar-make-button
15637     start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15638     'vhdl-speedbar-find-file pack-file-marker)
15639    (unless (car pack-file-marker)
15640      (insert "!"))
15641    (when (car body-file-marker)
15642      (insert " (")
15643      (setq start (point))
15644      (insert "body")
15645      (speedbar-make-button
15646       start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15647       'vhdl-speedbar-find-file body-file-marker)
15648      (insert ")"))
15649    (insert-char ?\n 1)
15650    (put-text-property visible-start (point) 'invisible nil)))
15651
15652(defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
15653						  pack-body-file-marker depth)
15654  "Insert used package entry."
15655  (let ((start (point))
15656	visible-start)
15657    (insert (int-to-string depth) ":")
15658    (put-text-property start (point) 'invisible t)
15659    (setq visible-start (point))
15660    (insert-char ?  (* depth speedbar-indentation-width))
15661    (put-text-property visible-start (point) 'invisible nil)
15662    (setq start (point))
15663    (insert ">")
15664    (speedbar-make-button start (point) nil nil nil)
15665    (setq visible-start (point))
15666    (insert " ")
15667    (setq start (point))
15668    (insert pack-name)
15669    (speedbar-make-button
15670     start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15671     'vhdl-speedbar-find-file pack-file-marker)
15672    (when (car pack-body-file-marker)
15673      (insert " (")
15674      (setq start (point))
15675      (insert "body")
15676      (speedbar-make-button
15677       start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15678       'vhdl-speedbar-find-file pack-body-file-marker)
15679      (insert ")"))
15680    (setq start (point))
15681    (insert " (" lib-name ")")
15682    (put-text-property (+ 2 start) (1- (point)) 'face
15683		       'vhdl-speedbar-library-face)
15684    (insert-char ?\n 1)
15685    (put-text-property visible-start (point) 'invisible nil)))
15686
15687(defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
15688						     func-body-file-marker
15689						     depth)
15690  "Insert subprogram entry."
15691  (let ((start (point))
15692	visible-start)
15693    (insert (int-to-string depth) ":")
15694    (put-text-property start (point) 'invisible t)
15695    (setq visible-start (point))
15696    (insert-char ?  (* depth speedbar-indentation-width))
15697    (put-text-property visible-start (point) 'invisible nil)
15698    (setq start (point))
15699    (insert ">")
15700    (speedbar-make-button start (point) nil nil nil)
15701    (setq visible-start (point))
15702    (insert " ")
15703    (setq start (point))
15704    (insert func-name)
15705    (speedbar-make-button
15706     start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15707     'vhdl-speedbar-find-file func-file-marker)
15708    (when (car func-body-file-marker)
15709      (insert " (")
15710      (setq start (point))
15711      (insert "body")
15712      (speedbar-make-button
15713       start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15714       'vhdl-speedbar-find-file func-body-file-marker)
15715      (insert ")"))
15716    (insert-char ?\n 1)
15717    (put-text-property visible-start (point) 'invisible nil)))
15718
15719(defun vhdl-speedbar-make-title-line (text &optional depth)
15720  "Insert design unit title entry."
15721  (let ((start (point))
15722	visible-start)
15723    (when depth
15724      (insert (int-to-string depth) ":")
15725      (put-text-property start (point) 'invisible t))
15726    (setq visible-start (point))
15727    (insert-char ?  (* (or depth 0) speedbar-indentation-width))
15728    (setq start (point))
15729    (insert text)
15730    (speedbar-make-button start (point) nil nil nil nil)
15731    (insert-char ?\n 1)
15732    (put-text-property visible-start (point) 'invisible nil)))
15733
15734(defun vhdl-speedbar-insert-dirs (files level)
15735  "Insert subdirectories."
15736  (let ((dirs (car files)))
15737    (while dirs
15738      (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs)
15739			      (car dirs) 'speedbar-dir-follow nil
15740			      'speedbar-directory-face level)
15741      (setq dirs (cdr dirs)))))
15742
15743(declare-function speedbar-reset-scanners "speedbar" ())
15744
15745(defun vhdl-speedbar-dired (text token indent)
15746  "Speedbar click handler for directory expand button in hierarchy mode."
15747  (cond ((string-match "\\+" text)	; we have to expand this dir
15748	 (setq speedbar-shown-directories
15749	       (cons (expand-file-name
15750		      (concat (speedbar-line-directory indent) token "/"))
15751		     speedbar-shown-directories))
15752  	 (speedbar-change-expand-button-char ?-)
15753	 (speedbar-reset-scanners)
15754	 (speedbar-with-writable
15755	   (save-excursion
15756	     (end-of-line) (forward-char 1)
15757	     (vhdl-speedbar-insert-dirs
15758	      (speedbar-file-lists
15759	       (concat (speedbar-line-directory indent) token "/"))
15760	      (1+ indent))
15761	     (speedbar-reset-scanners)
15762	     (vhdl-speedbar-insert-dir-hierarchy
15763	      (abbreviate-file-name
15764	       (concat (speedbar-line-directory indent) token "/"))
15765	      (1+ indent) speedbar-power-click)))
15766	 (vhdl-speedbar-update-current-unit t t))
15767	((string-match "-" text)	; we have to contract this node
15768	 (speedbar-reset-scanners)
15769	 (let ((oldl speedbar-shown-directories)
15770	       (newl nil)
15771	       (td (expand-file-name
15772		    (concat (speedbar-line-directory indent) token))))
15773	   (while oldl
15774	     (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
15775		 (push (car oldl) newl))
15776	     (setq oldl (cdr oldl)))
15777	   (setq speedbar-shown-directories (nreverse newl)))
15778	 (speedbar-change-expand-button-char ?+)
15779	 (speedbar-delete-subblock indent))
15780	(t (error "Nothing to display")))
15781  (when (equal (selected-frame) speedbar-frame)
15782    (speedbar-center-buffer-smartly)))
15783
15784(declare-function speedbar-files-item-info "speedbar" ())
15785
15786(defun vhdl-speedbar-item-info ()
15787  "Derive and display information about this line item."
15788  (save-excursion
15789    (beginning-of-line)
15790    ;; skip invisible number info
15791    (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
15792    (cond
15793     ;; project/directory entry
15794     ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
15795      (if vhdl-speedbar-show-projects
15796	  (message "Project \"%s\"" (match-string-no-properties 1))
15797	(speedbar-files-item-info)))
15798     ;; design unit entry
15799     ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
15800      (goto-char (match-end 1))
15801      (let ((face (get-text-property (point) 'face)))
15802	(message
15803	 "%s \"%s\" in \"%s\""
15804	 ;; design unit kind
15805	 (cond ((or (eq face 'vhdl-speedbar-entity-face)
15806		    (eq face 'vhdl-speedbar-entity-selected-face))
15807		(if (equal (match-string 2) ">") "Component" "Entity"))
15808	       ((or (eq face 'vhdl-speedbar-architecture-face)
15809		    (eq face 'vhdl-speedbar-architecture-selected-face))
15810		"Architecture")
15811	       ((or (eq face 'vhdl-speedbar-configuration-face)
15812		    (eq face 'vhdl-speedbar-configuration-selected-face))
15813		"Configuration")
15814	       ((or (eq face 'vhdl-speedbar-package-face)
15815		    (eq face 'vhdl-speedbar-package-selected-face))
15816		"Package")
15817	       ((or (eq face 'vhdl-speedbar-instantiation-face)
15818		    (eq face 'vhdl-speedbar-instantiation-selected-face))
15819		"Instantiation")
15820	       ((eq face 'vhdl-speedbar-subprogram-face)
15821		"Subprogram")
15822	       (t ""))
15823	 ;; design unit name
15824	 (buffer-substring-no-properties
15825	  (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
15826	  (match-end 1))
15827	 ;; file name
15828	 (file-relative-name
15829	  (or (car (get-text-property (point) 'speedbar-token))
15830	      "?")
15831	  (vhdl-default-directory)))))
15832     (t (message "")))))
15833
15834(declare-function speedbar-line-text "speedbar" (&optional p))
15835
15836(defun vhdl-speedbar-line-text ()
15837  "Call `speedbar-line-text' and remove text properties."
15838  (let ((string (speedbar-line-text)))
15839    (set-text-properties 0 (length string) nil string)
15840    string))
15841
15842(defun vhdl-speedbar-higher-text ()
15843  "Get speedbar-line-text of higher level."
15844  (let (depth string)
15845    (save-excursion
15846      (beginning-of-line)
15847      (looking-at "^\\([0-9]+\\):")
15848      (setq depth (string-to-number (match-string 1)))
15849      (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t)
15850	(setq string (match-string 1))
15851	(set-text-properties 0 (length string) nil string)
15852	string))))
15853
15854;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15855;; Help functions
15856
15857(defun vhdl-speedbar-line-key (&optional indent)
15858  "Get currently displayed directory of project name."
15859  (if vhdl-speedbar-show-projects
15860      (vhdl-speedbar-line-project)
15861    (abbreviate-file-name
15862     (file-name-as-directory (speedbar-line-directory indent)))))
15863
15864(defun vhdl-speedbar-line-project (&optional _indent)
15865  "Get currently displayed project name."
15866  (and vhdl-speedbar-show-projects
15867       (save-excursion
15868	 (end-of-line)
15869	 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
15870	 (match-string-no-properties 1))))
15871
15872(defun vhdl-add-modified-file ()
15873  "Add file to `vhdl-modified-file-list'."
15874  (when vhdl-file-alist
15875    (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
15876  nil)
15877
15878(defun vhdl-resolve-paths (path-list)
15879  "Resolve path wildcards in PATH-LIST."
15880  (let (path-list-1 path-list-2 path-beg path-end dir)
15881    ;; eliminate non-existent directories
15882    (while path-list
15883      (setq dir (car path-list))
15884      (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
15885      (if (file-directory-p (match-string 2 dir))
15886	  (push dir path-list-1)
15887	(vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
15888      (setq path-list (cdr path-list)))
15889    ;; resolve path wildcards
15890    (while path-list-1
15891      (setq dir (car path-list-1))
15892      (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
15893	  (progn
15894	    (setq path-beg (match-string 1 dir)
15895		  path-end (match-string 5 dir))
15896	    (setq path-list-1
15897		  (append
15898		   (mapcar
15899                    (lambda (var) (concat path-beg var path-end))
15900		    (let ((all-list (vhdl-directory-files
15901				     (match-string 2 dir) t
15902				     (concat "\\<" (wildcard-to-regexp
15903						    (match-string 4 dir)))))
15904			  dir-list)
15905		      (while all-list
15906			(when (file-directory-p (car all-list))
15907			  (push (car all-list) dir-list))
15908			(setq all-list (cdr all-list)))
15909		      dir-list))
15910		   (cdr path-list-1))))
15911	(string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
15912	(when (file-directory-p (match-string 2 dir))
15913	  (push dir path-list-2))
15914	(setq path-list-1 (cdr path-list-1))))
15915    (nreverse path-list-2)))
15916
15917(defun vhdl-speedbar-goto-this-unit (directory unit)
15918  "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
15919  (let ((dest (point)))
15920    (if (and (if vhdl-speedbar-show-projects
15921		 (progn (goto-char (point-min)) t)
15922	       (speedbar-goto-this-file directory))
15923	     (re-search-forward (concat "[]}] " unit "\\>") nil t))
15924	(progn (speedbar-position-cursor-on-line)
15925	       t)
15926      (goto-char dest)
15927      nil)))
15928
15929(declare-function speedbar-find-file-in-frame "speedbar" (file))
15930(declare-function speedbar-set-timer "speedbar" (timeout))
15931;; speedbar loads dframe at runtime.
15932(declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
15933
15934(defun vhdl-speedbar-find-file (_text token _indent)
15935  "When user clicks on TEXT, load file with name and position in TOKEN.
15936Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15937is already shown in a buffer."
15938  (if (not (car token))
15939      (error "ERROR:  File cannot be found")
15940    (let ((buffer (get-file-buffer (car token))))
15941      (speedbar-find-file-in-frame (car token))
15942      (when (or vhdl-speedbar-jump-to-unit buffer)
15943	(goto-char (point-min))
15944	(forward-line (1- (cdr token)))
15945	(recenter))
15946      (vhdl-speedbar-update-current-unit t t)
15947      (speedbar-set-timer dframe-update-speed)
15948      (dframe-maybee-jump-to-attached-frame))))
15949
15950(defun vhdl-speedbar-port-copy ()
15951  "Copy the port of the entity/component or subprogram under the cursor."
15952  (interactive)
15953  (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
15954    (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
15955	(error "ERROR:  No entity/component or subprogram under cursor")
15956      (beginning-of-line)
15957      (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
15958	  (condition-case info
15959	      (let ((token (get-text-property
15960			    (match-beginning 3) 'speedbar-token)))
15961		(vhdl-visit-file (car token) t
15962		  (goto-char (point-min))
15963		  (forward-line (1- (cdr token)))
15964		  (end-of-line)
15965		  (if is-entity
15966		      (vhdl-port-copy)
15967		    (vhdl-subprog-copy))))
15968	    (error (error "ERROR:  %s not scanned successfully\n  (%s)"
15969			  (if is-entity "Port" "Interface") (cadr info))))
15970	(error "ERROR:  No entity/component or subprogram on current line")))))
15971
15972(defun vhdl-speedbar-place-component ()
15973  "Place the entity/component under the cursor as component."
15974  (interactive)
15975  (if (not (vhdl-speedbar-check-unit 'entity))
15976      (error "ERROR:  No entity/component under cursor")
15977    (vhdl-speedbar-port-copy)
15978    (if (fboundp 'speedbar-select-attached-frame)
15979	(speedbar-select-attached-frame)
15980      (select-frame speedbar-attached-frame))
15981    (vhdl-compose-place-component)
15982    (select-frame speedbar-frame)))
15983
15984(defun vhdl-speedbar-configuration ()
15985  "Generate configuration for the architecture under the cursor."
15986  (interactive)
15987  (if (not (vhdl-speedbar-check-unit 'architecture))
15988      (error "ERROR:  No architecture under cursor")
15989    (let ((arch-name (vhdl-speedbar-line-text))
15990	  (ent-name (vhdl-speedbar-higher-text)))
15991      (if (fboundp 'speedbar-select-attached-frame)
15992	  (speedbar-select-attached-frame)
15993	(select-frame speedbar-attached-frame))
15994      (vhdl-compose-configuration ent-name arch-name))))
15995
15996(defun vhdl-speedbar-select-mra ()
15997  "Select the architecture under the cursor as MRA."
15998  (interactive)
15999  (if (not (vhdl-speedbar-check-unit 'architecture))
16000      (error "ERROR:  No architecture under cursor")
16001    (let* ((arch-key (downcase (vhdl-speedbar-line-text)))
16002	   (ent-key (downcase (vhdl-speedbar-higher-text)))
16003	   (ent-alist (vhdl-aget
16004		       vhdl-entity-alist
16005		       (or (vhdl-project-p)
16006			   (abbreviate-file-name default-directory))))
16007	   (ent-entry (vhdl-aget ent-alist ent-key)))
16008      (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
16009      (speedbar-refresh))))
16010
16011(declare-function speedbar-line-file "speedbar" (&optional p))
16012
16013(defun vhdl-speedbar-make-design ()
16014  "Make (compile) design unit or directory/project under the cursor."
16015  (interactive)
16016  (if (not (save-excursion (beginning-of-line)
16017			   (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
16018      (error "ERROR:  No primary design unit or directory/project under cursor")
16019    (let ((is-unit (match-string 2))
16020	  (unit-name (vhdl-speedbar-line-text))
16021	  (vhdl-project (vhdl-speedbar-line-project))
16022	  (directory (file-name-as-directory
16023		      (or (speedbar-line-file) (speedbar-line-directory)))))
16024      (if (fboundp 'speedbar-select-attached-frame)
16025	  (speedbar-select-attached-frame)
16026	(select-frame speedbar-attached-frame))
16027      (let ((default-directory directory))
16028	(vhdl-make (and is-unit unit-name))))))
16029
16030(defun vhdl-speedbar-generate-makefile ()
16031  "Generate Makefile for directory/project under the cursor."
16032  (interactive)
16033  (let ((vhdl-project (vhdl-speedbar-line-project))
16034	(default-directory (file-name-as-directory
16035			    (or (speedbar-line-file) (speedbar-line-directory)))))
16036    (vhdl-generate-makefile)))
16037
16038(defun vhdl-speedbar-check-unit (design-unit)
16039  "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
16040expansion function)."
16041    (save-excursion
16042      (speedbar-position-cursor-on-line)
16043      (cond ((eq design-unit 'entity)
16044	     (memq (get-text-property (match-end 0) 'face)
16045		   '(vhdl-speedbar-entity-face
16046		     vhdl-speedbar-entity-selected-face)))
16047	    ((eq design-unit 'architecture)
16048	     (memq (get-text-property (match-end 0) 'face)
16049		   '(vhdl-speedbar-architecture-face
16050		     vhdl-speedbar-architecture-selected-face)))
16051	    ((eq design-unit 'subprogram)
16052	     (eq (get-text-property (match-end 0) 'face)
16053		 'vhdl-speedbar-subprogram-face))
16054	    (t nil))))
16055
16056(defun vhdl-speedbar-set-depth (depth)
16057  "Set hierarchy display depth to DEPTH and refresh speedbar."
16058  (setq vhdl-speedbar-hierarchy-depth depth)
16059  (speedbar-refresh))
16060
16061;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16062;; Fontification
16063
16064(defface vhdl-speedbar-entity-face
16065  '((((class color) (background light)) (:foreground "ForestGreen"))
16066    (((class color) (background dark)) (:foreground "PaleGreen")))
16067  "Face used for displaying entity names."
16068  :group 'speedbar-faces)
16069
16070(defface vhdl-speedbar-architecture-face
16071  '((((min-colors 88) (class color) (background light)) (:foreground "Blue1"))
16072    (((class color) (background light)) (:foreground "Blue"))
16073
16074    (((class color) (background dark)) (:foreground "LightSkyBlue")))
16075  "Face used for displaying architecture names."
16076  :group 'speedbar-faces)
16077
16078(defface vhdl-speedbar-configuration-face
16079  '((((class color) (background light)) (:foreground "DarkGoldenrod"))
16080    (((class color) (background dark)) (:foreground "Salmon")))
16081  "Face used for displaying configuration names."
16082  :group 'speedbar-faces)
16083
16084(defface vhdl-speedbar-package-face
16085  '((((class color) (background light)) (:foreground "Grey50"))
16086    (((class color) (background dark)) (:foreground "Grey80")))
16087  "Face used for displaying package names."
16088  :group 'speedbar-faces)
16089
16090(defface vhdl-speedbar-library-face
16091  '((((class color) (background light)) (:foreground "Purple"))
16092    (((class color) (background dark)) (:foreground "Orchid1")))
16093  "Face used for displaying library names."
16094  :group 'speedbar-faces)
16095
16096(defface vhdl-speedbar-instantiation-face
16097  '((((class color) (background light)) (:foreground "Brown"))
16098    (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1"))
16099    (((class color) (background dark)) (:foreground "Yellow")))
16100  "Face used for displaying instantiation names."
16101  :group 'speedbar-faces)
16102
16103(defface vhdl-speedbar-subprogram-face
16104  '((((class color) (background light)) (:foreground "Orchid4"))
16105    (((class color) (background dark)) (:foreground "BurlyWood2")))
16106  "Face used for displaying subprogram names."
16107  :group 'speedbar-faces)
16108
16109(defface vhdl-speedbar-entity-selected-face
16110  '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
16111    (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
16112  "Face used for displaying entity names."
16113  :group 'speedbar-faces)
16114
16115(defface vhdl-speedbar-architecture-selected-face
16116  '((((min-colors 88) (class color) (background light)) (:foreground
16117  "Blue1" :underline t))
16118    (((class color) (background light)) (:foreground "Blue" :underline t))
16119    (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
16120  "Face used for displaying architecture names."
16121  :group 'speedbar-faces)
16122
16123(defface vhdl-speedbar-configuration-selected-face
16124  '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
16125    (((class color) (background dark)) (:foreground "Salmon" :underline t)))
16126  "Face used for displaying configuration names."
16127  :group 'speedbar-faces)
16128
16129(defface vhdl-speedbar-package-selected-face
16130  '((((class color) (background light)) (:foreground "Grey50" :underline t))
16131    (((class color) (background dark)) (:foreground "Grey80" :underline t)))
16132  "Face used for displaying package names."
16133  :group 'speedbar-faces)
16134
16135(defface vhdl-speedbar-instantiation-selected-face
16136  '((((class color) (background light)) (:foreground "Brown" :underline t))
16137    (((class color) (background dark)) (:foreground "Yellow" :underline t)))
16138  "Face used for displaying instantiation names."
16139  :group 'speedbar-faces)
16140
16141;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16142;; Initialization
16143
16144;; add speedbar
16145(when (fboundp 'speedbar)
16146  (let ((current-frame (selected-frame)))
16147    (condition-case ()
16148	(when (and vhdl-speedbar-auto-open
16149		   (not (and (boundp 'speedbar-frame)
16150			     (frame-live-p speedbar-frame))))
16151	  (speedbar-frame-mode 1))
16152      (error (vhdl-warning-when-idle "ERROR:  An error occurred while opening speedbar")))
16153    (select-frame current-frame)))
16154
16155;; initialize speedbar
16156(if (not (boundp 'speedbar-frame))
16157    (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize))
16158  (vhdl-speedbar-initialize)
16159  (when speedbar-frame (vhdl-speedbar-refresh)))
16160
16161
16162;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16163;;; Structural composition
16164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16165
16166(defun vhdl-get-components-package-name ()
16167  "Return the name of the components package."
16168  (let ((project (vhdl-project-p)))
16169    (if project
16170	(vhdl-replace-string (car vhdl-components-package-name)
16171			     (subst-char-in-string ?  ?_ project))
16172      (cdr vhdl-components-package-name))))
16173
16174(defun vhdl-compose-new-component ()
16175  "Create entity and architecture for new component."
16176  (interactive)
16177  (let* ((case-fold-search t)
16178	 (ent-name (read-from-minibuffer "entity name: "
16179					 nil vhdl-minibuffer-local-map))
16180	 (arch-name
16181	  (if (equal (cdr vhdl-compose-architecture-name) "")
16182	      (read-from-minibuffer "architecture name: "
16183				    nil vhdl-minibuffer-local-map)
16184	    (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
16185	 ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project
16186    (message "Creating component \"%s(%s)\"..." ent-name arch-name)
16187    ;; open entity file
16188    (unless (eq vhdl-compose-create-files 'none)
16189      (setq ent-file-name
16190	    (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16191		    "." (file-name-extension (buffer-file-name))))
16192      (when (and (file-exists-p ent-file-name)
16193		 (not (y-or-n-p (concat "File \"" ent-file-name
16194					"\" exists; overwrite? "))))
16195	(error "ERROR:  Creating component...aborted"))
16196      (find-file ent-file-name)
16197      (erase-buffer)
16198      (set-buffer-modified-p nil))
16199    ;; insert header
16200    (if vhdl-compose-include-header
16201	(progn (vhdl-template-header)
16202	       (setq end-pos (point))
16203	       (goto-char (point-max)))
16204      (vhdl-comment-display-line) (insert "\n\n"))
16205    ;; insert library clause
16206    (vhdl-template-package-std-logic-1164)
16207    (when vhdl-use-components-package
16208      (insert "\n")
16209      (vhdl-template-standard-package (vhdl-work-library)
16210				      (vhdl-get-components-package-name)))
16211    (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
16212    ;; insert entity declaration
16213    (vhdl-insert-keyword "ENTITY ") (insert ent-name)
16214    (vhdl-insert-keyword " IS\n")
16215    (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16216    (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
16217    (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16218    (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16219    (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
16220    (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16221    (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16222    (vhdl-insert-keyword "END ")
16223    (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
16224    (insert ent-name ";\n\n")
16225    (vhdl-comment-display-line) (insert "\n")
16226    ;; open architecture file
16227    (if (not (eq vhdl-compose-create-files 'separate))
16228	(insert "\n")
16229      (goto-char (or end-pos (point-min)))
16230      (setq ent-buffer (current-buffer))
16231      (setq arch-file-name
16232	    (concat (vhdl-replace-string vhdl-architecture-file-name
16233					 (concat ent-name " " arch-name) t)
16234		    "." (file-name-extension (buffer-file-name))))
16235      (when (and (file-exists-p arch-file-name)
16236		 (not (y-or-n-p (concat "File \"" arch-file-name
16237					"\" exists; overwrite? "))))
16238	(error "ERROR:  Creating component...aborted"))
16239      (find-file arch-file-name)
16240      (erase-buffer)
16241      (set-buffer-modified-p nil)
16242      ;; insert header
16243      (if vhdl-compose-include-header
16244	  (progn (vhdl-template-header)
16245		 (goto-char (point-max)))
16246	(vhdl-comment-display-line) (insert "\n\n")))
16247    ;; insert architecture body
16248    (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
16249    (vhdl-insert-keyword " OF ") (insert ent-name)
16250    (vhdl-insert-keyword " IS\n\n")
16251    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16252    (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
16253    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16254    (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
16255      (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16256      (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16257      (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
16258    (vhdl-insert-keyword "BEGIN")
16259    (when vhdl-self-insert-comments
16260      (insert "  -- ")
16261      (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16262      (insert arch-name))
16263    (insert "\n\n")
16264    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16265    (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
16266    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16267    (vhdl-insert-keyword "END ")
16268    (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16269    (insert arch-name ";\n\n")
16270    ;; insert footer and save
16271    (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16272	(vhdl-template-footer)
16273      (vhdl-comment-display-line) (insert "\n"))
16274    (goto-char (or end-pos (point-min)))
16275    (setq arch-buffer (current-buffer))
16276    (when ent-buffer (set-buffer ent-buffer) (save-buffer))
16277    (set-buffer arch-buffer) (save-buffer)
16278    (message "%s"
16279     (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
16280	     (and ent-file-name
16281		  (format "\n  File created: \"%s\"" ent-file-name))
16282	     (and arch-file-name
16283		  (format "\n  File created: \"%s\"" arch-file-name))))))
16284
16285(defun vhdl-compose-place-component ()
16286  "Place new component by pasting current port as component declaration and
16287component instantiation."
16288  (interactive)
16289  (if (not vhdl-port-list)
16290      (error "ERROR:  No port has been read")
16291    (save-excursion
16292      (vhdl-prepare-search-2
16293       (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)
16294		   (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))
16295	 (error "ERROR:  No architecture found"))
16296       (let* ((ent-name (match-string 1))
16297	      (ent-file-name
16298	       (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16299		       "." (file-name-extension (buffer-file-name))))
16300	      (orig-buffer (current-buffer)))
16301	 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
16302	 ;; place component declaration
16303	 (unless (or vhdl-use-components-package
16304		     (vhdl-use-direct-instantiation)
16305		     (save-excursion
16306		       (re-search-forward
16307			(concat "^\\s-*component\\s-+"
16308				(car vhdl-port-list) "\\>") nil t)))
16309	   (re-search-forward "^begin\\>" nil)
16310	   (beginning-of-line)
16311	   (skip-chars-backward " \t\n\r\f")
16312	   (insert "\n\n") (indent-to vhdl-basic-offset)
16313	   (vhdl-port-paste-component t))
16314	 ;; place component instantiation
16315	 (re-search-forward "^end\\>" nil)
16316	 (beginning-of-line)
16317	 (skip-chars-backward " \t\n\r\f")
16318	 (insert "\n\n") (indent-to vhdl-basic-offset)
16319	 (vhdl-port-paste-instance nil t t)
16320	 ;; place use clause for used packages
16321	 (when (nth 3 vhdl-port-list)
16322	   ;; open entity file
16323	   (when (file-exists-p ent-file-name)
16324	     (find-file ent-file-name))
16325	   (goto-char (point-min))
16326	   (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16327	     (error "ERROR:  Entity not found: \"%s\"" ent-name))
16328	   (goto-char (match-beginning 0))
16329	   (if (and (save-excursion
16330		      (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
16331		    (match-string 1))
16332	       (progn (goto-char (match-end 0))
16333		      (beginning-of-line 2))
16334	     (insert "\n")
16335	     (backward-char))
16336	   (vhdl-port-paste-context-clause)
16337	   (switch-to-buffer orig-buffer))
16338	 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
16339
16340(defun vhdl-compose-wire-components ()
16341  "Connect components."
16342  (interactive)
16343  (save-excursion
16344    (vhdl-prepare-search-2
16345     (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)
16346		 (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))
16347       (error "ERROR:  No architecture found"))
16348     (let* ((ent-name (match-string 1))
16349	    (ent-file-name
16350	     (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16351		     "." (file-name-extension (buffer-file-name))))
16352	    (arch-decl-pos (point-marker))
16353	    (arch-stat-pos (re-search-forward "^begin\\>" nil))
16354	    (arch-end-pos (re-search-forward "^end\\>" nil))
16355	    (pack-name (vhdl-get-components-package-name))
16356	    (pack-file-name
16357	     (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16358		     "." (file-name-extension (buffer-file-name))))
16359	    inst-name comp-name comp-ent-name comp-ent-file-name has-generic
16360	    port-alist generic-alist inst-alist
16361	    signal-name signal-entry signal-alist local-list written-list
16362	    single-in-list multi-in-list single-out-list multi-out-list
16363	    constant-name constant-entry constant-alist single-list multi-list
16364	    port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
16365	    generic-beg-pos generic-pos generic-inst-pos generic-end-pos
16366	    signal-beg-pos signal-pos
16367	    constant-temp-pos port-temp-pos signal-temp-pos)
16368       (message "Wiring components...")
16369       ;; process all instances
16370       (goto-char arch-stat-pos)
16371       (while (re-search-forward
16372	       (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
16373		       "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
16374		       "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
16375		       "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
16376		       "[ \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)
16377	 (setq inst-name (match-string-no-properties 1)
16378	       comp-name (match-string-no-properties 4)
16379	       comp-ent-name (match-string-no-properties 12)
16380	       has-generic (or (match-string 7) (match-string 17)))
16381	 ;; get port ...
16382	 (if comp-name
16383	     ;; ... from component declaration
16384	     (vhdl-visit-file
16385	         (when vhdl-use-components-package pack-file-name) t
16386	      (save-excursion
16387		(goto-char (point-min))
16388		(unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
16389		  (error "ERROR:  Component declaration not found: \"%s\"" comp-name))
16390		(vhdl-port-copy)))
16391	   ;; ... from entity declaration (direct instantiation)
16392	   (setq comp-ent-file-name
16393		 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
16394			 "." (file-name-extension (buffer-file-name))))
16395	   (vhdl-visit-file
16396	       comp-ent-file-name t
16397	    (save-excursion
16398	      (goto-char (point-min))
16399	      (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
16400		(error "ERROR:  Entity declaration not found: \"%s\"" comp-ent-name))
16401	      (vhdl-port-copy))))
16402	 (vhdl-port-flatten t)
16403	 (setq generic-alist (nth 1 vhdl-port-list)
16404	       port-alist (nth 2 vhdl-port-list)
16405	       vhdl-port-list nil)
16406	 (setq constant-alist nil
16407	       signal-alist nil)
16408	 (when has-generic
16409	   ;; process all constants in generic map
16410	   (vhdl-forward-syntactic-ws)
16411	   (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16412	     (setq constant-name (match-string-no-properties 3))
16413	     (setq constant-entry
16414		   (cons constant-name
16415			 (if (match-string 1)
16416			     (or (vhdl-aget generic-alist (match-string 2))
16417				 (error "ERROR:  Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16418			   (cdar generic-alist))))
16419	     (push constant-entry constant-alist)
16420	     (setq constant-name (downcase constant-name))
16421	     (if (or (member constant-name single-list)
16422		     (member constant-name multi-list))
16423		 (progn (setq single-list (delete constant-name single-list))
16424			(vhdl--pushnew constant-name multi-list :test #'equal))
16425	       (vhdl--pushnew constant-name single-list :test #'equal))
16426	     (unless (match-string 1)
16427	       (setq generic-alist (cdr generic-alist)))
16428	     (vhdl-forward-syntactic-ws))
16429	   (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
16430	 ;; process all signals in port map
16431	 (vhdl-forward-syntactic-ws)
16432	 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16433	   (setq signal-name (match-string-no-properties 3))
16434	   (setq signal-entry
16435		 (cons signal-name
16436		       (if (match-string 1)
16437			   (or (vhdl-aget port-alist (match-string 2))
16438			       (error "ERROR:  Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16439			 (cdar port-alist))))
16440	   (push signal-entry signal-alist)
16441	   (setq signal-name (downcase signal-name))
16442	   (if (equal (upcase (nth 2 signal-entry)) "IN")
16443	       ;; input signal
16444	       (cond
16445		((member signal-name local-list)
16446		 nil)
16447		((or (member signal-name single-out-list)
16448		     (member signal-name multi-out-list))
16449		 (setq single-out-list (delete signal-name single-out-list))
16450		 (setq multi-out-list (delete signal-name multi-out-list))
16451		 (vhdl--pushnew signal-name local-list :test #'equal))
16452		((member signal-name single-in-list)
16453		 (setq single-in-list (delete signal-name single-in-list))
16454		 (vhdl--pushnew signal-name multi-in-list :test #'equal))
16455		((not (member signal-name multi-in-list))
16456		 (vhdl--pushnew signal-name single-in-list :test #'equal)))
16457	     ;; output signal
16458	     (cond
16459	      ((member signal-name local-list)
16460	       nil)
16461	      ((or (member signal-name single-in-list)
16462		   (member signal-name multi-in-list))
16463	       (setq single-in-list (delete signal-name single-in-list))
16464	       (setq multi-in-list (delete signal-name multi-in-list))
16465	       (vhdl--pushnew signal-name local-list :test #'equal))
16466	      ((member signal-name single-out-list)
16467	       (setq single-out-list (delete signal-name single-out-list))
16468	       (vhdl--pushnew signal-name multi-out-list :test #'equal))
16469	      ((not (member signal-name multi-out-list))
16470	       (vhdl--pushnew signal-name single-out-list :test #'equal))))
16471	   (unless (match-string 1)
16472	     (setq port-alist (cdr port-alist)))
16473	   (vhdl-forward-syntactic-ws))
16474	 (push (list inst-name (nreverse constant-alist)
16475		     (nreverse signal-alist))
16476               inst-alist))
16477       ;; prepare signal insertion
16478       (vhdl-goto-marker arch-decl-pos)
16479       (forward-line 1)
16480       (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
16481       (setq signal-pos (point-marker))
16482       (while (progn (vhdl-forward-syntactic-ws)
16483		     (looking-at "signal\\>"))
16484	 (beginning-of-line 2)
16485	 (delete-region signal-pos (point)))
16486       (setq signal-beg-pos signal-pos)
16487       ;; open entity file
16488       (when (file-exists-p ent-file-name)
16489	 (find-file ent-file-name))
16490       (goto-char (point-min))
16491       (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16492	 (error "ERROR:  Entity not found: \"%s\"" ent-name))
16493       ;; prepare generic clause insertion
16494       (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16495		    (match-string 1))
16496	 (goto-char (match-beginning 0))
16497	 (indent-to vhdl-basic-offset)
16498	 (insert "generic ();\n\n")
16499	 (backward-char 4))
16500       (backward-char)
16501       (setq generic-pos (point-marker))
16502       (forward-sexp) (end-of-line)
16503       (delete-region generic-pos (point)) (delete-char 1)
16504       (insert "(\n")
16505       (when multi-list
16506	 (insert "\n")
16507	 (indent-to (* 2 vhdl-basic-offset))
16508	 (insert "-- global generics\n"))
16509       (setq generic-beg-pos (point-marker) generic-pos (point-marker)
16510	     generic-inst-pos (point-marker) generic-end-pos (point-marker))
16511       ;; prepare port clause insertion
16512       (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16513		    (match-string 1))
16514	 (goto-char (match-beginning 0))
16515	 (indent-to vhdl-basic-offset)
16516	 (insert "port ();\n\n")
16517	 (backward-char 4))
16518       (backward-char)
16519       (setq port-in-pos (point-marker))
16520       (forward-sexp) (end-of-line)
16521       (delete-region port-in-pos (point)) (delete-char 1)
16522       (insert "(\n")
16523       (when (or multi-in-list multi-out-list)
16524	 (insert "\n")
16525	 (indent-to (* 2 vhdl-basic-offset))
16526	 (insert "-- global ports\n"))
16527       (setq port-beg-pos (point-marker) port-in-pos (point-marker)
16528	     port-out-pos (point-marker) port-inst-pos (point-marker)
16529	     port-end-pos (point-marker))
16530       ;; insert generics, ports and signals
16531       (setq inst-alist (nreverse inst-alist))
16532       (while inst-alist
16533	 (setq inst-name (nth 0 (car inst-alist))
16534	       constant-alist (nth 1 (car inst-alist))
16535	       signal-alist (nth 2 (car inst-alist))
16536	       constant-temp-pos generic-inst-pos
16537	       port-temp-pos port-inst-pos
16538	       signal-temp-pos signal-pos)
16539	 ;; generics
16540	 (while constant-alist
16541	   (setq constant-name (downcase (caar constant-alist))
16542		 constant-entry (car constant-alist))
16543	   (unless (string-match "^[0-9]+" constant-name)
16544	   (cond ((member constant-name written-list)
16545		  nil)
16546		 ((member constant-name multi-list)
16547		  (vhdl-goto-marker generic-pos)
16548		  (setq generic-end-pos
16549			(vhdl-max-marker
16550			 generic-end-pos
16551			 (vhdl-compose-insert-generic constant-entry)))
16552		  (setq generic-pos (point-marker))
16553		  (vhdl--pushnew constant-name written-list :test #'equal))
16554		 (t
16555		  (vhdl-goto-marker
16556		   (vhdl-max-marker generic-inst-pos generic-pos))
16557		  (setq generic-end-pos
16558			(vhdl-compose-insert-generic constant-entry))
16559		  (setq generic-inst-pos (point-marker))
16560		    (vhdl--pushnew constant-name written-list :test #'equal))))
16561	   (setq constant-alist (cdr constant-alist)))
16562	 (when (/= constant-temp-pos generic-inst-pos)
16563	   (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
16564	   (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16565	   (insert "-- generics for \"" inst-name "\"\n")
16566	   (vhdl-goto-marker generic-inst-pos))
16567	 ;; ports and signals
16568	 (while signal-alist
16569	   (setq signal-name (downcase (caar signal-alist))
16570		 signal-entry (car signal-alist))
16571	   (cond ((member signal-name written-list)
16572		  nil)
16573		 ((member signal-name multi-in-list)
16574		  (vhdl-goto-marker port-in-pos)
16575		  (setq port-end-pos
16576			(vhdl-max-marker
16577			 port-end-pos (vhdl-compose-insert-port signal-entry)))
16578		  (setq port-in-pos (point-marker))
16579		  (vhdl--pushnew signal-name written-list :test #'equal))
16580		 ((member signal-name multi-out-list)
16581		  (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
16582		  (setq port-end-pos
16583			(vhdl-max-marker
16584			 port-end-pos (vhdl-compose-insert-port signal-entry)))
16585		  (setq port-out-pos (point-marker))
16586		  (vhdl--pushnew signal-name written-list :test #'equal))
16587		 ((or (member signal-name single-in-list)
16588		      (member signal-name single-out-list))
16589		  (vhdl-goto-marker
16590		   (vhdl-max-marker
16591		    port-inst-pos
16592		    (vhdl-max-marker port-out-pos port-in-pos)))
16593		  (setq port-end-pos (vhdl-compose-insert-port signal-entry))
16594		  (setq port-inst-pos (point-marker))
16595		  (vhdl--pushnew signal-name written-list :test #'equal))
16596		 ((equal (upcase (nth 2 signal-entry)) "OUT")
16597		  (vhdl-goto-marker signal-pos)
16598		  (vhdl-compose-insert-signal signal-entry)
16599		  (setq signal-pos (point-marker))
16600		  (vhdl--pushnew signal-name written-list :test #'equal)))
16601	   (setq signal-alist (cdr signal-alist)))
16602	 (when (/= port-temp-pos port-inst-pos)
16603	   (vhdl-goto-marker
16604	    (vhdl-max-marker port-temp-pos
16605			     (vhdl-max-marker port-in-pos port-out-pos)))
16606	   (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16607	   (insert "-- ports to \"" inst-name "\"\n")
16608	   (vhdl-goto-marker port-inst-pos))
16609	 (when (/= signal-temp-pos signal-pos)
16610	   (vhdl-goto-marker signal-temp-pos)
16611	   (insert "\n") (indent-to vhdl-basic-offset)
16612	   (insert "-- outputs of \"" inst-name "\"\n")
16613	   (vhdl-goto-marker signal-pos))
16614	 (setq inst-alist (cdr inst-alist)))
16615       ;; finalize generic/port clause
16616       (vhdl-goto-marker generic-end-pos) (backward-char)
16617       (when (= generic-beg-pos generic-end-pos)
16618	 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16619	 (insert ";") (backward-char))
16620       (insert ")")
16621       (vhdl-goto-marker port-end-pos) (backward-char)
16622       (when (= port-beg-pos port-end-pos)
16623	 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16624	 (insert ";") (backward-char))
16625       (insert ")")
16626       ;; align everything
16627       (when vhdl-auto-align
16628	 (vhdl-goto-marker generic-beg-pos)
16629	 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
16630	 (vhdl-align-region-groups port-beg-pos port-end-pos 1)
16631	 (vhdl-goto-marker signal-beg-pos)
16632	 (vhdl-align-region-groups signal-beg-pos signal-pos))
16633       (switch-to-buffer (marker-buffer signal-beg-pos))
16634       (message "Wiring components...done")))))
16635
16636(defun vhdl-compose-insert-generic (entry)
16637  "Insert ENTRY as generic declaration."
16638  (let (pos)
16639    (indent-to (* 2 vhdl-basic-offset))
16640    (insert (nth 0 entry) " : " (nth 1 entry))
16641    (when (nth 2 entry)
16642      (insert " := " (nth 2 entry)))
16643    (insert ";")
16644    (setq pos (point-marker))
16645    (when (and vhdl-include-port-comments (nth 3 entry))
16646      (vhdl-comment-insert-inline (nth 3 entry) t))
16647    (insert "\n")
16648    pos))
16649
16650(defun vhdl-compose-insert-port (entry)
16651  "Insert ENTRY as port declaration."
16652  (let (pos)
16653    (indent-to (* 2 vhdl-basic-offset))
16654    (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
16655    (setq pos (point-marker))
16656    (when (and vhdl-include-port-comments (nth 4 entry))
16657      (vhdl-comment-insert-inline (nth 4 entry) t))
16658    (insert "\n")
16659    pos))
16660
16661(defun vhdl-compose-insert-signal (entry)
16662  "Insert ENTRY as signal declaration."
16663  (indent-to vhdl-basic-offset)
16664  (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
16665  (when (and vhdl-include-port-comments (nth 4 entry))
16666    (vhdl-comment-insert-inline (nth 4 entry) t))
16667  (insert "\n"))
16668
16669(defvar lazy-lock-minimum-size)
16670
16671(defun vhdl-compose-components-package ()
16672  "Generate a package containing component declarations for all entities in the
16673current project/directory."
16674  (interactive)
16675  (vhdl-require-hierarchy-info)
16676  (let* ((project (vhdl-project-p))
16677	 (pack-name (vhdl-get-components-package-name))
16678	 (pack-file-name
16679	  (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16680		  "." (file-name-extension (buffer-file-name))))
16681	 (ent-alist (vhdl-aget vhdl-entity-alist
16682			       (or project
16683				   (abbreviate-file-name default-directory))))
16684	 (lazy-lock-minimum-size 0)
16685	 clause-pos component-pos)
16686    (message "Generating components package \"%s\"..." pack-name)
16687    ;; open package file
16688    (when (and (file-exists-p pack-file-name)
16689	       (not (y-or-n-p (concat "File \"" pack-file-name
16690				      "\" exists; overwrite? "))))
16691      (error "ERROR:  Generating components package...aborted"))
16692    (find-file pack-file-name)
16693    (erase-buffer)
16694    ;; insert header
16695    (if vhdl-compose-include-header
16696	(progn (vhdl-template-header
16697		(concat "Components package (generated by Emacs VHDL Mode "
16698			vhdl-version ")"))
16699	       (goto-char (point-max)))
16700      (vhdl-comment-display-line) (insert "\n\n"))
16701    ;; insert std_logic_1164 package
16702    (vhdl-template-package-std-logic-1164)
16703    (insert "\n") (setq clause-pos (point-marker))
16704    (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
16705    ;; insert package declaration
16706    (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
16707    (vhdl-insert-keyword " IS\n\n")
16708    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16709    (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16710    (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16711    (indent-to vhdl-basic-offset)
16712    (setq component-pos (point-marker))
16713    (insert "\n\n") (vhdl-insert-keyword "END ")
16714    (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
16715    (insert pack-name ";\n\n")
16716    ;; insert footer
16717    (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16718	(vhdl-template-footer)
16719      (vhdl-comment-display-line) (insert "\n"))
16720    ;; insert component declarations
16721    (while ent-alist
16722      (vhdl-visit-file (nth 2 (car ent-alist)) nil
16723	(goto-char (point-min))
16724	(forward-line (1- (nth 3 (car ent-alist))))
16725	(end-of-line)
16726	(vhdl-port-copy))
16727      (goto-char component-pos)
16728      (vhdl-port-paste-component t)
16729      (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
16730      (setq component-pos (point-marker))
16731      (goto-char clause-pos)
16732      (vhdl-port-paste-context-clause pack-name)
16733      (setq clause-pos (point-marker))
16734      (setq ent-alist (cdr ent-alist)))
16735    (goto-char (point-min))
16736    (save-buffer)
16737    (message "Generating components package \"%s\"...done\n  File created: \"%s\""
16738	     pack-name pack-file-name)))
16739
16740(defun vhdl-compose-configuration-architecture ( _ent-name arch-name
16741						 ent-alist-arg conf-alist-arg
16742						 inst-alist
16743						 &optional insert-conf)
16744  "Generate block configuration for architecture."
16745  (let ((ent-alist ent-alist-arg)
16746	(conf-alist conf-alist-arg)
16747	(margin (current-indentation))
16748	(beg (point-at-bol))
16749	ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key
16750    ;; insert block configuration (for architecture)
16751    (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
16752    (setq margin (+ margin vhdl-basic-offset))
16753    ;; process all instances
16754    (while inst-alist
16755      (setq inst-entry (car inst-alist))
16756      ;; is component?
16757      (when (nth 4 inst-entry)
16758	(setq insert-conf t)
16759	(setq inst-path (nth 9 inst-entry))
16760	;; skip common path with previous instance
16761	(while (and inst-path (equal (car inst-path) (car inst-prev-path)))
16762	  (setq inst-path (cdr inst-path)
16763		inst-prev-path (cdr inst-prev-path)))
16764	;; insert block configuration end (for previous block/generate)
16765	(while inst-prev-path
16766	  (setq margin (- margin vhdl-basic-offset))
16767	  (indent-to margin)
16768	  (vhdl-insert-keyword "END FOR;\n")
16769	  (setq inst-prev-path (cdr inst-prev-path)))
16770	;; insert block configuration beginning (for current block/generate)
16771	(indent-to margin)
16772	(while inst-path
16773	  (setq margin (+ margin vhdl-basic-offset))
16774	  (vhdl-insert-keyword "FOR ")
16775	  (insert (car inst-path) "\n")
16776	  (indent-to margin)
16777	  (setq inst-path (cdr inst-path)))
16778	;; insert component configuration beginning
16779	(vhdl-insert-keyword "FOR ")
16780	(insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n")
16781	;; find subconfiguration
16782	(setq conf-key (nth 7 inst-entry))
16783	(setq tmp-alist conf-alist)
16784	;; use first configuration found for instance's entity
16785	(while (and tmp-alist (null conf-key))
16786	  (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
16787	    (setq conf-key (nth 0 (car tmp-alist))))
16788	  (setq tmp-alist (cdr tmp-alist)))
16789	(setq conf-entry (vhdl-aget conf-alist conf-key))
16790	;; insert binding indication ...
16791	;; ... with subconfiguration (if exists)
16792	(if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
16793	    (progn
16794	      (indent-to (+ margin vhdl-basic-offset))
16795	      (vhdl-insert-keyword "USE CONFIGURATION ")
16796	      (insert (vhdl-work-library) "." (nth 0 conf-entry))
16797	      (insert ";\n"))
16798	  ;; ... with entity (if exists)
16799	  (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry)))
16800	  (when ent-entry
16801	    (indent-to (+ margin vhdl-basic-offset))
16802	    (vhdl-insert-keyword "USE ENTITY ")
16803	    (insert (vhdl-work-library) "." (nth 0 ent-entry))
16804	    ;; insert architecture name (if architecture exists)
16805	    (when (nth 3 ent-entry)
16806	      (setq arch-name
16807		    ;; choose architecture name a) from configuration,
16808		    ;; b) from mra, or c) from first architecture
16809		    (or (nth 0 (vhdl-aget (nth 3 ent-entry)
16810					  (or (nth 6 inst-entry)
16811					      (nth 4 ent-entry))))
16812			(nth 1 (car (nth 3 ent-entry)))))
16813	      (insert "(" arch-name ")"))
16814	    (insert ";\n")
16815	    ;; insert block configuration (for architecture of subcomponent)
16816	    (when (and vhdl-compose-configuration-hierarchical
16817		       (nth 3 ent-entry))
16818	      (indent-to (+ margin vhdl-basic-offset))
16819	      (vhdl-compose-configuration-architecture
16820	       (nth 0 ent-entry) arch-name ent-alist conf-alist
16821	       (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name)))))))
16822	;; insert component configuration end
16823	(indent-to margin)
16824	(vhdl-insert-keyword "END FOR;\n")
16825	(setq inst-prev-path (nth 9 inst-entry)))
16826      (setq inst-alist (cdr inst-alist)))
16827    ;; insert block configuration end (for block/generate)
16828    (while inst-prev-path
16829      (setq margin (- margin vhdl-basic-offset))
16830      (indent-to margin)
16831      (vhdl-insert-keyword "END FOR;\n")
16832      (setq inst-prev-path (cdr inst-prev-path)))
16833    (indent-to (- margin vhdl-basic-offset))
16834    ;; insert block configuration end or remove beginning (for architecture)
16835    (if insert-conf
16836	(vhdl-insert-keyword "END FOR;\n")
16837      (delete-region beg (point)))))
16838
16839(defun vhdl-compose-configuration (&optional ent-name arch-name)
16840  "Generate configuration declaration."
16841  (interactive)
16842  (vhdl-require-hierarchy-info)
16843  (let ((ent-alist (vhdl-aget vhdl-entity-alist
16844			      (or (vhdl-project-p)
16845				  (abbreviate-file-name default-directory))))
16846	(conf-alist (vhdl-aget vhdl-config-alist
16847			       (or (vhdl-project-p)
16848				   (abbreviate-file-name default-directory))))
16849	(from-speedbar ent-name)
16850	inst-alist conf-name conf-file-name pos)
16851    (vhdl-prepare-search-2
16852     ;; get entity and architecture name
16853     (unless ent-name
16854       (save-excursion
16855	 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
16856		      (not (equal "END" (upcase (match-string 1))))
16857		      (setq ent-name (match-string-no-properties 3))
16858		      (setq arch-name (match-string-no-properties 2)))
16859	   (error "ERROR:  Not within an architecture"))))
16860     (setq conf-name (vhdl-replace-string
16861		      vhdl-compose-configuration-name
16862		      (concat ent-name " " arch-name)))
16863     (setq inst-alist
16864	   (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name)))
16865			     (downcase arch-name)))))
16866     (message "Generating configuration \"%s\"..." conf-name)
16867     (if vhdl-compose-configuration-create-file
16868	 ;; open configuration file
16869	 (progn
16870	   (setq conf-file-name
16871		 (concat (vhdl-replace-string vhdl-configuration-file-name
16872					      conf-name t)
16873			 "." (file-name-extension (buffer-file-name))))
16874	   (when (and (file-exists-p conf-file-name)
16875		      (not (y-or-n-p (concat "File \"" conf-file-name
16876					     "\" exists; overwrite? "))))
16877	     (error "ERROR:  Creating configuration...aborted"))
16878	   (find-file conf-file-name)
16879	   (erase-buffer)
16880	   (set-buffer-modified-p nil)
16881	   ;; insert header
16882	   (if vhdl-compose-include-header
16883	       (progn (vhdl-template-header
16884		       (concat "Configuration declaration for design \""
16885			       ent-name "(" arch-name ")\""))
16886		      (goto-char (point-max)))
16887	     (vhdl-comment-display-line) (insert "\n\n")))
16888       ;; goto end of architecture
16889       (unless from-speedbar
16890	 (re-search-forward "^end\\>" nil)
16891	 (end-of-line) (insert "\n\n")
16892	 (vhdl-comment-display-line) (insert "\n\n")))
16893     ;; insert library clause
16894     (setq pos (point))
16895     (vhdl-template-standard-package (vhdl-work-library) nil)
16896     (when (/= pos (point))
16897       (insert "\n\n"))
16898     ;; insert configuration
16899     (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name)
16900     (vhdl-insert-keyword " OF ") (insert ent-name)
16901     (vhdl-insert-keyword " IS\n")
16902     (indent-to vhdl-basic-offset)
16903     ;; insert block configuration (for architecture)
16904     (vhdl-compose-configuration-architecture
16905      ent-name arch-name ent-alist conf-alist inst-alist t)
16906     (vhdl-insert-keyword "END ") (insert conf-name ";")
16907     (when conf-file-name
16908       ;; insert footer and save
16909       (insert "\n\n")
16910       (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16911	   (vhdl-template-footer)
16912	 (vhdl-comment-display-line) (insert "\n"))
16913       (save-buffer))
16914     (message "%s"
16915      (concat (format "Generating configuration \"%s\"...done" conf-name)
16916	      (and conf-file-name
16917		   (format "\n  File created: \"%s\"" conf-file-name))))))
16918
16919
16920;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16921;;; Compilation / Makefile generation
16922;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16923;; (using `compile.el')
16924
16925(defvar vhdl-compile-post-command ""
16926  "String appended to compile command after file name.")
16927
16928(defun vhdl-makefile-name ()
16929  "Return the Makefile name of the current project or the current compiler if
16930no project is defined."
16931  (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
16932	(compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
16933    (vhdl-replace-string
16934     (cons "\\(.*\\)\n\\(.*\\)"
16935	   (or (nth 8 project-alist) (nth 8 compiler-alist)))
16936     (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
16937
16938(defun vhdl-compile-directory ()
16939  "Return the directory where compilation/make should be run."
16940  (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
16941	 (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
16942	 (directory (vhdl-resolve-env-variable
16943		     (if project
16944			 (vhdl-replace-string
16945			  (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
16946		       (nth 6 compiler)))))
16947    (file-name-as-directory
16948     (if (file-name-absolute-p directory)
16949	 directory
16950       (expand-file-name directory (vhdl-default-directory))))))
16951
16952(defun vhdl-uniquify (in-list)
16953  "Remove duplicate elements from IN-LIST."
16954  (let (out-list)
16955    (while in-list
16956      (vhdl--pushnew (car in-list) out-list :test #'equal)
16957      (setq in-list (cdr in-list)))
16958    out-list))
16959
16960(defun vhdl-set-compiler (name)
16961  "Set current compiler to NAME."
16962  (interactive
16963   (list (let ((completion-ignore-case t))
16964	   (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
16965  (if (assoc name vhdl-compiler-alist)
16966      (progn (setq vhdl-compiler name)
16967	     (message "Current compiler: \"%s\"" vhdl-compiler))
16968    (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
16969
16970;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16971;; Compilation
16972
16973(defun vhdl-compile-init ()
16974  "Initialize for compilation."
16975  (when (and (not vhdl-emacs-22)
16976	     (or (null compilation-error-regexp-alist)
16977		 (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
16978			     compilation-error-regexp-alist))))
16979    ;; `compilation-error-regexp-alist'
16980    (let ((commands-alist vhdl-compiler-alist)
16981	  regexp-alist sublist)
16982      (while commands-alist
16983	(setq sublist (nth 11 (car commands-alist)))
16984	(unless (or (equal "" (car sublist))
16985		    (assoc (car sublist) regexp-alist))
16986	  (push (list (nth 0 sublist)
16987		      (if (and (featurep 'xemacs) (not (nth 1 sublist)))
16988			  9
16989					   (nth 1 sublist))
16990					 (nth 2 sublist) (nth 3 sublist))
16991		regexp-alist))
16992	(setq commands-alist (cdr commands-alist)))
16993      (setq compilation-error-regexp-alist
16994	    (append compilation-error-regexp-alist (nreverse regexp-alist))))
16995    ;; `compilation-file-regexp-alist'
16996    (let ((commands-alist vhdl-compiler-alist)
16997	  regexp-alist sublist)
16998      ;; matches vhdl-mode file name output
16999      (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
17000      (while commands-alist
17001	(setq sublist (nth 12 (car commands-alist)))
17002	(unless (or (equal "" (car sublist))
17003		    (assoc (car sublist) regexp-alist))
17004	  (push sublist regexp-alist))
17005	(setq commands-alist (cdr commands-alist)))
17006      (setq compilation-file-regexp-alist
17007	    (append compilation-file-regexp-alist (nreverse regexp-alist))))))
17008
17009(defvar vhdl-compile-file-name nil
17010  "Name of file to be compiled.")
17011
17012(defun vhdl-compile-print-file-name ()
17013  "Function called within `compile' to print out file name for compilers that
17014do not print any file names."
17015  (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
17016
17017(defun vhdl-get-compile-options (project compiler file-name
17018					 &optional file-options-only)
17019  "Get compiler options.  Returning nil means do not compile this file."
17020  (let* ((compiler-options (nth 1 compiler))
17021	 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
17022	 (project-options (nth 0 project-entry))
17023	 (exception-list (and file-name (nth 2 project-entry)))
17024	 (work-library (vhdl-work-library))
17025	 (case-fold-search nil)
17026	 file-options)
17027    (while (and exception-list
17028		(not (string-match (caar exception-list) file-name)))
17029      (setq exception-list (cdr exception-list)))
17030    (if (and exception-list (not (cdar exception-list)))
17031	nil
17032      (if (and file-options-only (not exception-list))
17033	  'default
17034	(setq file-options (cdar exception-list))
17035	;; insert library name in compiler-specific options
17036	(setq compiler-options
17037	      (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
17038				   work-library))
17039	;; insert compiler-specific options in project-specific options
17040	(when project-options
17041	  (setq project-options
17042		(vhdl-replace-string
17043		 (cons "\\(.*\\)\n\\(.*\\)" project-options)
17044		 (concat work-library "\n" compiler-options))))
17045	;; insert project-specific options in file-specific options
17046	(when file-options
17047	  (setq file-options
17048		(vhdl-replace-string
17049		 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
17050		 (concat work-library "\n" compiler-options "\n"
17051			 project-options))))
17052	;; return options
17053	(or file-options project-options compiler-options)))))
17054
17055(defun vhdl-get-make-options (project compiler)
17056  "Get make options."
17057  (let* ((compiler-options (nth 3 compiler))
17058	 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
17059	 (project-options (nth 1 project-entry))
17060	 (makefile-name (vhdl-makefile-name)))
17061    ;; insert Makefile name in compiler-specific options
17062    (setq compiler-options
17063	  (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
17064			       makefile-name))
17065    ;; insert compiler-specific options in project-specific options
17066    (when project-options
17067      (setq project-options
17068	    (vhdl-replace-string
17069	     (cons "\\(.*\\)\n\\(.*\\)" project-options)
17070	     (concat makefile-name "\n" compiler-options))))
17071    ;; return options
17072    (or project-options compiler-options)))
17073
17074(defun vhdl-compile ()
17075  "Compile current buffer using the VHDL compiler specified in `vhdl-compiler'."
17076  (interactive)
17077  (vhdl-compile-init)
17078  (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17079	 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17080		       (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17081	 (command (nth 0 compiler))
17082	 (default-directory (vhdl-compile-directory))
17083	 (file-name (if vhdl-compile-absolute-path
17084			(buffer-file-name)
17085		      (file-relative-name (buffer-file-name))))
17086	 (options (vhdl-get-compile-options project compiler file-name))
17087	 compilation-process-setup-function)
17088    (unless (file-directory-p default-directory)
17089      (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17090    ;; put file name into quotes if it contains spaces
17091    (when (string-match " " file-name)
17092      (setq file-name (concat "\"" file-name "\"")))
17093    ;; print out file name if compiler does not
17094    (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
17095				     (buffer-file-name)
17096				   (file-relative-name (buffer-file-name))))
17097    (when (and (= 0 (nth 1 (nth 10 compiler)))
17098	       (= 0 (nth 1 (nth 11 compiler))))
17099      (setq compilation-process-setup-function #'vhdl-compile-print-file-name))
17100    ;; run compilation
17101    (if options
17102	(when command
17103	  (compile (concat command " " options " " file-name
17104			   (unless (equal vhdl-compile-post-command "")
17105			     (concat " " vhdl-compile-post-command)))))
17106      (vhdl-warning "Your project settings tell me not to compile this file"))))
17107
17108(defvar vhdl-make-target "all"
17109  "Default target for `vhdl-make' command.")
17110
17111(defun vhdl-make (&optional target)
17112  "Call make command for compilation of all updated source files (requires
17113`Makefile').  Optional argument TARGET allows you to compile the design
17114specified by a target."
17115  (interactive)
17116  (setq vhdl-make-target
17117	(or target (read-from-minibuffer "Target: " vhdl-make-target
17118					 vhdl-minibuffer-local-map)))
17119  (vhdl-compile-init)
17120  (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17121	 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17122		       (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17123	 (command (nth 2 compiler))
17124	 (options (vhdl-get-make-options project compiler))
17125	 (default-directory (vhdl-compile-directory)))
17126    (unless (file-directory-p default-directory)
17127      (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17128    ;; run make
17129    (compile (concat (if (equal command "") "make" command)
17130		     " " options " " vhdl-make-target))))
17131
17132;; Emacs 22+ setup
17133(defvar vhdl-error-regexp-emacs-alist
17134  ;; Get regexps from `vhdl-compiler-alist'
17135  (let ((compiler-alist vhdl-compiler-alist)
17136	(error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
17137   (while compiler-alist
17138     ;; only add regexps for currently selected compiler
17139     (when (or (not vhdl-compile-use-local-error-regexp)
17140	       (equal vhdl-compiler (nth 0 (car compiler-alist))))
17141       ;; add error message regexps
17142       (setq error-regexp-alist
17143	     (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))))))
17144			   (nth 11 (car compiler-alist)))
17145		   error-regexp-alist))
17146       ;; add filename regexps
17147       (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
17148	 (setq error-regexp-alist
17149	       (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
17150			     (nth 12 (car compiler-alist)))
17151		     error-regexp-alist))))
17152     (setq compiler-alist (cdr compiler-alist)))
17153   error-regexp-alist)
17154  "List of regexps for VHDL compilers.  For Emacs 22+.")
17155
17156;; Add error regexps using compilation-mode-hook.
17157(defun vhdl-error-regexp-add-emacs ()
17158  "Set up Emacs compile for VHDL."
17159  (interactive)
17160  (when (and (boundp 'compilation-error-regexp-alist-alist)
17161	     (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
17162    ;; remove all other compilers
17163    (when vhdl-compile-use-local-error-regexp
17164      (setq compilation-error-regexp-alist nil))
17165    ;; add VHDL compilers
17166    (mapcar
17167     (lambda (item)
17168       (push (car item) compilation-error-regexp-alist)
17169       (push item compilation-error-regexp-alist-alist))
17170     vhdl-error-regexp-emacs-alist)))
17171
17172(when vhdl-emacs-22
17173  (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs))
17174
17175;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17176;; Makefile generation
17177
17178(defun vhdl-generate-makefile ()
17179  "Generate `Makefile'."
17180  (interactive)
17181  (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17182		       (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17183	 (command (nth 4 compiler)))
17184    ;; generate makefile
17185    (if command
17186	(let ((default-directory (vhdl-compile-directory)))
17187	  (compile (vhdl-replace-string
17188		    (cons "\\(.*\\) \\(.*\\)" command)
17189		    (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
17190      (vhdl-generate-makefile-1))))
17191
17192(defun vhdl-get-packages (lib-alist work-library)
17193  "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
17194  (let (pack-list)
17195    (while lib-alist
17196      (when (equal (downcase (caar lib-alist)) (downcase work-library))
17197	(push (cdar lib-alist) pack-list))
17198      (setq lib-alist (cdr lib-alist)))
17199    pack-list))
17200
17201(defun vhdl-generate-makefile-1 ()
17202  "Generate Makefile for current project or directory."
17203  ;; scan hierarchy if required
17204  (if (vhdl-project-p)
17205      (unless (or (assoc vhdl-project vhdl-file-alist)
17206		  (vhdl-load-cache vhdl-project))
17207	(vhdl-scan-project-contents vhdl-project))
17208    (let ((directory (abbreviate-file-name default-directory)))
17209      (unless (or (assoc directory vhdl-file-alist)
17210		  (vhdl-load-cache directory))
17211	(vhdl-scan-directory-contents directory))))
17212  (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
17213	 (project (vhdl-project-p))
17214	 (ent-alist (vhdl-aget vhdl-entity-alist (or project directory)))
17215	 (conf-alist (vhdl-aget vhdl-config-alist (or project directory)))
17216	 (pack-alist (vhdl-aget vhdl-package-alist (or project directory)))
17217	 (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17218			  '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
17219			    "\\1.vhd" "\\1_body.vhd" identity)))
17220	 (mapping-exist
17221	  (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
17222	 (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
17223	 (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
17224	 (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
17225	 (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
17226	 (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
17227	 (adjust-case (nth 5 regexp-list))
17228	 (work-library (downcase (vhdl-work-library)))
17229	 (compile-directory (expand-file-name (vhdl-compile-directory)
17230					      default-directory))
17231	 (makefile-name (vhdl-makefile-name))
17232	 rule-alist arch-alist inst-alist
17233	 target-list depend-list unit-list prim-list second-list subcomp-list
17234	 lib-alist lib-body-alist pack-list all-pack-list
17235	 ent-key ent-file-name arch-key arch-file-name ent-arch-key
17236	 conf-key conf-file-name pack-key pack-file-name
17237	 ent-entry arch-entry conf-entry pack-entry inst-entry
17238	 pack-body-key pack-body-file-name inst-ent-key inst-conf-key
17239	 tmp-key tmp-list rule)
17240    ;; check prerequisites
17241    (unless (file-exists-p compile-directory)
17242      (make-directory compile-directory t))
17243    (unless mapping-exist
17244      (vhdl-warning
17245       (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\""
17246	       vhdl-compiler vhdl-compiler) t))
17247    (message "Generating makefile \"%s\"..." makefile-name)
17248    ;; rules for all entities
17249    (setq tmp-list ent-alist)
17250    (while ent-alist
17251      (setq ent-entry (car ent-alist)
17252	    ent-key (nth 0 ent-entry))
17253      (when (nth 2 ent-entry)
17254	(setq ent-file-name (if vhdl-compile-absolute-path
17255				(nth 2 ent-entry)
17256			      (file-relative-name (nth 2 ent-entry)
17257						  compile-directory))
17258	      arch-alist (nth 4 ent-entry)
17259	      lib-alist (nth 6 ent-entry)
17260	      rule (vhdl-aget rule-alist ent-file-name)
17261	      target-list (nth 0 rule)
17262	      depend-list (nth 1 rule)
17263	      second-list nil
17264	      subcomp-list nil)
17265	(setq tmp-key (vhdl-replace-string
17266		       ent-regexp
17267		       (funcall adjust-case
17268				(concat ent-key "  " work-library))))
17269	(push (cons ent-key tmp-key) unit-list)
17270	;; rule target for this entity
17271	(push ent-key target-list)
17272	;; rule dependencies for all used packages
17273	(setq pack-list (vhdl-get-packages lib-alist work-library))
17274	(setq depend-list (append depend-list pack-list))
17275	(setq all-pack-list pack-list)
17276	;; add rule
17277	(vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
17278	;; rules for all corresponding architectures
17279	(while arch-alist
17280	  (setq arch-entry (car arch-alist)
17281		arch-key (nth 0 arch-entry)
17282		ent-arch-key (concat ent-key "-" arch-key)
17283		arch-file-name (if vhdl-compile-absolute-path
17284				   (nth 2 arch-entry)
17285				 (file-relative-name (nth 2 arch-entry)
17286						     compile-directory))
17287		inst-alist (nth 4 arch-entry)
17288		lib-alist (nth 5 arch-entry)
17289		rule (vhdl-aget rule-alist arch-file-name)
17290		target-list (nth 0 rule)
17291		depend-list (nth 1 rule))
17292	  (setq tmp-key (vhdl-replace-string
17293			 arch-regexp
17294			 (funcall adjust-case
17295				  (concat arch-key " " ent-key " "
17296					  work-library))))
17297	  (setq unit-list
17298		(cons (cons ent-arch-key tmp-key) unit-list))
17299	  (push ent-arch-key second-list)
17300	  ;; rule target for this architecture
17301	  (push ent-arch-key target-list)
17302	  ;; rule dependency for corresponding entity
17303	  (push ent-key depend-list)
17304	  ;; rule dependencies for contained component instantiations
17305	  (while inst-alist
17306	    (setq inst-entry (car inst-alist))
17307	    (when (or (null (nth 8 inst-entry))
17308		      (equal (downcase (nth 8 inst-entry)) work-library))
17309	      (setq inst-ent-key (or (nth 7 inst-entry)
17310				     (nth 5 inst-entry)))
17311	      (setq depend-list (cons inst-ent-key depend-list)
17312		    subcomp-list (cons inst-ent-key subcomp-list)))
17313	    (setq inst-alist (cdr inst-alist)))
17314	  ;; rule dependencies for all used packages
17315	  (setq pack-list (vhdl-get-packages lib-alist work-library))
17316	  (setq depend-list (append depend-list pack-list))
17317	  (setq all-pack-list (append all-pack-list pack-list))
17318	  ;; add rule
17319	  (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
17320	  (setq arch-alist (cdr arch-alist)))
17321	(push (list ent-key second-list (append subcomp-list all-pack-list))
17322	      prim-list))
17323      (setq ent-alist (cdr ent-alist)))
17324    (setq ent-alist tmp-list)
17325    ;; rules for all configurations
17326    (setq tmp-list conf-alist)
17327    (while conf-alist
17328      (setq conf-entry (car conf-alist)
17329	    conf-key (nth 0 conf-entry)
17330	    conf-file-name (if vhdl-compile-absolute-path
17331			       (nth 2 conf-entry)
17332			     (file-relative-name (nth 2 conf-entry)
17333						 compile-directory))
17334	    ent-key (nth 4 conf-entry)
17335	    arch-key (nth 5 conf-entry)
17336	    inst-alist (nth 6 conf-entry)
17337	    lib-alist (nth 7 conf-entry)
17338	    rule (vhdl-aget rule-alist conf-file-name)
17339	    target-list (nth 0 rule)
17340	    depend-list (nth 1 rule)
17341	    subcomp-list (list ent-key))
17342      (setq tmp-key (vhdl-replace-string
17343		     conf-regexp
17344		     (funcall adjust-case
17345			      (concat conf-key "  " work-library))))
17346      (push (cons conf-key tmp-key) unit-list)
17347      ;; rule target for this configuration
17348      (push conf-key target-list)
17349      ;; rule dependency for corresponding entity and architecture
17350      (setq depend-list
17351	    (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
17352      ;; rule dependencies for used packages
17353      (setq pack-list (vhdl-get-packages lib-alist work-library))
17354      (setq depend-list (append depend-list pack-list))
17355      ;; rule dependencies for contained component configurations
17356      (while inst-alist
17357	(setq inst-entry (car inst-alist))
17358	(setq inst-ent-key (nth 2 inst-entry)
17359	      inst-conf-key (nth 4 inst-entry))
17360	(when (equal (downcase (nth 5 inst-entry)) work-library)
17361	  (when inst-ent-key
17362	    (setq depend-list (cons inst-ent-key depend-list)
17363		  subcomp-list (cons inst-ent-key subcomp-list)))
17364	  (when inst-conf-key
17365	    (setq depend-list (cons inst-conf-key depend-list)
17366		  subcomp-list (cons inst-conf-key subcomp-list))))
17367	(setq inst-alist (cdr inst-alist)))
17368      ;; add rule
17369      (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
17370      (push (list conf-key nil (append subcomp-list pack-list)) prim-list)
17371      (setq conf-alist (cdr conf-alist)))
17372    (setq conf-alist tmp-list)
17373    ;; rules for all packages
17374    (setq tmp-list pack-alist)
17375    (while pack-alist
17376      (setq pack-entry (car pack-alist)
17377	    pack-key (nth 0 pack-entry)
17378	    pack-body-key nil)
17379      (when (nth 2 pack-entry)
17380	(setq pack-file-name (if vhdl-compile-absolute-path
17381				 (nth 2 pack-entry)
17382			       (file-relative-name (nth 2 pack-entry)
17383						   compile-directory))
17384	      lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
17385	      rule (vhdl-aget rule-alist pack-file-name)
17386	      target-list (nth 0 rule) depend-list (nth 1 rule))
17387	(setq tmp-key (vhdl-replace-string
17388		       pack-regexp
17389		       (funcall adjust-case
17390				(concat pack-key "  " work-library))))
17391	(push (cons pack-key tmp-key) unit-list)
17392	;; rule target for this package
17393	(push pack-key target-list)
17394	;; rule dependencies for all used packages
17395	(setq pack-list (vhdl-get-packages lib-alist work-library))
17396	(setq depend-list (append depend-list pack-list))
17397	(setq all-pack-list pack-list)
17398	;; add rule
17399	(vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
17400	;; rules for this package's body
17401	(when (nth 7 pack-entry)
17402	  (setq pack-body-key (concat pack-key "-body")
17403		pack-body-file-name (if vhdl-compile-absolute-path
17404					(nth 7 pack-entry)
17405				      (file-relative-name (nth 7 pack-entry)
17406							  compile-directory))
17407		rule (vhdl-aget rule-alist pack-body-file-name)
17408		target-list (nth 0 rule)
17409		depend-list (nth 1 rule))
17410	  (setq tmp-key (vhdl-replace-string
17411			 pack-body-regexp
17412			 (funcall adjust-case
17413				  (concat pack-key "  " work-library))))
17414	  (setq unit-list
17415		(cons (cons pack-body-key tmp-key) unit-list))
17416	  ;; rule target for this package's body
17417	  (push pack-body-key target-list)
17418	  ;; rule dependency for corresponding package declaration
17419	  (push pack-key depend-list)
17420	  ;; rule dependencies for all used packages
17421	  (setq pack-list (vhdl-get-packages lib-body-alist work-library))
17422	  (setq depend-list (append depend-list pack-list))
17423	  (setq all-pack-list (append all-pack-list pack-list))
17424	  ;; add rule
17425	  (vhdl-aput 'rule-alist pack-body-file-name
17426		     (list target-list depend-list)))
17427	(setq prim-list
17428	      (cons (list pack-key (when pack-body-key (list pack-body-key))
17429			  all-pack-list)
17430		    prim-list)))
17431      (setq pack-alist (cdr pack-alist)))
17432    (setq pack-alist tmp-list)
17433    ;; generate Makefile
17434    (let* ((project (vhdl-aget vhdl-project-alist project))
17435	   (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17436	   (compiler-id (nth 9 compiler))
17437	   (library-directory
17438	    (vhdl-resolve-env-variable
17439	     (vhdl-replace-string
17440	      (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
17441	      compiler-id)))
17442	   (makefile-path-name (expand-file-name
17443				makefile-name compile-directory))
17444	   (orig-buffer (current-buffer))
17445	   cell second-list subcomp-list options unit-key unit-name)
17446      ;; sort lists
17447      (setq unit-list (vhdl-sort-alist unit-list))
17448      (setq prim-list (vhdl-sort-alist prim-list))
17449      (setq tmp-list rule-alist)
17450      (while tmp-list			; pre-sort rule targets
17451	(setq cell (cdar tmp-list))
17452	(setcar cell (sort (car cell) #'string<))
17453	(setq tmp-list (cdr tmp-list)))
17454      (setq rule-alist			; sort by first rule target
17455	    (sort rule-alist
17456                  (lambda (a b)
17457                    (string< (car (cadr a)) (car (cadr b))))))
17458      ;; open and clear Makefile
17459      (set-buffer (find-file-noselect makefile-path-name t t))
17460      (erase-buffer)
17461      (insert "# -*- Makefile -*-\n"
17462	      "### " (file-name-nondirectory makefile-name)
17463	      " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
17464	      "\n")
17465      (if project
17466	  (insert "\n# Project   : " (nth 0 project))
17467	(insert "\n# Directory : \"" directory "\""))
17468      (insert "\n# Platform  : " vhdl-compiler
17469	      "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
17470	      (user-login-name) "\n")
17471      ;; insert compile and option variable settings
17472      (insert "\n\n# Define compilation command and options\n"
17473	      "\nCOMPILE = " (nth 0 compiler)
17474	      "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
17475	      (if (equal vhdl-compile-post-command "") ""
17476		(concat "\nPOST-COMPILE = " vhdl-compile-post-command))
17477	      "\n")
17478      ;; insert library paths
17479      (setq library-directory
17480	    (directory-file-name
17481	     (if (file-name-absolute-p library-directory)
17482		 library-directory
17483	       (file-relative-name
17484		(expand-file-name library-directory directory)
17485		compile-directory))))
17486      (insert "\n\n# Define library paths\n"
17487	      "\nLIBRARY-" work-library " = " library-directory "\n")
17488      (unless mapping-exist
17489	(insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
17490		")/make" "\n"))
17491      ;; insert variable definitions for all library unit files
17492      (insert "\n\n# Define library unit files\n")
17493      (setq tmp-list unit-list)
17494      (while unit-list
17495	(insert "\nUNIT-" work-library "-" (caar unit-list)
17496		" = \\\n\t$(LIBRARY-" work-library
17497		(if mapping-exist "" "-make") ")/" (cdar unit-list))
17498	(setq unit-list (cdr unit-list)))
17499      ;; insert variable definition for list of all library unit files
17500      (insert "\n\n\n# Define list of all library unit files\n"
17501	      "\nALL_UNITS =")
17502      (setq unit-list tmp-list)
17503      (while unit-list
17504	(insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
17505	(setq unit-list (cdr unit-list)))
17506      (insert "\n")
17507      (setq unit-list tmp-list)
17508      ;; insert `make all' rule
17509      (insert "\n\n\n# Rule for compiling entire design\n"
17510	      "\n" (nth 0 vhdl-makefile-default-targets) " :"
17511	      " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
17512	      " \\\n\t\t$(ALL_UNITS)\n")
17513      ;; insert `make clean' rule
17514      (insert "\n\n# Rule for cleaning entire design\n"
17515	      "\n" (nth 1 vhdl-makefile-default-targets) " : "
17516	      "\n\t-rm -f $(ALL_UNITS)\n")
17517      ;; insert `make library' rule
17518      (insert "\n\n# Rule for creating library directory\n"
17519	      "\n" (nth 2 vhdl-makefile-default-targets) " :"
17520	      " \\\n\t\t$(LIBRARY-" work-library ")"
17521	      (if mapping-exist ""
17522		(concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
17523	      "\n"
17524	      "\n$(LIBRARY-" work-library ") :"
17525	      "\n\t"
17526	      (vhdl-replace-string
17527	       (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
17528	       (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
17529	      "\n")
17530      (unless mapping-exist
17531	(insert "\n$(LIBRARY-" work-library "-make) :"
17532		"\n\t"
17533		"mkdir -p $(LIBRARY-" work-library "-make)\n"))
17534      ;; insert '.PHONY' declaration
17535      (insert "\n\n.PHONY : "
17536	      (nth 0 vhdl-makefile-default-targets) " "
17537	      (nth 1 vhdl-makefile-default-targets) " "
17538	      (nth 2 vhdl-makefile-default-targets) "\n")
17539      ;; insert rule for each library unit
17540      (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
17541      (while prim-list
17542	(setq second-list (sort (nth 1 (car prim-list)) #'string<))
17543	(setq subcomp-list
17544	      (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<))
17545	(setq unit-key (caar prim-list)
17546	      unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
17547			    (nth 0 (vhdl-aget conf-alist unit-key))
17548			    (nth 0 (vhdl-aget pack-alist unit-key))))
17549	(insert "\n" unit-key)
17550	(unless (equal unit-key unit-name)
17551	  (insert " \\\n" unit-name))
17552	(insert " :"
17553		" \\\n\t\t" (nth 2 vhdl-makefile-default-targets))
17554	(while subcomp-list
17555	  (when (and (assoc (car subcomp-list) unit-list)
17556		     (not (equal unit-key (car subcomp-list))))
17557	    (insert " \\\n\t\t" (car subcomp-list)))
17558	  (setq subcomp-list (cdr subcomp-list)))
17559	(insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
17560	(while second-list
17561	  (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
17562	  (setq second-list (cdr second-list)))
17563	(insert "\n")
17564	(setq prim-list (cdr prim-list)))
17565      ;; insert rule for each library unit file
17566      (insert "\n\n# Rules for compiling single library unit files\n")
17567      (while rule-alist
17568	(setq rule (car rule-alist))
17569	;; get compiler options for this file
17570	(setq options
17571	      (vhdl-get-compile-options project compiler (nth 0 rule) t))
17572	;; insert rule if file is supposed to be compiled
17573	(setq target-list (nth 1 rule)
17574	      depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<))
17575	;; insert targets
17576	(setq tmp-list target-list)
17577	(while target-list
17578	  (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
17579		  (if (cdr target-list) " \\" " :"))
17580	  (setq target-list (cdr target-list)))
17581	(setq target-list tmp-list)
17582	;; insert file name as first dependency
17583	(insert " \\\n\t\t" (nth 0 rule))
17584	;; insert dependencies (except if also target or unit does not exist)
17585	(while depend-list
17586	  (when (and (not (member (car depend-list) target-list))
17587		     (assoc (car depend-list) unit-list))
17588	    (insert " \\\n\t\t"
17589		    "$(UNIT-" work-library "-" (car depend-list) ")"))
17590	  (setq depend-list (cdr depend-list)))
17591	;; insert compile command
17592	(if options
17593	    (insert "\n\t$(COMPILE) "
17594		    (if (eq options 'default) "$(OPTIONS)" options) " "
17595		    (nth 0 rule)
17596		    (if (equal vhdl-compile-post-command "") ""
17597		      " $(POST-COMPILE)")
17598		    "\n")
17599	  (insert "\n"))
17600	(unless (and options mapping-exist)
17601	  (setq tmp-list target-list)
17602	  (while target-list
17603	    (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
17604	    (setq target-list (cdr target-list)))
17605	  (setq target-list tmp-list))
17606	(setq rule-alist (cdr rule-alist)))
17607
17608      (insert "\n\n### " makefile-name " ends here\n")
17609      ;; run Makefile generation hook
17610      (run-hooks 'vhdl-makefile-generation-hook)
17611      (message "Generating makefile \"%s\"...done" makefile-name)
17612      ;; save and close file
17613      (if (file-writable-p makefile-path-name)
17614	  (progn (save-buffer)
17615		 (kill-buffer (current-buffer))
17616		 (set-buffer orig-buffer)
17617		 (when (fboundp 'add-to-history)
17618		   (add-to-history 'file-name-history makefile-path-name)))
17619	(vhdl-warning-when-idle
17620	 (format "File not writable: \"%s\""
17621		 (abbreviate-file-name makefile-path-name)))
17622	(switch-to-buffer (current-buffer))))))
17623
17624
17625;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17626;;; Bug reports
17627;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17628;; (using `reporter.el')
17629
17630(defconst vhdl-mode-help-address
17631  "Reto Zimmermann <reto@gnu.org>"
17632  "Address for VHDL Mode bug reports.")
17633
17634(defun vhdl-submit-bug-report ()
17635  "Submit via mail a bug report on VHDL Mode."
17636  (interactive)
17637  ;; load in reporter
17638  (defvar reporter-prompt-for-summary-p)
17639  (and
17640   (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
17641   (let ((reporter-prompt-for-summary-p t))
17642     (reporter-submit-bug-report
17643      vhdl-mode-help-address
17644      (concat "VHDL Mode " vhdl-version)
17645      (list
17646       ;; report all important user options
17647       'vhdl-offsets-alist
17648       'vhdl-comment-only-line-offset
17649       'tab-width
17650       'vhdl-electric-mode
17651       'vhdl-stutter-mode
17652       'vhdl-indent-tabs-mode
17653       'vhdl-project-alist
17654       'vhdl-project
17655       'vhdl-project-file-name
17656       'vhdl-project-autoload
17657       'vhdl-project-sort
17658       'vhdl-compiler-alist
17659       'vhdl-compiler
17660       'vhdl-compile-use-local-error-regexp
17661       'vhdl-makefile-default-targets
17662       'vhdl-makefile-generation-hook
17663       'vhdl-default-library
17664       'vhdl-standard
17665       'vhdl-basic-offset
17666       'vhdl-upper-case-keywords
17667       'vhdl-upper-case-types
17668       'vhdl-upper-case-attributes
17669       'vhdl-upper-case-enum-values
17670       'vhdl-upper-case-constants
17671       'vhdl-use-direct-instantiation
17672       'vhdl-array-index-record-field-in-sensitivity-list
17673       'vhdl-compose-configuration-name
17674       'vhdl-entity-file-name
17675       'vhdl-architecture-file-name
17676       'vhdl-configuration-file-name
17677       'vhdl-package-file-name
17678       'vhdl-file-name-case
17679       'vhdl-electric-keywords
17680       'vhdl-optional-labels
17681       'vhdl-insert-empty-lines
17682       'vhdl-argument-list-indent
17683       'vhdl-association-list-with-formals
17684       'vhdl-conditions-in-parenthesis
17685       'vhdl-sensitivity-list-all
17686       'vhdl-zero-string
17687       'vhdl-one-string
17688       'vhdl-file-header
17689       'vhdl-file-footer
17690       'vhdl-company-name
17691       'vhdl-copyright-string
17692       'vhdl-platform-spec
17693       'vhdl-date-format
17694       'vhdl-modify-date-prefix-string
17695       'vhdl-modify-date-on-saving
17696       'vhdl-reset-kind
17697       'vhdl-reset-active-high
17698       'vhdl-clock-rising-edge
17699       'vhdl-clock-edge-condition
17700       'vhdl-clock-name
17701       'vhdl-reset-name
17702       'vhdl-model-alist
17703       'vhdl-include-port-comments
17704       'vhdl-include-direction-comments
17705       'vhdl-include-type-comments
17706       'vhdl-include-group-comments
17707       'vhdl-actual-generic-name
17708       'vhdl-actual-port-name
17709       'vhdl-instance-name
17710       'vhdl-testbench-entity-name
17711       'vhdl-testbench-architecture-name
17712       'vhdl-testbench-configuration-name
17713       'vhdl-testbench-dut-name
17714       'vhdl-testbench-include-header
17715       'vhdl-testbench-declarations
17716       'vhdl-testbench-statements
17717       'vhdl-testbench-initialize-signals
17718       'vhdl-testbench-include-library
17719       'vhdl-testbench-include-configuration
17720       'vhdl-testbench-create-files
17721       'vhdl-testbench-entity-file-name
17722       'vhdl-testbench-architecture-file-name
17723       'vhdl-compose-create-files
17724       'vhdl-compose-configuration-create-file
17725       'vhdl-compose-configuration-hierarchical
17726       'vhdl-compose-configuration-use-subconfiguration
17727       'vhdl-compose-include-header
17728       'vhdl-compose-architecture-name
17729       'vhdl-components-package-name
17730       'vhdl-use-components-package
17731       'vhdl-self-insert-comments
17732       'vhdl-prompt-for-comments
17733       'vhdl-inline-comment-column
17734       'vhdl-end-comment-column
17735       'vhdl-auto-align
17736       'vhdl-align-groups
17737       'vhdl-align-group-separate
17738       'vhdl-align-same-indent
17739       'vhdl-highlight-keywords
17740       'vhdl-highlight-names
17741       'vhdl-highlight-special-words
17742       'vhdl-highlight-forbidden-words
17743       'vhdl-highlight-verilog-keywords
17744       'vhdl-highlight-translate-off
17745       'vhdl-highlight-case-sensitive
17746       'vhdl-special-syntax-alist
17747       'vhdl-forbidden-words
17748       'vhdl-forbidden-syntax
17749       'vhdl-directive-keywords
17750       'vhdl-speedbar-auto-open
17751       'vhdl-speedbar-display-mode
17752       'vhdl-speedbar-scan-limit
17753       'vhdl-speedbar-jump-to-unit
17754       'vhdl-speedbar-update-on-saving
17755       'vhdl-speedbar-save-cache
17756       'vhdl-speedbar-cache-file-name
17757       'vhdl-index-menu
17758       'vhdl-source-file-menu
17759       'vhdl-hideshow-menu
17760       'vhdl-hide-all-init
17761       'vhdl-print-two-column
17762       'vhdl-print-customize-faces
17763       'vhdl-intelligent-tab
17764       'vhdl-indent-syntax-based
17765       'vhdl-indent-comment-like-next-code-line
17766       'vhdl-word-completion-case-sensitive
17767       'vhdl-word-completion-in-minibuffer
17768       'vhdl-underscore-is-part-of-word
17769       'vhdl-mode-hook)
17770      (lambda ()
17771        (insert
17772         (if vhdl-special-indent-hook
17773             (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
17774                     "vhdl-special-indent-hook is set to '"
17775                     (format "%s" vhdl-special-indent-hook)
17776                     ".\nPerhaps this is your problem?\n"
17777                     "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
17778           "\n")))
17779      nil
17780      "Hi Reto,"))))
17781
17782
17783;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17784;;; Documentation
17785;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17786
17787(defconst vhdl-doc-release-notes nil
17788  "\
17789Release Notes for VHDL Mode 3.37
17790================================
17791
17792- Added support for VHDL'08:
17793  - New keywords, types, functions, attributes, operators, packages
17794  - Context declaration
17795  - Block comments
17796  - Directives
17797  - `all' keyword in sensitivity list
17798
17799
17800Release Notes for VHDL Mode 3.34
17801================================
17802
17803- Added support for GNU Emacs 22/23/24:
17804  - Compilation error parsing fixed for new `compile.el' package.
17805
17806- Port translation: Derive actual generic name from formal generic name.
17807
17808- New user options:
17809  `vhdl-actual-generic-name': Specify how actual generic names are obtained.
17810
17811
17812Release Notes for VHDL Mode 3.33
17813================================
17814
17815New Features
17816------------
17817
17818CONFIGURATION DECLARATION GENERATION:
17819  - Automatic generation of a configuration declaration for a design.
17820    (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
17821
17822
17823Key Bindings
17824------------
17825
17826For Emacs compliance the following key bindings have been changed:
17827
17828- `C-c c'        ->  `C-c C-c'      `vhdl-comment-uncomment-region'
17829- `C-c f'        ->  `C-c C-i C-f'  `vhdl-fontify-buffer'
17830- `C-c s'        ->  `C-c C-i C-s'  `vhdl-statistics-buffer'
17831- `C-c C-c ...'  ->  `C-c C-m ...'  `vhdl-compose-...'
17832
17833
17834User Options
17835------------
17836
17837`vhdl-configuration-file-name': (new)
17838  Specify how the configuration file name is obtained.
17839`vhdl-compose-configuration-name': (new)
17840  Specify how the configuration name is obtained.
17841`vhdl-compose-configuration-create-file': (new)
17842  Specify whether a new file should be created for a configuration.
17843`vhdl-compose-configuration-hierarchical': (new)
17844  Specify whether hierarchical configurations should be created.
17845`vhdl-compose-configuration-use-subconfiguration': (new)
17846  Specify whether subconfigurations should be used inside configurations.
17847`vhdl-makefile-default-targets': (new)
17848  Customize names of Makefile default targets.
17849`vhdl-indent-comment-like-next-code-line': (new)
17850  Specify whether comment lines are indented like following code line.
17851`vhdl-array-index-record-field-in-sensitivity-list': (new)
17852  Specify whether to include array indices / record fields in sensitivity list.")
17853
17854
17855(defconst vhdl-doc-keywords nil
17856  "\
17857Reserved words in VHDL
17858----------------------
17859
17860VHDL'08 (IEEE Std 1076-2008):
17861  `vhdl-08-keywords'      : keywords
17862  `vhdl-08-types'         : standardized types
17863  `vhdl-08-attributes'    : standardized attributes
17864  `vhdl-08-functions'     : standardized functions
17865  `vhdl-08-packages'      : standardized packages and libraries
17866
17867VHDL'93/02 (IEEE Std 1076-1993/2002):
17868  `vhdl-02-keywords'      : keywords
17869  `vhdl-02-types'         : standardized types
17870  `vhdl-02-attributes'    : standardized attributes
17871  `vhdl-02-enum-values'   : standardized enumeration values
17872  `vhdl-02-functions'     : standardized functions
17873  `vhdl-02-packages'      : standardized packages and libraries
17874
17875VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
17876  `vhdl-ams-keywords'     : keywords
17877  `vhdl-ams-types'        : standardized types
17878  `vhdl-ams-attributes'   : standardized attributes
17879  `vhdl-ams-enum-values'  : standardized enumeration values
17880  `vhdl-ams-constants'    : standardized constants
17881  `vhdl-ams-functions'    : standardized functions
17882
17883Math Packages (IEEE Std 1076.2):
17884  `vhdl-math-types'       : standardized types
17885  `vhdl-math-constants'   : standardized constants
17886  `vhdl-math-functions'   : standardized functions
17887  `vhdl-math-packages'    : standardized packages
17888
17889Forbidden words:
17890  `vhdl-verilog-keywords' : Verilog reserved words
17891
17892NOTE: click `mouse-2' on variable names above (not in XEmacs).")
17893
17894
17895(defconst vhdl-doc-coding-style nil
17896  "\
17897For VHDL coding style and naming convention guidelines, see the following
17898references:
17899
17900[1] Ben Cohen.
17901    \"VHDL Coding Styles and Methodologies\".
17902    Kluwer Academic Publishers, 1999.
17903    http://members.aol.com/vhdlcohen/vhdl/
17904
17905[2] Michael Keating and Pierre Bricaud.
17906    \"Reuse Methodology Manual, Second Edition\".
17907    Kluwer Academic Publishers, 1999.
17908    http://www.openmore.com/openmore/rmm2.html
17909
17910[3] European Space Agency.
17911    \"VHDL Modelling Guidelines\".
17912    https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf
17913
17914Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
17915to visually support naming conventions.")
17916
17917
17918(defun vhdl-version ()
17919  "Echo the current version of VHDL Mode in the minibuffer."
17920  (interactive)
17921  (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
17922  (vhdl-keep-region-active))
17923
17924(defun vhdl-doc-variable (variable)
17925  "Display VARIABLE's documentation in *Help* buffer."
17926  (interactive)
17927  (unless (featurep 'xemacs)
17928    (help-setup-xref (list #'vhdl-doc-variable variable)
17929		     (called-interactively-p 'interactive)))
17930  (with-output-to-temp-buffer
17931      (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17932    (princ (documentation-property variable 'variable-documentation))
17933    (with-current-buffer standard-output
17934      (help-mode))
17935    (help-print-return-message)))
17936
17937(defun vhdl-doc-mode ()
17938  "Display VHDL Mode documentation in *Help* buffer."
17939  (interactive)
17940  (unless (featurep 'xemacs)
17941    (help-setup-xref (list #'vhdl-doc-mode)
17942		     (called-interactively-p 'interactive)))
17943  (with-output-to-temp-buffer
17944      (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17945    (princ mode-name)
17946    (princ " mode:\n")
17947    (princ (documentation 'vhdl-mode))
17948    (with-current-buffer standard-output
17949      (help-mode))
17950    (help-print-return-message)))
17951
17952
17953;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17954
17955(provide 'vhdl-mode)
17956
17957;;; vhdl-mode.el ends here
17958