1 ;;; vhdl-mode.el --- major mode for editing VHDL code
3 ;; Copyright (C) 1992-2006 Free Software Foundation, Inc.
5 ;; Authors: Reto Zimmermann <reto@gnu.org>
6 ;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
7 ;; Maintainer: Reto Zimmermann <reto@gnu.org>
8 ;; RCS: $Id: vhdl-mode.el,v 1.10 2006-08-11 17:41:15 james Exp $
9 ;; Keywords: languages vhdl
10 ;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
12 (defconst vhdl-version "3.33.12"
13 "VHDL Mode version number.")
15 (defconst vhdl-time-stamp "2006-05-23"
16 "VHDL Mode time stamp for last update.")
18 ;; This file is part of GNU Emacs.
20 ;; GNU Emacs is free software; you can redistribute it and/or modify
21 ;; it under the terms of the GNU General Public License as published by
22 ;; the Free Software Foundation; either version 2, or (at your option)
25 ;; GNU Emacs is distributed in the hope that it will be useful,
26 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
27 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 ;; GNU General Public License for more details.
30 ;; You should have received a copy of the GNU General Public License
31 ;; along with GNU Emacs; see the file COPYING. If not, write to the
32 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
33 ;; Boston, MA 02110-1301, USA.
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;; This package provides an Emacs major mode for editing VHDL code.
40 ;; It includes the following features:
42 ;; - Syntax highlighting
44 ;; - Template insertion (electrification)
45 ;; - Insertion of file headers
46 ;; - Insertion of user-specified models
47 ;; - Port translation / testbench generation
48 ;; - Structural composition
49 ;; - Configuration generation
50 ;; - Sensitivity list updating
52 ;; - Design hierarchy browser
53 ;; - Source file compilation (syntax analysis)
54 ;; - Makefile generation
56 ;; - Word/keyword completion
58 ;; - Code fixing/alignment/beautification
59 ;; - Postscript printing
60 ;; - VHDL'87/'93/'02 and VHDL-AMS supported
61 ;; - Comprehensive menu
62 ;; - Fully customizable
63 ;; - Works under GNU Emacs (recommended) and XEmacs
65 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68 ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
70 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73 ;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X
74 ;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
76 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
79 ;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X.
81 ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
82 ;; or into an arbitrary directory that is added to the load path by the
83 ;; following line in your Emacs start-up file `.emacs':
85 ;; (setq load-path (cons (expand-file-name "<directory-name>") load-path))
87 ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
88 ;; directory. Otherwise, byte-compile the source file:
89 ;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET
90 ;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
92 ;; Add the following lines to the `site-start.el' file in the `site-lisp'
93 ;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
94 ;; (not required in Emacs 20.X):
96 ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
97 ;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
99 ;; More detailed installation instructions are included in the official
100 ;; VHDL Mode distribution.
102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
105 ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
108 ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
109 ;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
111 ;; Many thanks to all the users who sent me bug reports and enhancement
113 ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
114 ;; enhancement suggestions and the fruitful discussions.
115 ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
116 ;; Thanks to Ulf Klaperski for the indentation speedup hint.
118 ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated
119 ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for
120 ;; giving me the opportunity to develop this code.
121 ;; This work has been funded in part by MICROSWISS, a Microelectronics Program
122 ;; of the Swiss Government.
124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 (defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
130 "Non-nil if XEmacs is used.")
131 ;; Emacs 21+ handling
132 (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs))
133 "Non-nil if GNU Emacs 21, 22, ... is used.")
134 (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs))
135 "Non-nil if GNU Emacs 22, ... is used.")
137 (defvar compilation-file-regexp-alist)
138 (defvar itimer-version)
139 (defvar lazy-lock-defer-contextually)
140 (defvar lazy-lock-defer-on-scrolling)
141 (defvar lazy-lock-defer-on-the-fly)
144 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
146 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
148 ;; help function for user options
149 (defun vhdl-custom-set (variable value &rest functions)
150 "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
151 (if (fboundp 'custom-set-default)
152 (custom-set-default variable value)
153 (set-default variable value))
155 (when (fboundp (car functions)) (funcall (car functions)))
156 (setq functions (cdr functions))))
158 (defun vhdl-widget-directory-validate (widget)
159 "Check that the value of WIDGET is a valid directory entry (i.e. ends with
161 (let ((val (widget-value widget)))
162 (unless (string-match "^\\(\\|.*/\\)$" val)
163 (widget-put widget :error "Invalid directory entry: must end with '/'")
166 ;; help string for user options
167 (defconst vhdl-name-doc-string "
169 FROM REGEXP is a regular expression matching the original name:
170 \".*\" matches the entire string
171 \"\\(...\\)\" matches a substring
172 TO STRING specifies the string to be inserted as new name:
173 \"\\&\" means substitute entire matched text
174 \"\\N\" means substitute what matched the Nth \"\\(...\\)\"
176 \".*\" \"\\&\" inserts original string
177 \".*\" \"\\&_i\" attaches \"_i\" to original string
178 \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string
179 \".*\" \"foo\" inserts constant string \"foo\"
180 \".*\" \"\" inserts empty string")
182 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
186 "Customizations for VHDL Mode."
189 ; :version "21.2" ; comment out for XEmacs
192 (defgroup vhdl-mode nil
193 "Customizations for modes."
196 (defcustom vhdl-electric-mode t
197 "*Non-nil enables electrification (automatic template generation).
198 If nil, template generators can still be invoked through key bindings and
199 menu. Is indicated in the modeline by \"/e\" after the mode name and can be
200 toggled by `\\[vhdl-electric-mode]'."
204 (defcustom vhdl-stutter-mode t
205 "*Non-nil enables stuttering.
206 Is indicated in the modeline by \"/s\" after the mode name and can be toggled
207 by `\\[vhdl-stutter-mode]'."
211 (defcustom vhdl-indent-tabs-mode nil
212 "*Non-nil means indentation can insert tabs.
213 Overrides local variable `indent-tabs-mode'."
218 (defgroup vhdl-compile nil
219 "Customizations for compilation."
222 (defcustom vhdl-compiler-alist
225 ;; COMP96 ERROR COMP96_0078: "Unknown identifier "Addr_Bits"." "<filename>" 40 30
226 ("Aldec" "vcom" "-93 -work \\1" "make" "-f \\1"
227 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
228 (".+?[ \t]+\\(?:ERROR\\)[^:]+:.+?\\(?:.+\"\\(.+?\\)\"[ \t]+\\([0-9]+\\)\\)" 1 2 0) ("" 0)
230 ;; Cadence Leapfrog: cv -file test.vhd
231 ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
232 ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
233 nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
234 ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0)
235 ("\\1/entity" "\\2/\\1" "\\1/configuration"
236 "\\1/package" "\\1/body" downcase))
237 ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
238 ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
239 ;; (PLL_400X_TOP) is not declared [10.3].
240 ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
241 nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
242 ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
243 ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
244 "\\1/package/pc.db" "\\1/body/pc.db" downcase))
245 ;; Ikos Voyager: analyze test.vhd
247 ;; E L4/C5: this library unit is inaccessible
248 ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
249 nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
250 ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2)
251 ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
253 ;; ModelSim, Model Technology: vcom test.vhd
254 ;; ERROR: test.vhd(14): Unknown identifier: positiv
255 ;; WARNING[2]: test.vhd(85): Possible infinite loop
256 ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
257 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
258 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
259 ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
260 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
261 "\\1/_primary.dat" "\\1/body.dat" downcase))
262 ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
263 ;; test.vhd:34: error message
264 ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
265 nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
266 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
267 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
268 "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
269 ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
270 ;; ERROR: test.vhd(24): near "dnd": expecting: END
271 ;; WARNING[4]: test.vhd(30): A space is required between ...
272 ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
273 nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
274 ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
275 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
276 "\\1/_primary.dat" "\\1/body.dat" downcase))
277 ;; Savant: scram -publish-cc test.vhd
278 ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
279 ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
280 nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
281 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
282 ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
283 "\\1_config.vhdl" "\\1_package.vhdl"
284 "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
285 ;; Simili: vhdlp -work test.vhd
286 ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
287 ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
288 nil "mkdir \\1" "./" "work/" "Makefile" "simili"
289 ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0)
290 ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
291 "\\1/prim.var" "\\1/_body.var" downcase))
292 ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
293 ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
294 ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
295 nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
296 ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0)
298 ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
299 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
300 ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
301 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
302 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
303 ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
304 ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
305 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
306 ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
307 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
308 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
309 ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
311 ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
312 ("Synplify" "n/a" "n/a" "make" "-f \\1"
313 nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
314 ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
316 ;; Vantage: analyze -libfile vsslib.ini -src test.vhd
317 ;; Compiling "test.vhd" line 1...
318 ;; **Error: LINE 49 *** No aggregate value is valid in this context.
319 ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
320 nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
321 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
322 ("^ *Compiling \"\\(.+\\)\" " 1)
324 ;; VeriBest: vc vhdl test.vhd
325 ;; (no file name printed out!)
326 ;; 32: Z <= A and BitA ;
328 ;; [Error] Name BITA is unknown
329 ("VeriBest" "vc" "vhdl" "make" "-f \\1"
330 nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
331 ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0)
333 ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
334 ;; Compiling "test.vhd" line 1...
335 ;; **Error: LINE 49 *** No aggregate value is valid in this context.
336 ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
337 nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
338 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
339 ("^ *Compiling \"\\(.+\\)\" " 1)
342 ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
343 ("Xilinx XST" "xflow" "" "make" "-f \\1"
344 nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
345 ("^ERROR:HDLParsers:[0-9]+ - \"\\(.+\\)\" Line \\([0-9]+\\)\." 1 2 0) ("" 0)
348 "*List of available VHDL compilers and their properties.
349 Each list entry specifies the following items for a compiler:
351 Compiler name : name used in option `vhdl-compiler' to choose compiler
352 Compile command : command used for source file compilation
353 Compile options : compile options (\"\\1\" inserts library name)
354 Make command : command used for compilation using a Makefile
355 Make options : make options (\"\\1\" inserts Makefile name)
356 Generate Makefile: use built-in function or command to generate a Makefile
357 \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
358 Library command : command to create library directory \(\"\\1\" inserts
359 library directory, \"\\2\" inserts library name)
360 Compile directory: where compilation is run and the Makefile is placed
361 Library directory: directory of default library
362 Makefile name : name of Makefile (default is \"Makefile\")
363 ID string : compiler identification string (see `vhdl-project-alist')
365 Regexp : regular expression to match error messages (*)
366 File subexp index: index of subexpression that matches the file name
367 Line subexp index: index of subexpression that matches the line number
368 Column subexp idx: index of subexpression that matches the column number
370 Regexp : regular expression to match a file name message
371 File subexp index: index of subexpression that matches the file name
372 Unit-to-file name mapping: mapping of library unit names to names of files
373 generated by the compiler (used for Makefile generation)
374 To string : string a name is mapped to (\"\\1\" inserts the unit name,
375 \"\\2\" inserts the entity name for architectures)
376 Case adjustment : adjust case of inserted unit names
378 \(*) The regular expression must match the error message starting from the
379 beginning of the line (but not necessarily to the end of the line).
381 Compile options allows insertion of the library name (see `vhdl-project-alist')
382 in order to set the compilers library option (e.g. \"vcom -work my_lib\").
384 For Makefile generation, the built-in function can be used (requires
385 specification of the unit-to-file name mapping). Alternatively, an
386 external command can be specified. Work directory allows specification of
387 an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
388 used for Makefile generation). To use another library name than \"work\",
389 customize `vhdl-project-alist'. The library command is inserted in Makefiles
390 to automatically create the library directory if not existent.
392 Compile options, compile directory, library directory, and Makefile name are
393 overwritten by the project settings if a project is defined (see
394 `vhdl-project-alist'). Directory paths are relative to the source file
397 Some compilers do not include the file name in the error message, but print
398 out a file name message in advance. In this case, set \"File Subexp Index\"
399 under \"Error Message\" to 0 and fill out the \"File Message\" entries.
400 If no file name at all is printed out, set both \"File Message\" entries to 0
401 \(a default file name message will be printed out instead, does not work in
404 A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
405 assigning its name to option `vhdl-compiler'.
407 Please send any missing or erroneous compiler properties to the maintainer for
410 NOTE: Activate new error and file message regexps and reflect the new setting
411 in the choice list of option `vhdl-compiler' by restarting Emacs."
413 (list :tag "Compiler" :indent 2
414 (string :tag "Compiler name ")
415 (string :tag "Compile command ")
416 (string :tag "Compile options " "-work \\1")
417 (string :tag "Make command " "make")
418 (string :tag "Make options " "-f \\1")
419 (choice :tag "Generate Makefile "
420 (const :tag "Built-in function" nil)
421 (string :tag "Command" "vmake \\2 > \\1"))
422 (string :tag "Library command " "mkdir \\1")
423 (directory :tag "Compile directory "
424 :validate vhdl-widget-directory-validate "./")
425 (directory :tag "Library directory "
426 :validate vhdl-widget-directory-validate "work/")
427 (file :tag "Makefile name " "Makefile")
428 (string :tag "ID string ")
429 (list :tag "Error message" :indent 4
430 (regexp :tag "Regexp ")
431 (integer :tag "File subexp index")
432 (integer :tag "Line subexp index")
433 (integer :tag "Column subexp idx"))
434 (list :tag "File message" :indent 4
435 (regexp :tag "Regexp ")
436 (integer :tag "File subexp index"))
437 (choice :tag "Unit-to-file name mapping"
438 :format "%t: %[Value Menu%] %v\n"
439 (const :tag "Not defined" nil)
440 (list :tag "To string" :indent 4
441 (string :tag "Entity " "\\1.vhd")
442 (string :tag "Architecture " "\\2_\\1.vhd")
443 (string :tag "Configuration " "\\1.vhd")
444 (string :tag "Package " "\\1.vhd")
445 (string :tag "Package Body " "\\1_body.vhd")
446 (choice :tag "Case adjustment "
447 (const :tag "None" identity)
448 (const :tag "Upcase" upcase)
449 (const :tag "Downcase" downcase))))))
450 :set (lambda (variable value)
451 (vhdl-custom-set variable value 'vhdl-update-mode-menu))
452 :group 'vhdl-compile)
454 (defcustom vhdl-compiler "ModelSim"
455 "*Specifies the VHDL compiler to be used for syntax analysis.
456 Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
457 :type (let ((alist vhdl-compiler-alist) list)
459 (setq list (cons (list 'const (caar alist)) list))
460 (setq alist (cdr alist)))
461 (append '(choice) (nreverse list)))
462 :group 'vhdl-compile)
464 (defcustom vhdl-compile-use-local-error-regexp t
465 "*Non-nil means use buffer-local `compilation-error-regexp-alist'.
466 In this case, only error message regexps for VHDL compilers are active if
467 compilation is started from a VHDL buffer. Otherwise, the error message
468 regexps are appended to the predefined global regexps, and all regexps are
469 active all the time. Note that by doing that, the predefined global regexps
470 might result in erroneous parsing of error messages for some VHDL compilers.
472 NOTE: Activate the new setting by restarting Emacs."
474 :group 'vhdl-compile)
476 (defcustom vhdl-makefile-generation-hook nil
477 "*Functions to run at the end of Makefile generation.
478 Allows to insert user specific parts into a Makefile.
482 \(re-search-backward \"^# Rule for compiling entire design\")
483 \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
485 :group 'vhdl-compile)
487 (defcustom vhdl-default-library "work"
488 "*Name of default library.
489 Is overwritten by project settings if a project is active."
491 :group 'vhdl-compile)
494 (defgroup vhdl-project nil
495 "Customizations for projects."
498 (defcustom vhdl-project-alist
499 '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
500 "~/example1/" ("src/system/" "src/components/") ""
501 (("ModelSim" "-87 \\2" "-f \\1 top_level" nil)
502 ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
503 "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
504 ("Example 2" "Individual source files, multiple compilers in different directories"
505 "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
506 nil "\\1/" "work" "\\1/work/" "Makefile" "")
507 ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
508 "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
509 nil "./" "work" "work-\\1/" "Makefile-\\1" "\
510 -------------------------------------------------------------------------------
511 -- This is a multi-line project description
512 -- that can be used as a project dependent part of the file header.
514 "*List of projects and their properties.
515 Name : name used in option `vhdl-project' to choose project
516 Title : title of project (single-line string)
517 Default directory: default project directory (absolute path)
518 Sources : a) source files : path + \"/\" + file name
519 b) directory : path + \"/\"
520 c) directory tree: \"-r \" + path + \"/\"
521 Exclude regexp : matches file/directory names to be excluded as sources
522 Compile options : project-specific options for each compiler
523 Compiler name : name of compiler for which these options are valid
524 Compile options: project-specific compiler options
525 (\"\\1\" inserts library name, \"\\2\" default options)
526 Make options: project-specific make options
527 (\"\\1\" inserts Makefile name, \"\\2\" default options)
528 Exceptions : file-specific exceptions
529 File name regexp: matches file names for which exceptions are valid
530 - Options : file-specific compiler options string
531 (\"\\1\" inserts library name, \"\\2\" default options,
532 \"\\3\" project-specific options)
533 - Do not compile: do not compile this file (in Makefile)
534 Compile directory: where compilation is run and the Makefile is placed
535 \(\"\\1\" inserts compiler ID string)
536 Library name : name of library (default is \"work\")
537 Library directory: path to library (\"\\1\" inserts compiler ID string)
538 Makefile name : name of Makefile
539 (\"\\1\" inserts compiler ID string, \"\\2\" library name)
540 Description : description of project (multi-line string)
542 Project title and description are used to insert into the file header (see
543 option `vhdl-file-header').
545 The default directory must have an absolute path (use `M-TAB' for completion).
546 All other paths can be absolute or relative to the default directory. All
547 paths must end with '/'.
549 The design units found in the sources (files and directories) are shown in the
550 hierarchy browser. Path and file name can contain wildcards `*' and `?' as
551 well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute.
552 Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are
553 specified, the default directory is taken as source directory. Otherwise,
554 the default directory is only taken as source directory if there is a sources
555 entry with the empty string or \"./\". Exclude regexp allows to filter out
556 specific file and directory names from the list of sources (e.g. CVS
559 Files are compiled in the compile directory. Makefiles are also placed into
560 the compile directory. Library directory specifies which directory the
561 compiler compiles into (used to generate the Makefile).
563 Since different compile/library directories and Makefiles may exist for
564 different compilers within one project, these paths and names allow the
565 insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
566 Compile options, compile directory, library directory, and Makefile name
567 overwrite the settings of the current compiler.
569 File-specific compiler options (highest priority) overwrite project-specific
570 options which overwrite default options (lowest priority). Lower priority
571 options can be inserted in higher priority options. This allows to reuse
572 default options (e.g. \"-file\") in project- or file-specific options (e.g.
575 NOTE: Reflect the new setting in the choice list of option `vhdl-project'
576 by restarting Emacs."
578 (list :tag "Project" :indent 2
579 (string :tag "Name ")
580 (string :tag "Title ")
581 (directory :tag "Default directory"
582 :validate vhdl-widget-directory-validate
583 ,(abbreviate-file-name default-directory))
584 (repeat :tag "Sources " :indent 4
585 (directory :format " %v" "./"))
586 (regexp :tag "Exclude regexp ")
588 :tag "Compile options " :indent 4
589 (list :tag "Compiler" :indent 6
590 ,(let ((alist vhdl-compiler-alist) list)
592 (setq list (cons (list 'const (caar alist)) list))
593 (setq alist (cdr alist)))
594 (append '(choice :tag "Compiler name")
596 (string :tag "Compile options" "\\2")
597 (string :tag "Make options " "\\2")
599 :tag "Exceptions " :indent 8
601 (regexp :tag "File name regexp ")
602 (choice :format "%[Value Menu%] %v"
603 (string :tag "Options" "\\3")
604 (const :tag "Do not compile" nil))))))
605 (directory :tag "Compile directory"
606 :validate vhdl-widget-directory-validate "./")
607 (string :tag "Library name " "work")
608 (directory :tag "Library directory"
609 :validate vhdl-widget-directory-validate "work/")
610 (file :tag "Makefile name " "Makefile")
611 (string :tag "Description: (type `C-j' for newline)"
612 :format "%t\n%v\n")))
613 :set (lambda (variable value)
614 (vhdl-custom-set variable value
615 'vhdl-update-mode-menu
616 'vhdl-speedbar-refresh))
617 :group 'vhdl-project)
619 (defcustom vhdl-project nil
620 "*Specifies the default for the current project.
621 Select a project name from the ones defined in option `vhdl-project-alist'.
622 Is used to determine the project title and description to be inserted in file
623 headers and the source files/directories to be scanned in the hierarchy
624 browser. The current project can also be changed temporarily in the menu."
625 :type (let ((alist vhdl-project-alist) list)
627 (setq list (cons (list 'const (caar alist)) list))
628 (setq alist (cdr alist)))
629 (append '(choice (const :tag "None" nil) (const :tag "--"))
631 :group 'vhdl-project)
633 (defcustom vhdl-project-file-name '("\\1.prj")
634 "*List of file names/paths for importing/exporting project setups.
635 \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
636 replaced by the user name (allows to have user-specific project setups).
637 The first entry is used as file name to import/export individual project
638 setups. All entries are used to automatically import project setups at
639 startup (see option `vhdl-project-auto-load'). Projects loaded from the
640 first entry are automatically made current. Hint: specify local project
641 setups in first entry, global setups in following entries; loading a local
642 project setup will make it current, while loading the global setups
643 is done without changing the current project.
644 Names can also have an absolute path (i.e. project setups can be stored
645 in global directories)."
646 :type '(repeat (string :tag "File name" "\\1.prj"))
647 :group 'vhdl-project)
649 (defcustom vhdl-project-auto-load '(startup)
650 "*Automatically load project setups from files.
651 All project setup files that match the file names specified in option
652 `vhdl-project-file-name' are automatically loaded. The project of the
653 \(alphabetically) last loaded setup of the first `vhdl-project-file-name'
655 A project setup file can be obtained by exporting a project (see menu).
656 At startup: project setup file is loaded at Emacs startup"
657 :type '(set (const :tag "At startup" startup))
658 :group 'vhdl-project)
660 (defcustom vhdl-project-sort t
661 "*Non-nil means projects are displayed in alphabetical order."
663 :group 'vhdl-project)
666 (defgroup vhdl-style nil
667 "Customizations for coding styles."
669 :group 'vhdl-template
671 :group 'vhdl-compose)
673 (defcustom vhdl-standard '(87 nil)
674 "*VHDL standards used.
676 VHDL'87 : IEEE Std 1076-1987
677 VHDL'93/02 : IEEE Std 1076-1993/2002
678 Additional standards:
679 VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
680 Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
682 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
683 \"Activate Options\"."
684 :type '(list (choice :tag "Basic standard"
685 (const :tag "VHDL'87" 87)
686 (const :tag "VHDL'93/02" 93))
687 (set :tag "Additional standards" :indent 2
688 (const :tag "VHDL-AMS" ams)
689 (const :tag "Math packages" math)))
690 :set (lambda (variable value)
691 (vhdl-custom-set variable value
692 'vhdl-template-map-init
693 'vhdl-mode-abbrev-table-init
694 'vhdl-template-construct-alist-init
695 'vhdl-template-package-alist-init
696 'vhdl-update-mode-menu
697 'vhdl-words-init 'vhdl-font-lock-init))
700 (defcustom vhdl-basic-offset 2
701 "*Amount of basic offset used for indentation.
702 This value is used by + and - symbols in `vhdl-offsets-alist'."
706 (defcustom vhdl-upper-case-keywords nil
707 "*Non-nil means convert keywords to upper case.
708 This is done when typed or expanded or by the fix case functions."
710 :set (lambda (variable value)
711 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
714 (defcustom vhdl-upper-case-types nil
715 "*Non-nil means convert standardized types to upper case.
716 This is done when expanded or by the fix case functions."
718 :set (lambda (variable value)
719 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
722 (defcustom vhdl-upper-case-attributes nil
723 "*Non-nil means convert standardized attributes to upper case.
724 This is done when expanded or by the fix case functions."
726 :set (lambda (variable value)
727 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
730 (defcustom vhdl-upper-case-enum-values nil
731 "*Non-nil means convert standardized enumeration values to upper case.
732 This is done when expanded or by the fix case functions."
734 :set (lambda (variable value)
735 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
738 (defcustom vhdl-upper-case-constants t
739 "*Non-nil means convert standardized constants to upper case.
740 This is done when expanded."
742 :set (lambda (variable value)
743 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
746 (defcustom vhdl-use-direct-instantiation 'standard
747 "*Non-nil means use VHDL'93 direct component instantiation.
749 Standard: only in VHDL standards that allow it (VHDL'93 and higher)
751 :type '(choice (const :tag "Never" never)
752 (const :tag "Standard" standard)
753 (const :tag "Always" always))
757 (defgroup vhdl-naming nil
758 "Customizations for naming conventions."
761 (defcustom vhdl-entity-file-name '(".*" . "\\&")
763 "*Specifies how the entity file name is obtained.
764 The entity file name can be obtained by modifying the entity name (e.g.
765 attaching or stripping off a substring). The file extension is automatically
766 taken from the file name of the current buffer."
767 vhdl-name-doc-string)
768 :type '(cons (regexp :tag "From regexp")
769 (string :tag "To string "))
771 :group 'vhdl-compose)
773 (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
775 "*Specifies how the architecture file name is obtained.
776 The architecture file name can be obtained by modifying the entity
777 and/or architecture name (e.g. attaching or stripping off a substring). The
778 file extension is automatically taken from the file name of the current
779 buffer. The string that is matched against the regexp is the concatenation
780 of the entity and the architecture name separated by a space. This gives
781 access to both names (see default setting as example)."
782 vhdl-name-doc-string)
783 :type '(cons (regexp :tag "From regexp")
784 (string :tag "To string "))
786 :group 'vhdl-compose)
788 (defcustom vhdl-configuration-file-name '(".*" . "\\&")
790 "*Specifies how the configuration file name is obtained.
791 The configuration file name can be obtained by modifying the configuration
792 name (e.g. attaching or stripping off a substring). The file extension is
793 automatically taken from the file name of the current buffer."
794 vhdl-name-doc-string)
795 :type '(cons (regexp :tag "From regexp")
796 (string :tag "To string "))
798 :group 'vhdl-compose)
800 (defcustom vhdl-package-file-name '(".*" . "\\&")
802 "*Specifies how the package file name is obtained.
803 The package file name can be obtained by modifying the package name (e.g.
804 attaching or stripping off a substring). The file extension is automatically
805 taken from the file name of the current buffer. Package files can be created
806 in a different directory by prepending a relative or absolute path to the
808 vhdl-name-doc-string)
809 :type '(cons (regexp :tag "From regexp")
810 (string :tag "To string "))
812 :group 'vhdl-compose)
814 (defcustom vhdl-file-name-case 'identity
815 "*Specifies how to change case for obtaining file names.
816 When deriving a file name from a VHDL unit name, case can be changed as
818 As Is: case is not changed (taken as is)
819 Lower Case: whole name is changed to lower case
820 Upper Case: whole name is changed to upper case
821 Capitalize: first letter of each word in name is capitalized"
822 :type '(choice (const :tag "As Is" identity)
823 (const :tag "Lower Case" downcase)
824 (const :tag "Upper Case" upcase)
825 (const :tag "Capitalize" capitalize))
827 :group 'vhdl-compose)
830 (defgroup vhdl-template nil
831 "Customizations for electrification."
834 (defcustom vhdl-electric-keywords '(vhdl user)
835 "*Type of keywords for which electrification is enabled.
836 VHDL keywords: invoke built-in templates
837 User keywords: invoke user models (see option `vhdl-model-alist')"
838 :type '(set (const :tag "VHDL keywords" vhdl)
839 (const :tag "User model keywords" user))
840 :set (lambda (variable value)
841 (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
842 :group 'vhdl-template)
844 (defcustom vhdl-optional-labels 'process
845 "*Constructs for which labels are to be queried.
846 Template generators prompt for optional labels for:
848 Processes only: processes only (also procedurals in VHDL-AMS)
849 All constructs: all constructs with optional labels and keyword END"
850 :type '(choice (const :tag "None" none)
851 (const :tag "Processes only" process)
852 (const :tag "All constructs" all))
853 :group 'vhdl-template)
855 (defcustom vhdl-insert-empty-lines 'unit
856 "*Specifies whether to insert empty lines in some templates.
857 This improves readability of code. Empty lines are inserted in:
859 Design units only: entities, architectures, configurations, packages only
860 All constructs : also all constructs with BEGIN...END parts
862 Replaces option `vhdl-additional-empty-lines'."
863 :type '(choice (const :tag "None" none)
864 (const :tag "Design units only" unit)
865 (const :tag "All constructs" all))
866 :group 'vhdl-template
868 :group 'vhdl-compose)
870 (defcustom vhdl-argument-list-indent nil
871 "*Non-nil means indent argument lists relative to opening parenthesis.
872 That is, argument, association, and port lists start on the same line as the
873 opening parenthesis and subsequent lines are indented accordingly.
874 Otherwise, lists start on a new line and are indented as normal code."
876 :group 'vhdl-template
878 :group 'vhdl-compose)
880 (defcustom vhdl-association-list-with-formals t
881 "*Non-nil means write association lists with formal parameters.
882 Templates prompt for formal and actual parameters (ports/generics).
883 When pasting component instantiations, formals are included.
884 If nil, only a list of actual parameters is entered."
886 :group 'vhdl-template
888 :group 'vhdl-compose)
890 (defcustom vhdl-conditions-in-parenthesis nil
891 "*Non-nil means place parenthesis around condition expressions."
893 :group 'vhdl-template)
895 (defcustom vhdl-zero-string "'0'"
896 "*String to use for a logic zero."
898 :group 'vhdl-template)
900 (defcustom vhdl-one-string "'1'"
901 "*String to use for a logic one."
903 :group 'vhdl-template)
906 (defgroup vhdl-header nil
907 "Customizations for file header."
908 :group 'vhdl-template
909 :group 'vhdl-compose)
911 (defcustom vhdl-file-header "\
912 -------------------------------------------------------------------------------
913 -- Title : <title string>
914 -- Project : <project>
915 -------------------------------------------------------------------------------
918 -- Company : <company>
920 -- Last update: <date>
921 -- Platform : <platform>
922 -- Standard : <standard>
923 <projectdesc>-------------------------------------------------------------------------------
924 -- Description: <cursor>
925 <copyright>-------------------------------------------------------------------------------
927 -- Date Version Author Description
928 -- <date> 1.0 <login>\tCreated
929 -------------------------------------------------------------------------------
932 "*String or file to insert as file header.
933 If the string specifies an existing file name, the contents of the file is
934 inserted, otherwise the string itself is inserted as file header.
935 Type `C-j' for newlines.
936 If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
937 if the header needs to be version controlled.
939 The following keywords for template generation are supported:
940 <filename> : replaced by the name of the buffer
941 <author> : replaced by the user name and email address
942 \(`user-full-name',`mail-host-address', `user-mail-address')
943 <login> : replaced by user login name (`user-login-name')
944 <company> : replaced by contents of option `vhdl-company-name'
945 <date> : replaced by the current date
946 <year> : replaced by the current year
947 <project> : replaced by title of current project (`vhdl-project')
948 <projectdesc> : replaced by description of current project (`vhdl-project')
949 <copyright> : replaced by copyright string (`vhdl-copyright-string')
950 <platform> : replaced by contents of option `vhdl-platform-spec'
951 <standard> : replaced by the VHDL language standard(s) used
952 <... string> : replaced by a queried string (\"...\" is the prompt word)
953 <title string>: replaced by file title in automatically generated files
954 <cursor> : final cursor position
956 The (multi-line) project description <projectdesc> can be used as a project
957 dependent part of the file header and can also contain the above keywords."
961 (defcustom vhdl-file-footer ""
962 "*String or file to insert as file footer.
963 If the string specifies an existing file name, the contents of the file is
964 inserted, otherwise the string itself is inserted as file footer (i.e. at
965 the end of the file).
966 Type `C-j' for newlines.
967 The same keywords as in option `vhdl-file-header' can be used."
971 (defcustom vhdl-company-name ""
972 "*Name of company to insert in file header.
973 See option `vhdl-file-header'."
977 (defcustom vhdl-copyright-string "\
978 -------------------------------------------------------------------------------
979 -- Copyright (c) <year> <company>
981 "*Copyright string to insert in file header.
982 Can be multi-line string (type `C-j' for newline) and contain other file
983 header keywords (see option `vhdl-file-header')."
987 (defcustom vhdl-platform-spec ""
988 "*Specification of VHDL platform to insert in file header.
989 The platform specification should contain names and versions of the
990 simulation and synthesis tools used.
991 See option `vhdl-file-header'."
995 (defcustom vhdl-date-format "%Y-%m-%d"
996 "*Specifies the date format to use in the header.
997 This string is passed as argument to the command `format-time-string'.
998 For more information on format strings, see the documentation for the
999 `format-time-string' command (C-h f `format-time-string')."
1001 :group 'vhdl-header)
1003 (defcustom vhdl-modify-date-prefix-string "-- Last update: "
1004 "*Prefix string of modification date in VHDL file header.
1005 If actualization of the modification date is called (menu,
1006 `\\[vhdl-template-modify]'), this string is searched and the rest
1007 of the line replaced by the current date."
1009 :group 'vhdl-header)
1011 (defcustom vhdl-modify-date-on-saving t
1012 "*Non-nil means update the modification date when the buffer is saved.
1013 Calls function `\\[vhdl-template-modify]').
1015 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1016 \"Activate Options\"."
1018 :group 'vhdl-header)
1021 (defgroup vhdl-sequential-process nil
1022 "Customizations for sequential processes."
1023 :group 'vhdl-template)
1025 (defcustom vhdl-reset-kind 'async
1026 "*Specifies which kind of reset to use in sequential processes."
1027 :type '(choice (const :tag "None" none)
1028 (const :tag "Synchronous" sync)
1029 (const :tag "Asynchronous" async))
1030 :group 'vhdl-sequential-process)
1032 (defcustom vhdl-reset-active-high nil
1033 "*Non-nil means reset in sequential processes is active high.
1034 Nil means active low."
1036 :group 'vhdl-sequential-process)
1038 (defcustom vhdl-clock-rising-edge t
1039 "*Non-nil means rising edge of clock triggers sequential processes.
1040 Nil means falling edge."
1042 :group 'vhdl-sequential-process)
1044 (defcustom vhdl-clock-edge-condition 'standard
1045 "*Syntax of the clock edge condition.
1046 Standard: \"clk'event and clk = '1'\"
1047 Function: \"rising_edge(clk)\""
1048 :type '(choice (const :tag "Standard" standard)
1049 (const :tag "Function" function))
1050 :group 'vhdl-sequential-process)
1052 (defcustom vhdl-clock-name ""
1053 "*Name of clock signal to use in templates."
1055 :group 'vhdl-sequential-process)
1057 (defcustom vhdl-reset-name ""
1058 "*Name of reset signal to use in templates."
1060 :group 'vhdl-sequential-process)
1063 (defgroup vhdl-model nil
1064 "Customizations for user models."
1067 (defcustom vhdl-model-alist
1069 "<label> : process (<clock>, <reset>)
1070 begin -- process <label>
1071 if <reset> = '0' then -- asynchronous reset (active low)
1073 elsif <clock>'event and <clock> = '1' then -- rising clock edge
1074 if <enable> = '1' then -- synchronous load
1078 end process <label>;"
1080 "*List of user models.
1081 VHDL models (templates) can be specified by the user in this list. They can be
1082 invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1083 electrification (i.e. overriding existing or creating new keywords, see
1084 option `vhdl-electric-keywords').
1085 Name : name of model (string of words and spaces)
1086 String : string or name of file to be inserted as model (newline: `C-j')
1087 Key Binding: key binding to invoke model, added to prefix `C-c C-m'
1088 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\")
1089 Keyword : keyword to invoke model
1091 The models can contain prompts to be queried. A prompt is of the form \"<...>\".
1092 A prompt that appears several times is queried once and replaced throughout
1093 the model. Special prompts are:
1094 <clock> : name specified in `vhdl-clock-name' (if not empty)
1095 <reset> : name specified in `vhdl-reset-name' (if not empty)
1096 <cursor>: final cursor position
1097 File header prompts (see variable `vhdl-file-header') are automatically
1098 replaced, so that user models can also be used to insert different types of
1101 If the string specifies an existing file name, the contents of the file is
1102 inserted, otherwise the string itself is inserted.
1103 The code within the models should be correctly indented.
1104 Type `C-j' for newlines.
1106 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1107 \"Activate Options\"."
1108 :type '(repeat (list :tag "Model" :indent 2
1109 (string :tag "Name ")
1110 (string :tag "String : (type `C-j' for newline)"
1112 (sexp :tag "Key binding" x)
1113 (string :tag "Keyword " :format "%t: %v\n")))
1114 :set (lambda (variable value)
1115 (vhdl-custom-set variable value
1116 'vhdl-model-map-init
1118 'vhdl-mode-abbrev-table-init
1119 'vhdl-update-mode-menu))
1123 (defgroup vhdl-compose nil
1124 "Customizations for structural composition."
1127 (defcustom vhdl-compose-architecture-name '(".*" . "str")
1129 "*Specifies how the component architecture name is obtained.
1130 The component architecture name can be obtained by modifying the entity name
1131 \(e.g. attaching or stripping off a substring).
1132 If TO STRING is empty, the architecture name is queried."
1133 vhdl-name-doc-string)
1134 :type '(cons (regexp :tag "From regexp")
1135 (string :tag "To string "))
1136 :group 'vhdl-compose)
1138 (defcustom vhdl-compose-configuration-name
1139 '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
1141 "*Specifies how the configuration name is obtained.
1142 The configuration name can be obtained by modifying the entity and/or
1143 architecture name (e.g. attaching or stripping off a substring). The string
1144 that is matched against the regexp is the concatenation of the entity and the
1145 architecture name separated by a space. This gives access to both names (see
1146 default setting as example)."
1147 vhdl-name-doc-string)
1148 :type '(cons (regexp :tag "From regexp")
1149 (string :tag "To string "))
1150 :group 'vhdl-compose)
1152 (defcustom vhdl-components-package-name
1153 '((".*" . "\\&_components") . "components")
1155 "*Specifies how the name for the components package is obtained.
1156 The components package is a package containing all component declarations for
1157 the current design. It's name can be obtained by modifying the project name
1158 \(e.g. attaching or stripping off a substring). If no project is defined, the
1159 DIRECTORY entry is chosen."
1160 vhdl-name-doc-string)
1161 :type '(cons (cons :tag "Project" :indent 2
1162 (regexp :tag "From regexp")
1163 (string :tag "To string "))
1164 (string :tag "Directory:\n String "))
1165 :group 'vhdl-compose)
1167 (defcustom vhdl-use-components-package nil
1168 "*Non-nil means use a separate components package for component declarations.
1169 Otherwise, component declarations are inserted and searched for in the
1170 architecture declarative parts."
1172 :group 'vhdl-compose)
1174 (defcustom vhdl-compose-include-header t
1175 "*Non-nil means include a header in automatically generated files."
1177 :group 'vhdl-compose)
1179 (defcustom vhdl-compose-create-files 'single
1180 "*Specifies whether new files should be created for the new component.
1181 The component's entity and architecture are inserted:
1182 None : in current buffer
1183 Single file : in new single file
1184 Separate files: in two separate files
1185 The file names are obtained from variables `vhdl-entity-file-name' and
1186 `vhdl-architecture-file-name'."
1187 :type '(choice (const :tag "None" none)
1188 (const :tag "Single file" single)
1189 (const :tag "Separate files" separate))
1190 :group 'vhdl-compose)
1192 (defcustom vhdl-compose-configuration-create-file nil
1193 "*Specifies whether a new file should be created for the configuration.
1194 If non-nil, a new file is created for the configuration.
1195 The file name is obtained from variable `vhdl-configuration-file-name'."
1197 :group 'vhdl-compose)
1199 (defcustom vhdl-compose-configuration-hierarchical t
1200 "*Specifies whether hierarchical configurations should be created.
1201 If non-nil, automatically created configurations are hierarchical and include
1202 the whole hierarchy of subcomponents. Otherwise the configuration only
1203 includes one level of subcomponents."
1205 :group 'vhdl-compose)
1207 (defcustom vhdl-compose-configuration-use-subconfiguration t
1208 "*Specifies whether subconfigurations should be used inside configurations.
1209 If non-nil, automatically created configurations use configurations in binding
1210 indications for subcomponents, if such configurations exist. Otherwise,
1211 entities are used in binding indications for subcomponents."
1213 :group 'vhdl-compose)
1216 (defgroup vhdl-port nil
1217 "Customizations for port translation functions."
1219 :group 'vhdl-compose)
1221 (defcustom vhdl-include-port-comments nil
1222 "*Non-nil means include port comments when a port is pasted."
1226 (defcustom vhdl-include-direction-comments nil
1227 "*Non-nil means include port direction in instantiations as comments."
1231 (defcustom vhdl-include-type-comments nil
1232 "*Non-nil means include generic/port type in instantiations as comments."
1236 (defcustom vhdl-include-group-comments 'never
1237 "*Specifies whether to include group comments and spacings.
1238 The comments and empty lines between groups of ports are pasted:
1240 Declarations: in entity/component/constant/signal declarations only
1241 Always : also in generic/port maps"
1242 :type '(choice (const :tag "Never" never)
1243 (const :tag "Declarations" decl)
1244 (const :tag "Always" always))
1247 (defcustom vhdl-actual-port-name '(".*" . "\\&")
1249 "*Specifies how actual port names are obtained from formal port names.
1250 In a component instantiation, an actual port name can be obtained by
1251 modifying the formal port name (e.g. attaching or stripping off a substring)."
1252 vhdl-name-doc-string)
1253 :type '(cons (regexp :tag "From regexp")
1254 (string :tag "To string "))
1257 (defcustom vhdl-instance-name '(".*" . "\\&_%d")
1259 "*Specifies how an instance name is obtained.
1260 The instance name can be obtained by modifying the name of the component to be
1261 instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced
1262 by a unique number (starting with 1).
1263 If TO STRING is empty, the instance name is queried."
1264 vhdl-name-doc-string)
1265 :type '(cons (regexp :tag "From regexp")
1266 (string :tag "To string "))
1270 (defgroup vhdl-testbench nil
1271 "Customizations for testbench generation."
1274 (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
1276 "*Specifies how the testbench entity name is obtained.
1277 The entity name of a testbench can be obtained by modifying the name of
1278 the component to be tested (e.g. attaching or stripping off a substring)."
1279 vhdl-name-doc-string)
1280 :type '(cons (regexp :tag "From regexp")
1281 (string :tag "To string "))
1282 :group 'vhdl-testbench)
1284 (defcustom vhdl-testbench-architecture-name '(".*" . "")
1286 "*Specifies how the testbench architecture name is obtained.
1287 The testbench architecture name can be obtained by modifying the name of
1288 the component to be tested (e.g. attaching or stripping off a substring).
1289 If TO STRING is empty, the architecture name is queried."
1290 vhdl-name-doc-string)
1291 :type '(cons (regexp :tag "From regexp")
1292 (string :tag "To string "))
1293 :group 'vhdl-testbench)
1295 (defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
1297 "*Specifies how the testbench configuration name is obtained.
1298 The configuration name of a testbench can be obtained by modifying the entity
1299 and/or architecture name (e.g. attaching or stripping off a substring). The
1300 string that is matched against the regexp is the concatenation of the entity
1301 and the architecture name separated by a space. This gives access to both
1302 names (see default setting as example)."
1303 vhdl-name-doc-string)
1304 :type '(cons (regexp :tag "From regexp")
1305 (string :tag "To string "))
1306 :group 'vhdl-testbench)
1308 (defcustom vhdl-testbench-dut-name '(".*" . "DUT")
1310 "*Specifies how a DUT instance name is obtained.
1311 The design-under-test instance name (i.e. the component instantiated in the
1312 testbench) can be obtained by modifying the component name (e.g. attaching
1313 or stripping off a substring)."
1314 vhdl-name-doc-string)
1315 :type '(cons (regexp :tag "From regexp")
1316 (string :tag "To string "))
1317 :group 'vhdl-testbench)
1319 (defcustom vhdl-testbench-include-header t
1320 "*Non-nil means include a header in automatically generated files."
1322 :group 'vhdl-testbench)
1324 (defcustom vhdl-testbench-declarations "\
1326 signal Clk : std_logic := '1';
1328 "*String or file to be inserted in the testbench declarative part.
1329 If the string specifies an existing file name, the contents of the file is
1330 inserted, otherwise the string itself is inserted in the testbench
1331 architecture before the BEGIN keyword.
1332 Type `C-j' for newlines."
1334 :group 'vhdl-testbench)
1336 (defcustom vhdl-testbench-statements "\
1338 Clk <= not Clk after 10 ns;
1340 -- waveform generation
1341 WaveGen_Proc: process
1343 -- insert signal assignments here
1345 wait until Clk = '1';
1346 end process WaveGen_Proc;
1348 "*String or file to be inserted in the testbench statement part.
1349 If the string specifies an existing file name, the contents of the file is
1350 inserted, otherwise the string itself is inserted in the testbench
1351 architecture before the END keyword.
1352 Type `C-j' for newlines."
1354 :group 'vhdl-testbench)
1356 (defcustom vhdl-testbench-initialize-signals nil
1357 "*Non-nil means initialize signals with `0' when declared in testbench."
1359 :group 'vhdl-testbench)
1361 (defcustom vhdl-testbench-include-library t
1362 "*Non-nil means a library/use clause for std_logic_1164 is included."
1364 :group 'vhdl-testbench)
1366 (defcustom vhdl-testbench-include-configuration t
1367 "*Non-nil means a testbench configuration is attached at the end."
1369 :group 'vhdl-testbench)
1371 (defcustom vhdl-testbench-create-files 'single
1372 "*Specifies whether new files should be created for the testbench.
1373 testbench entity and architecture are inserted:
1374 None : in current buffer
1375 Single file : in new single file
1376 Separate files: in two separate files
1377 The file names are obtained from variables `vhdl-testbench-entity-file-name'
1378 and `vhdl-testbench-architecture-file-name'."
1379 :type '(choice (const :tag "None" none)
1380 (const :tag "Single file" single)
1381 (const :tag "Separate files" separate))
1382 :group 'vhdl-testbench)
1384 (defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
1386 "*Specifies how the testbench entity file name is obtained.
1387 The entity file name can be obtained by modifying the testbench entity name
1388 \(e.g. attaching or stripping off a substring). The file extension is
1389 automatically taken from the file name of the current buffer. Testbench
1390 files can be created in a different directory by prepending a relative or
1391 absolute path to the file name."
1392 vhdl-name-doc-string)
1393 :type '(cons (regexp :tag "From regexp")
1394 (string :tag "To string "))
1395 :group 'vhdl-testbench)
1397 (defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
1399 "*Specifies how the testbench architecture file name is obtained.
1400 The architecture file name can be obtained by modifying the testbench entity
1401 and/or architecture name (e.g. attaching or stripping off a substring). The
1402 string that is matched against the regexp is the concatenation of the entity
1403 and the architecture name separated by a space. This gives access to both
1404 names (see default setting as example). Testbench files can be created in
1405 a different directory by prepending a relative or absolute path to the file
1407 vhdl-name-doc-string)
1408 :type '(cons (regexp :tag "From regexp")
1409 (string :tag "To string "))
1410 :group 'vhdl-testbench)
1413 (defgroup vhdl-comment nil
1414 "Customizations for comments."
1417 (defcustom vhdl-self-insert-comments t
1418 "*Non-nil means various templates automatically insert help comments."
1420 :group 'vhdl-comment)
1422 (defcustom vhdl-prompt-for-comments t
1423 "*Non-nil means various templates prompt for user definable comments."
1425 :group 'vhdl-comment)
1427 (defcustom vhdl-inline-comment-column 40
1428 "*Column to indent and align inline comments to.
1429 Overrides local option `comment-column'.
1431 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1432 \"Activate Options\"."
1434 :group 'vhdl-comment)
1436 (defcustom vhdl-end-comment-column 79
1437 "*End of comment column.
1438 Comments that exceed this column number are wrapped.
1440 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1441 \"Activate Options\"."
1443 :group 'vhdl-comment)
1445 (defvar end-comment-column)
1448 (defgroup vhdl-align nil
1449 "Customizations for alignment."
1452 (defcustom vhdl-auto-align t
1453 "*Non-nil means align some templates automatically after generation."
1457 (defcustom vhdl-align-groups t
1458 "*Non-nil means align groups of code lines separately.
1459 A group of code lines is a region of consecutive lines between two lines that
1460 match the regexp in option `vhdl-align-group-separate'."
1464 (defcustom vhdl-align-group-separate "^\\s-*$"
1465 "*Regexp for matching a line that separates groups of lines for alignment.
1467 \"^\\s-*$\": matches an empty line
1468 \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1472 (defcustom vhdl-align-same-indent t
1473 "*Non-nil means align blocks with same indent separately.
1474 When a region or the entire buffer is aligned, the code is divided into
1475 blocks of same indent which are aligned separately (except for argument/port
1476 lists). This gives nicer alignment in most cases.
1477 Option `vhdl-align-groups' still applies within these blocks."
1482 (defgroup vhdl-highlight nil
1483 "Customizations for highlighting."
1486 (defcustom vhdl-highlight-keywords t
1487 "*Non-nil means highlight VHDL keywords and other standardized words.
1488 The following faces are used:
1489 `font-lock-keyword-face' : keywords
1490 `font-lock-type-face' : standardized types
1491 `vhdl-font-lock-attribute-face': standardized attributes
1492 `vhdl-font-lock-enumvalue-face': standardized enumeration values
1493 `vhdl-font-lock-function-face' : standardized function and package names
1495 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1496 entry \"Fontify Buffer\")."
1498 :set (lambda (variable value)
1499 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1500 :group 'vhdl-highlight)
1502 (defcustom vhdl-highlight-names t
1503 "*Non-nil means highlight declaration names and construct labels.
1504 The following faces are used:
1505 `font-lock-function-name-face' : names in declarations of units,
1506 subprograms, components, as well as labels of VHDL constructs
1507 `font-lock-type-face' : names in type/nature declarations
1508 `vhdl-font-lock-attribute-face': names in attribute declarations
1509 `font-lock-variable-name-face' : names in declarations of signals,
1510 variables, constants, subprogram parameters, generics, and ports
1512 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1513 entry \"Fontify Buffer\")."
1515 :set (lambda (variable value)
1516 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1517 :group 'vhdl-highlight)
1519 (defcustom vhdl-highlight-special-words nil
1520 "*Non-nil means highlight words with special syntax.
1521 The words with syntax and color specified in option `vhdl-special-syntax-alist'
1522 are highlighted accordingly.
1523 Can be used for visual support of naming conventions.
1525 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1526 entry \"Fontify Buffer\")."
1528 :set (lambda (variable value)
1529 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1530 :group 'vhdl-highlight)
1532 (defcustom vhdl-highlight-forbidden-words nil
1533 "*Non-nil means highlight forbidden words.
1534 The reserved words specified in option `vhdl-forbidden-words' or having the
1535 syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1536 warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1539 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1540 entry \"Fontify Buffer\")."
1542 :set (lambda (variable value)
1543 (vhdl-custom-set variable value
1544 'vhdl-words-init 'vhdl-font-lock-init))
1545 :group 'vhdl-highlight)
1547 (defcustom vhdl-highlight-verilog-keywords nil
1548 "*Non-nil means highlight Verilog keywords as reserved words.
1549 Verilog keywords are highlighted in a warning color (face
1550 `vhdl-font-lock-reserved-words-face') to indicate not to use them.
1552 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1553 entry \"Fontify Buffer\")."
1555 :set (lambda (variable value)
1556 (vhdl-custom-set variable value
1557 'vhdl-words-init 'vhdl-font-lock-init))
1558 :group 'vhdl-highlight)
1560 (defcustom vhdl-highlight-translate-off nil
1561 "*Non-nil means background-highlight code excluded from translation.
1562 That is, all code between \"-- pragma translate_off\" and
1563 \"-- pragma translate_on\" is highlighted using a different background color
1564 \(face `vhdl-font-lock-translate-off-face').
1565 Note: this might slow down on-the-fly fontification (and thus editing).
1567 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1568 entry \"Fontify Buffer\")."
1570 :set (lambda (variable value)
1571 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1572 :group 'vhdl-highlight)
1574 (defcustom vhdl-highlight-case-sensitive nil
1575 "*Non-nil means consider case for highlighting.
1577 non-nil also upper-case VHDL words are highlighted, but case of words with
1578 special syntax is not considered
1579 nil only lower-case VHDL words are highlighted, but case of words with
1580 special syntax is considered
1581 Overrides local option `font-lock-keywords-case-fold-search'.
1583 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1584 entry \"Fontify Buffer\")."
1586 :group 'vhdl-highlight)
1588 (defcustom vhdl-special-syntax-alist
1589 '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1")
1590 ("type" "\\w+_t" "ForestGreen" "PaleGreen")
1591 ("variable" "\\w+_v" "Grey50" "Grey80"))
1592 "*List of special syntax to be highlighted.
1593 If option `vhdl-highlight-special-words' is non-nil, words with the specified
1594 syntax (as regular expression) are highlighted in the corresponding color.
1596 Name : string of words and spaces
1597 Regexp : regular expression describing word syntax
1598 (e.g. \"\\\w+_c\" matches word with suffix \"_c\")
1599 Color (light): foreground color for light background
1600 (matching color examples: Gold3, Grey50, LimeGreen, Tomato,
1601 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
1602 Color (dark) : foreground color for dark background
1603 (matching color examples: BurlyWood1, Grey80, Green, Coral,
1604 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1606 Can be used for visual support of naming conventions, such as highlighting
1607 different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1608 \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1609 common substrings or name suffices.
1610 For each entry, a new face is generated with the specified colors and name
1611 \"vhdl-font-lock-\" + name + \"-face\".
1613 NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1614 entry \"Fontify Buffer\"). All other changes require restarting Emacs."
1615 :type '(repeat (list :tag "Face" :indent 2
1616 (string :tag "Name ")
1617 (regexp :tag "Regexp " "\\w+_")
1618 (string :tag "Color (light)")
1619 (string :tag "Color (dark) ")))
1620 :set (lambda (variable value)
1621 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1622 :group 'vhdl-highlight)
1624 (defcustom vhdl-forbidden-words '()
1625 "*List of forbidden words to be highlighted.
1626 If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1627 words are highlighted in a warning color to indicate not to use them.
1629 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1630 entry \"Fontify Buffer\")."
1631 :type '(repeat (string :format "%v"))
1632 :set (lambda (variable value)
1633 (vhdl-custom-set variable value
1634 'vhdl-words-init 'vhdl-font-lock-init))
1635 :group 'vhdl-highlight)
1637 (defcustom vhdl-forbidden-syntax ""
1638 "*Syntax of forbidden words to be highlighted.
1639 If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1640 syntax are highlighted in a warning color to indicate not to use them.
1641 Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1642 highlights identifiers with 10 or more characters).
1644 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1645 entry \"Fontify Buffer\")."
1647 :set (lambda (variable value)
1648 (vhdl-custom-set variable value
1649 'vhdl-words-init 'vhdl-font-lock-init))
1650 :group 'vhdl-highlight)
1652 (defcustom vhdl-directive-keywords '("pragma" "synopsys")
1653 "*List of compiler directive keywords recognized for highlighting.
1655 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1656 entry \"Fontify Buffer\")."
1657 :type '(repeat (string :format "%v"))
1658 :set (lambda (variable value)
1659 (vhdl-custom-set variable value
1660 'vhdl-words-init 'vhdl-font-lock-init))
1661 :group 'vhdl-highlight)
1664 (defgroup vhdl-speedbar nil
1665 "Customizations for speedbar."
1668 (defcustom vhdl-speedbar-auto-open nil
1669 "*Non-nil means automatically open speedbar at startup.
1670 Alternatively, the speedbar can be opened from the VHDL menu."
1672 :group 'vhdl-speedbar)
1674 (defcustom vhdl-speedbar-display-mode 'files
1675 "*Specifies the default displaying mode when opening speedbar.
1676 Alternatively, the displaying mode can be selected from the speedbar menu or
1677 by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1678 :type '(choice (const :tag "Files" files)
1679 (const :tag "Directory hierarchy" directory)
1680 (const :tag "Project hierarchy" project))
1681 :group 'vhdl-speedbar)
1683 (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
1684 "*Limits scanning of large files and netlists.
1685 Design units: maximum file size to scan for design units
1686 Hierarchy (instances of subcomponents):
1687 File size: maximum file size to scan for instances (in bytes)
1688 Instances per arch: maximum number of instances to scan per architecture
1690 \"None\" always means that there is no limit.
1691 In case of files not or incompletely scanned, a warning message and the file
1692 names are printed out.
1693 Background: scanning for instances is considerably slower than scanning for
1694 design units, especially when there are many instances. These limits should
1695 prevent the scanning of large netlists."
1696 :type '(list (choice :tag "Design units"
1697 :format "%t : %[Value Menu%] %v"
1698 (const :tag "None" nil)
1699 (integer :tag "File size"))
1700 (list :tag "Hierarchy" :indent 2
1701 (choice :tag "File size"
1702 :format "%t : %[Value Menu%] %v"
1703 (const :tag "None" nil)
1704 (integer :tag "Size "))
1705 (choice :tag "Instances per arch"
1706 (const :tag "None" nil)
1707 (integer :tag "Number "))))
1708 :group 'vhdl-speedbar)
1710 (defcustom vhdl-speedbar-jump-to-unit t
1711 "*Non-nil means jump to the design unit code when opened in a buffer.
1712 The buffer cursor position is left unchanged otherwise."
1714 :group 'vhdl-speedbar)
1716 (defcustom vhdl-speedbar-update-on-saving t
1717 "*Automatically update design hierarchy when buffer is saved."
1719 :group 'vhdl-speedbar)
1721 (defcustom vhdl-speedbar-save-cache '(hierarchy display)
1722 "*Automatically save modified hierarchy caches when exiting Emacs.
1723 Hierarchy: design hierarchy information
1724 Display: displaying information (which design units to expand)"
1725 :type '(set (const :tag "Hierarchy" hierarchy)
1726 (const :tag "Display" display))
1727 :group 'vhdl-speedbar)
1729 (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
1730 "*Name of file for saving hierarchy cache.
1731 \"\\1\" is replaced by the project name if a project is specified,
1732 \"directory\" otherwise. \"\\2\" is replaced by the user name (allows for
1733 different users to have cache files in the same directory). Can also have
1734 an absolute path (i.e. all caches can be stored in one global directory)."
1736 :group 'vhdl-speedbar)
1739 (defgroup vhdl-menu nil
1740 "Customizations for menues."
1743 (defcustom vhdl-index-menu nil
1744 "*Non-nil means add an index menu for a source file when loading.
1745 Alternatively, the speedbar can be used. Note that the index menu scans a file
1746 when it is opened, while speedbar only scans the file upon request."
1750 (defcustom vhdl-source-file-menu nil
1751 "*Non-nil means add a menu of all source files in current directory.
1752 Alternatively, the speedbar can be used."
1756 (defcustom vhdl-hideshow-menu nil
1757 "*Non-nil means add hideshow menu and functionality at startup.
1758 Hideshow can also be enabled from the VHDL Mode menu.
1759 Hideshow allows hiding code of various VHDL constructs.
1761 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1762 \"Activate Options\"."
1766 (defcustom vhdl-hide-all-init nil
1767 "*Non-nil means hide all design units initially after a file is loaded."
1772 (defgroup vhdl-print nil
1773 "Customizations for printing."
1776 (defcustom vhdl-print-two-column t
1777 "*Non-nil means print code in two columns and landscape format.
1778 Adjusts settings in a way that postscript printing (\"File\" menu, `ps-print')
1779 prints VHDL files in a nice two-column landscape style.
1781 NOTE: Activate the new setting by restarting Emacs.
1782 Overrides `ps-print' settings locally."
1786 (defcustom vhdl-print-customize-faces t
1787 "*Non-nil means use an optimized set of faces for postscript printing.
1789 NOTE: Activate the new setting by restarting Emacs.
1790 Overrides `ps-print' settings locally."
1795 (defgroup vhdl-misc nil
1796 "Miscellaneous customizations."
1799 (defcustom vhdl-intelligent-tab t
1800 "*Non-nil means `TAB' does indentation, word completion and tab insertion.
1801 That is, if preceding character is part of a word then complete word,
1802 else if not at beginning of line then insert tab,
1803 else if last command was a `TAB' or `RET' then dedent one step,
1804 else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1805 If nil, TAB always indents current line (i.e. `TAB' is bound to
1806 `indent-according-to-mode').
1808 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1809 \"Activate Options\"."
1813 (defcustom vhdl-indent-syntax-based t
1814 "*Non-nil means indent lines of code based on their syntactic context.
1815 Otherwise, a line is indented like the previous nonblank line. This can be
1816 useful in large files where syntax-based indentation gets very slow."
1820 (defcustom vhdl-word-completion-case-sensitive nil
1821 "*Non-nil means word completion using `TAB' is case sensitive.
1822 That is, `TAB' completes words that start with the same letters and case.
1823 Otherwise, case is ignored."
1827 (defcustom vhdl-word-completion-in-minibuffer t
1828 "*Non-nil enables word completion in minibuffer (for template prompts).
1830 NOTE: Activate the new setting by restarting Emacs."
1834 (defcustom vhdl-underscore-is-part-of-word nil
1835 "*Non-nil means consider the underscore character `_' as part of word.
1836 An identifier containing underscores is then treated as a single word in
1837 select and move operations. All parts of an identifier separated by underscore
1838 are treated as single words otherwise.
1840 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1841 \"Activate Options\"."
1843 :set (lambda (variable value)
1844 (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init))
1848 (defgroup vhdl-related nil
1849 "Related general customizations."
1852 ;; add related general customizations
1853 (custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
1855 (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
1856 (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
1857 (custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
1858 (custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
1859 (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
1861 (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
1862 (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
1863 (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
1864 (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
1866 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1867 ;; Internal variables
1869 (defvar vhdl-menu-max-size 20
1870 "*Specifies the maximum size of a menu before splitting it into submenues.")
1872 (defvar vhdl-progress-interval 1
1873 "*Interval used to update progress status during long operations.
1874 If a number, percentage complete gets updated after each interval of
1875 that many seconds. To inhibit all messages, set this option to nil.")
1877 (defvar vhdl-inhibit-startup-warnings-p nil
1878 "*If non-nil, inhibits start up compatibility warnings.")
1880 (defvar vhdl-strict-syntax-p nil
1881 "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
1882 If the syntactic symbol for a particular line does not match a symbol
1883 in the offsets alist, an error is generated, otherwise no error is
1884 reported and the syntactic symbol is ignored.")
1886 (defvar vhdl-echo-syntactic-information-p nil
1887 "*If non-nil, syntactic info is echoed when the line is indented.")
1889 (defconst vhdl-offsets-alist-default
1895 (statement-cont . vhdl-lineup-statement-cont)
1896 (statement-block-intro . +)
1897 (statement-case-intro . +)
1898 (case-alternative . +)
1899 (comment . vhdl-lineup-comment)
1902 (arglist-cont-nonempty . vhdl-lineup-arglist)
1903 (arglist-close . vhdl-lineup-arglist)
1910 "Default settings for offsets of syntactic elements.
1911 Do not change this constant! See the variable `vhdl-offsets-alist' for
1914 (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
1915 "*Association list of syntactic element symbols and indentation offsets.
1916 As described below, each cons cell in this list has the form:
1918 (SYNTACTIC-SYMBOL . OFFSET)
1920 When a line is indented, `vhdl-mode' first determines the syntactic
1921 context of the line by generating a list of symbols called syntactic
1922 elements. This list can contain more than one syntactic element and
1923 the global variable `vhdl-syntactic-context' contains the context list
1924 for the line being indented. Each element in this list is actually a
1925 cons cell of the syntactic symbol and a buffer position. This buffer
1926 position is call the relative indent point for the line. Some
1927 syntactic symbols may not have a relative indent point associated with
1930 After the syntactic context list for a line is generated, `vhdl-mode'
1931 calculates the absolute indentation for the line by looking at each
1932 syntactic element in the list. First, it compares the syntactic
1933 element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it
1934 finds a match, it adds the OFFSET to the column of the relative indent
1935 point. The sum of this calculation for each element in the syntactic
1936 list is the absolute offset for line being indented.
1938 If the syntactic element does not match any in the `vhdl-offsets-alist',
1939 an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
1940 the element is ignored.
1942 Actually, OFFSET can be an integer, a function, a variable, or one of
1943 the following symbols: `+', `-', `++', or `--'. These latter
1944 designate positive or negative multiples of `vhdl-basic-offset',
1945 respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is
1946 called with a single argument containing the cons of the syntactic
1947 element symbol and the relative indent point. The function should
1948 return an integer offset.
1950 Here is the current list of valid syntactic element symbols:
1952 string -- inside multi-line string
1953 block-open -- statement block open
1954 block-close -- statement block close
1955 statement -- a VHDL statement
1956 statement-cont -- a continuation of a VHDL statement
1957 statement-block-intro -- the first line in a new statement block
1958 statement-case-intro -- the first line in a case alternative block
1959 case-alternative -- a case statement alternative clause
1960 comment -- a line containing only a comment
1961 arglist-intro -- the first line in an argument list
1962 arglist-cont -- subsequent argument list lines when no
1963 arguments follow on the same line as the
1964 the arglist opening paren
1965 arglist-cont-nonempty -- subsequent argument list lines when at
1966 least one argument follows on the same
1967 line as the arglist opening paren
1968 arglist-close -- the solo close paren of an argument list
1969 entity -- inside an entity declaration
1970 configuration -- inside a configuration declaration
1971 package -- inside a package declaration
1972 architecture -- inside an architecture body
1973 package-body -- inside a package body")
1975 (defvar vhdl-comment-only-line-offset 0
1976 "*Extra offset for line which contains only the start of a comment.
1977 Can contain an integer or a cons cell of the form:
1979 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
1981 Where NON-ANCHORED-OFFSET is the amount of offset given to
1982 non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
1983 the amount of offset to give column-zero anchored comment-only lines.
1984 Just an integer as value is equivalent to (<val> . 0)")
1986 (defvar vhdl-special-indent-hook nil
1987 "*Hook for user defined special indentation adjustments.
1988 This hook gets called after a line is indented by the mode.")
1990 (defvar vhdl-style-alist
1992 (vhdl-basic-offset . 4)
1993 (vhdl-offsets-alist . ())))
1994 "Styles of Indentation.
1995 Elements of this alist are of the form:
1997 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
1999 where STYLE-STRING is a short descriptive string used to select a
2000 style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended
2001 value for that variable when using the selected style.
2003 There is one special case when VARIABLE is `vhdl-offsets-alist'. In this
2004 case, the VALUE is a list containing elements of the form:
2006 (SYNTACTIC-SYMBOL . VALUE)
2008 as described in `vhdl-offsets-alist'. These are passed directly to
2009 `vhdl-set-offset' so there is no need to set every syntactic symbol in
2010 your style, only those that are different from the default.")
2012 ;; dynamically append the default value of most variables
2013 (or (assoc "Default" vhdl-style-alist)
2014 (let* ((varlist '(vhdl-inhibit-startup-warnings-p
2015 vhdl-strict-syntax-p
2016 vhdl-echo-syntactic-information-p
2019 vhdl-comment-only-line-offset))
2020 (default (cons "Default"
2024 (cons var (symbol-value var))))
2026 (setq vhdl-style-alist (cons default vhdl-style-alist))))
2028 (defvar vhdl-mode-hook nil
2029 "*Hook called by `vhdl-mode'.")
2032 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2033 ;;; Required packages
2034 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2038 (require 'compile) ; XEmacs
2040 (require 'hippie-exp)
2042 ;; optional (minimize warning messages during compile)
2044 (require 'font-lock)
2046 (require 'speedbar))
2049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2051 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2053 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2054 ;; XEmacs compatibility
2057 (defun vhdl-keep-region-active ()
2058 "Do whatever is necessary to keep the region active in XEmacs.
2059 Ignore byte-compiler warnings you might see."
2060 (and (boundp 'zmacs-region-stays)
2061 (setq zmacs-region-stays t)))
2063 ;; `wildcard-to-regexp' is included only in XEmacs 21
2064 (unless (fboundp 'wildcard-to-regexp)
2065 (defun wildcard-to-regexp (wildcard)
2066 "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'."
2067 (let* ((i (string-match "[*?]" wildcard))
2068 (result (substring wildcard 0 i))
2069 (len (length wildcard)))
2072 (let ((ch (aref wildcard i)))
2073 (setq result (concat result
2074 (cond ((eq ch ?*) "[^\000]*")
2075 ((eq ch ??) "[^\000]")
2076 (t (char-to-string ch)))))
2078 (concat "\\`" result "\\'"))))
2080 ;; `regexp-opt' undefined (`xemacs-devel' not installed)
2081 ;; `regexp-opt' accelerates fontification by 10-20%
2082 (unless (fboundp 'regexp-opt)
2083 ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
2084 (defun regexp-opt (strings &optional paren)
2085 (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
2086 (concat open (mapconcat 'regexp-quote strings "\\|") close))))
2088 ;; `match-string-no-properties' undefined (XEmacs, what else?)
2089 (unless (fboundp 'match-string-no-properties)
2090 (defalias 'match-string-no-properties 'match-string))
2092 ;; `subst-char-in-string' undefined (XEmacs)
2093 (unless (fboundp 'subst-char-in-string)
2094 (defun subst-char-in-string (fromchar tochar string &optional inplace)
2095 (let ((i (length string))
2096 (newstr (if inplace string (copy-sequence string))))
2099 (if (eq (aref newstr i) fromchar) (aset newstr i tochar)))
2102 ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
2103 (when (and vhdl-xemacs (string< itimer-version "1.09")
2104 (not noninteractive))
2106 (when (string< itimer-version "1.09")
2107 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)")
2108 (beep) (sit-for 5)))
2110 ;; `file-expand-wildcards' undefined (XEmacs)
2111 (unless (fboundp 'file-expand-wildcards)
2112 (defun file-expand-wildcards (pattern &optional full)
2113 "Taken from Emacs' `files.el'."
2114 (let* ((nondir (file-name-nondirectory pattern))
2115 (dirpart (file-name-directory pattern))
2116 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2117 (mapcar 'file-name-as-directory
2118 (file-expand-wildcards (directory-file-name dirpart)))
2122 (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
2123 (file-directory-p (directory-file-name (car dirs))))
2124 (let ((this-dir-contents
2126 (mapcar #'(lambda (name)
2127 (unless (string-match "\\`\\.\\.?\\'"
2128 (file-name-nondirectory name))
2130 (directory-files (or (car dirs) ".") full
2131 (wildcard-to-regexp nondir))))))
2134 (if (and (car dirs) (not full))
2135 (mapcar (function (lambda (name) (concat (car dirs) name)))
2139 (setq dirs (cdr dirs)))
2142 ;; `member-ignore-case' undefined (XEmacs)
2143 (unless (fboundp 'member-ignore-case)
2144 (defalias 'member-ignore-case 'member))
2146 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2147 ;; Compatibility with older VHDL Mode versions
2149 (defvar vhdl-warnings nil
2150 "Warnings to tell the user during start up.")
2152 (defun vhdl-run-when-idle (secs repeat function)
2153 "Wait until idle, then run FUNCTION."
2154 (if (fboundp 'start-itimer)
2155 (start-itimer "vhdl-mode" function secs repeat t)
2156 ; (run-with-idle-timer secs repeat function)))
2157 ;; explicitely activate timer (necessary when Emacs is already idle)
2158 (aset (run-with-idle-timer secs repeat function) 0 nil)))
2160 (defun vhdl-warning-when-idle (&rest args)
2161 "Wait until idle, then print out warning STRING and beep."
2163 (vhdl-warning (apply 'format args) t)
2164 (unless vhdl-warnings
2165 (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2166 (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings))))
2168 (defun vhdl-warning (string &optional nobeep)
2169 "Print out warning STRING and beep."
2170 (message (concat "WARNING: " string))
2171 (unless (or nobeep noninteractive) (beep)))
2173 (defun vhdl-print-warnings ()
2174 "Print out messages in variable `vhdl-warnings'."
2175 (let ((no-warnings (length vhdl-warnings)))
2176 (setq vhdl-warnings (nreverse vhdl-warnings))
2177 (while vhdl-warnings
2178 (message (concat "WARNING: " (car vhdl-warnings)))
2179 (setq vhdl-warnings (cdr vhdl-warnings)))
2181 (when (> no-warnings 1)
2182 (message "WARNING: See warnings in message buffer (type `C-c M-m')."))))
2184 ;; Backward compatibility checks and fixes
2185 ;; option `vhdl-compiler' changed format
2186 (unless (stringp vhdl-compiler)
2187 (setq vhdl-compiler "ModelSim")
2188 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2190 ;; option `vhdl-standard' changed format
2191 (unless (listp vhdl-standard)
2192 (setq vhdl-standard '(87 nil))
2193 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2195 ;; option `vhdl-model-alist' changed format
2196 (when (= (length (car vhdl-model-alist)) 3)
2197 (let ((old-alist vhdl-model-alist)
2200 (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2201 (setq old-alist (cdr old-alist)))
2202 (setq vhdl-model-alist (nreverse new-alist)))
2203 (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2205 ;; option `vhdl-project-alist' changed format
2206 (when (= (length (car vhdl-project-alist)) 3)
2207 (let ((old-alist vhdl-project-alist)
2210 (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2211 (setq old-alist (cdr old-alist)))
2212 (setq vhdl-project-alist (nreverse new-alist)))
2213 (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2215 ;; option `vhdl-project-alist' changed format (3.31.1)
2216 (when (= (length (car vhdl-project-alist)) 4)
2217 (let ((old-alist vhdl-project-alist)
2220 (setq elem (car old-alist))
2222 (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2223 nil "./" "work" "work/" "Makefile" (nth 3 elem))
2225 (setq old-alist (cdr old-alist)))
2226 (setq vhdl-project-alist (nreverse new-alist)))
2227 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2229 ;; option `vhdl-project-alist' changed format (3.31.12)
2230 (when (= (length (car vhdl-project-alist)) 10)
2231 (let ((tmp-alist vhdl-project-alist))
2233 (setcdr (nthcdr 3 (car tmp-alist))
2234 (cons "" (nthcdr 4 (car tmp-alist))))
2235 (setq tmp-alist (cdr tmp-alist))))
2236 (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2238 ;; option `vhdl-compiler-alist' changed format (3.31.1)
2239 (when (= (length (car vhdl-compiler-alist)) 7)
2240 (let ((old-alist vhdl-compiler-alist)
2243 (setq elem (car old-alist))
2245 (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2246 (if (equal (nth 3 elem) "") nil (nth 3 elem))
2247 (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2248 (nth 5 elem) (nth 6 elem) nil)
2250 (setq old-alist (cdr old-alist)))
2251 (setq vhdl-compiler-alist (nreverse new-alist)))
2252 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2254 ;; option `vhdl-compiler-alist' changed format (3.31.10)
2255 (when (= (length (car vhdl-compiler-alist)) 12)
2256 (let ((tmp-alist vhdl-compiler-alist))
2258 (setcdr (nthcdr 4 (car tmp-alist))
2259 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2260 (setq tmp-alist (cdr tmp-alist))))
2261 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2263 ;; option `vhdl-compiler-alist' changed format (3.31.11)
2264 (when (= (length (car vhdl-compiler-alist)) 13)
2265 (let ((tmp-alist vhdl-compiler-alist))
2267 (setcdr (nthcdr 3 (car tmp-alist))
2268 (cons "" (nthcdr 4 (car tmp-alist))))
2269 (setq tmp-alist (cdr tmp-alist))))
2270 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2272 ;; option `vhdl-compiler-alist' changed format (3.32.7)
2273 (when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2274 (let ((tmp-alist vhdl-compiler-alist))
2276 (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2278 (setq tmp-alist (cdr tmp-alist))))
2279 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2281 ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2282 (when (equal vhdl-project "")
2283 (setq vhdl-project nil)
2284 (customize-save-variable 'vhdl-project vhdl-project))
2286 ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2287 (when (stringp vhdl-project-file-name)
2288 (setq vhdl-project-file-name (list vhdl-project-file-name))
2289 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2291 ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2292 (if (not (boundp 'speedbar-indentation-width))
2293 (defvar speedbar-indentation-width 2)
2294 ;; set default to 2 if not already customized
2295 (unless (get 'speedbar-indentation-width 'saved-value)
2296 (setq speedbar-indentation-width 2)))
2299 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2300 ;;; Help functions / inline substitutions / macros
2301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2303 (defun vhdl-standard-p (standard)
2304 "Check if STANDARD is specified as used standard."
2305 (or (eq standard (car vhdl-standard))
2306 (memq standard (cadr vhdl-standard))))
2308 (defun vhdl-project-p (&optional warning)
2309 "Return non-nil if a project is displayed, i.e. directories or files are
2311 (if (assoc vhdl-project vhdl-project-alist)
2313 (when (and vhdl-project warning)
2314 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2317 (defun vhdl-resolve-env-variable (string)
2318 "Resolve environment variables in STRING."
2319 (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2320 (setq string (concat (match-string 1 string)
2321 (getenv (match-string 2 string))
2322 (match-string 4 string))))
2325 (defun vhdl-default-directory ()
2326 "Return the default directory of the current project or the directory of the
2327 current buffer if no project is defined."
2328 (if (vhdl-project-p)
2329 (expand-file-name (vhdl-resolve-env-variable
2330 (nth 1 (aget vhdl-project-alist vhdl-project))))
2333 (defmacro vhdl-prepare-search-1 (&rest body)
2334 "Enable case insensitive search and switch to syntax table that includes '_',
2335 then execute BODY, and finally restore the old environment. Used for
2336 consistent searching."
2337 `(let ((case-fold-search t) ; case insensitive search
2338 (current-syntax-table (syntax-table))
2340 (restore-prog ; program to restore enviroment
2342 ;; restore syntax table
2343 (set-syntax-table current-syntax-table))))
2344 ;; use extended syntax table
2345 (set-syntax-table vhdl-mode-ext-syntax-table)
2346 ;; execute BODY safely
2348 (condition-case info
2350 (error (eval restore-prog) ; restore environment on error
2351 (error (cadr info))))) ; pass error up
2352 ;; restore environment
2356 (defmacro vhdl-prepare-search-2 (&rest body)
2357 "Enable case insensitive search, switch to syntax table that includes '_',
2358 and remove `intangible' overlays, then execute BODY, and finally restore the
2359 old environment. Used for consistent searching."
2360 `(let ((case-fold-search t) ; case insensitive search
2361 (current-syntax-table (syntax-table))
2362 result overlay-all-list overlay-intangible-list overlay
2363 (restore-prog ; program to restore enviroment
2365 ;; restore syntax table
2366 (set-syntax-table current-syntax-table)
2367 ;; restore `intangible' overlays
2368 (when (fboundp 'overlay-lists)
2369 (while overlay-intangible-list
2370 (overlay-put (car overlay-intangible-list) 'intangible t)
2371 (setq overlay-intangible-list
2372 (cdr overlay-intangible-list)))))))
2373 ;; use extended syntax table
2374 (set-syntax-table vhdl-mode-ext-syntax-table)
2375 ;; remove `intangible' overlays
2376 (when (fboundp 'overlay-lists)
2377 (setq overlay-all-list (overlay-lists))
2378 (setq overlay-all-list
2379 (append (car overlay-all-list) (cdr overlay-all-list)))
2380 (while overlay-all-list
2381 (setq overlay (car overlay-all-list))
2382 (when (memq 'intangible (overlay-properties overlay))
2383 (setq overlay-intangible-list
2384 (cons overlay overlay-intangible-list))
2385 (overlay-put overlay 'intangible nil))
2386 (setq overlay-all-list (cdr overlay-all-list))))
2387 ;; execute BODY safely
2389 (condition-case info
2391 (error (eval restore-prog) ; restore environment on error
2392 (error (cadr info))))) ; pass error up
2393 ;; restore environment
2397 (defmacro vhdl-visit-file (file-name issue-error &rest body)
2398 "Visit file FILE-NAME and execute BODY."
2399 `(if (null ,file-name)
2401 (unless (file-directory-p ,file-name)
2402 (let ((source-buffer (current-buffer))
2403 (visiting-buffer (find-buffer-visiting ,file-name))
2405 (when (or (and visiting-buffer (set-buffer visiting-buffer))
2407 (progn (set-buffer (create-file-buffer ,file-name))
2408 (setq file-opened t)
2409 (vhdl-insert-file-contents ,file-name)
2410 (modify-syntax-entry ?\- ". 12" (syntax-table))
2411 (modify-syntax-entry ?\n ">" (syntax-table))
2412 (modify-syntax-entry ?\^M ">" (syntax-table))
2413 (modify-syntax-entry ?_ "w" (syntax-table))
2418 (when file-opened (kill-buffer (current-buffer)))
2419 (set-buffer source-buffer)
2420 (error "ERROR: File cannot be opened: \"%s\"" ,file-name))
2421 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
2423 (condition-case info
2428 (when file-opened (kill-buffer (current-buffer)))
2429 (set-buffer source-buffer)
2430 (error (cadr info)))
2431 (vhdl-warning (cadr info))))))
2432 (when file-opened (kill-buffer (current-buffer)))
2433 (set-buffer source-buffer)))))
2435 (defun vhdl-insert-file-contents (filename)
2436 "Nicked from `insert-file-contents-literally', but allow coding system
2438 (let ((format-alist nil)
2439 (after-insert-file-functions nil)
2440 (jka-compr-compression-info-list nil))
2441 (insert-file-contents filename t)))
2443 (defun vhdl-sort-alist (alist)
2445 (sort alist (function (lambda (a b) (string< (car a) (car b))))))
2447 (defun vhdl-get-subdirs (directory)
2448 "Recursively get subdirectories of DIRECTORY."
2449 (let ((dir-list (list (file-name-as-directory directory)))
2451 (setq file-list (vhdl-directory-files directory t "\\w.*"))
2453 (when (file-directory-p (car file-list))
2454 (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2455 (setq file-list (cdr file-list)))
2458 (defun vhdl-aput (alist-symbol key &optional value)
2459 "As `aput', but delete key-value pair if VALUE is nil."
2461 (aput alist-symbol key value)
2462 (adelete alist-symbol key)))
2464 (defun vhdl-delete (elt list)
2465 "Delete by side effect the first occurrence of ELT as a member of LIST."
2466 (setq list (cons nil list))
2468 (while (and (cdr list1) (not (equal elt (cadr list1))))
2469 (setq list1 (cdr list1)))
2471 (setcdr list1 (cddr list1))))
2474 (defun vhdl-speedbar-refresh (&optional key)
2475 "Refresh directory or project with name KEY."
2476 (when (and (boundp 'speedbar-frame)
2477 (frame-live-p speedbar-frame))
2479 (last-frame (selected-frame)))
2482 (select-frame speedbar-frame)
2483 (when (save-excursion
2484 (goto-char (point-min))
2485 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2486 (goto-char (match-end 1))
2487 (speedbar-do-function-pointer)
2489 (speedbar-do-function-pointer)
2490 (message "Refreshing speedbar...done"))
2491 (select-frame last-frame)))))
2493 (defun vhdl-show-messages ()
2494 "Get *Messages* buffer to show recent messages."
2496 (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*")))
2498 (defun vhdl-use-direct-instantiation ()
2499 "Return whether direct instantiation is used."
2500 (or (eq vhdl-use-direct-instantiation 'always)
2501 (and (eq vhdl-use-direct-instantiation 'standard)
2502 (not (vhdl-standard-p '87)))))
2504 (defun vhdl-max-marker (marker1 marker2)
2505 "Return larger marker."
2506 (if (> marker1 marker2) marker1 marker2))
2508 (defun vhdl-goto-marker (marker)
2509 "Goto marker in appropriate buffer."
2510 (when (markerp marker)
2511 (set-buffer (marker-buffer marker)))
2514 (defun vhdl-menu-split (list title)
2515 "Split menu LIST into several submenues, if number of
2516 elements > `vhdl-menu-max-size'."
2517 (if (> (length list) vhdl-menu-max-size)
2524 (setq sublist (cons (car remain) sublist))
2525 (setq remain (cdr remain))
2527 (if (= i vhdl-menu-max-size)
2529 (setq result (cons (cons (format "%s %s" title menuno)
2530 (nreverse sublist)) result))
2532 (setq menuno (+ menuno 1))
2533 (setq sublist '()))))
2535 (setq result (cons (cons (format "%s %s" title menuno)
2536 (nreverse sublist)) result)))
2541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2543 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2548 (defvar vhdl-template-map nil
2549 "Keymap for VHDL templates.")
2551 (defun vhdl-template-map-init ()
2552 "Initialize `vhdl-template-map'."
2553 (setq vhdl-template-map (make-sparse-keymap))
2554 ;; key bindings for VHDL templates
2555 (define-key vhdl-template-map "al" 'vhdl-template-alias)
2556 (define-key vhdl-template-map "ar" 'vhdl-template-architecture)
2557 (define-key vhdl-template-map "at" 'vhdl-template-assert)
2558 (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl)
2559 (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec)
2560 (define-key vhdl-template-map "bl" 'vhdl-template-block)
2561 (define-key vhdl-template-map "ca" 'vhdl-template-case-is)
2562 (define-key vhdl-template-map "cd" 'vhdl-template-component-decl)
2563 (define-key vhdl-template-map "ci" 'vhdl-template-component-inst)
2564 (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst)
2565 (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration)
2566 (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf)
2567 (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
2568 (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
2569 (define-key vhdl-template-map "co" 'vhdl-template-constant)
2570 (define-key vhdl-template-map "di" 'vhdl-template-disconnect)
2571 (define-key vhdl-template-map "el" 'vhdl-template-else)
2572 (define-key vhdl-template-map "ei" 'vhdl-template-elsif)
2573 (define-key vhdl-template-map "en" 'vhdl-template-entity)
2574 (define-key vhdl-template-map "ex" 'vhdl-template-exit)
2575 (define-key vhdl-template-map "fi" 'vhdl-template-file)
2576 (define-key vhdl-template-map "fg" 'vhdl-template-for-generate)
2577 (define-key vhdl-template-map "fl" 'vhdl-template-for-loop)
2578 (define-key vhdl-template-map "\C-f" 'vhdl-template-footer)
2579 (define-key vhdl-template-map "fb" 'vhdl-template-function-body)
2580 (define-key vhdl-template-map "fd" 'vhdl-template-function-decl)
2581 (define-key vhdl-template-map "ge" 'vhdl-template-generic)
2582 (define-key vhdl-template-map "gd" 'vhdl-template-group-decl)
2583 (define-key vhdl-template-map "gt" 'vhdl-template-group-template)
2584 (define-key vhdl-template-map "\C-h" 'vhdl-template-header)
2585 (define-key vhdl-template-map "ig" 'vhdl-template-if-generate)
2586 (define-key vhdl-template-map "it" 'vhdl-template-if-then)
2587 (define-key vhdl-template-map "li" 'vhdl-template-library)
2588 (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop)
2589 (define-key vhdl-template-map "\C-m" 'vhdl-template-modify)
2590 (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date)
2591 (define-key vhdl-template-map "ma" 'vhdl-template-map)
2592 (define-key vhdl-template-map "ne" 'vhdl-template-next)
2593 (define-key vhdl-template-map "ot" 'vhdl-template-others)
2594 (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl)
2595 (define-key vhdl-template-map "Pb" 'vhdl-template-package-body)
2596 (define-key vhdl-template-map "(" 'vhdl-template-paired-parens)
2597 (define-key vhdl-template-map "po" 'vhdl-template-port)
2598 (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body)
2599 (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl)
2600 (define-key vhdl-template-map "pc" 'vhdl-template-process-comb)
2601 (define-key vhdl-template-map "ps" 'vhdl-template-process-seq)
2602 (define-key vhdl-template-map "rp" 'vhdl-template-report)
2603 (define-key vhdl-template-map "rt" 'vhdl-template-return)
2604 (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst)
2605 (define-key vhdl-template-map "si" 'vhdl-template-signal)
2606 (define-key vhdl-template-map "su" 'vhdl-template-subtype)
2607 (define-key vhdl-template-map "ty" 'vhdl-template-type)
2608 (define-key vhdl-template-map "us" 'vhdl-template-use)
2609 (define-key vhdl-template-map "va" 'vhdl-template-variable)
2610 (define-key vhdl-template-map "wa" 'vhdl-template-wait)
2611 (define-key vhdl-template-map "wl" 'vhdl-template-while-loop)
2612 (define-key vhdl-template-map "wi" 'vhdl-template-with)
2613 (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait)
2614 (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
2615 (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
2616 (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
2617 (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
2618 (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
2619 (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed)
2620 (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio)
2621 (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned)
2622 (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
2623 (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
2624 (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
2625 (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
2626 (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
2627 (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt)
2628 (when (vhdl-standard-p 'ams)
2629 (define-key vhdl-template-map "br" 'vhdl-template-break)
2630 (define-key vhdl-template-map "cu" 'vhdl-template-case-use)
2631 (define-key vhdl-template-map "iu" 'vhdl-template-if-use)
2632 (define-key vhdl-template-map "lm" 'vhdl-template-limit)
2633 (define-key vhdl-template-map "na" 'vhdl-template-nature)
2634 (define-key vhdl-template-map "pa" 'vhdl-template-procedural)
2635 (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free)
2636 (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch)
2637 (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source)
2638 (define-key vhdl-template-map "sn" 'vhdl-template-subnature)
2639 (define-key vhdl-template-map "te" 'vhdl-template-terminal)
2641 (when (vhdl-standard-p 'math)
2642 (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
2643 (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
2646 ;; initialize template map for VHDL Mode
2647 (vhdl-template-map-init)
2649 (defun vhdl-function-name (prefix string &optional postfix)
2650 "Generate a Lisp function name.
2651 PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in
2652 STRING are replaced by `-' and substrings are converted to lower case."
2653 (let ((name prefix))
2654 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
2656 (concat name "-" (downcase (substring string 0 (match-end 1)))))
2657 (setq string (substring string (match-beginning 2))))
2658 (when postfix (setq name (concat name "-" postfix)))
2661 (defvar vhdl-model-map nil
2662 "Keymap for VHDL models.")
2664 (defun vhdl-model-map-init ()
2665 "Initialize `vhdl-model-map'."
2666 (setq vhdl-model-map (make-sparse-keymap))
2667 ;; key bindings for VHDL models
2668 (let ((model-alist vhdl-model-alist) model)
2670 (setq model (car model-alist))
2671 (define-key vhdl-model-map (nth 2 model)
2672 (vhdl-function-name "vhdl-model" (nth 0 model)))
2673 (setq model-alist (cdr model-alist)))))
2675 ;; initialize user model map for VHDL Mode
2676 (vhdl-model-map-init)
2678 (defvar vhdl-mode-map nil
2679 "Keymap for VHDL Mode.")
2681 (defun vhdl-mode-map-init ()
2682 "Initialize `vhdl-mode-map'."
2683 (setq vhdl-mode-map (make-sparse-keymap))
2684 ;; template key bindings
2685 (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map)
2686 ;; model key bindings
2687 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map)
2688 ;; standard key bindings
2689 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement)
2690 (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement)
2691 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp)
2692 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp)
2693 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
2694 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
2695 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
2696 (unless vhdl-xemacs ; would override `M-backspace' in XEmacs
2697 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
2698 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
2699 (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
2700 ;; backspace/delete key bindings
2701 (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify)
2702 (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
2703 (define-key vhdl-mode-map [delete] 'delete-char)
2704 (define-key vhdl-mode-map [(meta delete)] 'kill-word))
2705 ;; mode specific key bindings
2706 (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
2707 (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
2708 (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
2709 (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
2710 (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
2711 (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
2712 (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
2713 (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile)
2714 (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make)
2715 (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile)
2716 (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
2717 (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
2718 (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
2719 (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
2720 (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
2721 (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
2722 (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
2723 (if vhdl-xemacs ; `... C-g' not allowed in XEmacs
2724 (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
2725 (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
2726 (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
2727 (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
2728 (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
2729 (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
2730 (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
2731 (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
2732 (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
2733 (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
2734 (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
2735 (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
2736 (define-key vhdl-mode-map "\C-c\C-c\C-n" 'vhdl-compose-new-component)
2737 (define-key vhdl-mode-map "\C-c\C-c\C-p" 'vhdl-compose-place-component)
2738 (define-key vhdl-mode-map "\C-c\C-c\C-w" 'vhdl-compose-wire-components)
2739 (define-key vhdl-mode-map "\C-c\C-c\C-f" 'vhdl-compose-configuration)
2740 (define-key vhdl-mode-map "\C-c\C-c\C-k" 'vhdl-compose-components-package)
2741 (define-key vhdl-mode-map "\C-cc" 'vhdl-comment-uncomment-region)
2742 (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline)
2743 (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line)
2744 (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
2745 (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
2746 (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region)
2747 (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
2748 (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
2749 (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
2750 (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
2751 (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
2752 (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
2753 (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
2754 (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
2755 (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
2756 (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
2757 (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
2758 (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
2759 (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
2760 (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
2761 (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
2762 (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
2763 (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
2764 (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
2765 (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand)
2766 (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
2767 (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
2768 (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
2769 (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
2770 (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
2771 (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
2772 (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
2773 (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
2774 (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
2775 (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
2776 (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region)
2777 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer)
2778 (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
2779 (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
2780 (define-key vhdl-mode-map "\C-cf" 'vhdl-fontify-buffer)
2781 (define-key vhdl-mode-map "\C-cs" 'vhdl-statistics-buffer)
2782 (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages)
2783 (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode)
2784 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
2785 (define-key vhdl-mode-map "\M-\t" 'insert-tab)
2786 ;; insert commands bindings
2787 (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
2788 (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
2789 (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
2790 (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
2791 ;; electric key bindings
2792 (define-key vhdl-mode-map " " 'vhdl-electric-space)
2793 (when vhdl-intelligent-tab
2794 (define-key vhdl-mode-map "\t" 'vhdl-electric-tab))
2795 (define-key vhdl-mode-map "\r" 'vhdl-electric-return)
2796 (define-key vhdl-mode-map "-" 'vhdl-electric-dash)
2797 (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket)
2798 (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket)
2799 (define-key vhdl-mode-map "'" 'vhdl-electric-quote)
2800 (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon)
2801 (define-key vhdl-mode-map "," 'vhdl-electric-comma)
2802 (define-key vhdl-mode-map "." 'vhdl-electric-period)
2803 (when (vhdl-standard-p 'ams)
2804 (define-key vhdl-mode-map "=" 'vhdl-electric-equal)))
2806 ;; initialize mode map for VHDL Mode
2807 (vhdl-mode-map-init)
2809 ;; define special minibuffer keymap for enabling word completion in minibuffer
2810 ;; (useful in template generator prompts)
2811 (defvar vhdl-minibuffer-local-map
2812 (let ((map (make-sparse-keymap)))
2813 (set-keymap-parent map minibuffer-local-map)
2814 (when vhdl-word-completion-in-minibuffer
2815 (define-key map "\t" 'vhdl-minibuffer-tab))
2817 "Keymap for minibuffer used in VHDL Mode.")
2819 ;; set up electric character functions to work with
2820 ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2824 (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
2825 (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs)
2826 '(vhdl-electric-space
2828 vhdl-electric-return
2830 vhdl-electric-open-bracket
2831 vhdl-electric-close-bracket
2833 vhdl-electric-semicolon
2835 vhdl-electric-period
2836 vhdl-electric-equal))
2838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2841 (defvar vhdl-mode-syntax-table nil
2842 "Syntax table used in `vhdl-mode' buffers.")
2844 (defvar vhdl-mode-ext-syntax-table nil
2845 "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2847 (defun vhdl-mode-syntax-table-init ()
2848 "Initialize `vhdl-mode-syntax-table'."
2849 (setq vhdl-mode-syntax-table (make-syntax-table))
2850 ;; define punctuation
2851 (modify-syntax-entry ?\# "." vhdl-mode-syntax-table)
2852 (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table)
2853 (modify-syntax-entry ?\% "." vhdl-mode-syntax-table)
2854 (modify-syntax-entry ?\& "." vhdl-mode-syntax-table)
2855 (modify-syntax-entry ?\' "." vhdl-mode-syntax-table)
2856 (modify-syntax-entry ?\* "." vhdl-mode-syntax-table)
2857 (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table)
2858 (modify-syntax-entry ?\. "." vhdl-mode-syntax-table)
2859 (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table)
2860 (modify-syntax-entry ?\: "." vhdl-mode-syntax-table)
2861 (modify-syntax-entry ?\; "." vhdl-mode-syntax-table)
2862 (modify-syntax-entry ?\< "." vhdl-mode-syntax-table)
2863 (modify-syntax-entry ?\= "." vhdl-mode-syntax-table)
2864 (modify-syntax-entry ?\> "." vhdl-mode-syntax-table)
2865 (modify-syntax-entry ?\\ "w" vhdl-mode-syntax-table)
2866 (modify-syntax-entry ?\| "." vhdl-mode-syntax-table)
2868 (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table)
2869 ;; define underscore
2870 (when vhdl-underscore-is-part-of-word
2871 (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table))
2872 ;; a single hyphen is punctuation, but a double hyphen starts a comment
2873 (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)
2874 ;; and \n and \^M end a comment
2875 (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table)
2876 (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table)
2877 ;; define parentheses to match
2878 (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table)
2879 (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table)
2880 (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table)
2881 (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table)
2882 (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table)
2883 (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table)
2884 ;; extended syntax table including '_' (for simpler search regexps)
2885 (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table))
2886 (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table))
2888 ;; initialize syntax table for VHDL Mode
2889 (vhdl-mode-syntax-table-init)
2891 (defvar vhdl-syntactic-context nil
2892 "Buffer local variable containing syntactic analysis list.")
2893 (make-variable-buffer-local 'vhdl-syntactic-context)
2895 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2896 ;; Abbrev ook bindings
2898 (defvar vhdl-mode-abbrev-table nil
2899 "Abbrev table to use in `vhdl-mode' buffers.")
2901 (defun vhdl-mode-abbrev-table-init ()
2902 "Initialize `vhdl-mode-abbrev-table'."
2903 (when vhdl-mode-abbrev-table (clear-abbrev-table vhdl-mode-abbrev-table))
2904 (define-abbrev-table 'vhdl-mode-abbrev-table
2906 (when (memq 'vhdl vhdl-electric-keywords)
2909 ("--" "" vhdl-template-display-comment-hook 0)
2910 ("abs" "" vhdl-template-default-hook 0)
2911 ("access" "" vhdl-template-default-hook 0)
2912 ("after" "" vhdl-template-default-hook 0)
2913 ("alias" "" vhdl-template-alias-hook 0)
2914 ("all" "" vhdl-template-default-hook 0)
2915 ("and" "" vhdl-template-default-hook 0)
2916 ("arch" "" vhdl-template-architecture-hook 0)
2917 ("architecture" "" vhdl-template-architecture-hook 0)
2918 ("array" "" vhdl-template-default-hook 0)
2919 ("assert" "" vhdl-template-assert-hook 0)
2920 ("attr" "" vhdl-template-attribute-hook 0)
2921 ("attribute" "" vhdl-template-attribute-hook 0)
2922 ("begin" "" vhdl-template-default-indent-hook 0)
2923 ("block" "" vhdl-template-block-hook 0)
2924 ("body" "" vhdl-template-default-hook 0)
2925 ("buffer" "" vhdl-template-default-hook 0)
2926 ("bus" "" vhdl-template-default-hook 0)
2927 ("case" "" vhdl-template-case-hook 0)
2928 ("comp" "" vhdl-template-component-hook 0)
2929 ("component" "" vhdl-template-component-hook 0)
2930 ("cond" "" vhdl-template-conditional-signal-asst-hook 0)
2931 ("conditional" "" vhdl-template-conditional-signal-asst-hook 0)
2932 ("conf" "" vhdl-template-configuration-hook 0)
2933 ("configuration" "" vhdl-template-configuration-hook 0)
2934 ("cons" "" vhdl-template-constant-hook 0)
2935 ("constant" "" vhdl-template-constant-hook 0)
2936 ("disconnect" "" vhdl-template-disconnect-hook 0)
2937 ("downto" "" vhdl-template-default-hook 0)
2938 ("else" "" vhdl-template-else-hook 0)
2939 ("elseif" "" vhdl-template-elsif-hook 0)
2940 ("elsif" "" vhdl-template-elsif-hook 0)
2941 ("end" "" vhdl-template-default-indent-hook 0)
2942 ("entity" "" vhdl-template-entity-hook 0)
2943 ("exit" "" vhdl-template-exit-hook 0)
2944 ("file" "" vhdl-template-file-hook 0)
2945 ("for" "" vhdl-template-for-hook 0)
2946 ("func" "" vhdl-template-function-hook 0)
2947 ("function" "" vhdl-template-function-hook 0)
2948 ("generic" "" vhdl-template-generic-hook 0)
2949 ("group" "" vhdl-template-group-hook 0)
2950 ("guarded" "" vhdl-template-default-hook 0)
2951 ("if" "" vhdl-template-if-hook 0)
2952 ("impure" "" vhdl-template-default-hook 0)
2953 ("in" "" vhdl-template-default-hook 0)
2954 ("inertial" "" vhdl-template-default-hook 0)
2955 ("inout" "" vhdl-template-default-hook 0)
2956 ("inst" "" vhdl-template-instance-hook 0)
2957 ("instance" "" vhdl-template-instance-hook 0)
2958 ("is" "" vhdl-template-default-hook 0)
2959 ("label" "" vhdl-template-default-hook 0)
2960 ("library" "" vhdl-template-library-hook 0)
2961 ("linkage" "" vhdl-template-default-hook 0)
2962 ("literal" "" vhdl-template-default-hook 0)
2963 ("loop" "" vhdl-template-bare-loop-hook 0)
2964 ("map" "" vhdl-template-map-hook 0)
2965 ("mod" "" vhdl-template-default-hook 0)
2966 ("nand" "" vhdl-template-default-hook 0)
2967 ("new" "" vhdl-template-default-hook 0)
2968 ("next" "" vhdl-template-next-hook 0)
2969 ("nor" "" vhdl-template-default-hook 0)
2970 ("not" "" vhdl-template-default-hook 0)
2971 ("null" "" vhdl-template-default-hook 0)
2972 ("of" "" vhdl-template-default-hook 0)
2973 ("on" "" vhdl-template-default-hook 0)
2974 ("open" "" vhdl-template-default-hook 0)
2975 ("or" "" vhdl-template-default-hook 0)
2976 ("others" "" vhdl-template-others-hook 0)
2977 ("out" "" vhdl-template-default-hook 0)
2978 ("pack" "" vhdl-template-package-hook 0)
2979 ("package" "" vhdl-template-package-hook 0)
2980 ("port" "" vhdl-template-port-hook 0)
2981 ("postponed" "" vhdl-template-default-hook 0)
2982 ("procedure" "" vhdl-template-procedure-hook 0)
2983 ("process" "" vhdl-template-process-hook 0)
2984 ("protected" "" vhdl-template-default-hook 0)
2985 ("pure" "" vhdl-template-default-hook 0)
2986 ("range" "" vhdl-template-default-hook 0)
2987 ("record" "" vhdl-template-default-hook 0)
2988 ("register" "" vhdl-template-default-hook 0)
2989 ("reject" "" vhdl-template-default-hook 0)
2990 ("rem" "" vhdl-template-default-hook 0)
2991 ("report" "" vhdl-template-report-hook 0)
2992 ("return" "" vhdl-template-return-hook 0)
2993 ("rol" "" vhdl-template-default-hook 0)
2994 ("ror" "" vhdl-template-default-hook 0)
2995 ("select" "" vhdl-template-selected-signal-asst-hook 0)
2996 ("severity" "" vhdl-template-default-hook 0)
2997 ("shared" "" vhdl-template-default-hook 0)
2998 ("sig" "" vhdl-template-signal-hook 0)
2999 ("signal" "" vhdl-template-signal-hook 0)
3000 ("sla" "" vhdl-template-default-hook 0)
3001 ("sll" "" vhdl-template-default-hook 0)
3002 ("sra" "" vhdl-template-default-hook 0)
3003 ("srl" "" vhdl-template-default-hook 0)
3004 ("subtype" "" vhdl-template-subtype-hook 0)
3005 ("then" "" vhdl-template-default-hook 0)
3006 ("to" "" vhdl-template-default-hook 0)
3007 ("transport" "" vhdl-template-default-hook 0)
3008 ("type" "" vhdl-template-type-hook 0)
3009 ("unaffected" "" vhdl-template-default-hook 0)
3010 ("units" "" vhdl-template-default-hook 0)
3011 ("until" "" vhdl-template-default-hook 0)
3012 ("use" "" vhdl-template-use-hook 0)
3013 ("var" "" vhdl-template-variable-hook 0)
3014 ("variable" "" vhdl-template-variable-hook 0)
3015 ("wait" "" vhdl-template-wait-hook 0)
3016 ("when" "" vhdl-template-when-hook 0)
3017 ("while" "" vhdl-template-while-loop-hook 0)
3018 ("with" "" vhdl-template-with-hook 0)
3019 ("xnor" "" vhdl-template-default-hook 0)
3020 ("xor" "" vhdl-template-default-hook 0)
3022 ;; VHDL-AMS keywords
3023 (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
3025 ("across" "" vhdl-template-default-hook 0)
3026 ("break" "" vhdl-template-break-hook 0)
3027 ("limit" "" vhdl-template-limit-hook 0)
3028 ("nature" "" vhdl-template-nature-hook 0)
3029 ("noise" "" vhdl-template-default-hook 0)
3030 ("procedural" "" vhdl-template-procedural-hook 0)
3031 ("quantity" "" vhdl-template-quantity-hook 0)
3032 ("reference" "" vhdl-template-default-hook 0)
3033 ("spectrum" "" vhdl-template-default-hook 0)
3034 ("subnature" "" vhdl-template-subnature-hook 0)
3035 ("terminal" "" vhdl-template-terminal-hook 0)
3036 ("through" "" vhdl-template-default-hook 0)
3037 ("tolerance" "" vhdl-template-default-hook 0)
3039 ;; user model keywords
3040 (when (memq 'user vhdl-electric-keywords)
3041 (let ((alist vhdl-model-alist)
3042 abbrev-list keyword)
3044 (setq keyword (nth 3 (car alist)))
3045 (unless (equal keyword "")
3047 (cons (list keyword ""
3049 "vhdl-model" (nth 0 (car alist)) "hook") 0)
3051 (setq alist (cdr alist)))
3054 ;; initialize abbrev table for VHDL Mode
3055 (vhdl-mode-abbrev-table-init)
3057 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3058 ;; Template completion lists
3060 (defvar vhdl-template-construct-alist nil
3061 "List of built-in construct templates.")
3063 (defun vhdl-template-construct-alist-init ()
3064 "Initialize `vhdl-template-construct-alist'."
3066 vhdl-template-construct-alist
3069 ("alias declaration" vhdl-template-alias)
3070 ("architecture body" vhdl-template-architecture)
3071 ("assertion" vhdl-template-assert)
3072 ("attribute declaration" vhdl-template-attribute-decl)
3073 ("attribute specification" vhdl-template-attribute-spec)
3074 ("block configuration" vhdl-template-block-configuration)
3075 ("block statement" vhdl-template-block)
3076 ("case statement" vhdl-template-case-is)
3077 ("component configuration" vhdl-template-component-conf)
3078 ("component declaration" vhdl-template-component-decl)
3079 ("component instantiation statement" vhdl-template-component-inst)
3080 ("conditional signal assignment" vhdl-template-conditional-signal-asst)
3081 ("configuration declaration" vhdl-template-configuration-decl)
3082 ("configuration specification" vhdl-template-configuration-spec)
3083 ("constant declaration" vhdl-template-constant)
3084 ("disconnection specification" vhdl-template-disconnect)
3085 ("entity declaration" vhdl-template-entity)
3086 ("exit statement" vhdl-template-exit)
3087 ("file declaration" vhdl-template-file)
3088 ("generate statement" vhdl-template-generate)
3089 ("generic clause" vhdl-template-generic)
3090 ("group declaration" vhdl-template-group-decl)
3091 ("group template declaration" vhdl-template-group-template)
3092 ("if statement" vhdl-template-if-then)
3093 ("library clause" vhdl-template-library)
3094 ("loop statement" vhdl-template-loop)
3095 ("next statement" vhdl-template-next)
3096 ("package declaration" vhdl-template-package-decl)
3097 ("package body" vhdl-template-package-body)
3098 ("port clause" vhdl-template-port)
3099 ("process statement" vhdl-template-process)
3100 ("report statement" vhdl-template-report)
3101 ("return statement" vhdl-template-return)
3102 ("selected signal assignment" vhdl-template-selected-signal-asst)
3103 ("signal declaration" vhdl-template-signal)
3104 ("subprogram declaration" vhdl-template-subprogram-decl)
3105 ("subprogram body" vhdl-template-subprogram-body)
3106 ("subtype declaration" vhdl-template-subtype)
3107 ("type declaration" vhdl-template-type)
3108 ("use clause" vhdl-template-use)
3109 ("variable declaration" vhdl-template-variable)
3110 ("wait statement" vhdl-template-wait)
3112 (when (vhdl-standard-p 'ams)
3114 ("break statement" vhdl-template-break)
3115 ("nature declaration" vhdl-template-nature)
3116 ("quantity declaration" vhdl-template-quantity)
3117 ("simultaneous case statement" vhdl-template-case-use)
3118 ("simultaneous if statement" vhdl-template-if-use)
3119 ("simultaneous procedural statement" vhdl-template-procedural)
3120 ("step limit specification" vhdl-template-limit)
3121 ("subnature declaration" vhdl-template-subnature)
3122 ("terminal declaration" vhdl-template-terminal)
3125 ;; initialize for VHDL Mode
3126 (vhdl-template-construct-alist-init)
3128 (defvar vhdl-template-package-alist nil
3129 "List of built-in package templates.")
3131 (defun vhdl-template-package-alist-init ()
3132 "Initialize `vhdl-template-package-alist'."
3134 vhdl-template-package-alist
3137 ("numeric_bit" vhdl-template-package-numeric-bit)
3138 ("numeric_std" vhdl-template-package-numeric-std)
3139 ("std_logic_1164" vhdl-template-package-std-logic-1164)
3140 ("std_logic_arith" vhdl-template-package-std-logic-arith)
3141 ("std_logic_misc" vhdl-template-package-std-logic-misc)
3142 ("std_logic_signed" vhdl-template-package-std-logic-signed)
3143 ("std_logic_textio" vhdl-template-package-std-logic-textio)
3144 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned)
3145 ("textio" vhdl-template-package-textio)
3147 (when (vhdl-standard-p 'math)
3149 ("math_complex" vhdl-template-package-math-complex)
3150 ("math_real" vhdl-template-package-math-real)
3153 ;; initialize for VHDL Mode
3154 (vhdl-template-package-alist-init)
3156 (defvar vhdl-template-directive-alist
3158 ("translate_on" vhdl-template-directive-translate-on)
3159 ("translate_off" vhdl-template-directive-translate-off)
3160 ("synthesis_on" vhdl-template-directive-synthesis-on)
3161 ("synthesis_off" vhdl-template-directive-synthesis-off)
3163 "List of built-in directive templates.")
3166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3170 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3171 ;; VHDL menu (using `easy-menu.el')
3173 (defun vhdl-customize ()
3174 "Call the customize function with `vhdl' as argument."
3176 (customize-browse 'vhdl))
3178 (defun vhdl-create-mode-menu ()
3179 "Create VHDL Mode menu."
3183 ["None" (vhdl-set-project "")
3184 :style radio :selected (null vhdl-project)]
3186 ;; add menu entries for defined projects
3187 (let ((project-alist vhdl-project-alist) menu-list name)
3188 (while project-alist
3189 (setq name (caar project-alist))
3191 (cons `[,name (vhdl-set-project ,name)
3192 :style radio :selected (equal ,name vhdl-project)]
3194 (setq project-alist (cdr project-alist)))
3196 (if vhdl-project-sort
3198 (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
3199 (nreverse menu-list)))
3200 (vhdl-menu-split menu-list "Project"))
3202 ["Select Project..." vhdl-set-project t]
3203 ["Set As Default Project" vhdl-set-default-project t]
3205 ["Duplicate Project" vhdl-duplicate-project vhdl-project]
3206 ["Import Project..." vhdl-import-project
3207 :keys "C-c C-p C-m" :active t]
3208 ["Export Project" vhdl-export-project vhdl-project]
3210 ["Customize Project..." (customize-option 'vhdl-project-alist) t]))
3213 ["Compile Buffer" vhdl-compile t]
3214 ["Stop Compilation" kill-compilation t]
3216 ["Make" vhdl-make t]
3217 ["Generate Makefile" vhdl-generate-makefile t]
3219 ["Next Error" next-error t]
3220 ["Previous Error" previous-error t]
3221 ["First Error" first-error t]
3225 ;; add menu entries for defined compilers
3226 (let ((comp-alist vhdl-compiler-alist) menu-list name)
3228 (setq name (caar comp-alist))
3230 (cons `[,name (setq vhdl-compiler ,name)
3231 :style radio :selected (equal ,name vhdl-compiler)]
3233 (setq comp-alist (cdr comp-alist)))
3234 (setq menu-list (nreverse menu-list))
3235 (vhdl-menu-split menu-list "Compiler"))
3237 ["Select Compiler..." vhdl-set-compiler t]
3239 ["Customize Compiler..."
3240 (customize-option 'vhdl-compiler-alist) t])))
3245 ["Alias" vhdl-template-alias t]
3246 ["Architecture" vhdl-template-architecture t]
3247 ["Assert" vhdl-template-assert t]
3248 ["Attribute (Decl)" vhdl-template-attribute-decl t]
3249 ["Attribute (Spec)" vhdl-template-attribute-spec t]
3250 ["Block" vhdl-template-block t]
3251 ["Case" vhdl-template-case-is t]
3252 ["Component (Decl)" vhdl-template-component-decl t]
3253 ["(Component) Instance" vhdl-template-component-inst t]
3254 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t]
3255 ["Configuration (Block)" vhdl-template-block-configuration t]
3256 ["Configuration (Comp)" vhdl-template-component-conf t]
3257 ["Configuration (Decl)" vhdl-template-configuration-decl t]
3258 ["Configuration (Spec)" vhdl-template-configuration-spec t]
3259 ["Constant" vhdl-template-constant t]
3260 ["Disconnect" vhdl-template-disconnect t]
3261 ["Else" vhdl-template-else t]
3262 ["Elsif" vhdl-template-elsif t]
3263 ["Entity" vhdl-template-entity t]
3264 ["Exit" vhdl-template-exit t]
3265 ["File" vhdl-template-file t]
3266 ["For (Generate)" vhdl-template-for-generate t]
3267 ["For (Loop)" vhdl-template-for-loop t]
3268 ["Function (Body)" vhdl-template-function-body t]
3269 ["Function (Decl)" vhdl-template-function-decl t]
3270 ["Generic" vhdl-template-generic t]
3271 ["Group (Decl)" vhdl-template-group-decl t]
3272 ["Group (Template)" vhdl-template-group-template t])
3274 ["If (Generate)" vhdl-template-if-generate t]
3275 ["If (Then)" vhdl-template-if-then t]
3276 ["Library" vhdl-template-library t]
3277 ["Loop" vhdl-template-bare-loop t]
3278 ["Map" vhdl-template-map t]
3279 ["Next" vhdl-template-next t]
3280 ["Others (Aggregate)" vhdl-template-others t]
3281 ["Package (Decl)" vhdl-template-package-decl t]
3282 ["Package (Body)" vhdl-template-package-body t]
3283 ["Port" vhdl-template-port t]
3284 ["Procedure (Body)" vhdl-template-procedure-body t]
3285 ["Procedure (Decl)" vhdl-template-procedure-decl t]
3286 ["Process (Comb)" vhdl-template-process-comb t]
3287 ["Process (Seq)" vhdl-template-process-seq t]
3288 ["Report" vhdl-template-report t]
3289 ["Return" vhdl-template-return t]
3290 ["Select" vhdl-template-selected-signal-asst t]
3291 ["Signal" vhdl-template-signal t]
3292 ["Subtype" vhdl-template-subtype t]
3293 ["Type" vhdl-template-type t]
3294 ["Use" vhdl-template-use t]
3295 ["Variable" vhdl-template-variable t]
3296 ["Wait" vhdl-template-wait t]
3297 ["(Clocked Wait)" vhdl-template-clocked-wait t]
3298 ["When" vhdl-template-when t]
3299 ["While (Loop)" vhdl-template-while-loop t]
3300 ["With" vhdl-template-with t]))
3301 (when (vhdl-standard-p 'ams)
3302 '(("VHDL-AMS Construct"
3303 ["Break" vhdl-template-break t]
3304 ["Case (Use)" vhdl-template-case-use t]
3305 ["If (Use)" vhdl-template-if-use t]
3306 ["Limit" vhdl-template-limit t]
3307 ["Nature" vhdl-template-nature t]
3308 ["Procedural" vhdl-template-procedural t]
3309 ["Quantity (Free)" vhdl-template-quantity-free t]
3310 ["Quantity (Branch)" vhdl-template-quantity-branch t]
3311 ["Quantity (Source)" vhdl-template-quantity-source t]
3312 ["Subnature" vhdl-template-subnature t]
3313 ["Terminal" vhdl-template-terminal t])))
3314 '(["Insert Construct..." vhdl-template-insert-construct
3315 :keys "C-c C-i C-t"]
3320 (when (vhdl-standard-p 'math)
3321 '(["math_complex" vhdl-template-package-math-complex t]
3322 ["math_real" vhdl-template-package-math-real t]))
3323 '(["numeric_bit" vhdl-template-package-numeric-bit t]
3324 ["numeric_std" vhdl-template-package-numeric-std t]
3325 ["std_logic_1164" vhdl-template-package-std-logic-1164 t]
3326 ["textio" vhdl-template-package-textio t]
3328 ["std_logic_arith" vhdl-template-package-std-logic-arith t]
3329 ["std_logic_signed" vhdl-template-package-std-logic-signed t]
3330 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
3331 ["std_logic_misc" vhdl-template-package-std-logic-misc t]
3332 ["std_logic_textio" vhdl-template-package-std-logic-textio t]
3334 ["Insert Package..." vhdl-template-insert-package
3335 :keys "C-c C-i C-p"])))
3337 ["translate_on" vhdl-template-directive-translate-on t]
3338 ["translate_off" vhdl-template-directive-translate-off t]
3339 ["synthesis_on" vhdl-template-directive-synthesis-on t]
3340 ["synthesis_off" vhdl-template-directive-synthesis-off t]
3342 ["Insert Directive..." vhdl-template-insert-directive
3343 :keys "C-c C-i C-d"])
3345 ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"]
3346 ["Insert Footer" vhdl-template-footer t]
3347 ["Insert Date" vhdl-template-insert-date t]
3348 ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"]
3350 ["Query Next Prompt" vhdl-template-search-prompt t]))
3353 ;; add menu entries for defined models
3354 (let ((model-alist vhdl-model-alist) menu-list model)
3356 (setq model (car model-alist))
3361 (vhdl-function-name "vhdl-model" (nth 0 model))
3362 :keys (concat "C-c C-m " (key-description (nth 2 model))))
3364 (setq model-alist (cdr model-alist)))
3365 (setq menu-list (nreverse menu-list))
3366 (vhdl-menu-split menu-list "Model"))
3368 ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"]
3369 ["Customize Model..." (customize-option 'vhdl-model-alist) t]))
3371 ["Copy" vhdl-port-copy t]
3373 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list]
3374 ["Paste As Component" vhdl-port-paste-component vhdl-port-list]
3375 ["Paste As Instance" vhdl-port-paste-instance
3376 :keys "C-c C-p C-i" :active vhdl-port-list]
3377 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list]
3378 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list]
3379 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list]
3380 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3382 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list]
3384 ["Flatten" vhdl-port-flatten
3385 :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3386 ["Reverse Direction" vhdl-port-reverse-direction
3387 :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3389 ["New Component" vhdl-compose-new-component t]
3390 ["Copy Component" vhdl-port-copy t]
3391 ["Place Component" vhdl-compose-place-component vhdl-port-list]
3392 ["Wire Components" vhdl-compose-wire-components t]
3394 ["Generate Configuration" vhdl-compose-configuration t]
3395 ["Generate Components Package" vhdl-compose-components-package t])
3397 ["Copy" vhdl-subprog-copy t]
3399 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list]
3400 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list]
3401 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list]
3403 ["Flatten" vhdl-subprog-flatten
3404 :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3407 ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)]
3409 ["Insert Inline Comment" vhdl-comment-append-inline t]
3410 ["Insert Horizontal Line" vhdl-comment-display-line t]
3411 ["Insert Display Comment" vhdl-comment-display t]
3413 ["Fill Comment" fill-paragraph t]
3414 ["Fill Comment Region" fill-region (mark)]
3415 ["Kill Comment Region" vhdl-comment-kill-region (mark)]
3416 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3418 ["Kill" vhdl-line-kill t]
3419 ["Copy" vhdl-line-copy t]
3420 ["Yank" vhdl-line-yank t]
3421 ["Expand" vhdl-line-expand t]
3423 ["Transpose Next" vhdl-line-transpose-next t]
3424 ["Transpose Prev" vhdl-line-transpose-previous t]
3425 ["Open" vhdl-line-open t]
3426 ["Join" vhdl-delete-indentation t]
3428 ["Goto" goto-line t]
3429 ["(Un)Comment Out" vhdl-comment-uncomment-line t])
3431 ["Forward Statement" vhdl-end-of-statement t]
3432 ["Backward Statement" vhdl-beginning-of-statement t]
3433 ["Forward Expression" vhdl-forward-sexp t]
3434 ["Backward Expression" vhdl-backward-sexp t]
3435 ["Forward Same Indent" vhdl-forward-same-indent t]
3436 ["Backward Same Indent" vhdl-backward-same-indent t]
3437 ["Forward Function" vhdl-end-of-defun t]
3438 ["Backward Function" vhdl-beginning-of-defun t]
3439 ["Mark Function" vhdl-mark-defun t])
3442 ["Line" indent-according-to-mode :keys "C-c C-i C-l"]
3443 ["Group" vhdl-indent-group :keys "C-c C-i C-g"]
3444 ["Region" vhdl-indent-region (mark)]
3445 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"])
3447 ["Group" vhdl-align-group t]
3448 ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"]
3449 ["List" vhdl-align-list t]
3450 ["Declarations" vhdl-align-declarations t]
3451 ["Region" vhdl-align-region (mark)]
3452 ["Buffer" vhdl-align-buffer t]
3454 ["Inline Comment Group" vhdl-align-inline-comment-group t]
3455 ["Inline Comment Region" vhdl-align-inline-comment-region (mark)]
3456 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t])
3458 ["List" vhdl-fill-list t]
3459 ["Group" vhdl-fill-group t]
3460 ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"]
3461 ["Region" vhdl-fill-region (mark)])
3463 ["Region" vhdl-beautify-region (mark)]
3464 ["Buffer" vhdl-beautify-buffer t])
3466 ["Generic/Port Clause" vhdl-fix-clause t]
3468 ["Case Region" vhdl-fix-case-region (mark)]
3469 ["Case Buffer" vhdl-fix-case-buffer t]
3471 ["Whitespace Region" vhdl-fixup-whitespace-region (mark)]
3472 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t]
3474 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t])
3476 ["Sensitivity List" vhdl-update-sensitivity-list-process t]
3477 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t])
3479 ["Fontify Buffer" vhdl-fontify-buffer t]
3480 ["Statistics Buffer" vhdl-statistics-buffer t]
3481 ["Show Messages" vhdl-show-messages t]
3482 ["Syntactic Info" vhdl-show-syntactic-information t]
3484 ["Speedbar" vhdl-speedbar t]
3485 ["Hide/Show" vhdl-hs-minor-mode t]
3488 ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"]
3489 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t]
3490 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t]
3491 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t])
3492 ["Version" vhdl-version t]
3493 ["Bug Report..." vhdl-submit-bug-report t]
3498 (progn (customize-set-variable 'vhdl-electric-mode
3499 (not vhdl-electric-mode))
3500 (vhdl-mode-line-update))
3501 :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3503 (progn (customize-set-variable 'vhdl-stutter-mode
3504 (not vhdl-stutter-mode))
3505 (vhdl-mode-line-update))
3506 :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3508 (progn (customize-set-variable 'vhdl-indent-tabs-mode
3509 (not vhdl-indent-tabs-mode))
3510 (setq indent-tabs-mode vhdl-indent-tabs-mode))
3511 :style toggle :selected vhdl-indent-tabs-mode]
3513 ["Customize Group..." (customize-group 'vhdl-mode) t])
3515 ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3517 '("Selected Project at Startup"
3518 ["None" (progn (customize-set-variable 'vhdl-project nil)
3519 (vhdl-set-project ""))
3520 :style radio :selected (null vhdl-project)]
3522 ;; add menu entries for defined projects
3523 (let ((project-alist vhdl-project-alist) menu-list name)
3524 (while project-alist
3525 (setq name (caar project-alist))
3527 (cons `[,name (progn (customize-set-variable
3528 'vhdl-project ,name)
3529 (vhdl-set-project ,name))
3530 :style radio :selected (equal ,name vhdl-project)]
3532 (setq project-alist (cdr project-alist)))
3533 (setq menu-list (nreverse menu-list))
3534 (vhdl-menu-split menu-list "Project")))
3535 ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3536 ("Auto Load Setup File"
3538 (customize-set-variable 'vhdl-project-auto-load
3539 (if (memq 'startup vhdl-project-auto-load)
3540 (delq 'startup vhdl-project-auto-load)
3541 (cons 'startup vhdl-project-auto-load)))
3542 :style toggle :selected (memq 'startup vhdl-project-auto-load)])
3544 (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3545 :style toggle :selected vhdl-project-sort]
3547 ["Customize Group..." (customize-group 'vhdl-project) t])
3549 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3551 '("Selected Compiler at Startup")
3552 ;; add menu entries for defined compilers
3553 (let ((comp-alist vhdl-compiler-alist) menu-list name)
3555 (setq name (caar comp-alist))
3557 (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3558 :style radio :selected (equal ,name vhdl-compiler)]
3560 (setq comp-alist (cdr comp-alist)))
3561 (setq menu-list (nreverse menu-list))
3562 (vhdl-menu-split menu-list "Compler")))
3563 ["Use Local Error Regexp"
3564 (customize-set-variable 'vhdl-compile-use-local-error-regexp
3565 (not vhdl-compile-use-local-error-regexp))
3566 :style toggle :selected vhdl-compile-use-local-error-regexp]
3567 ["Makefile Generation Hook..."
3568 (customize-option 'vhdl-makefile-generation-hook) t]
3569 ["Default Library Name" (customize-option 'vhdl-default-library) t]
3571 ["Customize Group..." (customize-group 'vhdl-compiler) t])
3575 (progn (customize-set-variable 'vhdl-standard
3576 (list '87 (cadr vhdl-standard)))
3577 (vhdl-activate-customizations))
3578 :style radio :selected (eq '87 (car vhdl-standard))]
3580 (progn (customize-set-variable 'vhdl-standard
3581 (list '93 (cadr vhdl-standard)))
3582 (vhdl-activate-customizations))
3583 :style radio :selected (eq '93 (car vhdl-standard))]
3586 (progn (customize-set-variable
3587 'vhdl-standard (list (car vhdl-standard)
3588 (if (memq 'ams (cadr vhdl-standard))
3589 (delq 'ams (cadr vhdl-standard))
3590 (cons 'ams (cadr vhdl-standard)))))
3591 (vhdl-activate-customizations))
3592 :style toggle :selected (memq 'ams (cadr vhdl-standard))]
3594 (progn (customize-set-variable
3595 'vhdl-standard (list (car vhdl-standard)
3596 (if (memq 'math (cadr vhdl-standard))
3597 (delq 'math (cadr vhdl-standard))
3598 (cons 'math (cadr vhdl-standard)))))
3599 (vhdl-activate-customizations))
3600 :style toggle :selected (memq 'math (cadr vhdl-standard))])
3601 ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3602 ["Upper Case Keywords"
3603 (customize-set-variable 'vhdl-upper-case-keywords
3604 (not vhdl-upper-case-keywords))
3605 :style toggle :selected vhdl-upper-case-keywords]
3607 (customize-set-variable 'vhdl-upper-case-types
3608 (not vhdl-upper-case-types))
3609 :style toggle :selected vhdl-upper-case-types]
3610 ["Upper Case Attributes"
3611 (customize-set-variable 'vhdl-upper-case-attributes
3612 (not vhdl-upper-case-attributes))
3613 :style toggle :selected vhdl-upper-case-attributes]
3614 ["Upper Case Enumeration Values"
3615 (customize-set-variable 'vhdl-upper-case-enum-values
3616 (not vhdl-upper-case-enum-values))
3617 :style toggle :selected vhdl-upper-case-enum-values]
3618 ["Upper Case Constants"
3619 (customize-set-variable 'vhdl-upper-case-constants
3620 (not vhdl-upper-case-constants))
3621 :style toggle :selected vhdl-upper-case-constants]
3622 ("Use Direct Instantiation"
3624 (customize-set-variable 'vhdl-use-direct-instantiation 'never)
3625 :style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3627 (customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3628 :style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3630 (customize-set-variable 'vhdl-use-direct-instantiation 'always)
3631 :style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3633 ["Customize Group..." (customize-group 'vhdl-style) t])
3635 ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3636 ["Architecture File Name..."
3637 (customize-option 'vhdl-architecture-file-name) t]
3638 ["Configuration File Name..."
3639 (customize-option 'vhdl-configuration-file-name) t]
3640 ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3643 (customize-set-variable 'vhdl-file-name-case 'identity)
3644 :style radio :selected (eq 'identity vhdl-file-name-case)]
3646 (customize-set-variable 'vhdl-file-name-case 'downcase)
3647 :style radio :selected (eq 'downcase vhdl-file-name-case)]
3649 (customize-set-variable 'vhdl-file-name-case 'upcase)
3650 :style radio :selected (eq 'upcase vhdl-file-name-case)]
3652 (customize-set-variable 'vhdl-file-name-case 'capitalize)
3653 :style radio :selected (eq 'capitalize vhdl-file-name-case)])
3655 ["Customize Group..." (customize-group 'vhdl-naming) t])
3657 ("Electric Keywords"
3659 (customize-set-variable 'vhdl-electric-keywords
3660 (if (memq 'vhdl vhdl-electric-keywords)
3661 (delq 'vhdl vhdl-electric-keywords)
3662 (cons 'vhdl vhdl-electric-keywords)))
3663 :style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3664 ["User Model Keywords"
3665 (customize-set-variable 'vhdl-electric-keywords
3666 (if (memq 'user vhdl-electric-keywords)
3667 (delq 'user vhdl-electric-keywords)
3668 (cons 'user vhdl-electric-keywords)))
3669 :style toggle :selected (memq 'user vhdl-electric-keywords)])
3670 ("Insert Optional Labels"
3672 (customize-set-variable 'vhdl-optional-labels 'none)
3673 :style radio :selected (eq 'none vhdl-optional-labels)]
3675 (customize-set-variable 'vhdl-optional-labels 'process)
3676 :style radio :selected (eq 'process vhdl-optional-labels)]
3678 (customize-set-variable 'vhdl-optional-labels 'all)
3679 :style radio :selected (eq 'all vhdl-optional-labels)])
3680 ("Insert Empty Lines"
3682 (customize-set-variable 'vhdl-insert-empty-lines 'none)
3683 :style radio :selected (eq 'none vhdl-insert-empty-lines)]
3684 ["Design Units Only"
3685 (customize-set-variable 'vhdl-insert-empty-lines 'unit)
3686 :style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3688 (customize-set-variable 'vhdl-insert-empty-lines 'all)
3689 :style radio :selected (eq 'all vhdl-insert-empty-lines)])
3690 ["Argument List Indent"
3691 (customize-set-variable 'vhdl-argument-list-indent
3692 (not vhdl-argument-list-indent))
3693 :style toggle :selected vhdl-argument-list-indent]
3694 ["Association List with Formals"
3695 (customize-set-variable 'vhdl-association-list-with-formals
3696 (not vhdl-association-list-with-formals))
3697 :style toggle :selected vhdl-association-list-with-formals]
3698 ["Conditions in Parenthesis"
3699 (customize-set-variable 'vhdl-conditions-in-parenthesis
3700 (not vhdl-conditions-in-parenthesis))
3701 :style toggle :selected vhdl-conditions-in-parenthesis]
3702 ["Zero String..." (customize-option 'vhdl-zero-string) t]
3703 ["One String..." (customize-option 'vhdl-one-string) t]
3705 ["Header String..." (customize-option 'vhdl-file-header) t]
3706 ["Footer String..." (customize-option 'vhdl-file-footer) t]
3707 ["Company Name..." (customize-option 'vhdl-company-name) t]
3708 ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3709 ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3710 ["Date Format..." (customize-option 'vhdl-date-format) t]
3711 ["Modify Date Prefix String..."
3712 (customize-option 'vhdl-modify-date-prefix-string) t]
3713 ["Modify Date on Saving"
3714 (progn (customize-set-variable 'vhdl-modify-date-on-saving
3715 (not vhdl-modify-date-on-saving))
3716 (vhdl-activate-customizations))
3717 :style toggle :selected vhdl-modify-date-on-saving])
3718 ("Sequential Process"
3721 (customize-set-variable 'vhdl-reset-kind 'none)
3722 :style radio :selected (eq 'none vhdl-reset-kind)]
3724 (customize-set-variable 'vhdl-reset-kind 'sync)
3725 :style radio :selected (eq 'sync vhdl-reset-kind)]
3727 (customize-set-variable 'vhdl-reset-kind 'async)
3728 :style radio :selected (eq 'async vhdl-reset-kind)])
3729 ["Reset is Active High"
3730 (customize-set-variable 'vhdl-reset-active-high
3731 (not vhdl-reset-active-high))
3732 :style toggle :selected vhdl-reset-active-high]
3733 ["Use Rising Clock Edge"
3734 (customize-set-variable 'vhdl-clock-rising-edge
3735 (not vhdl-clock-rising-edge))
3736 :style toggle :selected vhdl-clock-rising-edge]
3737 ("Clock Edge Condition"
3739 (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3740 :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3741 ["Function \"rising_edge\""
3742 (customize-set-variable 'vhdl-clock-edge-condition 'function)
3743 :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3744 ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3745 ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3747 ["Customize Group..." (customize-group 'vhdl-template) t])
3749 ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3751 ["Include Port Comments"
3752 (customize-set-variable 'vhdl-include-port-comments
3753 (not vhdl-include-port-comments))
3754 :style toggle :selected vhdl-include-port-comments]
3755 ["Include Direction Comments"
3756 (customize-set-variable 'vhdl-include-direction-comments
3757 (not vhdl-include-direction-comments))
3758 :style toggle :selected vhdl-include-direction-comments]
3759 ["Include Type Comments"
3760 (customize-set-variable 'vhdl-include-type-comments
3761 (not vhdl-include-type-comments))
3762 :style toggle :selected vhdl-include-type-comments]
3763 ("Include Group Comments"
3765 (customize-set-variable 'vhdl-include-group-comments 'never)
3766 :style radio :selected (eq 'never vhdl-include-group-comments)]
3768 (customize-set-variable 'vhdl-include-group-comments 'decl)
3769 :style radio :selected (eq 'decl vhdl-include-group-comments)]
3771 (customize-set-variable 'vhdl-include-group-comments 'always)
3772 :style radio :selected (eq 'always vhdl-include-group-comments)])
3773 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3774 ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3776 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3777 ["Architecture Name..."
3778 (customize-option 'vhdl-testbench-architecture-name) t]
3779 ["Configuration Name..."
3780 (customize-option 'vhdl-testbench-configuration-name) t]
3781 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3783 (customize-set-variable 'vhdl-testbench-include-header
3784 (not vhdl-testbench-include-header))
3785 :style toggle :selected vhdl-testbench-include-header]
3786 ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3787 ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3788 ["Initialize Signals"
3789 (customize-set-variable 'vhdl-testbench-initialize-signals
3790 (not vhdl-testbench-initialize-signals))
3791 :style toggle :selected vhdl-testbench-initialize-signals]
3792 ["Include Library Clause"
3793 (customize-set-variable 'vhdl-testbench-include-library
3794 (not vhdl-testbench-include-library))
3795 :style toggle :selected vhdl-testbench-include-library]
3796 ["Include Configuration"
3797 (customize-set-variable 'vhdl-testbench-include-configuration
3798 (not vhdl-testbench-include-configuration))
3799 :style toggle :selected vhdl-testbench-include-configuration]
3802 (customize-set-variable 'vhdl-testbench-create-files 'none)
3803 :style radio :selected (eq 'none vhdl-testbench-create-files)]
3805 (customize-set-variable 'vhdl-testbench-create-files 'single)
3806 :style radio :selected (eq 'single vhdl-testbench-create-files)]
3808 (customize-set-variable 'vhdl-testbench-create-files 'separate)
3809 :style radio :selected (eq 'separate vhdl-testbench-create-files)])
3810 ["Testbench Entity File Name..."
3811 (customize-option 'vhdl-testbench-entity-file-name) t]
3812 ["Testbench Architecture File Name..."
3813 (customize-option 'vhdl-testbench-architecture-file-name) t])
3815 ["Customize Group..." (customize-group 'vhdl-port) t])
3817 ["Architecture Name..."
3818 (customize-option 'vhdl-compose-architecture-name) t]
3819 ["Configuration Name..."
3820 (customize-option 'vhdl-compose-configuration-name) t]
3821 ["Components Package Name..."
3822 (customize-option 'vhdl-components-package-name) t]
3823 ["Use Components Package"
3824 (customize-set-variable 'vhdl-use-components-package
3825 (not vhdl-use-components-package))
3826 :style toggle :selected vhdl-use-components-package]
3828 (customize-set-variable 'vhdl-compose-include-header
3829 (not vhdl-compose-include-header))
3830 :style toggle :selected vhdl-compose-include-header]
3831 ("Create Entity/Architecture Files"
3833 (customize-set-variable 'vhdl-compose-create-files 'none)
3834 :style radio :selected (eq 'none vhdl-compose-create-files)]
3836 (customize-set-variable 'vhdl-compose-create-files 'single)
3837 :style radio :selected (eq 'single vhdl-compose-create-files)]
3839 (customize-set-variable 'vhdl-compose-create-files 'separate)
3840 :style radio :selected (eq 'separate vhdl-compose-create-files)])
3841 ["Create Configuration File"
3842 (customize-set-variable 'vhdl-compose-configuration-create-file
3843 (not vhdl-compose-configuration-create-file))
3844 :style toggle :selected vhdl-compose-configuration-create-file]
3845 ["Hierarchical Configuration"
3846 (customize-set-variable 'vhdl-compose-configuration-hierarchical
3847 (not vhdl-compose-configuration-hierarchical))
3848 :style toggle :selected vhdl-compose-configuration-hierarchical]
3849 ["Use Subconfiguration"
3850 (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration
3851 (not vhdl-compose-configuration-use-subconfiguration))
3852 :style toggle :selected vhdl-compose-configuration-use-subconfiguration]
3854 ["Customize Group..." (customize-group 'vhdl-compose) t])
3856 ["Self Insert Comments"
3857 (customize-set-variable 'vhdl-self-insert-comments
3858 (not vhdl-self-insert-comments))
3859 :style toggle :selected vhdl-self-insert-comments]
3860 ["Prompt for Comments"
3861 (customize-set-variable 'vhdl-prompt-for-comments
3862 (not vhdl-prompt-for-comments))
3863 :style toggle :selected vhdl-prompt-for-comments]
3864 ["Inline Comment Column..."
3865 (customize-option 'vhdl-inline-comment-column) t]
3866 ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
3868 ["Customize Group..." (customize-group 'vhdl-comment) t])
3870 ["Auto Align Templates"
3871 (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
3872 :style toggle :selected vhdl-auto-align]
3873 ["Align Line Groups"
3874 (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
3875 :style toggle :selected vhdl-align-groups]
3876 ["Group Separation String..."
3877 (customize-set-variable 'vhdl-align-group-separate) t]
3878 ["Align Lines with Same Indent"
3879 (customize-set-variable 'vhdl-align-same-indent
3880 (not vhdl-align-same-indent))
3881 :style toggle :selected vhdl-align-same-indent]
3883 ["Customize Group..." (customize-group 'vhdl-align) t])
3885 ["Highlighting On/Off..."
3887 (if (fboundp 'global-font-lock-mode)
3888 'global-font-lock-mode 'font-lock-auto-fontify)) t]
3889 ["Highlight Keywords"
3890 (progn (customize-set-variable 'vhdl-highlight-keywords
3891 (not vhdl-highlight-keywords))
3892 (vhdl-fontify-buffer))
3893 :style toggle :selected vhdl-highlight-keywords]
3895 (progn (customize-set-variable 'vhdl-highlight-names
3896 (not vhdl-highlight-names))
3897 (vhdl-fontify-buffer))
3898 :style toggle :selected vhdl-highlight-names]
3899 ["Highlight Special Words"
3900 (progn (customize-set-variable 'vhdl-highlight-special-words
3901 (not vhdl-highlight-special-words))
3902 (vhdl-fontify-buffer))
3903 :style toggle :selected vhdl-highlight-special-words]
3904 ["Highlight Forbidden Words"
3905 (progn (customize-set-variable 'vhdl-highlight-forbidden-words
3906 (not vhdl-highlight-forbidden-words))
3907 (vhdl-fontify-buffer))
3908 :style toggle :selected vhdl-highlight-forbidden-words]
3909 ["Highlight Verilog Keywords"
3910 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
3911 (not vhdl-highlight-verilog-keywords))
3912 (vhdl-fontify-buffer))
3913 :style toggle :selected vhdl-highlight-verilog-keywords]
3914 ["Highlight \"translate_off\""
3915 (progn (customize-set-variable 'vhdl-highlight-translate-off
3916 (not vhdl-highlight-translate-off))
3917 (vhdl-fontify-buffer))
3918 :style toggle :selected vhdl-highlight-translate-off]
3919 ["Case Sensitive Highlighting"
3920 (progn (customize-set-variable 'vhdl-highlight-case-sensitive
3921 (not vhdl-highlight-case-sensitive))
3922 (vhdl-fontify-buffer))
3923 :style toggle :selected vhdl-highlight-case-sensitive]
3924 ["Special Syntax Definition..."
3925 (customize-option 'vhdl-special-syntax-alist) t]
3926 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
3927 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
3928 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
3929 ["Colors..." (customize-group 'vhdl-highlight-faces) t]
3931 ["Customize Group..." (customize-group 'vhdl-highlight) t])
3933 ["Auto Open at Startup"
3934 (customize-set-variable 'vhdl-speedbar-auto-open
3935 (not vhdl-speedbar-auto-open))
3936 :style toggle :selected vhdl-speedbar-auto-open]
3937 ("Default Displaying Mode"
3939 (customize-set-variable 'vhdl-speedbar-display-mode 'files)
3940 :style radio :selected (eq 'files vhdl-speedbar-display-mode)]
3941 ["Directory Hierarchy"
3942 (customize-set-variable 'vhdl-speedbar-display-mode 'directory)
3943 :style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
3944 ["Project Hierarchy"
3945 (customize-set-variable 'vhdl-speedbar-display-mode 'project)
3946 :style radio :selected (eq 'project vhdl-speedbar-display-mode)])
3947 ["Indentation Offset..."
3948 (customize-option 'speedbar-indentation-width) t]
3949 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
3950 ["Jump to Unit when Opening"
3951 (customize-set-variable 'vhdl-speedbar-jump-to-unit
3952 (not vhdl-speedbar-jump-to-unit))
3953 :style toggle :selected vhdl-speedbar-jump-to-unit]
3954 ["Update Hierarchy on File Saving"
3955 (customize-set-variable 'vhdl-speedbar-update-on-saving
3956 (not vhdl-speedbar-update-on-saving))
3957 :style toggle :selected vhdl-speedbar-update-on-saving]
3958 ("Save in Cache File"
3959 ["Hierarchy Information"
3960 (customize-set-variable 'vhdl-speedbar-save-cache
3961 (if (memq 'hierarchy vhdl-speedbar-save-cache)
3962 (delq 'hierarchy vhdl-speedbar-save-cache)
3963 (cons 'hierarchy vhdl-speedbar-save-cache)))
3964 :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
3965 ["Displaying Status"
3966 (customize-set-variable 'vhdl-speedbar-save-cache
3967 (if (memq 'display vhdl-speedbar-save-cache)
3968 (delq 'display vhdl-speedbar-save-cache)
3969 (cons 'display vhdl-speedbar-save-cache)))
3970 :style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
3971 ["Cache File Name..."
3972 (customize-option 'vhdl-speedbar-cache-file-name) t]
3974 ["Customize Group..." (customize-group 'vhdl-speedbar) t])
3976 ["Add Index Menu when Loading File"
3977 (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
3978 (vhdl-index-menu-init))
3979 :style toggle :selected vhdl-index-menu]
3980 ["Add Source File Menu when Loading File"
3981 (progn (customize-set-variable 'vhdl-source-file-menu
3982 (not vhdl-source-file-menu))
3983 (vhdl-add-source-files-menu))
3984 :style toggle :selected vhdl-source-file-menu]
3985 ["Add Hideshow Menu at Startup"
3986 (progn (customize-set-variable 'vhdl-hideshow-menu
3987 (not vhdl-hideshow-menu))
3988 (vhdl-activate-customizations))
3989 :style toggle :selected vhdl-hideshow-menu]
3990 ["Hide Everything Initially"
3991 (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
3992 :style toggle :selected vhdl-hide-all-init]
3994 ["Customize Group..." (customize-group 'vhdl-menu) t])
3996 ["In Two Column Format"
3997 (progn (customize-set-variable 'vhdl-print-two-column
3998 (not vhdl-print-two-column))
3999 (message "Activate new setting by saving options and restarting Emacs"))
4000 :style toggle :selected vhdl-print-two-column]
4001 ["Use Customized Faces"
4002 (progn (customize-set-variable 'vhdl-print-customize-faces
4003 (not vhdl-print-customize-faces))
4004 (message "Activate new setting by saving options and restarting Emacs"))
4005 :style toggle :selected vhdl-print-customize-faces]
4007 ["Customize Group..." (customize-group 'vhdl-print) t])
4009 ["Use Intelligent Tab"
4010 (progn (customize-set-variable 'vhdl-intelligent-tab
4011 (not vhdl-intelligent-tab))
4012 (vhdl-activate-customizations))
4013 :style toggle :selected vhdl-intelligent-tab]
4014 ["Indent Syntax-Based"
4015 (customize-set-variable 'vhdl-indent-syntax-based
4016 (not vhdl-indent-syntax-based))
4017 :style toggle :selected vhdl-indent-syntax-based]
4018 ["Word Completion is Case Sensitive"
4019 (customize-set-variable 'vhdl-word-completion-case-sensitive
4020 (not vhdl-word-completion-case-sensitive))
4021 :style toggle :selected vhdl-word-completion-case-sensitive]
4022 ["Word Completion in Minibuffer"
4023 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
4024 (not vhdl-word-completion-in-minibuffer))
4025 (message "Activate new setting by saving options and restarting Emacs"))
4026 :style toggle :selected vhdl-word-completion-in-minibuffer]
4027 ["Underscore is Part of Word"
4028 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
4029 (not vhdl-underscore-is-part-of-word))
4030 (vhdl-activate-customizations))
4031 :style toggle :selected vhdl-underscore-is-part-of-word]
4033 ["Customize Group..." (customize-group 'vhdl-misc) t])
4034 ["Related..." (customize-browse 'vhdl-related) t]
4036 ["Save Options" customize-save-customized t]
4037 ["Activate Options" vhdl-activate-customizations t]
4038 ["Browse Options..." vhdl-customize t])))
4040 (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
4043 (defun vhdl-update-mode-menu ()
4044 "Update VHDL Mode menu."
4046 (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
4047 (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
4048 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
4049 (easy-menu-define vhdl-mode-menu vhdl-mode-map
4050 "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
4052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4053 ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
4055 (defconst vhdl-imenu-generic-expression
4058 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4061 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
4064 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4067 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
4070 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
4073 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
4076 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4079 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4082 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4085 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4088 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
4090 (defun vhdl-index-menu-init ()
4091 "Initialize index menu."
4092 (set (make-local-variable 'imenu-case-fold-search) t)
4093 (set (make-local-variable 'imenu-generic-expression)
4094 vhdl-imenu-generic-expression)
4095 (when (and vhdl-index-menu (fboundp 'imenu))
4096 (if (or (not (boundp 'font-lock-maximum-size))
4097 (> font-lock-maximum-size (buffer-size)))
4098 (imenu-add-to-menubar "Index")
4099 (message "Scanning buffer for index...buffer too big"))))
4101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4102 ;; Source file menu (using `easy-menu.el')
4104 (defvar vhdl-sources-menu nil)
4106 (defun vhdl-directory-files (directory &optional full match)
4107 "Call `directory-files' if DIRECTORY exists, otherwise generate error
4109 (if (not (file-directory-p directory))
4110 (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
4111 (let ((dir (directory-files directory full match)))
4112 (setq dir (delete "." dir))
4113 (setq dir (delete ".." dir))
4116 (defun vhdl-get-source-files (&optional full directory)
4117 "Get list of VHDL source files in DIRECTORY or current directory."
4118 (let ((mode-alist auto-mode-alist)
4120 ;; create regular expressions for matching file names
4121 (setq filename-regexp "\\`[^.].*\\(")
4123 (when (eq (cdar mode-alist) 'vhdl-mode)
4124 (setq filename-regexp
4125 (concat filename-regexp (caar mode-alist) "\\|")))
4126 (setq mode-alist (cdr mode-alist)))
4127 (setq filename-regexp
4128 (concat (substring filename-regexp 0
4129 (string-match "\\\\|$" filename-regexp)) "\\)"))
4131 (vhdl-directory-files
4132 (or directory default-directory) full filename-regexp)))
4134 (defun vhdl-add-source-files-menu ()
4135 "Scan directory for all VHDL source files and generate menu.
4136 The directory of the current source file is scanned."
4138 (message "Scanning directory for source files ...")
4139 (let ((newmap (current-local-map))
4140 (file-list (vhdl-get-source-files))
4142 ;; Create list for menu
4146 (setq menu-list (cons (vector (car file-list)
4147 (list 'find-file (car file-list)) t)
4149 (setq file-list (cdr file-list)))
4150 (setq menu-list (vhdl-menu-split menu-list "Sources"))
4151 (when found (setq menu-list (cons "--" menu-list)))
4152 (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list))
4153 (setq menu-list (cons "Sources" menu-list))
4155 (easy-menu-add menu-list)
4156 (easy-menu-define vhdl-sources-menu newmap
4157 "VHDL source files menu" menu-list))
4161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4164 ;; performs all buffer local initializations
4168 "Major mode for editing VHDL code.
4173 TEMPLATE INSERTION (electrification):
4174 After typing a VHDL keyword and entering `SPC', you are prompted for
4175 arguments while a template is generated for that VHDL construct. Typing
4176 `RET' or `C-g' at the first \(mandatory) prompt aborts the current
4177 template generation. Optional arguments are indicated by square
4178 brackets and removed if the queried string is left empty. Prompts for
4179 mandatory arguments remain in the code if the queried string is left
4180 empty. They can be queried again by `C-c C-t C-q'. Enabled
4181 electrification is indicated by `/e' in the modeline.
4183 Typing `M-SPC' after a keyword inserts a space without calling the
4184 template generator. Automatic template generation (i.e.
4185 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4186 setting option `vhdl-electric-mode' (see OPTIONS).
4188 Template generators can be invoked from the VHDL menu, by key
4189 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4190 the keyword (i.e. first word of menu entry not in parenthesis) and
4191 `SPC'. The following abbreviations can also be used: arch, attr, cond,
4192 conf, comp, cons, func, inst, pack, sig, var.
4194 Template styles can be customized in customization group
4195 `vhdl-template' \(see OPTIONS).
4199 A file header can be inserted by `C-c C-t C-h'. A file footer
4200 (template at the end of the file) can be inserted by `C-c C-t C-f'.
4201 See customization group `vhdl-header'.
4205 Double striking of some keys inserts cumbersome VHDL syntax elements.
4206 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4207 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
4208 the modeline. The stuttering keys and their effects are:
4210 ;; --> \" : \" [ --> ( -- --> comment
4211 ;;; --> \" := \" [[ --> [ --CR --> comment-out code
4212 .. --> \" => \" ] --> ) --- --> horizontal line
4213 ,, --> \" <= \" ]] --> ] ---- --> display comment
4214 == --> \" == \" '' --> \\\"
4218 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4219 word in the buffer that starts alike, inserts it and adjusts case.
4220 Re-typing `TAB' toggles through alternative word completions. This also
4221 works in the minibuffer (i.e. in template generator prompts).
4223 Typing `TAB' after `(' looks for and inserts complete parenthesized
4224 expressions (e.g. for array index ranges). All keywords as well as
4225 standard types and subprograms of VHDL have predefined abbreviations
4226 \(e.g. type \"std\" and `TAB' will toggle through all standard types
4227 beginning with \"std\").
4229 Typing `TAB' after a non-word character indents the line if at the
4230 beginning of a line (i.e. no preceding non-blank characters), and
4231 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator
4236 `--' puts a single comment.
4237 `---' draws a horizontal line for separating code segments.
4238 `----' inserts a display comment, i.e. two horizontal lines
4239 with a comment in between.
4240 `--CR' comments out code on that line. Re-hitting CR comments
4241 out following lines.
4242 `C-c c' comments out a region if not commented out,
4243 uncomments a region if already commented out.
4245 You are prompted for comments after object definitions (i.e. signals,
4246 variables, constants, ports) and after subprogram and process
4247 specifications if option `vhdl-prompt-for-comments' is non-nil.
4248 Comments are automatically inserted as additional labels (e.g. after
4249 begin statements) and as help comments if `vhdl-self-insert-comments' is
4252 Inline comments (i.e. comments after a piece of code on the same line)
4253 are indented at least to `vhdl-inline-comment-column'. Comments go at
4254 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment
4255 will open a new comment line. Typing beyond `vhdl-end-comment-column'
4256 in a comment automatically opens a new comment line. `M-q' re-fills
4257 multi-line comments.
4261 `TAB' indents a line if at the beginning of the line. The amount of
4262 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
4263 always indents the current line (is bound to `TAB' if option
4264 `vhdl-intelligent-tab' is nil).
4266 Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4267 \(`M-C-\\') or the entire buffer (menu). Argument and port lists are
4268 indented normally (nil) or relative to the opening parenthesis (non-nil)
4269 according to option `vhdl-argument-list-indent'.
4271 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4272 tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
4275 Syntax-based indentation can be very slow in large files. Option
4276 `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
4280 The alignment functions align operators, keywords, and inline comments
4281 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines
4282 separated by blank lines, `C-c C-a C-i' a block of lines with same
4283 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4284 a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4285 C-a C-d' all lines within the declarative part of a design unit. `C-c
4286 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments
4287 for a group of lines, and `C-c C-a M-c' for a region.
4289 If option `vhdl-align-groups' is non-nil, groups of code lines
4290 separated by special lines (see option `vhdl-align-group-separate') are
4291 aligned individually. If option `vhdl-align-same-indent' is non-nil,
4292 blocks of lines with same indent are aligned separately. Some templates
4293 are automatically aligned after generation if option `vhdl-auto-align'
4296 Alignment tries to align inline comments at
4297 `vhdl-inline-comment-column' and tries inline comment not to exceed
4298 `vhdl-end-comment-column'.
4300 `C-c C-x M-w' fixes up whitespace in a region. That is, operator
4301 symbols are surrounded by one space, and multiple spaces are eliminated.
4305 Code filling allows to condense code (e.g. sensitivity lists or port
4306 maps) by removing comments and newlines and re-wrapping so that all
4307 lines are maximally filled (block filling). `C-c C-f C-f' fills a list
4308 enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4309 blank lines, `C-c C-f C-i' a block of lines with same indent, and
4310 `C-c C-f M-f' an entire region.
4313 CODE BEAUTIFICATION:
4314 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4315 buffer respectively. This inludes indentation, alignment, and case
4316 fixing. Code beautification can also be run non-interactively using the
4319 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4323 Generic and port clauses from entity or component declarations can be
4324 copied (`C-c C-p C-w') and pasted as entity and component declarations,
4325 as component instantiations and corresponding internal constants and
4326 signals, as a generic map with constants as actual generics, and as
4327 internal signal initializations (menu).
4329 To include formals in component instantiations, see option
4330 `vhdl-association-list-with-formals'. To include comments in pasting,
4331 see options `vhdl-include-...-comments'.
4333 A clause with several generic/port names on the same line can be
4334 flattened (`C-c C-p C-f') so that only one name per line exists. The
4335 direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4336 outputs and vice versa, which can be useful in testbenches. (This
4337 reversion is done on the internal data structure and is only reflected
4338 in subsequent paste operations.)
4340 Names for actual ports, instances, testbenches, and
4341 design-under-test instances can be derived from existing names according
4342 to options `vhdl-...-name'. See customization group `vhdl-port'.
4345 SUBPROGRAM TRANSLATION:
4346 Similar functionality exists for copying/pasting the interface of
4347 subprograms (function/procedure). A subprogram interface can be copied
4348 and then pasted as a subprogram declaration, body or call (uses
4349 association list with formals).
4352 TESTBENCH GENERATION:
4353 A copied port can also be pasted as a testbench. The generated
4354 testbench includes an entity, an architecture, and an optional
4355 configuration. The architecture contains the component declaration and
4356 instantiation of the DUT as well as internal constant and signal
4357 declarations. Additional user-defined templates can be inserted. The
4358 names used for entity/architecture/configuration/DUT as well as the file
4359 structure to be generated can be customized. See customization group
4364 Key bindings (`C-c ...') exist for most commands (see in menu).
4368 All commands can be found in the VHDL menu including their key bindings.
4372 The speedbar allows browsing of directories and file contents. It can
4373 be accessed from the VHDL menu and is automatically opened if option
4374 `vhdl-speedbar-auto-open' is non-nil.
4376 In speedbar, open files and directories with `mouse-2' on the name and
4377 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4380 DESIGN HIERARCHY BROWSER:
4381 The speedbar can also be used for browsing the hierarchy of design units
4382 contained in the source files of the current directory or the specified
4383 projects (see option `vhdl-project-alist').
4385 The speedbar can be switched between file, directory hierarchy and
4386 project hierarchy browsing mode in the speedbar menu or by typing `f',
4387 `h' or `H' in speedbar.
4389 In speedbar, open design units with `mouse-2' on the name and browse
4390 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied
4391 from entities and components (in packages). Individual design units and
4392 complete designs can directly be compiled (\"Make\" menu entry).
4394 The hierarchy is automatically updated upon saving a modified source
4395 file when option `vhdl-speedbar-update-on-saving' is non-nil. The
4396 hierarchy is only updated for projects that have been opened once in the
4397 speedbar. The hierarchy is cached between Emacs sessions in a file (see
4398 options in group `vhdl-speedbar').
4400 Simple design consistency checks are done during scanning, such as
4401 multiple declarations of the same unit or missing primary units that are
4402 required by secondary units.
4405 STRUCTURAL COMPOSITION:
4406 Enables simple structural composition. `C-c C-c C-n' creates a skeleton
4407 for a new component. Subcomponents (i.e. component declaration and
4408 instantiation) can be automatically placed from a previously read port
4409 \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
4410 all subcomponents can be automatically connected using internal signals
4411 and ports (`C-c C-c C-w') following these rules:
4412 - subcomponent actual ports with same name are considered to be
4413 connected by a signal (internal signal or port)
4414 - signals that are only inputs to subcomponents are considered as
4415 inputs to this component -> input port created
4416 - signals that are only outputs from subcomponents are considered as
4417 outputs from this component -> output port created
4418 - signals that are inputs to AND outputs from subcomponents are
4419 considered as internal connections -> internal signal created
4421 Purpose: With appropriate naming conventions it is possible to
4422 create higher design levels with only a few mouse clicks or key
4423 strokes. A new design level can be created by simply generating a new
4424 component, placing the required subcomponents from the hierarchy
4425 browser, and wiring everything automatically.
4427 Note: Automatic wiring only works reliably on templates of new
4428 components and component instantiations that were created by VHDL mode.
4430 Component declarations can be placed in a components package (option
4431 `vhdl-use-components-package') which can be automatically generated for
4432 an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
4433 component instantiation is also supported (option
4434 `vhdl-use-direct-instantiation').
4436 | Configuration declarations can automatically be generated either from
4437 | the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from
4438 | the speedbar menu (for the architecture under the cursor). The
4439 | configurations can optionally be hierarchical (i.e. include all
4440 | component levels of a hierarchical design, option
4441 | `vhdl-compose-configuration-hierarchical') or include subconfigurations
4442 | (option `vhdl-compose-configuration-use-subconfiguration'). For
4443 | subcomponents in hierarchical configurations, the most-recently-analyzed
4444 | (mra) architecture is selected. If another architecture is desired, it
4445 | can be marked as most-recently-analyzed (speedbar menu) before
4446 | generating the configuration.
4448 | Note: Configurations of subcomponents (i.e. hierarchical configuration
4449 | declarations) are currently not considered when displaying
4450 | configurations in speedbar.
4452 See the options group `vhdl-compose' for all relevant user options.
4455 SOURCE FILE COMPILATION:
4456 The syntax of the current buffer can be analyzed by calling a VHDL
4457 compiler (menu, `C-c C-k'). The compiler to be used is specified by
4458 option `vhdl-compiler'. The available compilers are listed in option
4459 `vhdl-compiler-alist' including all required compilation command,
4460 command options, compilation directory, and error message syntax
4461 information. New compilers can be added.
4463 All the source files of an entire design can be compiled by the `make'
4464 command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4467 MAKEFILE GENERATION:
4468 Makefiles can be generated automatically by an internal generation
4469 routine (`C-c M-k'). The library unit dependency information is
4470 obtained from the hierarchy browser. Makefile generation can be
4471 customized for each compiler in option `vhdl-compiler-alist'.
4473 Makefile generation can also be run non-interactively using the
4476 emacs -batch -l ~/.emacs -l vhdl-mode
4477 [-compiler compilername] [-project projectname]
4478 -f vhdl-generate-makefile
4480 The Makefile's default target \"all\" compiles the entire design, the
4481 target \"clean\" removes it and the target \"library\" creates the
4482 library directory if not existent. The Makefile also includes a target
4483 for each primary library unit which allows selective compilation of this
4484 unit, its secondary units and its subhierarchy (example: compilation of
4485 a design specified by a configuration). User specific parts can be
4486 inserted into a Makefile with option `vhdl-makefile-generation-hook'.
4489 - Only library units and dependencies within the current library are
4490 considered. Makefiles for designs that span multiple libraries are
4491 not (yet) supported.
4492 - Only one-level configurations are supported (also hierarchical),
4493 but configurations that go down several levels are not.
4494 - The \"others\" keyword in configurations is not supported.
4498 Projects can be defined in option `vhdl-project-alist' and a current
4499 project be selected using option `vhdl-project' (permanently) or from
4500 the menu or speedbar (temporarily). For each project, title and
4501 description strings (for the file headers), source files/directories
4502 (for the hierarchy browser and Makefile generation), library name, and
4503 compiler-dependent options, exceptions and compilation directory can be
4504 specified. Compilation settings overwrite the settings of option
4505 `vhdl-compiler-alist'.
4507 Project setups can be exported (i.e. written to a file) and imported.
4508 Imported setups are not automatically saved in `vhdl-project-alist' but
4509 can be saved afterwards in its customization buffer. When starting
4510 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4511 vhdl-mode\") in a directory with an existing project setup file, it is
4512 automatically loaded and its project activated if option
4513 `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
4514 files can be specified in option `vhdl-project-file-name'. Multiple
4515 project setups can be automatically loaded from global directories.
4516 This is an alternative to specifying project setups with option
4517 `vhdl-project-alist'.
4521 As an alternative to the speedbar, an index menu can be added (set
4522 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4523 (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4524 file) for browsing the file contents (is not populated if buffer is
4525 larger than `font-lock-maximum-size'). Also, a source file menu can be
4526 added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4527 current directory for VHDL source files.
4531 The VHDL standards to be used are specified in option `vhdl-standard'.
4532 Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages.
4536 Lower and upper case for keywords and standardized types, attributes,
4537 and enumeration values is supported. If the option
4538 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4539 lower case and are converted into upper case automatically (not for
4540 types, attributes, and enumeration values). The case of keywords,
4541 types, attributes,and enumeration values can be fixed for an entire
4542 region (menu) or buffer (`C-c C-x C-c') according to the options
4543 `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4546 HIGHLIGHTING (fontification):
4547 Keywords and standardized types, attributes, enumeration values, and
4548 function names (controlled by option `vhdl-highlight-keywords'), as well
4549 as comments, strings, and template prompts are highlighted using
4550 different colors. Unit, subprogram, signal, variable, constant,
4551 parameter and generic/port names in declarations as well as labels are
4552 highlighted if option `vhdl-highlight-names' is non-nil.
4554 Additional reserved words or words with a forbidden syntax (e.g. words
4555 that should be avoided) can be specified in option
4556 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4557 a warning color (option `vhdl-highlight-forbidden-words'). Verilog
4558 keywords are highlighted as forbidden words if option
4559 `vhdl-highlight-verilog-keywords' is non-nil.
4561 Words with special syntax can be highlighted by specifying their
4562 syntax and color in option `vhdl-special-syntax-alist' and by setting
4563 option `vhdl-highlight-special-words' to non-nil. This allows to
4564 establish some naming conventions (e.g. to distinguish different kinds
4565 of signals or other objects by using name suffices) and to support them
4568 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4569 to support case-sensitive highlighting. However, keywords are then only
4570 highlighted if written in lower case.
4572 Code between \"translate_off\" and \"translate_on\" pragmas is
4573 highlighted using a different background color if option
4574 `vhdl-highlight-translate-off' is non-nil.
4576 For documentation and customization of the used colors see
4577 customization group `vhdl-highlight-faces' (`M-x customize-group'). For
4578 highlighting of matching parenthesis, see customization group
4579 `paren-showing'. Automatic buffer highlighting is turned on/off by
4580 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4584 VHDL models (templates) can be specified by the user and made accessible
4585 in the menu, through key bindings (`C-c C-m ...'), or by keyword
4586 electrification. See option `vhdl-model-alist'.
4590 The code of blocks, processes, subprograms, component declarations and
4591 instantiations, generic/port clauses, and configuration declarations can
4592 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4593 the code (see customization group `vhdl-menu'). XEmacs: limited
4594 functionality due to old `hideshow.el' package.
4598 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4599 current process, `C-c C-u M-s' of all processes in the current buffer.
4601 - Only declared local signals (ports, signals declared in
4602 architecture and blocks) are automatically inserted.
4603 - Global signals declared in packages are not automatically inserted.
4604 Insert them once manually (will be kept afterwards).
4605 - Out parameters of procedures are considered to be read.
4606 Use option `vhdl-entity-file-name' to specify the entity file name
4607 \(used to obtain the port names).
4611 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4612 \(e.g. if the closing parenthesis is on the wrong line or is missing).
4616 Postscript printing with different faces (an optimized set of faces is
4617 used if `vhdl-print-customize-faces' is non-nil) or colors \(if
4618 `ps-print-color-p' is non-nil) is possible using the standard Emacs
4619 postscript printing commands. Option `vhdl-print-two-column' defines
4620 appropriate default settings for nice landscape two-column printing.
4621 The paper format can be set by option `ps-paper-type'. Do not forget to
4622 switch `ps-print-color-p' to nil for printing on black-and-white
4627 User options allow customization of VHDL Mode. All options are
4628 accessible from the \"Options\" menu entry. Simple options (switches
4629 and choices) can directly be changed, while for complex options a
4630 customization buffer is opened. Changed options can be saved for future
4631 sessions using the \"Save Options\" menu entry.
4633 Options and their detailed descriptions can also be accessed by using
4634 the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
4635 customize-group' for groups). Some customizations only take effect
4636 after some action (read the NOTE in the option documentation).
4637 Customization can also be done globally (i.e. site-wide, read the
4640 Not all options are described in this documentation, so go and see
4641 what other useful user options there are (`M-x vhdl-customize' or menu)!
4645 As default, files with extensions \".vhd\" and \".vhdl\" are
4646 automatically recognized as VHDL source files. To add an extension
4647 \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4649 \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
4653 - To start Emacs with open VHDL hierarchy browser without having to load
4654 a VHDL file first, use the command:
4656 emacs -l vhdl-mode -f speedbar-frame-mode
4658 - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4660 - Some features only work on properly indented code.
4664 See also the release notes (menu) for added features in new releases.
4670 To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
4671 Add a description of the problem and include a reproducible test case.
4673 Questions and enhancement requests can be sent to <reto@gnu.org>.
4675 The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4676 The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4677 releases. You are kindly invited to participate in beta testing. Subscribe
4678 to above mailing lists by sending an email to <reto@gnu.org>.
4680 VHDL Mode is officially distributed at
4681 http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
4682 where the latest version can be found.
4688 - XEmacs: Incorrect start-up when automatically opening speedbar.
4689 - XEmacs: Indentation in XEmacs 21.4 (and higher).
4692 The VHDL Mode Authors
4693 Reto Zimmermann and Rod Whitby
4700 (kill-all-local-variables)
4701 (setq major-mode 'vhdl-mode)
4702 (setq mode-name "VHDL")
4704 ;; set maps and tables
4705 (use-local-map vhdl-mode-map)
4706 (set-syntax-table vhdl-mode-syntax-table)
4707 (setq local-abbrev-table vhdl-mode-abbrev-table)
4709 ;; set local variables
4710 (set (make-local-variable 'paragraph-start)
4711 "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
4712 (set (make-local-variable 'paragraph-separate) paragraph-start)
4713 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4714 (set (make-local-variable 'require-final-newline)
4715 (if vhdl-emacs-22 mode-require-final-newline t))
4716 (set (make-local-variable 'parse-sexp-ignore-comments) t)
4717 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
4718 (set (make-local-variable 'comment-start) "--")
4719 (set (make-local-variable 'comment-end) "")
4721 (set (make-local-variable 'comment-padding) ""))
4722 (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4723 (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4724 (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4725 (set (make-local-variable 'comment-multi-line) nil)
4726 (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
4727 (set (make-local-variable 'hippie-expand-verbose) nil)
4729 ;; setup the comment indent variable in a Emacs version portable way
4730 ;; ignore any byte compiler warnings you might get here
4731 (when (boundp 'comment-indent-function)
4732 (make-local-variable 'comment-indent-function)
4733 (setq comment-indent-function 'vhdl-comment-indent))
4735 ;; initialize font locking
4736 (set (make-local-variable 'font-lock-defaults)
4738 '(nil vhdl-font-lock-keywords) nil
4739 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
4740 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
4741 (unless vhdl-emacs-21
4742 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4743 (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4744 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4745 ; (set (make-local-variable 'lazy-lock-defer-time) 0.1)
4746 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4747 ; (turn-on-font-lock)
4749 ;; variables for source file compilation
4750 (when vhdl-compile-use-local-error-regexp
4751 (set (make-local-variable 'compilation-error-regexp-alist) nil)
4752 (set (make-local-variable 'compilation-file-regexp-alist) nil))
4755 (vhdl-index-menu-init)
4756 ;; add source file menu
4757 (if vhdl-source-file-menu (vhdl-add-source-files-menu))
4759 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
4760 (easy-menu-define vhdl-mode-menu vhdl-mode-map
4761 "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4762 ;; initialize hideshow and add menu
4763 (vhdl-hideshow-init)
4764 (run-hooks 'menu-bar-update-hook)
4767 (vhdl-ps-print-init)
4768 (vhdl-write-file-hooks-init)
4769 (vhdl-mode-line-update)
4770 (message "VHDL Mode %s.%s" vhdl-version
4771 (if noninteractive "" " See menu for documentation and release notes."))
4775 (run-mode-hooks 'vhdl-mode-hook)
4776 (run-hooks 'vhdl-mode-hook)))
4778 (defun vhdl-activate-customizations ()
4779 "Activate all customizations on local variables."
4781 (vhdl-mode-map-init)
4782 (use-local-map vhdl-mode-map)
4783 (set-syntax-table vhdl-mode-syntax-table)
4784 (setq comment-column vhdl-inline-comment-column)
4785 (setq end-comment-column vhdl-end-comment-column)
4786 (vhdl-write-file-hooks-init)
4787 (vhdl-update-mode-menu)
4788 (vhdl-hideshow-init)
4789 (run-hooks 'menu-bar-update-hook)
4790 (vhdl-mode-line-update))
4792 (defun vhdl-write-file-hooks-init ()
4793 "Add/remove hooks when buffer is saved."
4794 (if vhdl-modify-date-on-saving
4795 (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)
4796 (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror))
4797 (make-local-variable 'after-save-hook)
4798 (add-hook 'after-save-hook 'vhdl-add-modified-file))
4800 (defun vhdl-process-command-line-option (option)
4801 "Process command line options for VHDL Mode."
4804 ((equal option "-compiler")
4805 (vhdl-set-compiler (car command-line-args-left))
4806 (setq command-line-args-left (cdr command-line-args-left)))
4808 ((equal option "-project")
4809 (vhdl-set-project (car command-line-args-left))
4810 (setq command-line-args-left (cdr command-line-args-left)))))
4812 ;; make Emacs process VHDL Mode options
4813 (setq command-switch-alist
4814 (append command-switch-alist
4815 '(("-compiler" . vhdl-process-command-line-option)
4816 ("-project" . vhdl-process-command-line-option))))
4819 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4820 ;;; Keywords and standardized words
4821 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4823 (defconst vhdl-02-keywords
4825 "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4826 "assert" "attribute"
4827 "begin" "block" "body" "buffer" "bus"
4828 "case" "component" "configuration" "constant"
4829 "disconnect" "downto"
4830 "else" "elsif" "end" "entity" "exit"
4831 "file" "for" "function"
4832 "generate" "generic" "group" "guarded"
4833 "if" "impure" "in" "inertial" "inout" "is"
4834 "label" "library" "linkage" "literal" "loop"
4836 "nand" "new" "next" "nor" "not" "null"
4837 "of" "on" "open" "or" "others" "out"
4838 "package" "port" "postponed" "procedure" "process" "protected" "pure"
4839 "range" "record" "register" "reject" "rem" "report" "return"
4841 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
4842 "then" "to" "transport" "type"
4843 "unaffected" "units" "until" "use"
4845 "wait" "when" "while" "with"
4848 "List of VHDL'02 keywords.")
4850 (defconst vhdl-ams-keywords
4852 "across" "break" "limit" "nature" "noise" "procedural" "quantity"
4853 "reference" "spectrum" "subnature" "terminal" "through"
4856 "List of VHDL-AMS keywords.")
4858 (defconst vhdl-verilog-keywords
4860 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
4861 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
4862 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
4863 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
4864 "endprimitive" "endspecify" "endtable" "endtask" "event"
4865 "for" "force" "forever" "fork" "function"
4866 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
4867 "macromodule" "makefile" "medium" "module"
4868 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
4869 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
4871 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
4872 "rtranif0" "rtranif1"
4873 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
4874 "strong1" "supply" "supply0" "supply1"
4875 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
4876 "triand" "trior" "trireg"
4877 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
4879 "List of Verilog keywords as candidate for additional reserved words.")
4881 (defconst vhdl-02-types
4883 "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
4884 "real" "time" "natural" "positive" "string" "line" "text" "side"
4885 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
4886 "std_logic" "std_logic_vector"
4887 "std_ulogic" "std_ulogic_vector"
4889 "List of VHDL'02 standardized types.")
4891 (defconst vhdl-ams-types
4893 "domain_type" "real_vector"
4894 ;; from `nature_pkg' package
4895 "voltage" "current" "electrical" "position" "velocity" "force"
4896 "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational"
4897 "pressure" "flowrate" "fluid"
4899 "List of VHDL-AMS standardized types.")
4901 (defconst vhdl-math-types
4903 "complex" "complex_polar"
4905 "List of Math Packages standardized types.")
4907 (defconst vhdl-02-attributes
4909 "base" "left" "right" "high" "low" "pos" "val" "succ"
4910 "pred" "leftof" "rightof" "range" "reverse_range"
4911 "length" "delayed" "stable" "quiet" "transaction"
4912 "event" "active" "last_event" "last_active" "last_value"
4913 "driving" "driving_value" "ascending" "value" "image"
4914 "simple_name" "instance_name" "path_name"
4917 "List of VHDL'02 standardized attributes.")
4919 (defconst vhdl-ams-attributes
4922 "reference" "contribution" "tolerance"
4923 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
4926 "List of VHDL-AMS standardized attributes.")
4928 (defconst vhdl-02-enum-values
4931 "note" "warning" "error" "failure"
4932 "read_mode" "write_mode" "append_mode"
4933 "open_ok" "status_error" "name_error" "mode_error"
4934 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
4937 "List of VHDL'02 standardized enumeration values.")
4939 (defconst vhdl-ams-enum-values
4941 "quiescent_domain" "time_domain" "frequency_domain"
4942 ;; from `nature_pkg' package
4943 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
4945 "List of VHDL-AMS standardized enumeration values.")
4947 (defconst vhdl-math-constants
4949 "math_e" "math_1_over_e"
4950 "math_pi" "math_two_pi" "math_1_over_pi"
4951 "math_half_pi" "math_q_pi" "math_3_half_pi"
4952 "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e"
4953 "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi"
4954 "math_deg_to_rad" "math_rad_to_deg"
4955 "cbase_1" "cbase_j" "czero"
4957 "List of Math Packages standardized constants.")
4959 (defconst vhdl-02-functions
4961 "now" "resolved" "rising_edge" "falling_edge"
4962 "read" "readline" "write" "writeline" "endfile"
4963 "resize" "is_X" "std_match"
4964 "shift_left" "shift_right" "rotate_left" "rotate_right"
4965 "to_unsigned" "to_signed" "to_integer"
4966 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
4967 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
4968 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
4969 "shl" "shr" "ext" "sxt"
4972 "List of VHDL'02 standardized functions.")
4974 (defconst vhdl-ams-functions
4978 "List of VHDL-AMS standardized functions.")
4980 (defconst vhdl-math-functions
4982 "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform"
4983 "sqrt" "cbrt" "exp" "log"
4984 "sin" "cos" "tan" "arcsin" "arccos" "arctan"
4985 "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh"
4986 "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj"
4988 "List of Math Packages standardized functions.")
4990 (defconst vhdl-02-packages
4992 "std_logic_1164" "numeric_std" "numeric_bit"
4994 "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
4995 "std_logic_misc" "std_logic_textio"
4998 "List of VHDL'02 standardized packages and libraries.")
5000 (defconst vhdl-ams-packages
5002 ;; from `nature_pkg' package
5005 "List of VHDL-AMS standardized packages and libraries.")
5007 (defconst vhdl-math-packages
5009 "math_real" "math_complex"
5011 "List of Math Packages standardized packages and libraries.")
5013 (defvar vhdl-keywords nil
5014 "List of VHDL keywords.")
5016 (defvar vhdl-types nil
5017 "List of VHDL standardized types.")
5019 (defvar vhdl-attributes nil
5020 "List of VHDL standardized attributes.")
5022 (defvar vhdl-enum-values nil
5023 "List of VHDL standardized enumeration values.")
5025 (defvar vhdl-constants nil
5026 "List of VHDL standardized constants.")
5028 (defvar vhdl-functions nil
5029 "List of VHDL standardized functions.")
5031 (defvar vhdl-packages nil
5032 "List of VHDL standardized packages and libraries.")
5034 (defvar vhdl-reserved-words nil
5035 "List of additional reserved words.")
5037 (defvar vhdl-keywords-regexp nil
5038 "Regexp for VHDL keywords.")
5040 (defvar vhdl-types-regexp nil
5041 "Regexp for VHDL standardized types.")
5043 (defvar vhdl-attributes-regexp nil
5044 "Regexp for VHDL standardized attributes.")
5046 (defvar vhdl-enum-values-regexp nil
5047 "Regexp for VHDL standardized enumeration values.")
5049 (defvar vhdl-functions-regexp nil
5050 "Regexp for VHDL standardized functions.")
5052 (defvar vhdl-packages-regexp nil
5053 "Regexp for VHDL standardized packages and libraries.")
5055 (defvar vhdl-reserved-words-regexp nil
5056 "Regexp for additional reserved words.")
5058 (defvar vhdl-directive-keywords-regexp nil
5059 "Regexp for compiler directive keywords.")
5061 (defun vhdl-words-init ()
5062 "Initialize reserved words."
5064 (append vhdl-02-keywords
5065 (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))
5067 (append vhdl-02-types
5068 (when (vhdl-standard-p 'ams) vhdl-ams-types)
5069 (when (vhdl-standard-p 'math) vhdl-math-types)))
5070 (setq vhdl-attributes
5071 (append vhdl-02-attributes
5072 (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))
5073 (setq vhdl-enum-values
5074 (append vhdl-02-enum-values
5075 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))
5076 (setq vhdl-constants
5077 (append (when (vhdl-standard-p 'math) vhdl-math-constants)))
5078 (setq vhdl-functions
5079 (append vhdl-02-functions
5080 (when (vhdl-standard-p 'ams) vhdl-ams-functions)
5081 (when (vhdl-standard-p 'math) vhdl-math-functions)))
5083 (append vhdl-02-packages
5084 (when (vhdl-standard-p 'ams) vhdl-ams-packages)
5085 (when (vhdl-standard-p 'math) vhdl-math-packages)))
5086 (setq vhdl-reserved-words
5087 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
5088 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
5090 (setq vhdl-keywords-regexp
5091 (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>"))
5092 (setq vhdl-types-regexp
5093 (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>"))
5094 (setq vhdl-attributes-regexp
5095 (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
5096 (setq vhdl-enum-values-regexp
5097 (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
5098 (setq vhdl-functions-regexp
5099 (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
5100 (setq vhdl-packages-regexp
5101 (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>"))
5102 (setq vhdl-reserved-words-regexp
5104 (unless (equal vhdl-forbidden-syntax "")
5105 (concat vhdl-forbidden-syntax "\\|"))
5106 (regexp-opt vhdl-reserved-words)
5108 (setq vhdl-directive-keywords-regexp
5109 (concat "\\<\\(" (mapconcat 'regexp-quote
5110 vhdl-directive-keywords "\\|") "\\)\\>"))
5111 (vhdl-abbrev-list-init))
5113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5116 (defvar vhdl-abbrev-list nil
5117 "Predefined abbreviations for VHDL.")
5119 (defun vhdl-abbrev-list-init ()
5120 (setq vhdl-abbrev-list
5122 (list vhdl-upper-case-keywords) vhdl-keywords
5123 (list vhdl-upper-case-types) vhdl-types
5124 (list vhdl-upper-case-attributes) vhdl-attributes
5125 (list vhdl-upper-case-enum-values) vhdl-enum-values
5126 (list vhdl-upper-case-constants) vhdl-constants
5127 (list nil) vhdl-functions
5128 (list nil) vhdl-packages)))
5130 ;; initialize reserved words for VHDL Mode
5134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5141 ;; constant regular expressions for looking at various constructs
5143 (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
5144 "Regexp describing a VHDL symbol.
5145 We cannot use just `word' syntax class since `_' cannot be in word
5146 class. Putting underscore in word class breaks forward word movement
5147 behavior that users are familiar with.")
5149 (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
5150 "Regexp describing a case statement header key.")
5152 (defconst vhdl-label-key
5153 (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]")
5154 "Regexp describing a VHDL label.")
5156 ;; Macro definitions:
5158 (defmacro vhdl-point (position)
5159 "Return the value of point at certain commonly referenced POSITIONs.
5160 POSITION can be one of the following symbols:
5162 bol -- beginning of line
5164 bod -- beginning of defun
5165 boi -- back to indentation
5166 eoi -- last whitespace on line
5167 ionl -- indentation of next line
5168 iopl -- indentation of previous line
5169 bonl -- beginning of next line
5170 bopl -- beginning of previous line
5172 This function does not modify point or mark."
5173 (or (and (eq 'quote (car-safe position))
5174 (null (cddr position)))
5175 (error "ERROR: Bad buffer position requested: %s" position))
5176 (setq position (nth 1 position))
5177 `(let ((here (point)))
5179 ((eq position 'bol) '((beginning-of-line)))
5180 ((eq position 'eol) '((end-of-line)))
5181 ((eq position 'bod) '((save-match-data
5182 (vhdl-beginning-of-defun))))
5183 ((eq position 'boi) '((back-to-indentation)))
5184 ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t")))
5185 ((eq position 'bonl) '((forward-line 1)))
5186 ((eq position 'bopl) '((forward-line -1)))
5187 ((eq position 'iopl)
5189 (back-to-indentation)))
5190 ((eq position 'ionl)
5192 (back-to-indentation)))
5193 (t (error "ERROR: Unknown buffer position requested: %s" position))
5198 ;; workaround for an Emacs18 bug -- blech! Well, at least it
5199 ;; doesn't hurt for v19
5203 (defmacro vhdl-safe (&rest body)
5204 "Safely execute BODY, return nil if an error occurred."
5205 `(condition-case nil
5209 (defmacro vhdl-add-syntax (symbol &optional relpos)
5210 "A simple macro to append the syntax in SYMBOL to the syntax list.
5211 Try to increase performance by using this macro."
5212 `(setq vhdl-syntactic-context
5213 (cons (cons ,symbol ,relpos) vhdl-syntactic-context)))
5215 (defmacro vhdl-has-syntax (symbol)
5216 "A simple macro to return check the syntax list.
5217 Try to increase performance by using this macro."
5218 `(assoc ,symbol vhdl-syntactic-context))
5220 ;; Syntactic element offset manipulation:
5222 (defun vhdl-read-offset (langelem)
5223 "Read new offset value for LANGELEM from minibuffer.
5224 Return a valid value only."
5225 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
5226 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5228 offset input interned)
5230 (setq input (read-string prompt oldoff)
5231 offset (cond ((string-equal "+" input) '+)
5232 ((string-equal "-" input) '-)
5233 ((string-equal "++" input) '++)
5234 ((string-equal "--" input) '--)
5235 ((string-match "^-?[0-9]+$" input)
5236 (string-to-number input))
5237 ((fboundp (setq interned (intern input)))
5239 ((boundp interned) interned)
5240 ;; error, but don't signal one, keep trying
5241 ;; to read an input value
5243 (setq prompt errmsg)
5247 (defun vhdl-set-offset (symbol offset &optional add-p)
5248 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5249 SYMBOL is the syntactic element symbol to change and OFFSET is the new
5250 offset for that syntactic element. Optional ADD says to add SYMBOL to
5251 `vhdl-offsets-alist' if it doesn't already appear there."
5254 (intern (completing-read
5255 (concat "Syntactic symbol to change"
5256 (if current-prefix-arg " or add" "")
5261 (cons (format "%s" (car langelem)) nil)))
5263 nil (not current-prefix-arg)
5264 ;; initial contents tries to be the last element
5265 ;; on the syntactic analysis list for the current
5267 (let* ((syntax (vhdl-get-syntactic-context))
5268 (len (length syntax))
5269 (ic (format "%s" (car (nth (1- len) syntax)))))
5272 (offset (vhdl-read-offset langelem)))
5273 (list langelem offset current-prefix-arg)))
5274 ;; sanity check offset
5282 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s"
5284 (let ((entry (assq symbol vhdl-offsets-alist)))
5286 (setcdr entry offset)
5288 (setq vhdl-offsets-alist
5289 (cons (cons symbol offset) vhdl-offsets-alist))
5290 (error "ERROR: %s is not a valid syntactic symbol" symbol))))
5291 (vhdl-keep-region-active))
5293 (defun vhdl-set-style (style &optional local)
5294 "Set `vhdl-mode' variables to use one of several different indentation styles.
5295 STYLE is a string representing the desired style and optional LOCAL is
5296 a flag which, if non-nil, means to make the style variables being
5297 changed buffer local, instead of the default, which is to set the
5298 global variables. Interactively, the flag comes from the prefix
5299 argument. The styles are chosen from the `vhdl-style-alist' variable."
5300 (interactive (list (completing-read "Use which VHDL indentation style? "
5301 vhdl-style-alist nil t)
5302 current-prefix-arg))
5303 (let ((vars (cdr (assoc style vhdl-style-alist))))
5305 (error "ERROR: Invalid VHDL indentation style `%s'" style))
5306 ;; set all the variables
5310 (let ((var (car varentry))
5311 (val (cdr varentry)))
5313 (make-local-variable var))
5314 ;; special case for vhdl-offsets-alist
5315 (if (not (eq var 'vhdl-offsets-alist))
5317 ;; reset vhdl-offsets-alist to the default value first
5318 (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default))
5319 ;; now set the langelems that are different
5323 (let ((langelem (car langentry))
5324 (offset (cdr langentry)))
5325 (vhdl-set-offset langelem offset)
5330 (vhdl-keep-region-active))
5332 (defun vhdl-get-offset (langelem)
5333 "Get offset from LANGELEM which is a cons cell of the form:
5334 \(SYMBOL . RELPOS). The symbol is matched against
5335 vhdl-offsets-alist and the offset found there is either returned,
5336 or added to the indentation at RELPOS. If RELPOS is nil, then
5337 the offset is simply returned."
5338 (let* ((symbol (car langelem))
5339 (relpos (cdr langelem))
5340 (match (assq symbol vhdl-offsets-alist))
5341 (offset (cdr-safe match)))
5342 ;; offset can be a number, a function, a variable, or one of the
5346 (if vhdl-strict-syntax-p
5347 (error "ERROR: Don't know how to indent a %s" symbol)
5350 ((eq offset '+) (setq offset vhdl-basic-offset))
5351 ((eq offset '-) (setq offset (- vhdl-basic-offset)))
5352 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
5353 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
5354 ((and (not (numberp offset))
5356 (setq offset (funcall offset langelem)))
5357 ((not (numberp offset))
5358 (setq offset (eval offset)))
5361 (< relpos (vhdl-point 'bol)))
5368 ;; Syntactic support functions:
5370 (defun vhdl-in-comment-p ()
5371 "Check if point is in a comment."
5372 (eq (vhdl-in-literal) 'comment))
5374 (defun vhdl-in-string-p ()
5375 "Check if point is in a string."
5376 (eq (vhdl-in-literal) 'string))
5378 (defun vhdl-in-quote-p ()
5379 "Check if point is in a quote ('x')."
5380 (or (and (> (point) (point-min))
5381 (< (1+ (point)) (point-max))
5382 (= (char-before (point)) ?\')
5383 (= (char-after (1+ (point))) ?\'))
5384 (and (> (1- (point)) (point-min))
5385 (< (point) (point-max))
5386 (= (char-before (1- (point))) ?\')
5387 (= (char-after (point)) ?\'))))
5389 (defun vhdl-in-literal ()
5390 "Determine if point is in a VHDL literal."
5392 (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
5394 ((nth 3 state) 'string)
5395 ((nth 4 state) 'comment)
5396 ((vhdl-beginning-of-macro) 'pound)
5399 (defun vhdl-forward-comment (&optional direction)
5400 "Skip all comments (including whitespace). Skip backwards if DIRECTION is
5401 negative, skip forward otherwise."
5403 (if (and direction (< direction 0))
5406 (skip-chars-backward " \t\n")
5407 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5408 (goto-char (match-beginning 3))
5409 (skip-chars-backward " \t\n")))
5411 (skip-chars-forward " \t\n")
5412 (while (looking-at "--.*")
5413 (goto-char (match-end 0))
5414 (skip-chars-forward " \t\n"))))
5416 ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5417 (unless (and vhdl-xemacs (string< "21.2" emacs-version))
5418 (defalias 'vhdl-forward-comment 'forward-comment))
5420 ;; This is the best we can do in Win-Emacs.
5421 (defun vhdl-win-il (&optional lim)
5422 "Determine if point is in a VHDL literal."
5424 (let* ((here (point))
5427 (lim (or lim (vhdl-point 'bod))))
5429 (while (< (point) here)
5431 (and (re-search-forward "--\\|[\"']"
5433 (buffer-substring (match-beginning 0) (match-end 0))))
5438 ;; looking at the opening of a VHDL style comment
5439 ((string= "--" match)
5440 (if (<= here (progn (end-of-line) (point))) 'comment))
5441 ;; looking at the opening of a double quote string
5442 ((string= "\"" match)
5443 (if (not (save-restriction
5444 ;; this seems to be necessary since the
5445 ;; re-search-forward will not work without it
5446 (narrow-to-region (point) here)
5448 ;; this regexp matches a double quote
5449 ;; which is preceded by an even number
5450 ;; of backslashes, including zero
5451 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
5453 ;; looking at the opening of a single quote string
5454 ((string= "'" match)
5455 (if (not (save-restriction
5456 ;; see comments from above
5457 (narrow-to-region (point) here)
5459 ;; this matches a single quote which is
5460 ;; preceded by zero or two backslashes.
5461 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5468 (and (string-match "Win-Emacs" emacs-version)
5469 (fset 'vhdl-in-literal 'vhdl-win-il))
5471 ;; Skipping of "syntactic whitespace". Syntactic whitespace is
5472 ;; defined as lexical whitespace or comments. Search no farther back
5473 ;; or forward than optional LIM. If LIM is omitted, (point-min) is
5474 ;; used for backward skipping, (point-max) is used for forward
5477 (defun vhdl-forward-syntactic-ws (&optional lim)
5478 "Forward skip of syntactic whitespace."
5479 (let* ((here (point-max))
5480 (hugenum (point-max)))
5481 (while (/= here (point))
5483 (vhdl-forward-comment hugenum)
5484 ;; skip preprocessor directives
5485 (when (and (eq (char-after) ?#)
5486 (= (vhdl-point 'boi) (point)))
5487 (while (and (eq (char-before (vhdl-point 'eol)) ?\\)
5488 (= (forward-line 1) 0)))
5490 (if lim (goto-char (min (point) lim)))))
5493 ;; This is the best we can do in Win-Emacs.
5494 (defun vhdl-win-fsws (&optional lim)
5495 "Forward skip syntactic whitespace for Win-Emacs."
5496 (let ((lim (or lim (point-max)))
5499 (skip-chars-forward " \t\n\r\f" lim)
5502 ((looking-at "--") (end-of-line))
5503 ;; none of the above
5504 (t (setq stop t))))))
5506 (and (string-match "Win-Emacs" emacs-version)
5507 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
5509 (defun vhdl-beginning-of-macro (&optional lim)
5510 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5511 (let ((here (point)))
5513 (while (eq (char-before (1- (point))) ?\\)
5515 (back-to-indentation)
5516 (if (and (<= (point) here)
5517 (eq (char-after) ?#))
5522 (defun vhdl-backward-syntactic-ws (&optional lim)
5523 "Backward skip over syntactic whitespace."
5524 (let* ((here (point-min))
5525 (hugenum (- (point-max))))
5526 (while (/= here (point))
5528 (vhdl-forward-comment hugenum)
5529 (vhdl-beginning-of-macro))
5530 (if lim (goto-char (max (point) lim)))))
5532 ;; This is the best we can do in Win-Emacs.
5533 (defun vhdl-win-bsws (&optional lim)
5534 "Backward skip syntactic whitespace for Win-Emacs."
5535 (let ((lim (or lim (vhdl-point 'bod)))
5538 (skip-chars-backward " \t\n\r\f" lim)
5541 ((eq (vhdl-in-literal) 'comment)
5542 (skip-chars-backward "^-" lim)
5543 (skip-chars-backward "-" lim)
5544 (while (not (or (and (= (following-char) ?-)
5545 (= (char-after (1+ (point))) ?-))
5547 (skip-chars-backward "^-" lim)
5548 (skip-chars-backward "-" lim)))
5549 ;; none of the above
5550 (t (setq stop t))))))
5552 (and (string-match "Win-Emacs" emacs-version)
5553 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
5555 ;; Functions to help finding the correct indentation column:
5557 (defun vhdl-first-word (point)
5558 "If the keyword at POINT is at boi, then return (current-column) at
5559 that point, else nil."
5561 (and (goto-char point)
5562 (eq (point) (vhdl-point 'boi))
5565 (defun vhdl-last-word (point)
5566 "If the keyword at POINT is at eoi, then return (current-column) at
5567 that point, else nil."
5569 (and (goto-char point)
5570 (save-excursion (or (eq (progn (forward-sexp) (point))
5572 (looking-at "\\s-*\\(--\\)?")))
5575 ;; Core syntactic evaluation functions:
5577 (defconst vhdl-libunit-re
5578 "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
5580 (defun vhdl-libunit-p ()
5584 (skip-chars-forward " \t\n")
5585 (not (looking-at "is\\b[^_]")))
5588 (and (not (looking-at "use\\b[^_]"))
5591 (vhdl-forward-syntactic-ws)
5592 (/= (following-char) ?:))))
5595 (defconst vhdl-defun-re
5596 "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5598 (defun vhdl-defun-p ()
5600 (if (looking-at "block\\|process\\|procedural")
5601 ;; "block", "process", "procedural":
5604 (not (looking-at "end\\s-+\\w")))
5605 ;; "architecture", "configuration", "entity",
5606 ;; "package", "procedure", "function":
5609 (defun vhdl-corresponding-defun ()
5610 "If the word at the current position corresponds to a \"defun\"
5611 keyword, then return a string that can be used to find the
5612 corresponding \"begin\" keyword, else return nil."
5614 (and (looking-at vhdl-defun-re)
5616 (if (looking-at "block\\|process\\|procedural")
5617 ;; "block", "process". "procedural:
5618 (buffer-substring (match-beginning 0) (match-end 0))
5619 ;; "architecture", "configuration", "entity", "package",
5620 ;; "procedure", "function":
5623 (defconst vhdl-begin-fwd-re
5624 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
5625 "A regular expression for searching forward that matches all known
5626 \"begin\" keywords.")
5628 (defconst vhdl-begin-bwd-re
5629 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|for\\)\\b[^_]"
5630 "A regular expression for searching backward that matches all known
5631 \"begin\" keywords.")
5633 (defun vhdl-begin-p (&optional lim)
5634 "Return t if we are looking at a real \"begin\" keyword.
5635 Assumes that the caller will make sure that we are looking at
5636 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5637 the middle of an identifier that just happens to contain a \"begin\"
5640 ;; "[architecture|case|configuration|entity|package|
5641 ;; procedure|function] ... is":
5642 ((and (looking-at "i")
5644 ;; Skip backward over first sexp (needed to skip over a
5645 ;; procedure interface list, and is harmless in other
5646 ;; situations). Note that we need "return" in the
5647 ;; following search list so that we don't run into
5648 ;; semicolons in the function interface list.
5651 (while (and (not foundp)
5653 ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
5655 (if (or (= (preceding-char) ?_)
5659 (and (/= (following-char) ?\;)
5660 (not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
5662 ;; "begin", "then", "use":
5663 ((looking-at "be\\|t\\|use")
5666 ((and (looking-at "e")
5667 ;; make sure that the "else" isn't inside a
5668 ;; conditional signal assignment.
5670 (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
5671 (or (eq (following-char) ?\;)
5674 ;; "block", "generate", "loop", "process", "procedural",
5675 ;; "units", "record":
5676 ((and (looking-at "bl\\|[glpur]")
5679 (not (looking-at "end\\s-+\\w"))))
5682 ((and (looking-at "c")
5685 (not (looking-at "end\\s-+\\w")))
5686 ;; look out for the dreaded entity class in an attribute
5688 (vhdl-backward-syntactic-ws lim)
5689 (/= (preceding-char) ?:)))
5691 ;; "for" (inside configuration declaration):
5692 ((and (looking-at "f")
5695 (not (looking-at "end\\s-+\\w")))
5696 (vhdl-has-syntax 'configuration))
5700 (defun vhdl-corresponding-mid (&optional lim)
5702 ((looking-at "is\\|block\\|generate\\|process\\|procedural")
5704 ((looking-at "then\\|use")
5709 (defun vhdl-corresponding-end (&optional lim)
5710 "If the word at the current position corresponds to a \"begin\"
5711 keyword, then return a vector containing enough information to find
5712 the corresponding \"end\" keyword, else return nil. The keyword to
5713 search forward for is aref 0. The column in which the keyword must
5714 appear is aref 1 or nil if any column is suitable.
5715 Assumes that the caller will make sure that we are not in the middle
5716 of an identifier that just happens to contain a \"begin\" keyword."
5718 (and (looking-at vhdl-begin-fwd-re)
5719 (or (not (looking-at "\\<use\\>"))
5720 (save-excursion (back-to-indentation)
5721 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
5722 (/= (preceding-char) ?_)
5723 (not (vhdl-in-literal))
5726 ;; "is", "generate", "loop":
5727 ((looking-at "[igl]")
5729 (and (vhdl-last-word (point))
5730 (or (vhdl-first-word (point))
5732 (vhdl-beginning-of-statement-1 lim)
5733 (vhdl-backward-skip-label lim)
5734 (vhdl-first-word (point)))))))
5735 ;; "begin", "else", "for":
5736 ((looking-at "be\\|[ef]")
5738 (and (vhdl-last-word (point))
5739 (or (vhdl-first-word (point))
5741 (vhdl-beginning-of-statement-1 lim)
5742 (vhdl-backward-skip-label lim)
5743 (vhdl-first-word (point)))))))
5744 ;; "component", "units", "record":
5745 ((looking-at "c\\|un\\|r")
5746 ;; The first end found will close the block
5748 ;; "block", "process", "procedural":
5749 ((looking-at "bl\\|p")
5751 (or (vhdl-first-word (point))
5753 (vhdl-beginning-of-statement-1 lim)
5754 (vhdl-backward-skip-label lim)
5755 (vhdl-first-word (point))))))
5757 ((looking-at "t\\|use")
5758 (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
5759 (and (vhdl-last-word (point))
5760 (or (vhdl-first-word (point))
5762 (vhdl-beginning-of-statement-1 lim)
5763 (vhdl-backward-skip-label lim)
5764 (vhdl-first-word (point)))))))
5767 (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
5769 (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]")
5771 (defun vhdl-end-p (&optional lim)
5772 "Return t if we are looking at a real \"end\" keyword.
5773 Assumes that the caller will make sure that we are looking at
5774 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
5775 the middle of an identifier that just happens to contain an \"end\"
5777 (or (not (looking-at "else"))
5778 ;; make sure that the "else" isn't inside a conditional signal
5781 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
5782 (or (eq (following-char) ?\;)
5784 (vhdl-in-literal)))))
5786 (defun vhdl-corresponding-begin (&optional lim)
5787 "If the word at the current position corresponds to an \"end\"
5788 keyword, then return a vector containing enough information to find
5789 the corresponding \"begin\" keyword, else return nil. The keyword to
5790 search backward for is aref 0. The column in which the keyword must
5791 appear is aref 1 or nil if any column is suitable. The supplementary
5792 keyword to search forward for is aref 2 or nil if this is not
5793 required. If aref 3 is t, then the \"begin\" keyword may be found in
5794 the middle of a statement.
5795 Assumes that the caller will make sure that we are not in the middle
5796 of an identifier that just happens to contain an \"end\" keyword."
5799 (if (and (looking-at vhdl-end-fwd-re)
5800 (not (vhdl-in-literal))
5802 (if (looking-at "el")
5804 (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
5808 (skip-chars-forward " \t\n")
5811 ((looking-at "if\\b[^_]")
5812 (vector "else\\|elsif\\|if"
5813 (vhdl-first-word pos)
5814 "else\\|then\\|use" nil))
5816 ((looking-at "component\\b[^_]")
5817 (vector (buffer-substring (match-beginning 1)
5819 (vhdl-first-word pos)
5821 ;; "end units", "end record":
5822 ((looking-at "\\(units\\|record\\)\\b[^_]")
5823 (vector (buffer-substring (match-beginning 1)
5825 (vhdl-first-word pos)
5827 ;; "end block", "end process", "end procedural":
5828 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
5829 (vector "begin" (vhdl-first-word pos) nil nil))
5831 ((looking-at "case\\b[^_]")
5832 (vector "case" (vhdl-first-word pos) "is" nil))
5834 ((looking-at "generate\\b[^_]")
5835 (vector "generate\\|for\\|if"
5836 (vhdl-first-word pos)
5839 ((looking-at "loop\\b[^_]")
5840 (vector "loop\\|while\\|for"
5841 (vhdl-first-word pos)
5843 ;; "end for" (inside configuration declaration):
5844 ((looking-at "for\\b[^_]")
5845 (vector "for" (vhdl-first-word pos) nil nil))
5848 (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
5849 (vhdl-first-word pos)
5850 ;; return an alist of (statement . keyword) mappings
5852 ;; "begin ... end [id]":
5854 ;; "architecture ... is ... begin ... end [id]":
5855 ("architecture" . "is")
5856 ;; "configuration ... is ... end [id]":
5857 ("configuration" . "is")
5858 ;; "entity ... is ... end [id]":
5860 ;; "package ... is ... end [id]":
5862 ;; "procedure ... is ... begin ... end [id]":
5863 ("procedure" . "is")
5864 ;; "function ... is ... begin ... end [id]":
5871 (defconst vhdl-leader-re
5872 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
5874 (defun vhdl-end-of-leader ()
5876 (cond ((looking-at "block\\|process\\|procedural")
5879 (skip-chars-forward " \t\n")
5880 (= (following-char) ?\())
5883 (when (looking-at "[ \t\n]*is")
5884 (goto-char (match-end 0)))
5886 ((looking-at "component")
5888 (when (looking-at "[ \t\n]*is")
5889 (goto-char (match-end 0)))
5893 (skip-chars-forward " \t\n")
5894 (while (looking-at "[,:(]")
5896 (skip-chars-forward " \t\n"))
5901 (defconst vhdl-trailer-re
5902 "\\b\\(is\\|then\\|generate\\|loop\\|record\\|use\\)\\b[^_]")
5904 (defconst vhdl-statement-fwd-re
5905 "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
5906 "A regular expression for searching forward that matches all known
5907 \"statement\" keywords.")
5909 (defconst vhdl-statement-bwd-re
5910 "\\b\\(if\\|for\\|while\\)\\b[^_]"
5911 "A regular expression for searching backward that matches all known
5912 \"statement\" keywords.")
5914 (defun vhdl-statement-p (&optional lim)
5915 "Return t if we are looking at a real \"statement\" keyword.
5916 Assumes that the caller will make sure that we are looking at
5917 vhdl-statement-fwd-re, and are not inside a literal, and that we are not
5918 in the middle of an identifier that just happens to contain a
5919 \"statement\" keyword."
5921 ;; "for" ... "generate":
5922 ((and (looking-at "f")
5923 ;; Make sure it's the start of a parameter specification.
5926 (skip-chars-forward " \t\n")
5927 (looking-at "in\\b[^_]"))
5928 ;; Make sure it's not an "end for".
5931 (not (looking-at "end\\s-+\\w"))))
5933 ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
5934 ((and (looking-at "i")
5935 ;; Make sure it's not an "end if".
5938 (not (looking-at "end\\s-+\\w"))))
5940 ;; "while" ... "loop":
5945 (defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>"
5946 "Regexp describing a case statement alternative key.")
5948 (defun vhdl-case-alternative-p (&optional lim)
5949 "Return t if we are looking at a real case alternative.
5950 Assumes that the caller will make sure that we are looking at
5951 vhdl-case-alternative-re, and are not inside a literal, and that
5952 we are not in the middle of an identifier that just happens to
5953 contain a \"when\" keyword."
5956 (while (and (not foundp)
5957 (re-search-backward ";\\|<=" lim 'move))
5958 (if (or (= (preceding-char) ?_)
5962 (or (eq (following-char) ?\;)
5966 ;; Core syntactic movement functions:
5968 (defconst vhdl-b-t-b-re
5969 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
5971 (defun vhdl-backward-to-block (&optional lim)
5972 "Move backward to the previous \"begin\" or \"end\" keyword."
5974 (while (and (not foundp)
5975 (re-search-backward vhdl-b-t-b-re lim 'move))
5976 (if (or (= (preceding-char) ?_)
5981 ((and (looking-at vhdl-begin-fwd-re)
5982 (or (not (looking-at "\\<use\\>"))
5983 (save-excursion (back-to-indentation)
5984 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
5985 (/= (preceding-char) ?_)
5987 (setq foundp 'begin))
5989 ((and (looking-at vhdl-end-fwd-re)
5990 (/= (preceding-char) ?_)
5998 (defun vhdl-forward-sexp (&optional count lim)
5999 "Move forward across one balanced expression (sexp).
6000 With COUNT, do it that many times."
6002 (let ((count (or count 1))
6003 (case-fold-search t)
6008 (skip-chars-forward " \t\n")
6009 ;; Check for an unbalanced "end" keyword
6010 (if (and (looking-at vhdl-end-fwd-re)
6011 (/= (preceding-char) ?_)
6012 (not (vhdl-in-literal))
6014 (not (looking-at "else")))
6016 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp"))
6017 ;; If the current keyword is a "begin" keyword, then find the
6018 ;; corresponding "end" keyword.
6019 (if (setq end-vec (vhdl-corresponding-end lim))
6021 ;; end-re is the statement keyword to search for
6023 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
6024 ;; column is either the statement keyword target column
6026 (column (aref end-vec 1))
6027 (eol (vhdl-point 'eol))
6028 foundp literal placeholder)
6029 ;; Look for the statement keyword.
6030 (while (and (not foundp)
6031 (re-search-forward end-re nil t)
6032 (setq placeholder (match-end 1))
6033 (goto-char (match-beginning 0)))
6034 ;; If we are in a literal, or not in the right target
6035 ;; column and not on the same line as the begin, then
6038 (/= (current-indentation) column)
6040 (= (preceding-char) ?_)
6041 (setq literal (vhdl-in-literal)))
6042 (if (eq literal 'comment)
6045 ;; An "else" keyword corresponds to both the opening brace
6046 ;; of the following sexp and the closing brace of the
6048 (if (not (looking-at "else"))
6049 (goto-char placeholder))
6053 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp"))
6055 ;; If the current keyword is not a "begin" keyword, then just
6056 ;; perform the normal forward-sexp.
6059 (setq count (1- count))
6061 (setq target (point)))
6065 (defun vhdl-backward-sexp (&optional count lim)
6066 "Move backward across one balanced expression (sexp).
6067 With COUNT, do it that many times. LIM bounds any required backward
6070 (let ((count (or count 1))
6071 (case-fold-search t)
6075 ;; Perform the normal backward-sexp, unless we are looking at
6076 ;; "else" - an "else" keyword corresponds to both the opening brace
6077 ;; of the following sexp and the closing brace of the previous sexp.
6078 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
6079 (/= (preceding-char) ?_)
6080 (not (vhdl-in-literal)))
6083 (if (and (looking-at vhdl-begin-fwd-re)
6084 (or (not (looking-at "\\<use\\>"))
6086 (back-to-indentation)
6087 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6088 (/= (preceding-char) ?_)
6089 (not (vhdl-in-literal))
6091 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp")))
6092 ;; If the current keyword is an "end" keyword, then find the
6093 ;; corresponding "begin" keyword.
6094 (if (and (setq begin-vec (vhdl-corresponding-begin lim))
6095 (/= (preceding-char) ?_))
6097 ;; begin-re is the statement keyword to search for
6099 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
6100 ;; column is either the statement keyword target column
6102 (column (aref begin-vec 1))
6103 ;; internal-p controls where the statement keyword can
6105 (internal-p (aref begin-vec 3))
6106 (last-backward (point)) last-forward
6107 foundp literal keyword)
6108 ;; Look for the statement keyword.
6109 (while (and (not foundp)
6110 (re-search-backward begin-re lim t)
6112 (buffer-substring (match-beginning 1)
6114 ;; If we are in a literal or in the wrong column,
6117 (and (/= (current-indentation) column)
6118 ;; possibly accept current-column as
6119 ;; well as current-indentation.
6120 (or (not internal-p)
6121 (/= (current-column) column))))
6122 (= (preceding-char) ?_)
6125 ;; If there is a supplementary keyword, then
6126 ;; search forward for it.
6127 (if (and (setq begin-re (aref begin-vec 2))
6128 (or (not (listp begin-re))
6129 ;; If begin-re is an alist, then find the
6130 ;; element corresponding to the actual
6131 ;; keyword that we found.
6134 (assoc keyword begin-re))
6136 (setq begin-re (cdr begin-re))))))
6139 (concat "\\b\\(" begin-re "\\)\\b[^_]"))
6141 (setq last-forward (point))
6142 ;; Look for the supplementary keyword
6143 ;; (bounded by the backward search start
6145 (while (and (not foundp)
6146 (re-search-forward begin-re
6148 (goto-char (match-beginning 1)))
6149 ;; If we are in a literal, then try again.
6150 (if (or (= (preceding-char) ?_)
6153 (if (eq literal 'comment)
6155 (min (vhdl-point 'eol) last-backward))
6157 ;; We have found the supplementary keyword.
6158 ;; Save the position of the keyword in foundp.
6159 (setq foundp (point)))
6162 ;; If the supplementary keyword was found, then
6163 ;; move point to the supplementary keyword.
6165 ;; If there was no supplementary keyword, then
6166 ;; point is already at the statement keyword.
6168 ) ; end of the search for the statement keyword
6170 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp"))
6172 (setq count (1- count))
6174 (setq target (point)))
6178 (defun vhdl-backward-up-list (&optional count limit)
6179 "Move backward out of one level of blocks.
6180 With argument, do this that many times."
6182 (let ((count (or count 1))
6186 (if (looking-at vhdl-defun-re)
6187 (error "ERROR: Unbalanced blocks"))
6188 (vhdl-backward-to-block limit)
6189 (setq count (1- count)))
6190 (setq target (point)))
6191 (goto-char target)))
6193 (defun vhdl-end-of-defun (&optional count)
6194 "Move forward to the end of a VHDL defun."
6196 (let ((case-fold-search t))
6197 (vhdl-beginning-of-defun)
6198 (if (not (looking-at "block\\|process\\|procedural"))
6199 (re-search-forward "\\bis\\b"))
6200 (vhdl-forward-sexp)))
6202 (defun vhdl-mark-defun ()
6203 "Put mark at end of this \"defun\", point at beginning."
6205 (let ((case-fold-search t))
6207 (vhdl-beginning-of-defun)
6209 (if (not (looking-at "block\\|process\\|procedural"))
6210 (re-search-forward "\\bis\\b"))
6212 (exchange-point-and-mark)))
6214 (defun vhdl-beginning-of-libunit ()
6215 "Move backward to the beginning of a VHDL library unit.
6216 Returns the location of the corresponding begin keyword, unless search
6217 stops due to beginning or end of buffer.
6218 Note that if point is between the \"libunit\" keyword and the
6219 corresponding \"begin\" keyword, then that libunit will not be
6220 recognized, and the search will continue backwards. If point is
6221 at the \"begin\" keyword, then the defun will be recognized. The
6222 returned point is at the first character of the \"libunit\" keyword."
6223 (let ((last-forward (point))
6225 ;; Just in case we are actually sitting on the "begin"
6226 ;; keyword, allow for the keyword and an extra character,
6227 ;; as this will be used when looking forward for the
6229 (save-excursion (forward-word 1) (1+ (point))))
6230 foundp literal placeholder)
6231 ;; Find the "libunit" keyword.
6232 (while (and (not foundp)
6233 (re-search-backward vhdl-libunit-re nil 'move))
6234 ;; If we are in a literal, or not at a real libunit, then try again.
6235 (if (or (= (preceding-char) ?_)
6237 (not (vhdl-libunit-p)))
6239 ;; Find the corresponding "begin" keyword.
6240 (setq last-forward (point))
6241 (while (and (not foundp)
6242 (re-search-forward "\\bis\\b[^_]" last-backward t)
6243 (setq placeholder (match-beginning 0)))
6244 (if (or (= (preceding-char) ?_)
6245 (setq literal (vhdl-in-literal)))
6246 ;; It wasn't a real keyword, so keep searching.
6247 (if (eq literal 'comment)
6249 (min (vhdl-point 'eol) last-backward))
6251 ;; We have found the begin keyword, loop will exit.
6252 (setq foundp placeholder)))
6253 ;; Go back to the libunit keyword
6254 (goto-char last-forward)))
6257 (defun vhdl-beginning-of-defun (&optional count)
6258 "Move backward to the beginning of a VHDL defun.
6259 With argument, do it that many times.
6260 Returns the location of the corresponding begin keyword, unless search
6261 stops due to beginning or end of buffer."
6262 ;; Note that if point is between the "defun" keyword and the
6263 ;; corresponding "begin" keyword, then that defun will not be
6264 ;; recognized, and the search will continue backwards. If point is
6265 ;; at the "begin" keyword, then the defun will be recognized. The
6266 ;; returned point is at the first character of the "defun" keyword.
6268 (let ((count (or count 1))
6269 (case-fold-search t)
6270 (last-forward (point))
6274 (goto-char last-forward)
6275 (let ((last-backward
6276 ;; Just in case we are actually sitting on the "begin"
6277 ;; keyword, allow for the keyword and an extra character,
6278 ;; as this will be used when looking forward for the
6280 (save-excursion (forward-word 1) (1+ (point))))
6281 begin-string literal)
6282 (while (and (not foundp)
6283 (re-search-backward vhdl-defun-re nil 'move))
6284 ;; If we are in a literal, then try again.
6285 (if (or (= (preceding-char) ?_)
6288 (if (setq begin-string (vhdl-corresponding-defun))
6289 ;; This is a real defun keyword.
6290 ;; Find the corresponding "begin" keyword.
6291 ;; Look for the begin keyword.
6293 ;; Save the search start point.
6294 (setq last-forward (point))
6295 (while (and (not foundp)
6296 (search-forward begin-string last-backward t))
6297 (if (or (= (preceding-char) ?_)
6299 (setq literal (vhdl-in-literal))))
6300 ;; It wasn't a real keyword, so keep searching.
6301 (if (eq literal 'comment)
6303 (min (vhdl-point 'eol) last-backward))
6305 ;; We have found the begin keyword, loop will exit.
6306 (setq foundp (match-beginning 0)))
6308 ;; Go back to the defun keyword
6309 (goto-char last-forward)) ; end search for begin keyword
6311 ) ; end of the search for the defun keyword
6313 (setq count (1- count))
6315 (vhdl-keep-region-active)
6318 (defun vhdl-beginning-of-statement (&optional count lim interactive)
6319 "Go to the beginning of the innermost VHDL statement.
6320 With prefix arg, go back N - 1 statements. If already at the
6321 beginning of a statement then go to the beginning of the preceding
6322 one. If within a string or comment, or next to a comment (only
6323 whitespace between), move by sentences instead of statements.
6325 When called from a program, this function takes 3 optional args: the
6326 prefix arg, a buffer position limit which is the farthest back to
6327 search, and an argument indicating an interactive call."
6328 (interactive "p\np")
6329 (let ((count (or count 1))
6330 (case-fold-search t)
6331 (lim (or lim (point-min)))
6336 (setq state (parse-partial-sexp (point) here nil nil)))
6337 (if (and interactive
6340 (looking-at (concat "[ \t]*" comment-start-skip))))
6341 (forward-sentence (- count))
6343 (vhdl-beginning-of-statement-1 lim)
6344 (setq count (1- count))))
6345 ;; its possible we've been left up-buf of lim
6346 (goto-char (max (point) lim))
6348 (vhdl-keep-region-active))
6350 (defconst vhdl-e-o-s-re
6351 (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re))
6353 (defun vhdl-end-of-statement ()
6354 "Very simple implementation."
6356 (re-search-forward vhdl-e-o-s-re))
6358 (defconst vhdl-b-o-s-re
6359 (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
6360 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
6362 (defun vhdl-beginning-of-statement-1 (&optional lim)
6363 "Move to the start of the current statement, or the previous
6364 statement if already at the beginning of one."
6365 (let ((lim (or lim (point-min)))
6369 ;; go backwards one balanced expression, but be careful of
6370 ;; unbalanced paren being reached
6371 (if (not (vhdl-safe (progn (backward-sexp) t)))
6373 (backward-up-list 1)
6375 (vhdl-forward-syntactic-ws here)
6377 (while (and (not donep)
6379 ;; look backwards for a statement boundary
6380 (re-search-backward vhdl-b-o-s-re lim 'move))
6381 (if (or (= (preceding-char) ?_)
6385 ;; If we are looking at an open paren, then stop after it
6386 ((eq (following-char) ?\()
6388 (vhdl-forward-syntactic-ws here)
6390 ;; If we are looking at a close paren, then skip it
6391 ((eq (following-char) ?\))
6396 (progn (goto-char pos)
6397 (vhdl-forward-syntactic-ws here)
6399 ;; If we are looking at a semicolon, then stop
6400 ((eq (following-char) ?\;)
6403 (vhdl-forward-syntactic-ws here)
6405 ;; If we are looking at a "begin", then stop
6406 ((and (looking-at vhdl-begin-fwd-re)
6407 (or (not (looking-at "\\<use\\>"))
6409 (back-to-indentation)
6410 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6411 (/= (preceding-char) ?_)
6413 ;; If it's a leader "begin", then find the
6415 (if (looking-at vhdl-leader-re)
6417 ;; set a default stop point at the begin
6419 ;; is the start point inside the leader area ?
6420 (goto-char (vhdl-end-of-leader))
6421 (vhdl-forward-syntactic-ws here)
6422 (if (< (point) here)
6423 ;; start point was not inside leader area
6424 ;; set stop point at word after leader
6425 (setq pos (point))))
6427 (vhdl-forward-syntactic-ws here)
6431 ;; If we are looking at a "statement", then stop
6432 ((and (looking-at vhdl-statement-fwd-re)
6433 (/= (preceding-char) ?_)
6434 (vhdl-statement-p nil))
6436 ;; If we are looking at a case alternative key, then stop
6437 ((and (looking-at vhdl-case-alternative-re)
6438 (vhdl-case-alternative-p lim))
6440 ;; set a default stop point at the when
6442 ;; is the start point inside the case alternative key ?
6443 (looking-at vhdl-case-alternative-re)
6444 (goto-char (match-end 0))
6445 (vhdl-forward-syntactic-ws here)
6446 (if (< (point) here)
6447 ;; start point was not inside the case alternative key
6448 ;; set stop point at word after case alternative keyleader
6449 (setq pos (point))))
6452 ;; Bogus find, continue
6457 ;; Defuns for calculating the current syntactic state:
6459 (defun vhdl-get-library-unit (bod placeholder)
6460 "If there is an enclosing library unit at bod, with it's \"begin\"
6461 keyword at placeholder, then return the library unit type."
6462 (let ((here (vhdl-point 'bol)))
6464 (goto-char placeholder)
6465 (vhdl-safe (vhdl-forward-sexp 1 bod))
6470 ((looking-at "e") 'entity)
6471 ((looking-at "a") 'architecture)
6472 ((looking-at "c") 'configuration)
6477 (vhdl-forward-syntactic-ws here)
6478 (if (looking-at "body\\b[^_]")
6479 'package-body 'package))))))
6482 (defun vhdl-get-block-state (&optional lim)
6483 "Finds and records all the closest opens.
6484 lim is the furthest back we need to search (it should be the
6485 previous libunit keyword)."
6486 (let ((here (point))
6487 (lim (or lim (point-min)))
6488 keyword sexp-start sexp-mid sexp-end
6489 preceding-sexp containing-sexp
6490 containing-begin containing-mid containing-paren)
6492 ;; Find the containing-paren, and use that as the limit
6493 (if (setq containing-paren
6495 (narrow-to-region lim (point))
6496 (vhdl-safe (scan-lists (point) -1 1))))
6497 (setq lim containing-paren))
6498 ;; Look backwards for "begin" and "end" keywords.
6499 (while (and (> (point) lim)
6500 (not containing-sexp))
6501 (setq keyword (vhdl-backward-to-block lim))
6503 ((eq keyword 'begin)
6504 ;; Found a "begin" keyword
6505 (setq sexp-start (point))
6506 (setq sexp-mid (vhdl-corresponding-mid lim))
6507 (setq sexp-end (vhdl-safe
6509 (vhdl-forward-sexp 1 lim) (point))))
6510 (if (and sexp-end (<= sexp-end here))
6511 ;; we want to record this sexp, but we only want to
6512 ;; record the last-most of any of them before here
6514 (setq preceding-sexp sexp-start))
6515 ;; we're contained in this sexp so put sexp-start on
6517 (setq containing-sexp sexp-start)
6518 (setq containing-mid sexp-mid)
6519 (setq containing-begin t)))
6521 ;; Found an "end" keyword
6523 (setq sexp-end (point))
6526 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
6527 (progn (backward-sexp) (point))))
6528 ;; we want to record this sexp, but we only want to
6529 ;; record the last-most of any of them before here
6531 (setq preceding-sexp sexp-start)))
6533 ;; Check if the containing-paren should be the containing-sexp
6534 (if (and containing-paren
6535 (or (null containing-sexp)
6536 (< containing-sexp containing-paren)))
6537 (setq containing-sexp containing-paren
6539 containing-begin nil
6540 containing-mid nil))
6541 (vector containing-sexp preceding-sexp containing-begin containing-mid)
6545 (defconst vhdl-s-c-a-re
6546 (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key))
6548 (defun vhdl-skip-case-alternative (&optional lim)
6549 "Skip forward over case/when bodies, with optional maximal
6550 limit. If no next case alternative is found, nil is returned and point
6552 (let ((lim (or lim (point-max)))
6555 (while (and (< (point) lim)
6557 (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
6559 (not (vhdl-in-literal)))
6560 (/= (match-beginning 0) here))
6562 (goto-char (match-beginning 0))
6564 ((and (looking-at "case")
6565 (re-search-forward "\\bis[^_]" lim t))
6567 (vhdl-forward-sexp))
6575 (defun vhdl-backward-skip-label (&optional lim)
6576 "Skip backward over a label, with optional maximal
6577 limit. If label is not found, nil is returned and point
6579 (let ((lim (or lim (point-min)))
6582 (vhdl-backward-syntactic-ws lim)
6583 (and (eq (preceding-char) ?:)
6586 (setq placeholder (point))
6587 (looking-at vhdl-label-key))))
6588 (goto-char placeholder))
6591 (defun vhdl-forward-skip-label (&optional lim)
6592 "Skip forward over a label, with optional maximal
6593 limit. If label is not found, nil is returned and point
6595 (let ((lim (or lim (point-max))))
6596 (if (looking-at vhdl-label-key)
6598 (goto-char (match-end 0))
6599 (vhdl-forward-syntactic-ws lim)))
6602 (defun vhdl-get-syntactic-context ()
6603 "Guess the syntactic description of the current line of VHDL code."
6607 (let* ((indent-point (point))
6608 (case-fold-search t)
6609 vec literal containing-sexp preceding-sexp
6610 containing-begin containing-mid containing-leader
6611 char-before-ip char-after-ip begin-after-ip end-after-ip
6612 placeholder lim library-unit
6615 ;; Reset the syntactic context
6616 (setq vhdl-syntactic-context nil)
6619 ;; Move to the start of the previous library unit, and
6620 ;; record the position of the "begin" keyword.
6621 (setq placeholder (vhdl-beginning-of-libunit))
6622 ;; The position of the "libunit" keyword gives us a gross
6627 ;; If there is a previous library unit, and we are enclosed by
6628 ;; it, then set the syntax accordingly.
6630 (setq library-unit (vhdl-get-library-unit lim placeholder))
6631 (vhdl-add-syntax library-unit lim))
6633 ;; Find the surrounding state.
6634 (if (setq vec (vhdl-get-block-state lim))
6636 (setq containing-sexp (aref vec 0))
6637 (setq preceding-sexp (aref vec 1))
6638 (setq containing-begin (aref vec 2))
6639 (setq containing-mid (aref vec 3))
6642 ;; set the limit on the farthest back we need to search
6643 (setq lim (if containing-sexp
6645 (goto-char containing-sexp)
6646 ;; set containing-leader if required
6647 (if (looking-at vhdl-leader-re)
6648 (setq containing-leader (vhdl-end-of-leader)))
6652 ;; cache char before and after indent point, and move point to
6653 ;; the most likely position to perform the majority of tests
6654 (goto-char indent-point)
6655 (skip-chars-forward " \t")
6656 (setq literal (vhdl-in-literal))
6657 (setq char-after-ip (following-char))
6658 (setq begin-after-ip (and
6660 (looking-at vhdl-begin-fwd-re)
6661 (or (not (looking-at "\\<use\\>"))
6663 (back-to-indentation)
6664 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6666 (setq end-after-ip (and
6668 (looking-at vhdl-end-fwd-re)
6670 (vhdl-backward-syntactic-ws lim)
6671 (setq char-before-ip (preceding-char))
6672 (goto-char indent-point)
6673 (skip-chars-forward " \t")
6675 ;; now figure out syntactic qualities of the current line
6677 ;; CASE 1: in a string or comment.
6678 ((memq literal '(string comment))
6679 (vhdl-add-syntax literal (vhdl-point 'bopl)))
6680 ;; CASE 2: Line is at top level.
6681 ((null containing-sexp)
6682 ;; Find the point to which indentation will be relative
6684 (if (null preceding-sexp)
6686 ;; no preceding-sexp -> use the preceding statement
6687 (vhdl-beginning-of-statement-1 lim)
6689 ;; if there is a preceding-sexp then indent relative to it
6690 (goto-char preceding-sexp)
6691 ;; if not at boi, then the block-opening keyword is
6692 ;; probably following a label, so we need a different
6694 (if (/= (point) (vhdl-point 'boi))
6696 (vhdl-beginning-of-statement-1 lim)))
6697 ;; v-b-o-s could have left us at point-min
6700 (vhdl-forward-syntactic-ws indent-point))
6701 (setq placeholder (point)))
6703 ;; CASE 2A : we are looking at a block-open
6705 (vhdl-add-syntax 'block-open placeholder))
6706 ;; CASE 2B: we are looking at a block-close
6708 (vhdl-add-syntax 'block-close placeholder))
6709 ;; CASE 2C: we are looking at a top-level statement
6711 (vhdl-backward-syntactic-ws lim)
6713 (= (preceding-char) ?\;)))
6714 (vhdl-add-syntax 'statement placeholder))
6715 ;; CASE 2D: we are looking at a top-level statement-cont
6717 (vhdl-beginning-of-statement-1 lim)
6718 ;; v-b-o-s could have left us at point-min
6721 (vhdl-forward-syntactic-ws indent-point))
6722 (vhdl-add-syntax 'statement-cont (point)))
6724 ;; CASE 3: line is inside parentheses. Most likely we are
6725 ;; either in a subprogram argument (interface) list, or a
6726 ;; continued expression containing parentheses.
6727 ((null containing-begin)
6728 (vhdl-backward-syntactic-ws containing-sexp)
6730 ;; CASE 3A: we are looking at the arglist closing paren
6731 ((eq char-after-ip ?\))
6732 (goto-char containing-sexp)
6733 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
6734 ;; CASE 3B: we are looking at the first argument in an empty
6736 ((eq char-before-ip ?\()
6737 (goto-char containing-sexp)
6738 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
6739 ;; CASE 3C: we are looking at an arglist continuation line,
6740 ;; but the preceding argument is on the same line as the
6741 ;; opening paren. This case includes multi-line
6742 ;; expression paren groupings.
6743 ((and (save-excursion
6744 (goto-char (1+ containing-sexp))
6745 (skip-chars-forward " \t")
6747 (not (looking-at "--")))
6749 (vhdl-beginning-of-statement-1 containing-sexp)
6750 (skip-chars-backward " \t(")
6751 (while (= (preceding-char) ?\;)
6752 (vhdl-beginning-of-statement-1 containing-sexp)
6753 (skip-chars-backward " \t("))
6754 (<= (point) containing-sexp)))
6755 (goto-char containing-sexp)
6756 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
6757 ;; CASE 3D: we are looking at just a normal arglist
6758 ;; continuation line
6759 (t (vhdl-beginning-of-statement-1 containing-sexp)
6760 (vhdl-forward-syntactic-ws indent-point)
6761 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
6763 ;; CASE 4: A block mid open
6764 ((and begin-after-ip
6765 (looking-at containing-mid))
6766 (goto-char containing-sexp)
6767 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6768 (if (looking-at vhdl-trailer-re)
6770 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6771 (vhdl-backward-skip-label (vhdl-point 'boi))
6772 (vhdl-add-syntax 'block-open (point)))
6773 ;; CASE 5: block close brace
6775 (goto-char containing-sexp)
6776 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6777 (if (looking-at vhdl-trailer-re)
6779 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6780 (vhdl-backward-skip-label (vhdl-point 'boi))
6781 (vhdl-add-syntax 'block-close (point)))
6782 ;; CASE 6: A continued statement
6783 ((and (/= char-before-ip ?\;)
6784 ;; check it's not a trailer begin keyword, or a begin
6785 ;; keyword immediately following a label.
6786 (not (and begin-after-ip
6787 (or (looking-at vhdl-trailer-re)
6789 (vhdl-backward-skip-label containing-sexp)))))
6790 ;; check it's not a statement keyword
6791 (not (and (looking-at vhdl-statement-fwd-re)
6792 (vhdl-statement-p)))
6793 ;; see if the b-o-s is before the indent point
6796 (vhdl-beginning-of-statement-1 containing-sexp)
6797 ;; If we ended up after a leader, then this will
6798 ;; move us forward to the start of the first
6799 ;; statement. Note that a containing sexp here is
6800 ;; always a keyword, not a paren, so this will
6801 ;; have no effect if we hit the containing-sexp.
6802 (vhdl-forward-syntactic-ws indent-point)
6803 (setq placeholder (point))))
6804 ;; check it's not a block-intro
6805 (/= placeholder containing-sexp)
6806 ;; check it's not a case block-intro
6808 (goto-char placeholder)
6809 (or (not (looking-at vhdl-case-alternative-re))
6810 (> (match-end 0) indent-point))))
6811 ;; Make placeholder skip a label, but only if it puts us
6812 ;; before the indent point at the start of a line.
6813 (let ((new placeholder))
6814 (if (and (> indent-point
6816 (goto-char placeholder)
6817 (vhdl-forward-skip-label indent-point)
6818 (setq new (point))))
6821 (eq new (progn (back-to-indentation) (point)))))
6822 (setq placeholder new)))
6823 (vhdl-add-syntax 'statement-cont placeholder)
6825 (vhdl-add-syntax 'block-open)))
6826 ;; Statement. But what kind?
6827 ;; CASE 7: A case alternative key
6828 ((and (looking-at vhdl-case-alternative-re)
6829 (vhdl-case-alternative-p containing-sexp))
6830 ;; for a case alternative key, we set relpos to the first
6831 ;; non-whitespace char on the line containing the "case"
6833 (goto-char containing-sexp)
6834 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6835 (if (looking-at vhdl-trailer-re)
6836 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6837 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
6838 ;; CASE 8: statement catchall
6840 ;; we know its a statement, but we need to find out if it is
6841 ;; the first statement in a block
6842 (if containing-leader
6843 (goto-char containing-leader)
6844 (goto-char containing-sexp)
6845 ;; Note that a containing sexp here is always a keyword,
6846 ;; not a paren, so skip over the keyword.
6848 ;; move to the start of the first statement
6849 (vhdl-forward-syntactic-ws indent-point)
6850 (setq placeholder (point))
6851 ;; we want to ignore case alternatives keys when skipping forward
6853 (while (looking-at vhdl-case-alternative-re)
6854 (setq incase-p (point))
6855 ;; we also want to skip over the body of the
6856 ;; case/when statement if that doesn't put us at
6857 ;; after the indent-point
6858 (while (vhdl-skip-case-alternative indent-point))
6859 ;; set up the match end
6860 (looking-at vhdl-case-alternative-re)
6861 (goto-char (match-end 0))
6862 ;; move to the start of the first case alternative statement
6863 (vhdl-forward-syntactic-ws indent-point)
6864 (setq placeholder (point)))
6866 ;; CASE 8A: we saw a case/when statement so we must be
6867 ;; in a switch statement. find out if we are at the
6868 ;; statement just after a case alternative key
6870 (= (point) indent-point))
6871 ;; relpos is the "when" keyword
6872 (vhdl-add-syntax 'statement-case-intro incase-p))
6873 ;; CASE 8B: any old statement
6874 ((< (point) indent-point)
6875 ;; relpos is the first statement of the block
6876 (vhdl-add-syntax 'statement placeholder)
6878 (vhdl-add-syntax 'block-open)))
6879 ;; CASE 8C: first statement in a block
6881 (goto-char containing-sexp)
6882 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6883 (if (looking-at vhdl-trailer-re)
6884 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6885 (vhdl-backward-skip-label (vhdl-point 'boi))
6886 (vhdl-add-syntax 'statement-block-intro (point))
6888 (vhdl-add-syntax 'block-open)))
6892 ;; now we need to look at any modifiers
6893 (goto-char indent-point)
6894 (skip-chars-forward " \t")
6895 (if (looking-at "--")
6896 (vhdl-add-syntax 'comment))
6897 (if (eq literal 'pound)
6898 (vhdl-add-syntax 'cpp-macro))
6899 ;; return the syntax
6900 vhdl-syntactic-context))))
6902 ;; Standard indentation line-ups:
6904 (defun vhdl-lineup-arglist (langelem)
6905 "Lineup the current arglist line with the arglist appearing just
6906 after the containing paren which starts the arglist."
6908 (let* ((containing-sexp
6910 ;; arglist-cont-nonempty gives relpos ==
6911 ;; to boi of containing-sexp paren. This
6912 ;; is good when offset is +, but bad
6913 ;; when it is vhdl-lineup-arglist, so we
6914 ;; have to special case a kludge here.
6915 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
6918 (backward-up-list 1)
6919 (skip-chars-forward " \t" (vhdl-point 'eol)))
6920 (goto-char (cdr langelem)))
6922 (cs-curcol (save-excursion
6923 (goto-char (cdr langelem))
6927 (looking-at "[ \t]*)"))
6928 (progn (goto-char (match-end 0))
6931 (vhdl-forward-syntactic-ws)
6932 (- (current-column) cs-curcol))
6933 (goto-char containing-sexp)
6935 (let ((eol (vhdl-point 'eol))
6938 (skip-chars-forward " \t")
6940 (vhdl-forward-syntactic-ws)
6943 (- (current-column) cs-curcol)
6946 (defun vhdl-lineup-arglist-intro (langelem)
6947 "Lineup an arglist-intro line to just after the open paren."
6949 (let ((cs-curcol (save-excursion
6950 (goto-char (cdr langelem))
6952 (ce-curcol (save-excursion
6954 (backward-up-list 1)
6955 (skip-chars-forward " \t" (vhdl-point 'eol))
6957 (- ce-curcol cs-curcol -1))))
6959 (defun vhdl-lineup-comment (langelem)
6960 "Support old behavior for comment indentation. We look at
6961 vhdl-comment-only-line-offset to decide how to indent comment
6964 (back-to-indentation)
6965 ;; at or to the right of comment-column
6966 (if (>= (current-column) comment-column)
6967 (vhdl-comment-indent)
6968 ;; otherwise, indent as specified by vhdl-comment-only-line-offset
6970 (or (car-safe vhdl-comment-only-line-offset)
6971 vhdl-comment-only-line-offset)
6972 (or (cdr-safe vhdl-comment-only-line-offset)
6973 (car-safe vhdl-comment-only-line-offset)
6974 -1000 ;jam it against the left side
6977 (defun vhdl-lineup-statement-cont (langelem)
6978 "Line up statement-cont after the assignment operator."
6980 (let* ((relpos (cdr langelem))
6981 (assignp (save-excursion
6982 (goto-char (vhdl-point 'boi))
6983 (and (re-search-forward "\\(<\\|:\\)="
6984 (vhdl-point 'eol) t)
6985 (- (point) (vhdl-point 'boi)))))
6990 (while (and (not foundp)
6991 (< (point) (vhdl-point 'eol)))
6992 (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
6993 (if (vhdl-in-literal)
6995 (if (= (preceding-char) ?\()
6996 ;; skip over any parenthesized expressions
6997 (goto-char (min (vhdl-point 'eol)
6998 (scan-lists (point) 1 1)))
6999 ;; found an assignment operator (not at eol)
7000 (setq foundp (not (looking-at "\\s-*$"))))))
7002 ;; there's no assignment operator on the line
7004 ;; calculate indentation column after assign and ws, unless
7005 ;; our line contains an assignment operator
7009 (skip-chars-forward " \t")
7011 (- (current-column) assignp curcol))
7014 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7015 ;; Progress reporting
7017 (defvar vhdl-progress-info nil
7018 "Array variable for progress information: 0 begin, 1 end, 2 time.")
7020 (defun vhdl-update-progress-info (string pos)
7021 "Update progress information."
7022 (when (and vhdl-progress-info (not noninteractive)
7023 (< vhdl-progress-interval
7024 (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
7025 (message (concat string "... (%2d%s)")
7026 (/ (* 100 (- pos (aref vhdl-progress-info 0)))
7027 (- (aref vhdl-progress-info 1)
7028 (aref vhdl-progress-info 0))) "%")
7029 (aset vhdl-progress-info 2 (nth 1 (current-time)))))
7031 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7032 ;; Indentation commands
7034 (defun vhdl-electric-tab (&optional prefix-arg)
7035 "If preceding character is part of a word or a paren then hippie-expand,
7036 else if right of non whitespace on line then insert tab,
7037 else if last command was a tab or return then dedent one step or if a comment
7038 toggle between normal indent and inline comment indent,
7039 else indent `correctly'."
7041 (vhdl-prepare-search-2
7044 ((= (char-syntax (preceding-char)) ?w)
7045 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7047 (hippie-expand-only-buffers
7048 (or (and (boundp 'hippie-expand-only-buffers)
7049 hippie-expand-only-buffers)
7051 (vhdl-expand-abbrev prefix-arg)))
7052 ;; expand parenthesis
7053 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
7054 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7056 (vhdl-expand-paren prefix-arg)))
7058 ((> (current-column) (current-indentation))
7060 ;; toggle comment indent
7061 ((and (looking-at "--")
7062 (or (eq last-command 'vhdl-electric-tab)
7063 (eq last-command 'vhdl-electric-return)))
7064 (cond ((= (current-indentation) 0) ; no indent
7066 (indent-according-to-mode))
7067 ((< (current-indentation) comment-column) ; normal indent
7068 (indent-to comment-column)
7069 (indent-according-to-mode))
7070 (t ; inline comment indent
7073 ((and (>= (current-indentation) vhdl-basic-offset)
7074 (or (eq last-command 'vhdl-electric-tab)
7075 (eq last-command 'vhdl-electric-return)))
7076 (backward-delete-char-untabify vhdl-basic-offset nil))
7078 (t (indent-according-to-mode)))
7079 (setq this-command 'vhdl-electric-tab)))
7081 (defun vhdl-electric-return ()
7082 "newline-and-indent or indent-new-comment-line if in comment and preceding
7083 character is a space."
7085 (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
7086 (indent-new-comment-line)
7087 (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
7088 (vhdl-fix-case-word -1))
7089 (newline-and-indent)))
7091 (defun vhdl-indent-line ()
7092 "Indent the current line as VHDL code. Returns the amount of
7093 indentation change."
7095 (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
7096 (pos (- (point-max) (point)))
7099 ;; indent syntax-based
7100 (if (and (eq (caar syntax) 'comment)
7101 (>= (vhdl-get-offset (car syntax)) comment-column))
7102 ;; special case: comments at or right of comment-column
7103 (vhdl-get-offset (car syntax))
7104 (apply '+ (mapcar 'vhdl-get-offset syntax)))
7105 ;; indent like previous nonblank line
7106 (save-excursion (beginning-of-line)
7107 (re-search-backward "^[^\n]" nil t)
7108 (current-indentation))))
7109 (shift-amt (- indent (current-indentation))))
7110 (and vhdl-echo-syntactic-information-p
7111 (message "syntax: %s, indent= %d" syntax indent))
7112 (unless (zerop shift-amt)
7113 (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
7116 (if (< (point) (vhdl-point 'boi))
7117 (back-to-indentation)
7118 ;; If initial point was within line's indentation, position after
7119 ;; the indentation. Else stay at same point in text.
7120 (when (> (- (point-max) pos) (point))
7121 (goto-char (- (point-max) pos))))
7122 (run-hooks 'vhdl-special-indent-hook)
7123 (vhdl-update-progress-info "Indenting" (vhdl-current-line))
7126 (defun vhdl-indent-region (beg end column)
7127 "Indent region as VHDL code.
7128 Adds progress reporting to `indent-region'."
7129 (interactive "r\nP")
7130 (when vhdl-progress-interval
7131 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7132 (count-lines (point-min) end) 0)))
7133 (indent-region beg end column)
7134 (when vhdl-progress-interval (message "Indenting...done"))
7135 (setq vhdl-progress-info nil))
7137 (defun vhdl-indent-buffer ()
7138 "Indent whole buffer as VHDL code.
7139 Calls `indent-region' for whole buffer and adds progress reporting."
7141 (vhdl-indent-region (point-min) (point-max) nil))
7143 (defun vhdl-indent-group ()
7144 "Indent group of lines between empty lines."
7146 (let ((beg (save-excursion
7147 (if (re-search-backward vhdl-align-group-separate nil t)
7149 (point-min-marker))))
7150 (end (save-excursion
7151 (if (re-search-forward vhdl-align-group-separate nil t)
7153 (point-max-marker)))))
7154 (vhdl-indent-region beg end nil)))
7156 (defun vhdl-indent-sexp (&optional endpos)
7157 "Indent each line of the list starting just after point.
7158 If optional arg ENDPOS is given, indent each line, stopping when
7159 ENDPOS is encountered."
7163 (end (progn (vhdl-forward-sexp nil endpos) (point))))
7164 (indent-region beg end nil))))
7166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7167 ;; Miscellaneous commands
7169 (defun vhdl-show-syntactic-information ()
7170 "Show syntactic information for current line."
7172 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
7173 (vhdl-keep-region-active))
7175 ;; Verification and regression functions:
7177 (defun vhdl-regress-line (&optional arg)
7178 "Check syntactic information for current line."
7180 (let ((expected (save-excursion
7182 (when (search-backward " -- ((" (vhdl-point 'bol) t)
7184 (read (current-buffer)))))
7185 (actual (vhdl-get-syntactic-context))
7187 ;; remove the library unit symbols
7191 (if (memq (car elt) '(entity configuration package
7192 package-body architecture))
7194 (setq expurgated (append expurgated (list elt))))))
7196 (if (and (not arg) expected (listp expected))
7197 (if (not (equal expected expurgated))
7198 (error "ERROR: Should be: %s, is: %s" expected expurgated))
7201 (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
7203 (if (search-backward " -- ((" (vhdl-point 'bol) t)
7206 (insert (format "%s" expurgated))))))
7207 (vhdl-keep-region-active))
7210 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7211 ;;; Alignment, whitespace fixup, beautifying
7212 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7214 (defconst vhdl-align-alist
7216 ;; after some keywords
7217 (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]"
7218 "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2)
7220 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7221 ;; after direction specifications
7222 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7223 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7224 ;; before "==", ":=", "=>", and "<="
7225 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur
7226 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7227 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur
7228 ;; before some keywords
7229 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7230 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7231 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7232 ;; before "=>" since "when/else ... =>" can occur
7233 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7235 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7236 It is searched in order. If REGEXP is found anywhere in the first
7237 line of a region to be aligned, ALIGN-PATTERN will be used for that
7238 region. ALIGN-PATTERN must include the whitespace to be expanded or
7239 contracted. It may also provide regexps for the text surrounding the
7240 whitespace. SUBEXP specifies which sub-expression of
7241 ALIGN-PATTERN matches the white space to be expanded/contracted.")
7243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7246 (defvar vhdl-align-try-all-clauses t
7247 "If REGEXP is not found on the first line of the region that clause
7248 is ignored. If this variable is non-nil, then the clause is tried anyway.")
7250 (defun vhdl-do-group (function &optional spacing)
7251 "Apply FUNCTION on group of lines between empty lines."
7253 ;; search for group beginning
7254 ((beg (save-excursion
7255 (if (re-search-backward vhdl-align-group-separate nil t)
7256 (progn (beginning-of-line 2) (back-to-indentation) (point))
7258 ;; search for group end
7259 (end (save-excursion
7260 (if (re-search-forward vhdl-align-group-separate nil t)
7261 (progn (beginning-of-line) (point))
7264 (funcall function beg end spacing)))
7266 (defun vhdl-do-list (function &optional spacing)
7267 "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7271 ;; search for beginning of balanced group of parentheses
7272 (setq beg (vhdl-re-search-backward "[()]" nil t))
7273 (while (looking-at ")")
7274 (forward-char) (backward-sexp)
7275 (setq beg (vhdl-re-search-backward "[()]" nil t)))
7276 ;; search for end of balanced group of parentheses
7280 (goto-char (1+ beg))
7281 (skip-chars-forward " \t\n")
7282 (setq beg (point))))
7285 (funcall function beg end spacing)
7286 (error "ERROR: Not within a list enclosed by a pair of parentheses"))))
7288 (defun vhdl-do-same-indent (function &optional spacing)
7289 "Apply FUNCTION to block of lines with same indent."
7290 (let ((indent (current-indentation))
7292 ;; search for first line with same indent
7294 (while (and (not (bobp))
7295 (or (looking-at "^\\s-*\\(--.*\\)?$")
7296 (= (current-indentation) indent)))
7297 (unless (looking-at "^\\s-*$")
7298 (back-to-indentation) (setq beg (point)))
7299 (beginning-of-line -0)))
7300 ;; search for last line with same indent
7302 (while (and (not (eobp))
7303 (or (looking-at "^\\s-*\\(--.*\\)?$")
7304 (= (current-indentation) indent)))
7305 (if (looking-at "^\\s-*$")
7306 (beginning-of-line 2)
7307 (beginning-of-line 2)
7308 (setq end (point)))))
7310 (funcall function beg end spacing)))
7312 (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
7313 "Attempt to align a range of lines based on the content of the
7314 lines. The definition of `alignment-list' determines the matching
7315 order and the manner in which the lines are aligned. If ALIGNMENT-LIST
7316 is not specified `vhdl-align-alist' is used. If INDENT is non-nil,
7317 indentation is done before aligning."
7318 (interactive "r\np")
7319 (setq alignment-list (or alignment-list vhdl-align-alist))
7320 (setq spacing (or spacing 1))
7324 (setq end (point-marker))
7326 (setq bol (setq begin (progn (beginning-of-line) (point))))
7327 ; (untabify bol end)
7329 (indent-region bol end nil))))
7330 (let ((copy (copy-alist alignment-list)))
7331 (vhdl-prepare-search-2
7336 (eol (save-excursion (progn (end-of-line) (point)))))
7337 (setq element (nth 0 copy))
7338 (when (and (or (and (listp (car element))
7339 (memq major-mode (car element)))
7340 (eq major-mode (car element)))
7341 (or vhdl-align-try-all-clauses
7342 (re-search-forward (car (cdr element)) eol t)))
7343 (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7344 (car (cdr (cdr (cdr element)))) spacing))
7345 (setq copy (cdr copy))))))))
7347 (defun vhdl-align-region-2 (begin end match &optional substr spacing)
7348 "Align a range of lines from BEGIN to END. The regular expression
7349 MATCH must match exactly one fields: the whitespace to be
7350 contracted/expanded. The alignment column will equal the
7351 rightmost column of the widest whitespace block. SPACING is
7352 the amount of extra spaces to add to the calculated maximum required.
7353 SPACING defaults to 1 so that at least one space is inserted after
7354 the token in MATCH."
7355 (setq spacing (or spacing 1))
7356 (setq substr (or substr 1))
7358 (let (distance (max 0) (lines 0) bol eol width)
7359 ;; Determine the greatest whitespace distance to the alignment
7362 (setq eol (progn (end-of-line) (point))
7363 bol (setq begin (progn (beginning-of-line) (point))))
7366 (when (and (re-search-forward match eol t)
7368 (goto-char (match-beginning 0))
7369 (and (not (vhdl-in-literal))
7370 (not (vhdl-in-quote-p))))
7371 (not (looking-at "\\s-*$")))
7372 (setq distance (- (match-beginning substr) bol))
7373 (when (> distance max)
7374 (setq max distance))))
7377 eol (save-excursion (end-of-line) (point)))
7378 (setq lines (1+ lines)))
7379 ;; Now insert enough maxs to push each assignment operator to
7380 ;; the same column. We need to use 'lines' as a counter, since
7381 ;; the location of the mark may change
7382 (goto-char (setq bol begin))
7383 (setq eol (save-excursion (end-of-line) (point)))
7385 (when (and (re-search-forward match eol t)
7387 (goto-char (match-beginning 0))
7388 (and (not (vhdl-in-literal))
7389 (not (vhdl-in-quote-p))))
7390 (not (looking-at "\\s-*$"))
7391 (> (match-beginning 0) ; not if at boi
7392 (save-excursion (back-to-indentation) (point))))
7393 (setq width (- (match-end substr) (match-beginning substr)))
7394 (setq distance (- (match-beginning substr) bol))
7395 (goto-char (match-beginning substr))
7397 (insert-char ? (+ (- max distance) spacing)))
7401 eol (save-excursion (end-of-line) (point)))
7402 (setq lines (1- lines))))))
7404 (defun vhdl-align-region-groups (beg end &optional spacing
7405 no-message no-comments)
7406 "Align region, treat groups of lines separately."
7407 (interactive "r\nP")
7412 (setq orig (point-marker))
7415 (setq end (point-marker))
7418 (when vhdl-progress-interval
7419 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7420 (count-lines (point-min) end) 0))))
7421 (vhdl-fixup-whitespace-region beg end t)
7423 (if (not vhdl-align-groups)
7424 ;; align entire region
7425 (progn (vhdl-align-region-1 beg end spacing)
7427 (vhdl-align-inline-comment-region-1 beg end)))
7429 (while (and (< beg end)
7430 (re-search-forward vhdl-align-group-separate end t))
7431 (setq pos (point-marker))
7432 (vhdl-align-region-1 beg pos spacing)
7433 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7434 (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7439 (vhdl-align-region-1 beg end spacing)
7440 (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7441 (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7442 (when vhdl-indent-tabs-mode
7445 (when vhdl-progress-interval (message "Aligning...done"))
7446 (setq vhdl-progress-info nil)))))
7448 (defun vhdl-align-region (beg end &optional spacing)
7449 "Align region, treat blocks with same indent and argument lists separately."
7450 (interactive "r\nP")
7451 (if (not vhdl-align-same-indent)
7452 ;; align entire region
7453 (vhdl-align-region-groups beg end spacing)
7454 ;; align blocks with same indent and argument lists
7458 (when vhdl-progress-interval
7459 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7460 (count-lines (point-min) end) 0)))
7462 (setq end (point-marker))
7464 (while (< (point) end)
7465 ;; is argument list opening?
7466 (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7467 (point) (vhdl-point 'eol)))))
7468 ;; determine region for argument list
7469 (progn (goto-char cur-beg)
7471 (setq cur-end (point))
7472 (beginning-of-line 2))
7473 ;; determine region with same indent
7474 (setq indent (current-indentation))
7475 (setq cur-beg (point))
7476 (setq cur-end (vhdl-point 'bonl))
7477 (beginning-of-line 2)
7478 (while (and (< (point) end)
7479 (or (looking-at "^\\s-*\\(--.*\\)?$")
7480 (= (current-indentation) indent))
7482 (nth 0 (parse-partial-sexp
7483 (point) (vhdl-point 'eol)))) 0))
7484 (unless (looking-at "^\\s-*$")
7485 (setq cur-end (vhdl-point 'bonl)))
7486 (beginning-of-line 2)))
7488 (vhdl-align-region-groups cur-beg cur-end spacing t t))
7489 (vhdl-align-inline-comment-region beg end spacing noninteractive)
7490 (when vhdl-progress-interval (message "Aligning...done"))
7491 (setq vhdl-progress-info nil)))))
7493 (defun vhdl-align-group (&optional spacing)
7494 "Align group of lines between empty lines."
7496 (vhdl-do-group 'vhdl-align-region spacing))
7498 (defun vhdl-align-list (&optional spacing)
7499 "Align the lines of a list surrounded by a balanced group of parentheses."
7501 (vhdl-do-list 'vhdl-align-region-groups spacing))
7503 (defun vhdl-align-same-indent (&optional spacing)
7504 "Align block of lines with same indent."
7506 (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7508 (defun vhdl-align-declarations (&optional spacing)
7509 "Align the lines within the declarative part of a design unit."
7512 (vhdl-prepare-search-2
7514 ;; search for declarative part
7515 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
7516 (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7518 (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7519 (setq end (point)))))
7521 (vhdl-align-region-groups beg end spacing)
7522 (error "ERROR: Not within the declarative part of a design unit"))))
7524 (defun vhdl-align-buffer ()
7527 (vhdl-align-region (point-min) (point-max)))
7529 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7530 ;; Align inline comments
7532 (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7533 "Align inline comments in region."
7535 (let ((start-max comment-column)
7537 comment-list start-list tmp-list start length
7538 cur-start prev-start no-code)
7539 (setq spacing (or spacing 2))
7540 (vhdl-prepare-search-2
7542 ;; search for comment start positions and lengths
7543 (while (< (point) end)
7544 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7545 (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$")
7546 (not (save-excursion (goto-char (match-beginning 2))
7547 (vhdl-in-literal))))
7548 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7549 (setq length (- (match-end 2) (match-beginning 2)))
7550 (setq start-max (max start start-max))
7551 (setq length-max (max length length-max))
7552 (setq comment-list (cons (cons start length) comment-list)))
7553 (beginning-of-line 2))
7555 (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
7556 ;; reduce start positions
7557 (setq start-list (list (caar comment-list)))
7558 (setq comment-list (cdr comment-list))
7560 (unless (or (= (caar comment-list) (car start-list))
7561 (<= (+ (car start-list) (cdar comment-list))
7562 end-comment-column))
7563 (setq start-list (cons (caar comment-list) start-list)))
7564 (setq comment-list (cdr comment-list)))
7565 ;; align lines as nicely as possible
7567 (while (< (point) end)
7568 (setq cur-start nil)
7569 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7570 (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7571 (not (save-excursion
7572 (goto-char (match-beginning 3))
7573 (vhdl-in-literal))))
7574 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7575 (>= (- (match-end 2) (match-beginning 2))
7577 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7578 (setq length (- (match-end 3) (match-beginning 3)))
7579 (setq no-code (= (match-beginning 1) (match-end 1)))
7580 ;; insert minimum whitespace
7581 (goto-char (match-end 2))
7582 (delete-region (match-beginning 2) (match-end 2))
7583 (insert-char ?\ spacing)
7584 (setq tmp-list start-list)
7585 ;; insert additional whitespace to align
7588 ;; align comment-only line to inline comment of previous line
7589 ((and no-code prev-start
7590 (<= length (- end-comment-column prev-start)))
7592 ;; align all comments at `start-max' if this is possible
7593 ((<= (+ start-max length-max) end-comment-column)
7595 ;; align at `comment-column' if possible
7596 ((and (<= start comment-column)
7597 (<= length (- end-comment-column comment-column)))
7599 ;; align at left-most possible start position otherwise
7601 (while (and tmp-list (< (car tmp-list) start))
7602 (setq tmp-list (cdr tmp-list)))
7604 (indent-to cur-start))
7605 (setq prev-start cur-start)
7606 (beginning-of-line 2))))))
7608 (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7609 "Align inline comments within a region. Groups of code lines separated by
7610 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7611 (interactive "r\nP")
7616 (setq orig (point-marker))
7619 (setq end (point-marker))
7621 (unless no-message (message "Aligning inline comments..."))
7623 (if (not vhdl-align-groups)
7624 ;; align entire region
7625 (vhdl-align-inline-comment-region-1 beg end spacing)
7627 (while (and (< beg end)
7628 (re-search-forward vhdl-align-group-separate end t))
7629 (setq pos (point-marker))
7630 (vhdl-align-inline-comment-region-1 beg pos spacing)
7635 (vhdl-align-inline-comment-region-1 beg end spacing)))
7636 (when vhdl-indent-tabs-mode
7638 (unless no-message (message "Aligning inline comments...done")))))
7640 (defun vhdl-align-inline-comment-group (&optional spacing)
7641 "Align inline comments within a group of lines between empty lines."
7644 (let ((start (point))
7646 (setq end (if (re-search-forward vhdl-align-group-separate nil t)
7647 (point-marker) (point-max)))
7649 (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
7650 (point) (point-min)))
7652 (message "Aligning inline comments...")
7653 (vhdl-align-inline-comment-region-1 beg end)
7654 (when vhdl-indent-tabs-mode
7656 (message "Aligning inline comments...done"))))
7658 (defun vhdl-align-inline-comment-buffer ()
7659 "Align inline comments within buffer. Groups of code lines separated by
7660 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7662 (vhdl-align-inline-comment-region (point-min) (point-max)))
7664 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7667 (defun vhdl-fixup-whitespace-region (beg end &optional no-message)
7668 "Fixup whitespace in region. Surround operator symbols by one space,
7669 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7670 end of line, do nothing in comments and strings."
7672 (unless no-message (message "Fixing up whitespace..."))
7675 (setq end (point-marker))
7676 ;; have no space before and one space after `,' and ';'
7678 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
7679 (if (match-string 1)
7680 (goto-char (match-end 1))
7681 (replace-match "\\3 " nil nil nil 2)))
7682 ;; have no space after `('
7684 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\((\\)\\s-+" end t)
7685 (if (match-string 1)
7686 (goto-char (match-end 1))
7687 (replace-match "\\2")))
7688 ;; have no space before `)'
7690 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
7691 (if (match-string 1)
7692 (goto-char (match-end 1))
7693 (replace-match "\\2")))
7694 ;; surround operator symbols by one space
7696 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\([^/:<>=]\\)\\(:\\|\\??=\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>]\\|$\\)\\)" end t)
7697 (if (or (match-string 1)
7698 (<= (match-beginning 0) ; not if at boi
7699 (save-excursion (back-to-indentation) (point))))
7700 (goto-char (match-end 0))
7701 (replace-match "\\3 \\4 \\5")
7702 (goto-char (match-end 2))))
7703 ;; eliminate multiple spaces and spaces at end of line
7705 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
7706 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
7707 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
7708 (progn (replace-match "" nil nil) t))
7709 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
7710 (progn (replace-match ";" nil nil) t))
7711 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
7712 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
7713 (progn (replace-match " " nil nil) t))
7714 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
7715 (progn (replace-match " " nil nil) t))
7716 (and (looking-at "-") (re-search-forward "-" end t))
7717 ; (re-search-forward "[^ \t-]+" end t))))
7718 (re-search-forward "[^ \t\"-]+" end t))))
7719 (unless no-message (message "Fixing up whitespace...done")))
7721 (defun vhdl-fixup-whitespace-buffer ()
7722 "Fixup whitespace in buffer. Surround operator symbols by one space,
7723 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7724 end of line, do nothing in comments."
7726 (vhdl-fixup-whitespace-region (point-min) (point-max)))
7728 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7731 (defun vhdl-beautify-region (beg end)
7732 "Beautify region by applying indentation, whitespace fixup, alignment, and
7733 case fixing to a region. Calls functions `vhdl-indent-buffer',
7734 `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
7735 `vhdl-fix-case-buffer'."
7737 (setq end (save-excursion (goto-char end) (point-marker)))
7738 (vhdl-indent-region beg end nil)
7739 (let ((vhdl-align-groups t))
7740 (vhdl-align-region beg end))
7741 (vhdl-fix-case-region beg end))
7743 (defun vhdl-beautify-buffer ()
7744 "Beautify buffer by applying indentation, whitespace fixup, alignment, and
7745 case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire
7748 (vhdl-beautify-region (point-min) (point-max))
7749 (when noninteractive (save-buffer)))
7751 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7754 (defun vhdl-fill-region (beg end &optional arg)
7755 "Fill lines for a region of code."
7756 (interactive "r\np")
7759 (let ((margin (if arg (current-indentation) (current-column))))
7761 (setq end (point-marker))
7762 ;; remove inline comments, newlines and whitespace
7763 (vhdl-comment-kill-region beg end)
7764 (vhdl-comment-kill-inline-region beg end)
7765 (subst-char-in-region beg (1- end) ?\n ?\ )
7766 (vhdl-fixup-whitespace-region beg end)
7767 ;; wrap and end-comment-column
7769 (while (re-search-forward "\\s-" end t)
7770 (when(> (current-column) vhdl-end-comment-column)
7772 (when (re-search-backward "\\s-" beg t)
7773 (replace-match "\n")
7774 (indent-to margin)))))))
7776 (defun vhdl-fill-group ()
7777 "Fill group of lines between empty lines."
7779 (vhdl-do-group 'vhdl-fill-region))
7781 (defun vhdl-fill-list ()
7782 "Fill the lines of a list surrounded by a balanced group of parentheses."
7784 (vhdl-do-list 'vhdl-fill-region))
7786 (defun vhdl-fill-same-indent ()
7787 "Fill the lines of block of lines with same indent."
7789 (vhdl-do-same-indent 'vhdl-fill-region))
7792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7793 ;;; Code updating/fixing
7794 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7796 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7797 ;; Sensitivity list update
7800 ;; - no sensitivity list is generated for processes with wait statements
7801 ;; - otherwise, do the following:
7802 ;; 1. scan for all local signals (ports, signals declared in arch./blocks)
7803 ;; 2. scan for all signals already in the sensitivity list (in order to catch
7804 ;; manually entered global signals)
7805 ;; 3. signals from 1. and 2. form the list of visible signals
7806 ;; 4. search for if/elsif conditions containing an event (sequential code)
7807 ;; 5. scan for strings that are within syntactical regions where signals are
7808 ;; read but not within sequential code, and that correspond to visible
7810 ;; 6. replace sensitivity list by list of signals from 5.
7812 (defun vhdl-update-sensitivity-list-process ()
7813 "Update sensitivity list of current process."
7816 (vhdl-prepare-search-2
7818 ;; look whether in process
7819 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
7820 (equal (upcase (match-string 2)) "PROCESS")
7821 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
7822 (error "ERROR: Not within a process")
7823 (message "Updating sensitivity list...")
7824 (vhdl-update-sensitivity-list)
7825 (message "Updating sensitivity list...done")))))
7827 (defun vhdl-update-sensitivity-list-buffer ()
7828 "Update sensitivity list of all processes in current buffer."
7831 (vhdl-prepare-search-2
7832 (goto-char (point-min))
7833 (message "Updating sensitivity lists...")
7834 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t)
7835 (goto-char (match-beginning 0))
7836 (condition-case nil (vhdl-update-sensitivity-list) (error "")))
7837 (message "Updating sensitivity lists...done"))))
7839 (defun vhdl-update-sensitivity-list ()
7840 "Update sensitivity list."
7841 (let ((proc-beg (point))
7842 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
7843 (proc-mid (re-search-backward "^\\s-*begin\\>" nil t))
7846 ;; search for wait statement (no sensitivity list allowed)
7847 ((progn (goto-char proc-mid)
7848 (vhdl-re-search-forward "\\<wait\\>" proc-end t))
7849 (error "ERROR: Process with wait statement, sensitivity list not generated"))
7850 ;; combinational process (update sensitivity list)
7853 ;; scan for visible signals
7854 ((visible-list (vhdl-get-visible-signals))
7855 ;; define syntactic regions where signals are read
7857 '(;; right-hand side of signal/variable assignment
7858 ;; (special case: "<=" is relational operator in a condition)
7859 ((re-search-forward "[<:]=" proc-end t)
7860 (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
7862 ((re-search-forward "^\\s-*if\\>" proc-end t)
7863 (re-search-forward "\\<then\\>" proc-end t))
7865 ((re-search-forward "\\<elsif\\>" proc-end t)
7866 (re-search-forward "\\<then\\>" proc-end t))
7867 ;; while loop condition
7868 ((re-search-forward "^\\s-*while\\>" proc-end t)
7869 (re-search-forward "\\<loop\\>" proc-end t))
7870 ;; exit/next condition
7871 ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
7872 (re-search-forward ";" proc-end t))
7874 ((re-search-forward "\\<assert\\>" proc-end t)
7875 (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
7877 ((re-search-forward "^\\s-*case\\>" proc-end t)
7878 (re-search-forward "\\<is\\>" proc-end t))
7879 ;; parameter list of procedure call
7880 ((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
7882 (progn (backward-char) (forward-sexp)
7883 (while (looking-at "(") (forward-sexp)) (point)))))
7884 name read-list sens-list signal-list
7885 sens-beg sens-end beg end margin)
7886 ;; scan for signals in old sensitivity list
7887 (goto-char proc-beg)
7888 (re-search-forward "\\<process\\>" proc-mid t)
7889 (if (not (looking-at "[ \t\n]*("))
7890 (setq sens-beg (point))
7891 (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t))
7892 (goto-char (match-end 1))
7894 (setq sens-end (1- (point)))
7895 (goto-char sens-beg)
7896 (while (and (re-search-forward "\\(\\w+\\)" sens-end t)
7898 (cons (downcase (match-string 0)) sens-list))
7899 (re-search-forward "\\s-*,\\s-*" sens-end t))))
7900 (setq signal-list (append visible-list sens-list))
7901 ;; search for sequential parts
7902 (goto-char proc-mid)
7903 (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
7904 (setq end (re-search-forward "\\<then\\>" proc-end t))
7905 (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
7909 (setq seq-region-list (cons (cons end (point)) seq-region-list))
7910 (beginning-of-line)))
7911 ;; scan for signals read in process
7912 (while scan-regions-list
7913 (goto-char proc-mid)
7914 (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
7915 (setq end (eval (nth 1 (car scan-regions-list)))))
7917 (unless (or (vhdl-in-literal)
7918 (and seq-region-list
7919 (let ((tmp-list seq-region-list))
7920 (while (and tmp-list
7921 (< (point) (caar tmp-list)))
7922 (setq tmp-list (cdr tmp-list)))
7923 (and tmp-list (< (point) (cdar tmp-list))))))
7924 (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>[ \t\n]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
7925 (setq name (match-string 1))
7926 (when (and (not (match-string 4)) ; not when formal parameter
7927 (not (and (match-string 3) ; not event attribute
7928 (not (member (downcase (match-string 3))
7929 '("event" "last_event" "transaction")))))
7930 (member (downcase name) signal-list))
7931 (unless (member-ignore-case name read-list)
7932 (setq read-list (cons name read-list))))
7933 (goto-char (match-end 1)))))
7934 (setq scan-regions-list (cdr scan-regions-list)))
7935 ;; update sensitivity list
7936 (goto-char sens-beg)
7938 (delete-region sens-beg sens-end)
7940 (insert " ()") (backward-char)))
7941 (setq read-list (sort read-list 'string<))
7943 (setq margin (current-column))
7944 (insert (car read-list))
7945 (setq read-list (cdr read-list))
7948 (if (<= (+ (current-column) (length (car read-list)) 2)
7951 (insert "\n") (indent-to margin))
7952 (insert (car read-list))
7953 (setq read-list (cdr read-list)))))))))
7955 (defun vhdl-get-visible-signals ()
7956 "Get all signals visible in the current block."
7957 (let (beg end signal-list entity-name file-name)
7958 (vhdl-prepare-search-2
7961 (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
7962 (not (equal "END" (upcase (match-string 1))))
7963 (setq entity-name (match-string 2)))
7964 (error "ERROR: Not within an architecture")))
7965 ;; search for signals declared in entity port clause
7967 (goto-char (point-min))
7968 (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
7970 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
7971 "." (file-name-extension (buffer-file-name)))))
7974 (vhdl-prepare-search-2
7975 (goto-char (point-min))
7976 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
7977 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name)
7978 (when (setq beg (vhdl-re-search-forward
7981 (re-search-forward "^end\\>" nil t)) t))
7982 (setq end (save-excursion
7983 (backward-char) (forward-sexp) (point)))
7984 (vhdl-forward-syntactic-ws)
7985 (while (< (point) end)
7986 (when (looking-at "signal[ \t\n]+")
7987 (goto-char (match-end 0)))
7988 (while (looking-at "\\(\\w+\\)[ \t\n,]+")
7990 (cons (downcase (match-string 1)) signal-list))
7991 (goto-char (match-end 0))
7992 (vhdl-forward-syntactic-ws))
7993 (re-search-forward ";" end 1)
7994 (vhdl-forward-syntactic-ws)))))))
7995 ;; search for signals declared in architecture declarative part
7997 (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
7998 (not (equal "END" (upcase (match-string 1))))
7999 (setq end (re-search-forward "^begin\\>" nil t))))
8000 (error "ERROR: No architecture declarative part found")
8001 ;; scan for all declared signal and alias names
8003 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8004 (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8005 (if (match-string 2)
8007 (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8009 (cons (downcase (match-string 1)) signal-list))
8010 (goto-char (match-end 0)))
8011 ;; scan alias name, check is alias of (declared) signal
8012 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8013 (member (downcase (match-string 2)) signal-list))
8015 (cons (downcase (match-string 1)) signal-list))
8016 (goto-char (match-end 0))))
8017 (setq beg (point))))))
8018 ;; search for signals declared in surrounding block declarative parts
8020 (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
8022 (goto-char (match-end 2))
8023 (vhdl-backward-sexp)
8024 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
8026 (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
8027 ;; scan for all declared signal names
8029 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8030 (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8031 (if (match-string 2)
8033 (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8035 (cons (downcase (match-string 1)) signal-list))
8036 (goto-char (match-end 0)))
8037 ;; scan alias name, check is alias of (declared) signal
8038 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8039 (member (downcase (match-string 2)) signal-list))
8041 (cons (downcase (match-string 1)) signal-list))
8042 (goto-char (match-end 0))))))
8046 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8047 ;; Generic/port clause fixing
8049 (defun vhdl-fix-clause ()
8050 "Fix closing parenthesis within generic/port clause."
8053 (vhdl-prepare-search-2
8056 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t))
8057 (error "ERROR: Not within a generic/port clause")
8058 ;; search for end of clause
8059 (goto-char (match-end 0))
8060 (setq beg (1- (point)))
8061 (vhdl-forward-syntactic-ws)
8062 (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;")
8063 (goto-char (1- (match-end 0)))
8064 (setq end (point-marker))
8066 (vhdl-forward-syntactic-ws))
8068 (when (> pos (save-excursion (end-of-line) (point)))
8069 (error "ERROR: Not within a generic/port clause"))
8070 ;; delete closing parenthesis on separate line (not supported style)
8071 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
8073 (vhdl-backward-syntactic-ws)
8074 (setq end (point-marker))
8076 ;; delete superfluous parentheses
8077 (while (progn (goto-char beg)
8078 (condition-case () (forward-sexp)
8079 (error (goto-char (point-max))))
8081 (delete-backward-char 1))
8082 ;; add closing parenthesis
8083 (when (> (point) end)
8087 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8090 (defun vhdl-remove-trailing-spaces ()
8091 "Remove trailing spaces in the whole buffer."
8095 (goto-char (point-min))
8096 (while (re-search-forward "[ \t]+$" (point-max) t)
8097 (unless (vhdl-in-literal)
8098 (replace-match "" nil nil))))))
8101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8105 (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
8106 "Syntax of prompt inserted by template generators.")
8108 (defvar vhdl-template-invoked-by-hook nil
8109 "Indicates whether a template has been invoked by a hook or by key or menu.
8110 Used for undoing after template abortion.")
8112 ;; correct different behavior of function `unread-command-events' in XEmacs
8113 (defun vhdl-character-to-event (arg))
8114 (defalias 'vhdl-character-to-event
8115 (if (fboundp 'character-to-event) 'character-to-event 'identity))
8117 (defun vhdl-work-library ()
8118 "Return the working library name of the current project or \"work\" if no
8119 project is defined."
8120 (vhdl-resolve-env-variable
8121 (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
8123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8124 ;; Enabling/disabling
8126 (defun vhdl-mode-line-update ()
8127 "Update the modeline string for VHDL major mode."
8128 (setq mode-name (concat "VHDL"
8129 (and (or vhdl-electric-mode vhdl-stutter-mode) "/")
8130 (and vhdl-electric-mode "e")
8131 (and vhdl-stutter-mode "s")))
8132 (force-mode-line-update t))
8134 (defun vhdl-electric-mode (arg)
8135 "Toggle VHDL electric mode.
8136 Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
8138 (setq vhdl-electric-mode
8139 (cond ((or (not arg) (zerop arg)) (not vhdl-electric-mode))
8140 ((> arg 0) t) (t nil)))
8141 (vhdl-mode-line-update))
8143 (defun vhdl-stutter-mode (arg)
8144 "Toggle VHDL stuttering mode.
8145 Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
8147 (setq vhdl-stutter-mode
8148 (cond ((or (not arg) (zerop arg)) (not vhdl-stutter-mode))
8149 ((> arg 0) t) (t nil)))
8150 (vhdl-mode-line-update))
8152 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8155 (defun vhdl-electric-dash (count)
8156 "-- starts a comment, --- draws a horizontal line,
8157 ---- starts a display comment"
8159 (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
8161 ((and abbrev-start-location (= abbrev-start-location (point)))
8162 (setq abbrev-start-location nil)
8163 (goto-char last-abbrev-location)
8164 (beginning-of-line nil)
8165 (vhdl-comment-display))
8166 ((/= (preceding-char) ?-) ; standard dash (minus)
8167 (self-insert-command count))
8168 (t (self-insert-command count)
8169 (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment")
8170 (let ((next-input (read-char)))
8171 (if (= next-input ?-) ; triple dash
8173 (vhdl-comment-display-line)
8175 "Enter '-' for display comment, else continue coding")
8176 (let ((next-input (read-char)))
8177 (if (= next-input ?-) ; four dashes
8178 (vhdl-comment-display t)
8179 (setq unread-command-events ; pushback the char
8180 (list (vhdl-character-to-event next-input))))))
8181 (setq unread-command-events ; pushback the char
8182 (list (vhdl-character-to-event next-input)))
8183 (vhdl-comment-insert)))))
8184 (self-insert-command count)))
8186 (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
8188 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8189 (if (= (preceding-char) ?\()
8190 (progn (delete-char -1) (insert-char ?\[ 1))
8191 (insert-char ?\( 1))
8192 (self-insert-command count)))
8194 (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
8196 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8198 (if (= (preceding-char) ?\))
8199 (progn (delete-char -1) (insert-char ?\] 1))
8200 (insert-char ?\) 1))
8201 (blink-matching-open))
8202 (self-insert-command count)))
8204 (defun vhdl-electric-quote (count) "'' --> \""
8206 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8207 (if (= (preceding-char) last-input-char)
8208 (progn (delete-backward-char 1) (insert-char ?\" 1))
8209 (insert-char ?\' 1))
8210 (self-insert-command count)))
8212 (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
8214 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8215 (cond ((= (preceding-char) last-input-char)
8216 (progn (delete-char -1)
8217 (unless (eq (preceding-char) ? ) (insert " "))
8219 (setq this-command 'vhdl-electric-colon)))
8221 (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? ))
8222 (progn (delete-char -1) (insert "= ")))
8223 (t (insert-char ?\; 1)))
8224 (self-insert-command count)))
8226 (defun vhdl-electric-comma (count) "',,' --> ' <= '"
8228 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8229 (cond ((= (preceding-char) last-input-char)
8230 (progn (delete-char -1)
8231 (unless (eq (preceding-char) ? ) (insert " "))
8233 (t (insert-char ?\, 1)))
8234 (self-insert-command count)))
8236 (defun vhdl-electric-period (count) "'..' --> ' => '"
8238 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8239 (cond ((= (preceding-char) last-input-char)
8240 (progn (delete-char -1)
8241 (unless (eq (preceding-char) ? ) (insert " "))
8243 (t (insert-char ?\. 1)))
8244 (self-insert-command count)))
8246 (defun vhdl-electric-equal (count) "'==' --> ' == '"
8248 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8249 (cond ((= (preceding-char) last-input-char)
8250 (progn (delete-char -1)
8251 (unless (eq (preceding-char) ? ) (insert " "))
8253 (t (insert-char ?\= 1)))
8254 (self-insert-command count)))
8256 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8259 (defun vhdl-template-paired-parens ()
8260 "Insert a pair of round parentheses, placing point between them."
8265 (defun vhdl-template-alias ()
8266 "Insert alias declaration."
8268 (let ((start (point)))
8269 (vhdl-insert-keyword "ALIAS ")
8270 (when (vhdl-template-field "name" nil t start (point))
8272 (unless (vhdl-template-field
8273 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8275 (delete-backward-char 3))
8276 (vhdl-insert-keyword " IS ")
8277 (vhdl-template-field "name" ";")
8278 (vhdl-comment-insert-inline))))
8280 (defun vhdl-template-architecture ()
8281 "Insert architecture."
8283 (let ((margin (current-indentation))
8286 (vhdl-insert-keyword "ARCHITECTURE ")
8287 (when (setq arch-name
8288 (vhdl-template-field "name" nil t start (point)))
8289 (vhdl-insert-keyword " OF ")
8291 (vhdl-prepare-search-1
8292 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8293 (insert (match-string 1))
8294 (vhdl-template-field "entity name"))
8295 (vhdl-insert-keyword " IS\n")
8296 (vhdl-template-begin-end
8297 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8298 (memq vhdl-insert-empty-lines '(unit all))))))
8300 (defun vhdl-template-array (kind &optional secondary)
8301 "Insert array type definition."
8303 (let ((start (point)))
8304 (vhdl-insert-keyword "ARRAY (")
8305 (when (or (vhdl-template-field "range" nil (not secondary) start (point))
8307 (vhdl-insert-keyword ") OF ")
8308 (vhdl-template-field (if (eq kind 'type) "type" "nature"))
8309 (vhdl-insert-keyword ";"))))
8311 (defun vhdl-template-assert ()
8312 "Insert an assertion statement."
8314 (let ((start (point)))
8315 (vhdl-insert-keyword "ASSERT ")
8316 (when vhdl-conditions-in-parenthesis (insert "("))
8317 (when (vhdl-template-field "condition (negated)" nil t start (point))
8318 (when vhdl-conditions-in-parenthesis (insert ")"))
8319 (setq start (point))
8320 (vhdl-insert-keyword " REPORT ")
8321 (unless (vhdl-template-field "string expression" nil nil nil nil t)
8322 (delete-region start (point)))
8323 (setq start (point))
8324 (vhdl-insert-keyword " SEVERITY ")
8325 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
8326 (delete-region start (point)))
8329 (defun vhdl-template-attribute ()
8330 "Insert an attribute declaration or specification."
8332 (if (eq (vhdl-decision-query
8333 "attribute" "(d)eclaration or (s)pecification?" t) ?s)
8334 (vhdl-template-attribute-spec)
8335 (vhdl-template-attribute-decl)))
8337 (defun vhdl-template-attribute-decl ()
8338 "Insert an attribute declaration."
8340 (let ((start (point)))
8341 (vhdl-insert-keyword "ATTRIBUTE ")
8342 (when (vhdl-template-field "name" " : " t start (point))
8343 (vhdl-template-field "type" ";")
8344 (vhdl-comment-insert-inline))))
8346 (defun vhdl-template-attribute-spec ()
8347 "Insert an attribute specification."
8349 (let ((start (point)))
8350 (vhdl-insert-keyword "ATTRIBUTE ")
8351 (when (vhdl-template-field "name" nil t start (point))
8352 (vhdl-insert-keyword " OF ")
8353 (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8354 (vhdl-template-field "entity class")
8355 (vhdl-insert-keyword " IS ")
8356 (vhdl-template-field "expression" ";"))))
8358 (defun vhdl-template-block ()
8361 (let ((margin (current-indentation))
8364 (vhdl-insert-keyword ": BLOCK ")
8366 (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
8370 (if (vhdl-template-field "[guard expression]" nil t)
8373 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8375 (vhdl-template-begin-end "BLOCK" label margin)
8376 (vhdl-comment-block))))
8378 (defun vhdl-template-block-configuration ()
8379 "Insert a block configuration statement."
8381 (let ((margin (current-indentation))
8383 (vhdl-insert-keyword "FOR ")
8384 (when (vhdl-template-field "block name" nil t start (point))
8385 (vhdl-insert-keyword "\n\n")
8387 (vhdl-insert-keyword "END FOR;")
8389 (indent-to (+ margin vhdl-basic-offset)))))
8391 (defun vhdl-template-break ()
8392 "Insert a break statement."
8395 (vhdl-insert-keyword "BREAK")
8396 (setq position (point))
8399 (progn (vhdl-insert-keyword "FOR ")
8400 (if (vhdl-template-field "[quantity name]" " USE " t)
8401 (progn (vhdl-template-field "quantity name" " => ") t)
8402 (kill-word -1) nil))
8403 (vhdl-template-field "[quantity name]" " => " t))
8404 (vhdl-template-field "expression")
8405 (setq position (point))
8407 (delete-region position (point))
8408 (unless (vhdl-sequential-statement-p)
8409 (vhdl-insert-keyword " ON ")
8410 (if (vhdl-template-field "[sensitivity list]" nil t)
8411 (setq position (point))
8412 (delete-region position (point))))
8413 (vhdl-insert-keyword " WHEN ")
8414 (when vhdl-conditions-in-parenthesis (insert "("))
8415 (if (vhdl-template-field "[condition]" nil t)
8416 (when vhdl-conditions-in-parenthesis (insert ")"))
8417 (delete-region position (point)))
8420 (defun vhdl-template-case (&optional kind)
8421 "Insert a case statement."
8423 (let ((margin (current-indentation))
8426 (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
8427 (not (vhdl-standard-p 'ams))) 'is 'use)))
8428 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8429 (vhdl-insert-keyword "CASE ")
8430 (vhdl-insert-keyword ": CASE ")
8432 (setq label (vhdl-template-field "[label]" nil t))
8433 (unless label (delete-char 2))
8436 (when (vhdl-template-field "expression" nil t start (point))
8437 (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
8439 (vhdl-insert-keyword "END CASE")
8440 (when label (insert " " label))
8443 (indent-to (+ margin vhdl-basic-offset))
8444 (vhdl-insert-keyword "WHEN ")
8445 (let ((position (point)))
8447 (indent-to (+ margin vhdl-basic-offset))
8448 (vhdl-insert-keyword "WHEN OTHERS => null;")
8449 (goto-char position)))))
8451 (defun vhdl-template-case-is ()
8452 "Insert a sequential case statement."
8454 (vhdl-template-case 'is))
8456 (defun vhdl-template-case-use ()
8457 "Insert a simultaneous case statement."
8459 (vhdl-template-case 'use))
8461 (defun vhdl-template-component ()
8462 "Insert a component declaration."
8464 (vhdl-template-component-decl))
8466 (defun vhdl-template-component-conf ()
8467 "Insert a component configuration (uses `vhdl-template-configuration-spec'
8468 since these are almost equivalent)."
8470 (let ((margin (current-indentation))
8471 (result (vhdl-template-configuration-spec t)))
8475 (vhdl-insert-keyword "END FOR;")
8476 (when (eq result 'no-use)
8477 (end-of-line -0)))))
8479 (defun vhdl-template-component-decl ()
8480 "Insert a component declaration."
8482 (let ((margin (current-indentation))
8485 (vhdl-insert-keyword "COMPONENT ")
8486 (when (setq name (vhdl-template-field "name" nil t start (point)))
8487 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8490 (vhdl-insert-keyword "END COMPONENT")
8491 (unless (vhdl-standard-p '87) (insert " " name))
8493 (setq end-column (current-column))
8495 (indent-to (+ margin vhdl-basic-offset))
8496 (vhdl-template-generic-list t t)
8498 (indent-to (+ margin vhdl-basic-offset))
8499 (vhdl-template-port-list t)
8500 (beginning-of-line 2)
8501 (forward-char end-column))))
8503 (defun vhdl-template-component-inst ()
8504 "Insert a component instantiation statement."
8506 (let ((margin (current-indentation))
8509 (when (vhdl-template-field "instance label" nil t start (point))
8511 (if (not (vhdl-use-direct-instantiation))
8512 (vhdl-template-field "component name")
8513 ;; direct instantiation
8514 (setq unit (vhdl-template-field
8515 "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
8516 (setq unit (upcase (or unit "")))
8517 (cond ((equal unit "ENTITY")
8518 (vhdl-template-field "library name" "." nil nil nil nil
8519 (vhdl-work-library))
8520 (vhdl-template-field "entity name" "(")
8521 (if (vhdl-template-field "[architecture name]" nil t)
8524 ((equal unit "CONFIGURATION")
8525 (vhdl-template-field "library name" "." nil nil nil nil
8526 (vhdl-work-library))
8527 (vhdl-template-field "configuration name"))
8528 (t (vhdl-template-field "component name"))))
8530 (indent-to (+ margin vhdl-basic-offset))
8531 (setq position (point))
8532 (vhdl-insert-keyword "GENERIC ")
8533 (when (vhdl-template-map position t t)
8535 (indent-to (+ margin vhdl-basic-offset)))
8536 (setq position (point))
8537 (vhdl-insert-keyword "PORT ")
8538 (unless (vhdl-template-map position t t)
8543 (defun vhdl-template-conditional-signal-asst ()
8544 "Insert a conditional signal assignment."
8546 (when (vhdl-template-field "target signal")
8548 ; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
8550 (let ((margin (current-column))
8553 (vhdl-template-field "waveform")
8554 (setq position (point))
8555 (vhdl-insert-keyword " WHEN ")
8556 (when vhdl-conditions-in-parenthesis (insert "("))
8557 (while (and (vhdl-template-field "[condition]" nil t)
8559 (when vhdl-conditions-in-parenthesis (insert ")"))
8560 (setq position (point))
8561 (vhdl-insert-keyword " ELSE")
8564 (vhdl-template-field "[waveform]" nil t)))
8565 (setq position (point))
8566 (vhdl-insert-keyword " WHEN ")
8567 (when vhdl-conditions-in-parenthesis (insert "(")))
8568 (delete-region position (point))
8570 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
8572 (defun vhdl-template-configuration ()
8573 "Insert a configuration specification if within an architecture,
8574 a block or component configuration if within a configuration declaration,
8575 a configuration declaration if not within a design unit."
8577 (vhdl-prepare-search-1
8579 ((and (save-excursion ; architecture body
8580 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
8581 (equal "ARCHITECTURE" (upcase (match-string 1))))
8582 (vhdl-template-configuration-spec))
8583 ((and (save-excursion ; configuration declaration
8584 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8585 (equal "CONFIGURATION" (upcase (match-string 1))))
8586 (if (eq (vhdl-decision-query
8587 "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
8588 (vhdl-template-component-conf)
8589 (vhdl-template-block-configuration)))
8590 (t (vhdl-template-configuration-decl))))) ; otherwise
8592 (defun vhdl-template-configuration-spec (&optional optional-use)
8593 "Insert a configuration specification."
8595 (let ((margin (current-indentation))
8598 (vhdl-insert-keyword "FOR ")
8599 (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
8601 (vhdl-template-field "component name" "\n")
8602 (indent-to (+ margin vhdl-basic-offset))
8603 (setq start (point))
8604 (vhdl-insert-keyword "USE ")
8605 (if (and optional-use
8606 (not (setq aspect (vhdl-template-field
8607 "[ENTITY | CONFIGURATION | OPEN]" " " t))))
8608 (progn (delete-region start (point)) 'no-use)
8609 (unless optional-use
8610 (setq aspect (vhdl-template-field
8611 "ENTITY | CONFIGURATION | OPEN" " ")))
8612 (setq aspect (upcase (or aspect "")))
8613 (cond ((equal aspect "ENTITY")
8614 (vhdl-template-field "library name" "." nil nil nil nil
8615 (vhdl-work-library))
8616 (vhdl-template-field "entity name" "(")
8617 (if (vhdl-template-field "[architecture name]" nil t)
8621 (indent-to (+ margin (* 2 vhdl-basic-offset)))
8622 (setq position (point))
8623 (vhdl-insert-keyword "GENERIC ")
8624 (when (vhdl-template-map position t t)
8626 (indent-to (+ margin (* 2 vhdl-basic-offset))))
8627 (setq position (point))
8628 (vhdl-insert-keyword "PORT ")
8629 (unless (vhdl-template-map position t t)
8634 ((equal aspect "CONFIGURATION")
8635 (vhdl-template-field "library name" "." nil nil nil nil
8636 (vhdl-work-library))
8637 (vhdl-template-field "configuration name" ";"))
8638 (t (delete-backward-char 1) (insert ";") t))))))
8641 (defun vhdl-template-configuration-decl ()
8642 "Insert a configuration declaration."
8644 (let ((margin (current-indentation))
8646 entity-exists string name position)
8647 (vhdl-insert-keyword "CONFIGURATION ")
8648 (when (setq name (vhdl-template-field "name" nil t start (point)))
8649 (vhdl-insert-keyword " OF ")
8651 (vhdl-prepare-search-1
8652 (setq entity-exists (vhdl-re-search-backward
8653 "\\<entity \\(\\w*\\) is\\>" nil t))
8654 (setq string (match-string 1))))
8655 (if (and entity-exists (not (equal string "")))
8657 (vhdl-template-field "entity name"))
8658 (vhdl-insert-keyword " IS\n")
8659 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8660 (indent-to (+ margin vhdl-basic-offset))
8661 (setq position (point))
8663 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8665 (vhdl-insert-keyword "END ")
8666 (unless (vhdl-standard-p '87)
8667 (vhdl-insert-keyword "CONFIGURATION "))
8669 (goto-char position))))
8671 (defun vhdl-template-constant ()
8672 "Insert a constant declaration."
8674 (let ((start (point))
8675 (in-arglist (vhdl-in-argument-list-p)))
8676 (vhdl-insert-keyword "CONSTANT ")
8677 (when (vhdl-template-field "name" nil t start (point))
8679 (when in-arglist (vhdl-insert-keyword "IN "))
8680 (vhdl-template-field "type")
8683 (vhdl-comment-insert-inline))
8684 (let ((position (point)))
8686 (unless (vhdl-template-field "[initialization]" nil t)
8687 (delete-region position (point)))
8689 (vhdl-comment-insert-inline))))))
8691 (defun vhdl-template-default ()
8700 (defun vhdl-template-default-indent ()
8701 "Insert nothing and indent."
8708 (indent-according-to-mode))
8710 (defun vhdl-template-disconnect ()
8711 "Insert a disconnect statement."
8713 (let ((start (point)))
8714 (vhdl-insert-keyword "DISCONNECT ")
8715 (when (vhdl-template-field "signal names | OTHERS | ALL"
8716 " : " t start (point))
8717 (vhdl-template-field "type")
8718 (vhdl-insert-keyword " AFTER ")
8719 (vhdl-template-field "time expression" ";"))))
8721 (defun vhdl-template-else ()
8722 "Insert an else statement."
8725 (vhdl-prepare-search-1
8726 (vhdl-insert-keyword "ELSE")
8727 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
8728 (equal "WHEN" (upcase (match-string 1))))
8730 (indent-according-to-mode)
8731 (setq margin (current-indentation))
8733 (indent-to (+ margin vhdl-basic-offset))))))
8735 (defun vhdl-template-elsif ()
8736 "Insert an elsif statement."
8738 (let ((start (point))
8740 (vhdl-insert-keyword "ELSIF ")
8741 (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
8742 (when vhdl-conditions-in-parenthesis (insert "("))
8743 (when (vhdl-template-field "condition" nil t start (point))
8744 (when vhdl-conditions-in-parenthesis (insert ")"))
8745 (indent-according-to-mode)
8746 (setq margin (current-indentation))
8747 (vhdl-insert-keyword
8748 (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
8749 (indent-to (+ margin vhdl-basic-offset))))))
8751 (defun vhdl-template-entity ()
8754 (let ((margin (current-indentation))
8757 (vhdl-insert-keyword "ENTITY ")
8758 (when (setq name (vhdl-template-field "name" nil t start (point)))
8759 (vhdl-insert-keyword " IS\n\n")
8761 (vhdl-insert-keyword "END ")
8762 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
8764 (setq end-column (current-column))
8766 (indent-to (+ margin vhdl-basic-offset))
8767 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8768 (indent-to (+ margin vhdl-basic-offset))
8769 (when (vhdl-template-generic-list t)
8770 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
8772 (indent-to (+ margin vhdl-basic-offset))
8773 (when (vhdl-template-port-list t)
8774 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
8775 (beginning-of-line 2)
8776 (forward-char end-column))))
8778 (defun vhdl-template-exit ()
8779 "Insert an exit statement."
8781 (let ((start (point)))
8782 (vhdl-insert-keyword "EXIT ")
8783 (if (vhdl-template-field "[loop label]" nil t start (point))
8784 (let ((position (point)))
8785 (vhdl-insert-keyword " WHEN ")
8786 (when vhdl-conditions-in-parenthesis (insert "("))
8787 (if (vhdl-template-field "[condition]" nil t)
8788 (when vhdl-conditions-in-parenthesis (insert ")"))
8789 (delete-region position (point))))
8793 (defun vhdl-template-file ()
8794 "Insert a file declaration."
8796 (let ((start (point)))
8797 (vhdl-insert-keyword "FILE ")
8798 (when (vhdl-template-field "name" nil t start (point))
8800 (vhdl-template-field "type")
8801 (unless (vhdl-standard-p '87)
8802 (vhdl-insert-keyword " OPEN ")
8803 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
8805 (delete-backward-char 6)))
8806 (vhdl-insert-keyword " IS ")
8807 (when (vhdl-standard-p '87)
8808 (vhdl-template-field "[IN | OUT]" " " t))
8809 (vhdl-template-field "filename-string" nil nil nil nil t)
8811 (vhdl-comment-insert-inline))))
8813 (defun vhdl-template-for ()
8814 "Insert a block or component configuration if within a configuration
8815 declaration, a configuration specification if within an architecture
8816 declarative part (and not within a subprogram), a for-loop if within a
8817 sequential statement part (subprogram or process), and a for-generate
8820 (vhdl-prepare-search-1
8822 ((vhdl-sequential-statement-p) ; sequential statement
8823 (vhdl-template-for-loop))
8824 ((and (save-excursion ; configuration declaration
8825 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8826 (equal "CONFIGURATION" (upcase (match-string 1))))
8827 (if (eq (vhdl-decision-query
8828 "for" "(b)lock or (c)omponent configuration?" t) ?c)
8829 (vhdl-template-component-conf)
8830 (vhdl-template-block-configuration)))
8831 ((and (save-excursion
8832 (re-search-backward ; architecture declarative part
8833 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
8834 (equal "ARCHITECTURE" (upcase (match-string 1))))
8835 (vhdl-template-configuration-spec))
8836 (t (vhdl-template-for-generate))))) ; concurrent statement
8838 (defun vhdl-template-for-generate ()
8839 "Insert a for-generate."
8841 (let ((margin (current-indentation))
8844 (vhdl-insert-keyword ": FOR ")
8845 (setq position (point-marker))
8847 (when (setq label (vhdl-template-field "label" nil t start position))
8848 (goto-char position)
8849 (vhdl-template-field "loop variable")
8850 (vhdl-insert-keyword " IN ")
8851 (vhdl-template-field "range")
8852 (vhdl-template-generate-body margin label))))
8854 (defun vhdl-template-for-loop ()
8855 "Insert a for loop."
8857 (let ((margin (current-indentation))
8860 (if (not (eq vhdl-optional-labels 'all))
8861 (vhdl-insert-keyword "FOR ")
8862 (vhdl-insert-keyword ": FOR ")
8864 (setq label (vhdl-template-field "[label]" nil t))
8865 (unless label (delete-char 2))
8868 (when (setq index (vhdl-template-field "loop variable"
8869 nil t start (point)))
8870 (vhdl-insert-keyword " IN ")
8871 (vhdl-template-field "range")
8872 (vhdl-insert-keyword " LOOP\n\n")
8874 (vhdl-insert-keyword "END LOOP")
8876 (insert " " label ";")
8878 (when vhdl-self-insert-comments (insert " -- " index)))
8880 (indent-to (+ margin vhdl-basic-offset)))))
8882 (defun vhdl-template-function (&optional kind)
8883 "Insert a function declaration or body."
8885 (let ((margin (current-indentation))
8888 (vhdl-insert-keyword "FUNCTION ")
8889 (when (setq name (vhdl-template-field "name" nil t start (point)))
8890 (vhdl-template-argument-list t)
8891 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
8894 (indent-to (+ margin vhdl-basic-offset))
8895 (vhdl-insert-keyword "RETURN ")
8896 (vhdl-template-field "type")
8897 (if (if kind (eq kind 'body)
8898 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
8899 (progn (vhdl-insert-keyword " IS\n")
8900 (vhdl-template-begin-end
8901 (unless (vhdl-standard-p '87) "FUNCTION") name margin)
8902 (vhdl-comment-block))
8905 (defun vhdl-template-function-decl ()
8906 "Insert a function declaration."
8908 (vhdl-template-function 'decl))
8910 (defun vhdl-template-function-body ()
8911 "Insert a function declaration."
8913 (vhdl-template-function 'body))
8915 (defun vhdl-template-generate ()
8916 "Insert a generation scheme."
8918 (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i)
8919 (vhdl-template-if-generate)
8920 (vhdl-template-for-generate)))
8922 (defun vhdl-template-generic ()
8923 "Insert generic declaration, or generic map in instantiation statements."
8925 (let ((start (point)))
8926 (vhdl-prepare-search-1
8928 ((and (save-excursion ; entity declaration
8929 (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
8930 (equal "ENTITY" (upcase (match-string 1))))
8931 (vhdl-template-generic-list nil))
8932 ((or (save-excursion
8933 (or (beginning-of-line)
8934 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
8935 (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
8936 (vhdl-insert-keyword "GENERIC ")
8937 (vhdl-template-map start))
8938 (t (vhdl-template-generic-list nil t))))))
8940 (defun vhdl-template-group ()
8941 "Insert group or group template declaration."
8943 (let ((start (point)))
8944 (if (eq (vhdl-decision-query
8945 "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
8946 (vhdl-template-group-template)
8947 (vhdl-template-group-decl))))
8949 (defun vhdl-template-group-decl ()
8950 "Insert group declaration."
8952 (let ((start (point)))
8953 (vhdl-insert-keyword "GROUP ")
8954 (when (vhdl-template-field "name" " : " t start (point))
8955 (vhdl-template-field "template name" " (")
8956 (vhdl-template-field "constituent list" ");")
8957 (vhdl-comment-insert-inline))))
8959 (defun vhdl-template-group-template ()
8960 "Insert group template declaration."
8962 (let ((start (point)))
8963 (vhdl-insert-keyword "GROUP ")
8964 (when (vhdl-template-field "template name" nil t start (point))
8965 (vhdl-insert-keyword " IS (")
8966 (vhdl-template-field "entity class list" ");")
8967 (vhdl-comment-insert-inline))))
8969 (defun vhdl-template-if ()
8970 "Insert a sequential if statement or an if-generate statement."
8972 (if (vhdl-sequential-statement-p)
8973 (vhdl-template-if-then)
8974 (if (and (vhdl-standard-p 'ams)
8975 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u))
8976 (vhdl-template-if-use)
8977 (vhdl-template-if-generate))))
8979 (defun vhdl-template-if-generate ()
8980 "Insert an if-generate."
8982 (let ((margin (current-indentation))
8985 (vhdl-insert-keyword ": IF ")
8986 (setq position (point-marker))
8988 (when (setq label (vhdl-template-field "label" nil t start position))
8989 (goto-char position)
8990 (when vhdl-conditions-in-parenthesis (insert "("))
8991 (vhdl-template-field "condition")
8992 (when vhdl-conditions-in-parenthesis (insert ")"))
8993 (vhdl-template-generate-body margin label))))
8995 (defun vhdl-template-if-then-use (kind)
8996 "Insert a sequential if statement."
8998 (let ((margin (current-indentation))
9001 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
9002 (vhdl-insert-keyword "IF ")
9003 (vhdl-insert-keyword ": IF ")
9005 (setq label (vhdl-template-field "[label]" nil t))
9006 (unless label (delete-char 2))
9009 (when vhdl-conditions-in-parenthesis (insert "("))
9010 (when (vhdl-template-field "condition" nil t start (point))
9011 (when vhdl-conditions-in-parenthesis (insert ")"))
9012 (vhdl-insert-keyword
9013 (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
9015 (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
9016 (when label (insert " " label))
9019 (indent-to (+ margin vhdl-basic-offset)))))
9021 (defun vhdl-template-if-then ()
9022 "Insert a sequential if statement."
9024 (vhdl-template-if-then-use 'then))
9026 (defun vhdl-template-if-use ()
9027 "Insert a simultaneous if statement."
9029 (vhdl-template-if-then-use 'use))
9031 (defun vhdl-template-instance ()
9032 "Insert a component instantiation statement."
9034 (vhdl-template-component-inst))
9036 (defun vhdl-template-library ()
9037 "Insert a library specification."
9039 (let ((margin (current-indentation))
9042 (vhdl-insert-keyword "LIBRARY ")
9043 (when (setq name (vhdl-template-field "names" nil t start (point)))
9045 (unless (string-match "," name)
9046 (setq end-pos (point))
9049 (vhdl-insert-keyword "USE ")
9051 (vhdl-insert-keyword "..ALL;")
9053 (if (vhdl-template-field "package name")
9055 (delete-region end-pos (+ (point) 5)))))))
9057 (defun vhdl-template-limit ()
9060 (let ((start (point)))
9061 (vhdl-insert-keyword "LIMIT ")
9062 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
9064 (vhdl-template-field "type")
9065 (vhdl-insert-keyword " WITH ")
9066 (vhdl-template-field "real expression" ";"))))
9068 (defun vhdl-template-loop ()
9071 (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t)))
9073 (vhdl-template-while-loop))
9075 (vhdl-template-for-loop))
9076 (t (vhdl-template-bare-loop)))))
9078 (defun vhdl-template-bare-loop ()
9081 (let ((margin (current-indentation))
9084 (if (not (eq vhdl-optional-labels 'all))
9085 (vhdl-insert-keyword "LOOP ")
9086 (vhdl-insert-keyword ": LOOP ")
9088 (setq label (vhdl-template-field "[label]" nil t))
9089 (unless label (delete-char 2))
9094 (vhdl-insert-keyword "END LOOP")
9095 (insert (if label (concat " " label ";") ";"))
9097 (indent-to (+ margin vhdl-basic-offset))))
9099 (defun vhdl-template-map (&optional start optional secondary)
9100 "Insert a map specification with association list."
9102 (let ((start (or start (point)))
9104 (vhdl-insert-keyword "MAP (")
9105 (if (not vhdl-association-list-with-formals)
9106 (if (vhdl-template-field
9107 (concat (and optional "[") "association list" (and optional "]"))
9108 ")" (or (not secondary) optional)
9109 (and (not secondary) start) (point))
9111 (if (and optional secondary) (delete-region start (point)))
9113 (if vhdl-argument-list-indent
9114 (setq margin (current-column))
9115 (setq margin (+ (current-indentation) vhdl-basic-offset))
9118 (if (vhdl-template-field
9119 (concat (and optional "[") "formal" (and optional "]"))
9120 " => " (or (not secondary) optional)
9121 (and (not secondary) start) (point))
9123 (vhdl-template-field "actual" ",")
9124 (setq end-pos (point))
9127 (while (vhdl-template-field "[formal]" " => " t)
9128 (vhdl-template-field "actual" ",")
9129 (setq end-pos (point))
9132 (delete-region end-pos (point))
9133 (delete-backward-char 1)
9135 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9137 (when (and optional secondary) (delete-region start (point)))
9140 (defun vhdl-template-modify (&optional noerror)
9141 "Actualize modification date."
9143 (vhdl-prepare-search-2
9145 (goto-char (point-min))
9146 (if (re-search-forward vhdl-modify-date-prefix-string nil t)
9147 (progn (delete-region (point) (progn (end-of-line) (point)))
9148 (vhdl-template-insert-date))
9150 (error (concat "ERROR: Modification date prefix string \""
9151 vhdl-modify-date-prefix-string "\" not found")))))))
9153 (defun vhdl-template-modify-noerror ()
9154 "Call `vhdl-template-modify' with NOERROR non-nil."
9155 (vhdl-template-modify t))
9157 (defun vhdl-template-nature ()
9158 "Insert a nature declaration."
9160 (let ((start (point))
9161 name mid-pos end-pos)
9162 (vhdl-insert-keyword "NATURE ")
9163 (when (setq name (vhdl-template-field "name" nil t start (point)))
9164 (vhdl-insert-keyword " IS ")
9167 (or (vhdl-template-field
9168 "across type | ARRAY | RECORD")
9170 (cond ((equal definition "")
9172 ((equal definition "ARRAY")
9174 (vhdl-template-array 'nature t))
9175 ((equal definition "RECORD")
9176 (setq mid-pos (point-marker))
9178 (vhdl-template-record 'nature name t))
9180 (vhdl-insert-keyword " ACROSS ")
9181 (vhdl-template-field "through type")
9182 (vhdl-insert-keyword " THROUGH ")
9183 (vhdl-template-field "reference name")
9184 (vhdl-insert-keyword " REFERENCE;")))
9186 (setq end-pos (point-marker))
9189 (vhdl-comment-insert-inline)
9190 (when end-pos (goto-char end-pos))))))
9192 (defun vhdl-template-next ()
9193 "Insert a next statement."
9195 (let ((start (point)))
9196 (vhdl-insert-keyword "NEXT ")
9197 (if (vhdl-template-field "[loop label]" nil t start (point))
9198 (let ((position (point)))
9199 (vhdl-insert-keyword " WHEN ")
9200 (when vhdl-conditions-in-parenthesis (insert "("))
9201 (if (vhdl-template-field "[condition]" nil t)
9202 (when vhdl-conditions-in-parenthesis (insert ")"))
9203 (delete-region position (point))))
9207 (defun vhdl-template-others ()
9208 "Insert an others aggregate."
9210 (let ((start (point)))
9211 (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
9212 (progn (unless vhdl-template-invoked-by-hook (insert "("))
9213 (vhdl-insert-keyword "OTHERS => '")
9214 (when (vhdl-template-field "value" nil t start (point))
9216 (vhdl-insert-keyword "OTHERS "))))
9218 (defun vhdl-template-package (&optional kind)
9219 "Insert a package specification or body."
9221 (let ((margin (current-indentation))
9224 (vhdl-insert-keyword "PACKAGE ")
9225 (setq body (if kind (eq kind 'body)
9226 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
9228 (vhdl-insert-keyword "BODY ")
9229 (when (save-excursion
9230 (vhdl-prepare-search-1
9231 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
9232 (insert (setq name (match-string 1)))))
9234 (setq name (vhdl-template-field "name" nil t start (point))))
9235 (vhdl-insert-keyword " IS\n")
9236 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9237 (indent-to (+ margin vhdl-basic-offset))
9238 (setq position (point))
9240 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9242 (vhdl-insert-keyword "END ")
9243 (unless (vhdl-standard-p '87)
9244 (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY "))))
9245 (insert (or name "") ";")
9246 (goto-char position))))
9248 (defun vhdl-template-package-decl ()
9249 "Insert a package specification."
9251 (vhdl-template-package 'decl))
9253 (defun vhdl-template-package-body ()
9254 "Insert a package body."
9256 (vhdl-template-package 'body))
9258 (defun vhdl-template-port ()
9259 "Insert a port declaration, or port map in instantiation statements."
9261 (let ((start (point)))
9262 (vhdl-prepare-search-1
9264 ((and (save-excursion ; entity declaration
9265 (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9266 (equal "ENTITY" (upcase (match-string 1))))
9267 (vhdl-template-port-list nil))
9268 ((or (save-excursion
9269 (or (beginning-of-line)
9270 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9271 (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9272 (vhdl-insert-keyword "PORT ")
9273 (vhdl-template-map start))
9274 (t (vhdl-template-port-list nil))))))
9276 (defun vhdl-template-procedural ()
9277 "Insert a procedural."
9279 (let ((margin (current-indentation))
9281 (case-fold-search t)
9283 (vhdl-insert-keyword "PROCEDURAL ")
9284 (when (memq vhdl-optional-labels '(process all))
9288 (setq label (vhdl-template-field "[label]" nil t))
9289 (unless label (delete-char 2))
9292 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9294 (vhdl-template-begin-end "PROCEDURAL" label margin)
9295 (vhdl-comment-block)))
9297 (defun vhdl-template-procedure (&optional kind)
9298 "Insert a procedure declaration or body."
9300 (let ((margin (current-indentation))
9303 (vhdl-insert-keyword "PROCEDURE ")
9304 (when (setq name (vhdl-template-field "name" nil t start (point)))
9305 (vhdl-template-argument-list)
9306 (if (if kind (eq kind 'body)
9307 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9308 (progn (vhdl-insert-keyword " IS")
9309 (when vhdl-auto-align
9310 (vhdl-align-region-groups start (point) 1))
9311 (end-of-line) (insert "\n")
9312 (vhdl-template-begin-end
9313 (unless (vhdl-standard-p '87) "PROCEDURE")
9315 (vhdl-comment-block))
9317 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9320 (defun vhdl-template-procedure-decl ()
9321 "Insert a procedure declaration."
9323 (vhdl-template-procedure 'decl))
9325 (defun vhdl-template-procedure-body ()
9326 "Insert a procedure body."
9328 (vhdl-template-procedure 'body))
9330 (defun vhdl-template-process (&optional kind)
9333 (let ((margin (current-indentation))
9335 label seq input-signals clock reset final-pos)
9336 (setq seq (if kind (eq kind 'seq)
9337 (eq (vhdl-decision-query
9338 "process" "(c)ombinational or (s)equential?" t) ?s)))
9339 (vhdl-insert-keyword "PROCESS ")
9340 (when (memq vhdl-optional-labels '(process all))
9344 (setq label (vhdl-template-field "[label]" nil t))
9345 (unless label (delete-char 2))
9350 (unless (setq input-signals
9351 (vhdl-template-field "[sensitivity list]" ")" t))
9352 (setq input-signals "")
9354 (setq clock (or (and (not (equal "" vhdl-clock-name))
9355 (progn (insert vhdl-clock-name) vhdl-clock-name))
9356 (vhdl-template-field "clock name") "<clock>"))
9357 (when (eq vhdl-reset-kind 'async)
9359 (setq reset (or (and (not (equal "" vhdl-reset-name))
9360 (progn (insert vhdl-reset-name) vhdl-reset-name))
9361 (vhdl-template-field "reset name") "<reset>")))
9363 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9365 (vhdl-template-begin-end "PROCESS" label margin)
9366 (when seq (setq reset (vhdl-template-seq-process clock reset)))
9367 (when vhdl-prompt-for-comments
9368 (setq final-pos (point-marker))
9369 (vhdl-prepare-search-2
9370 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9371 (vhdl-re-search-backward "\\<process\\>" nil t))
9374 (progn (insert "\n") (forward-line -1))
9377 (insert "-- purpose: ")
9378 (if (not (vhdl-template-field "[description]" nil t))
9379 (vhdl-line-kill-entire)
9382 (insert "-- type : ")
9383 (insert (if seq "sequential" "combinational") "\n")
9385 (insert "-- inputs : ")
9387 (insert input-signals)
9389 (when reset (insert reset ", "))
9390 (unless (vhdl-template-field "[signal names]" nil t)
9394 (insert "-- outputs: ")
9395 (vhdl-template-field "[signal names]" nil t))))
9396 (goto-char final-pos))))
9398 (defun vhdl-template-process-comb ()
9399 "Insert a combinational process."
9401 (vhdl-template-process 'comb))
9403 (defun vhdl-template-process-seq ()
9404 "Insert a sequential process."
9406 (vhdl-template-process 'seq))
9408 (defun vhdl-template-quantity ()
9409 "Insert a quantity declaration."
9411 (if (vhdl-in-argument-list-p)
9412 (let ((start (point)))
9413 (vhdl-insert-keyword "QUANTITY ")
9414 (when (vhdl-template-field "names" nil t start (point))
9416 (vhdl-template-field "[IN | OUT]" " " t)
9417 (vhdl-template-field "type")
9419 (vhdl-comment-insert-inline)))
9420 (let ((char (vhdl-decision-query
9421 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
9422 (cond ((eq char ?f) (vhdl-template-quantity-free))
9423 ((eq char ?b) (vhdl-template-quantity-branch))
9424 ((eq char ?s) (vhdl-template-quantity-source))
9425 (t (vhdl-template-undo (point) (point)))))))
9427 (defun vhdl-template-quantity-free ()
9428 "Insert a free quantity declaration."
9430 (vhdl-insert-keyword "QUANTITY ")
9431 (vhdl-template-field "names")
9433 (vhdl-template-field "type")
9434 (let ((position (point)))
9436 (unless (vhdl-template-field "[initialization]" nil t)
9437 (delete-region position (point)))
9439 (vhdl-comment-insert-inline)))
9441 (defun vhdl-template-quantity-branch ()
9442 "Insert a branch quantity declaration."
9445 (vhdl-insert-keyword "QUANTITY ")
9446 (when (vhdl-template-field "[across names]" " " t)
9447 (vhdl-insert-keyword "ACROSS "))
9448 (when (vhdl-template-field "[through names]" " " t)
9449 (vhdl-insert-keyword "THROUGH "))
9450 (vhdl-template-field "plus terminal name")
9451 (setq position (point))
9452 (vhdl-insert-keyword " TO ")
9453 (unless (vhdl-template-field "[minus terminal name]" nil t)
9454 (delete-region position (point)))
9456 (vhdl-comment-insert-inline)))
9458 (defun vhdl-template-quantity-source ()
9459 "Insert a source quantity declaration."
9461 (vhdl-insert-keyword "QUANTITY ")
9462 (vhdl-template-field "names")
9464 (vhdl-template-field "type" " ")
9465 (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n)
9466 (progn (vhdl-insert-keyword "NOISE ")
9467 (vhdl-template-field "power expression"))
9468 (vhdl-insert-keyword "SPECTRUM ")
9469 (vhdl-template-field "magnitude expression" ", ")
9470 (vhdl-template-field "phase expression"))
9472 (vhdl-comment-insert-inline))
9474 (defun vhdl-template-record (kind &optional name secondary)
9475 "Insert a record type declaration."
9477 (let ((margin (current-column))
9480 (vhdl-insert-keyword "RECORD\n")
9481 (indent-to (+ margin vhdl-basic-offset))
9482 (when (or (vhdl-template-field "element names"
9483 nil (not secondary) start (point))
9485 (while (or first (vhdl-template-field "[element names]" nil t))
9487 (vhdl-template-field (if (eq kind 'type) "type" "nature") ";")
9488 (vhdl-comment-insert-inline)
9490 (indent-to (+ margin vhdl-basic-offset))
9494 (vhdl-insert-keyword "END RECORD")
9495 (unless (vhdl-standard-p '87) (and name (insert " " name)))
9497 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9499 (defun vhdl-template-report ()
9500 "Insert a report statement."
9502 (let ((start (point)))
9503 (vhdl-insert-keyword "REPORT ")
9504 (if (equal "\"\"" (vhdl-template-field
9505 "string expression" nil t start (point) t))
9506 (delete-backward-char 2)
9507 (setq start (point))
9508 (vhdl-insert-keyword " SEVERITY ")
9509 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
9510 (delete-region start (point)))
9513 (defun vhdl-template-return ()
9514 "Insert a return statement."
9516 (let ((start (point)))
9517 (vhdl-insert-keyword "RETURN ")
9518 (unless (vhdl-template-field "[expression]" nil t start (point))
9522 (defun vhdl-template-selected-signal-asst ()
9523 "Insert a selected signal assignment."
9525 (let ((margin (current-indentation))
9528 (let ((position (point)))
9529 (vhdl-insert-keyword " SELECT ")
9530 (goto-char position))
9531 (vhdl-insert-keyword "WITH ")
9532 (when (vhdl-template-field "selector expression"
9533 nil t start (+ (point) 7))
9537 (indent-to (+ margin vhdl-basic-offset))
9538 (vhdl-template-field "target signal" " <= ")
9539 ; (vhdl-template-field "[GUARDED] [TRANSPORT]")
9541 (indent-to (+ margin vhdl-basic-offset))
9542 (vhdl-template-field "waveform")
9543 (vhdl-insert-keyword " WHEN ")
9544 (vhdl-template-field "choices" ",")
9546 (indent-to (+ margin vhdl-basic-offset))
9547 (while (and choices (vhdl-template-field "[waveform]" nil t))
9548 (vhdl-insert-keyword " WHEN ")
9549 (if (setq choices (vhdl-template-field "[choices]" "," t))
9550 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
9551 (vhdl-insert-keyword "OTHERS")))
9556 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9558 (defun vhdl-template-signal ()
9559 "Insert a signal declaration."
9561 (let ((start (point))
9562 (in-arglist (vhdl-in-argument-list-p)))
9563 (vhdl-insert-keyword "SIGNAL ")
9564 (when (vhdl-template-field "names" nil t start (point))
9566 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
9567 (vhdl-template-field "type")
9570 (vhdl-comment-insert-inline))
9571 (let ((position (point)))
9573 (unless (vhdl-template-field "[initialization]" nil t)
9574 (delete-region position (point)))
9576 (vhdl-comment-insert-inline))))))
9578 (defun vhdl-template-subnature ()
9579 "Insert a subnature declaration."
9581 (let ((start (point))
9583 (vhdl-insert-keyword "SUBNATURE ")
9584 (when (vhdl-template-field "name" nil t start (point))
9585 (vhdl-insert-keyword " IS ")
9586 (vhdl-template-field "nature" " (")
9587 (if (vhdl-template-field "[index range]" nil t)
9590 (setq position (point))
9591 (vhdl-insert-keyword " TOLERANCE ")
9592 (if (equal "\"\"" (vhdl-template-field "[string expression]"
9594 (delete-region position (point))
9595 (vhdl-insert-keyword " ACROSS ")
9596 (vhdl-template-field "string expression" nil nil nil nil t)
9597 (vhdl-insert-keyword " THROUGH"))
9599 (vhdl-comment-insert-inline))))
9601 (defun vhdl-template-subprogram-body ()
9602 "Insert a subprogram body."
9604 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
9605 (vhdl-template-function-body)
9606 (vhdl-template-procedure-body)))
9608 (defun vhdl-template-subprogram-decl ()
9609 "Insert a subprogram declaration."
9611 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
9612 (vhdl-template-function-decl)
9613 (vhdl-template-procedure-decl)))
9615 (defun vhdl-template-subtype ()
9616 "Insert a subtype declaration."
9618 (let ((start (point)))
9619 (vhdl-insert-keyword "SUBTYPE ")
9620 (when (vhdl-template-field "name" nil t start (point))
9621 (vhdl-insert-keyword " IS ")
9622 (vhdl-template-field "type" " ")
9624 (vhdl-template-field "[RANGE value range | ( index range )]" nil t)
9627 (vhdl-comment-insert-inline))))
9629 (defun vhdl-template-terminal ()
9630 "Insert a terminal declaration."
9632 (let ((start (point)))
9633 (vhdl-insert-keyword "TERMINAL ")
9634 (when (vhdl-template-field "names" nil t start (point))
9636 (vhdl-template-field "nature")
9638 (vhdl-comment-insert-inline))))
9640 (defun vhdl-template-type ()
9641 "Insert a type declaration."
9643 (let ((start (point))
9644 name mid-pos end-pos)
9645 (vhdl-insert-keyword "TYPE ")
9646 (when (setq name (vhdl-template-field "name" nil t start (point)))
9647 (vhdl-insert-keyword " IS ")
9650 (or (vhdl-template-field
9651 "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)
9653 (cond ((equal definition "")
9654 (delete-backward-char 4)
9656 ((equal definition "ARRAY")
9658 (vhdl-template-array 'type t))
9659 ((equal definition "RECORD")
9660 (setq mid-pos (point-marker))
9662 (vhdl-template-record 'type name t))
9663 ((equal definition "ACCESS")
9665 (vhdl-template-field "type" ";"))
9666 ((equal definition "FILE")
9667 (vhdl-insert-keyword " OF ")
9668 (vhdl-template-field "type" ";"))
9671 (setq end-pos (point-marker))
9674 (vhdl-comment-insert-inline)
9675 (when end-pos (goto-char end-pos))))))
9677 (defun vhdl-template-use ()
9678 "Insert a use clause."
9680 (let ((start (point)))
9681 (vhdl-prepare-search-1
9682 (vhdl-insert-keyword "USE ")
9683 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
9684 (vhdl-insert-keyword "..ALL;")
9686 (when (vhdl-template-field "library name" nil t start (+ (point) 6))
9688 (vhdl-template-field "package name")
9689 (forward-char 5))))))
9691 (defun vhdl-template-variable ()
9692 "Insert a variable declaration."
9694 (let ((start (point))
9695 (in-arglist (vhdl-in-argument-list-p)))
9696 (vhdl-prepare-search-2
9697 (if (or (save-excursion
9698 (and (vhdl-re-search-backward
9699 "\\<function\\|procedure\\|process\\|procedural\\|end\\>"
9701 (not (progn (backward-word 1) (looking-at "\\<end\\>")))))
9702 (save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
9703 (vhdl-insert-keyword "VARIABLE ")
9704 (vhdl-insert-keyword "SHARED VARIABLE ")))
9705 (when (vhdl-template-field "names" nil t start (point))
9707 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
9708 (vhdl-template-field "type")
9711 (vhdl-comment-insert-inline))
9712 (let ((position (point)))
9714 (unless (vhdl-template-field "[initialization]" nil t)
9715 (delete-region position (point)))
9717 (vhdl-comment-insert-inline))))))
9719 (defun vhdl-template-wait ()
9720 "Insert a wait statement."
9722 (vhdl-insert-keyword "WAIT ")
9723 (unless (vhdl-template-field
9724 "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
9729 (defun vhdl-template-when ()
9730 "Indent correctly if within a case statement."
9732 (let ((position (point))
9734 (vhdl-prepare-search-2
9735 (if (and (= (current-column) (current-indentation))
9736 (vhdl-re-search-forward "\\<end\\>" nil t)
9737 (looking-at "\\s-*\\<case\\>"))
9739 (setq margin (current-indentation))
9740 (goto-char position)
9741 (delete-horizontal-space)
9742 (indent-to (+ margin vhdl-basic-offset)))
9743 (goto-char position)))
9744 (vhdl-insert-keyword "WHEN ")))
9746 (defun vhdl-template-while-loop ()
9747 "Insert a while loop."
9749 (let* ((margin (current-indentation))
9752 (if (not (eq vhdl-optional-labels 'all))
9753 (vhdl-insert-keyword "WHILE ")
9754 (vhdl-insert-keyword ": WHILE ")
9756 (setq label (vhdl-template-field "[label]" nil t))
9757 (unless label (delete-char 2))
9760 (when vhdl-conditions-in-parenthesis (insert "("))
9761 (when (vhdl-template-field "condition" nil t start (point))
9762 (when vhdl-conditions-in-parenthesis (insert ")"))
9763 (vhdl-insert-keyword " LOOP\n\n")
9765 (vhdl-insert-keyword "END LOOP")
9766 (insert (if label (concat " " label ";") ";"))
9768 (indent-to (+ margin vhdl-basic-offset)))))
9770 (defun vhdl-template-with ()
9771 "Insert a with statement (i.e. selected signal assignment)."
9773 (vhdl-prepare-search-1
9774 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
9775 (equal ";" (match-string 1)))
9776 (vhdl-template-selected-signal-asst)
9777 (vhdl-insert-keyword "WITH "))))
9779 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9780 ;; Special templates
9782 (defun vhdl-template-clocked-wait ()
9783 "Insert a wait statement for rising/falling clock edge."
9785 (let ((start (point))
9787 (vhdl-insert-keyword "WAIT UNTIL ")
9789 (or (and (not (equal "" vhdl-clock-name))
9790 (progn (insert vhdl-clock-name) vhdl-clock-name))
9791 (vhdl-template-field "clock name" nil t start (point))))
9793 (vhdl-insert-keyword " AND ")
9796 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";")
9797 (vhdl-comment-insert-inline
9798 (concat (if vhdl-clock-rising-edge "rising" "falling")
9801 (defun vhdl-template-seq-process (clock reset)
9802 "Insert a template for the body of a sequential process."
9803 (let ((margin (current-indentation))
9805 (vhdl-insert-keyword "IF ")
9806 (when (eq vhdl-reset-kind 'async)
9808 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
9809 (vhdl-insert-keyword " THEN")
9810 (vhdl-comment-insert-inline
9811 (concat "asynchronous reset (active "
9812 (if vhdl-reset-active-high "high" "low") ")"))
9813 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9814 (setq position (point))
9815 (insert "\n") (indent-to margin)
9816 (vhdl-insert-keyword "ELSIF "))
9817 (if (eq vhdl-clock-edge-condition 'function)
9818 (insert (if vhdl-clock-rising-edge "rising" "falling")
9820 (insert clock "'event")
9821 (vhdl-insert-keyword " AND ")
9823 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
9824 (vhdl-insert-keyword " THEN")
9825 (vhdl-comment-insert-inline
9826 (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
9827 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9828 (when (eq vhdl-reset-kind 'sync)
9829 (vhdl-insert-keyword "IF ")
9830 (setq reset (or (and (not (equal "" vhdl-reset-name))
9831 (progn (insert vhdl-reset-name) vhdl-reset-name))
9832 (vhdl-template-field "reset name") "<reset>"))
9834 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
9835 (vhdl-insert-keyword " THEN")
9836 (vhdl-comment-insert-inline
9837 (concat "synchronous reset (active "
9838 (if vhdl-reset-active-high "high" "low") ")"))
9839 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
9840 (setq position (point))
9841 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9842 (vhdl-insert-keyword "ELSE")
9843 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
9844 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9845 (vhdl-insert-keyword "END IF;"))
9846 (when (eq vhdl-reset-kind 'none)
9847 (setq position (point)))
9848 (insert "\n") (indent-to margin)
9849 (vhdl-insert-keyword "END IF;")
9850 (goto-char position)
9853 (defun vhdl-template-standard-package (library package)
9854 "Insert specification of a standard package. Include a library
9855 specification, if not already there."
9856 (let ((margin (current-indentation)))
9857 (unless (equal library "std")
9858 (unless (or (save-excursion
9859 (vhdl-prepare-search-1
9862 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
9863 library "\\|end\\)\\>") nil t)
9865 (equal (downcase library) "work"))
9866 (vhdl-insert-keyword "LIBRARY ")
9867 (insert library ";")
9870 (indent-to margin)))
9872 (vhdl-insert-keyword "USE ")
9873 (insert library "." package)
9874 (vhdl-insert-keyword ".ALL;")))))
9876 (defun vhdl-template-package-math-complex ()
9877 "Insert specification of `math_complex' package."
9879 (vhdl-template-standard-package "ieee" "math_complex"))
9881 (defun vhdl-template-package-math-real ()
9882 "Insert specification of `math_real' package."
9884 (vhdl-template-standard-package "ieee" "math_real"))
9886 (defun vhdl-template-package-numeric-bit ()
9887 "Insert specification of `numeric_bit' package."
9889 (vhdl-template-standard-package "ieee" "numeric_bit"))
9891 (defun vhdl-template-package-numeric-std ()
9892 "Insert specification of `numeric_std' package."
9894 (vhdl-template-standard-package "ieee" "numeric_std"))
9896 (defun vhdl-template-package-std-logic-1164 ()
9897 "Insert specification of `std_logic_1164' package."
9899 (vhdl-template-standard-package "ieee" "std_logic_1164"))
9901 (defun vhdl-template-package-std-logic-arith ()
9902 "Insert specification of `std_logic_arith' package."
9904 (vhdl-template-standard-package "ieee" "std_logic_arith"))
9906 (defun vhdl-template-package-std-logic-misc ()
9907 "Insert specification of `std_logic_misc' package."
9909 (vhdl-template-standard-package "ieee" "std_logic_misc"))
9911 (defun vhdl-template-package-std-logic-signed ()
9912 "Insert specification of `std_logic_signed' package."
9914 (vhdl-template-standard-package "ieee" "std_logic_signed"))
9916 (defun vhdl-template-package-std-logic-textio ()
9917 "Insert specification of `std_logic_textio' package."
9919 (vhdl-template-standard-package "ieee" "std_logic_textio"))
9921 (defun vhdl-template-package-std-logic-unsigned ()
9922 "Insert specification of `std_logic_unsigned' package."
9924 (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
9926 (defun vhdl-template-package-textio ()
9927 "Insert specification of `textio' package."
9929 (vhdl-template-standard-package "std" "textio"))
9931 (defun vhdl-template-directive (directive)
9933 (unless (= (current-indentation) (current-column))
9934 (delete-horizontal-space)
9936 (insert "-- pragma " directive))
9938 (defun vhdl-template-directive-translate-on ()
9939 "Insert directive 'translate_on'."
9941 (vhdl-template-directive "translate_on"))
9943 (defun vhdl-template-directive-translate-off ()
9944 "Insert directive 'translate_off'."
9946 (vhdl-template-directive "translate_off"))
9948 (defun vhdl-template-directive-synthesis-on ()
9949 "Insert directive 'synthesis_on'."
9951 (vhdl-template-directive "synthesis_on"))
9953 (defun vhdl-template-directive-synthesis-off ()
9954 "Insert directive 'synthesis_off'."
9956 (vhdl-template-directive "synthesis_off"))
9958 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9959 ;; Header and footer templates
9961 (defun vhdl-template-header (&optional file-title)
9962 "Insert a VHDL file header."
9964 (unless (equal vhdl-file-header "")
9967 (goto-char (point-min))
9968 (vhdl-insert-string-or-file vhdl-file-header)
9969 (setq pos (point-marker)))
9970 (vhdl-template-replace-header-keywords
9971 (point-min-marker) pos file-title))))
9973 (defun vhdl-template-footer ()
9974 "Insert a VHDL file footer."
9976 (unless (equal vhdl-file-footer "")
9979 (goto-char (point-max))
9980 (setq pos (point-marker))
9981 (vhdl-insert-string-or-file vhdl-file-footer)
9982 (unless (= (preceding-char) ?\n)
9984 (vhdl-template-replace-header-keywords pos (point-max-marker)))))
9986 (defun vhdl-template-replace-header-keywords (beg end &optional file-title
9988 "Replace keywords in header and footer."
9989 (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
9990 (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
9992 (vhdl-prepare-search-2
9995 (while (search-forward "<projectdesc>" end t)
9996 (replace-match project-desc t t))
9998 (while (search-forward "<filename>" end t)
9999 (replace-match (buffer-name) t t))
10001 (while (search-forward "<copyright>" end t)
10002 (replace-match vhdl-copyright-string t t))
10004 (while (search-forward "<author>" end t)
10005 (replace-match "" t t)
10006 (insert (user-full-name))
10007 (when user-mail-address (insert " <" user-mail-address ">")))
10009 (while (search-forward "<login>" end t)
10010 (replace-match (user-login-name) t t))
10012 (while (search-forward "<project>" end t)
10013 (replace-match project-title t t))
10015 (while (search-forward "<company>" end t)
10016 (replace-match vhdl-company-name t t))
10018 (while (search-forward "<platform>" end t)
10019 (replace-match vhdl-platform-spec t t))
10021 (while (search-forward "<standard>" end t)
10023 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
10024 ((vhdl-standard-p '93) "'93/02"))
10025 (when (vhdl-standard-p 'ams) ", VHDL-AMS")
10026 (when (vhdl-standard-p 'math) ", Math Packages")) t t))
10028 ;; Replace <RCS> with $, so that RCS for the source is
10029 ;; not over-enthusiastic with replacements
10030 (while (search-forward "<RCS>" end t)
10031 (replace-match "$" nil t))
10033 (while (search-forward "<date>" end t)
10034 (replace-match "" t t)
10035 (vhdl-template-insert-date))
10037 (while (search-forward "<year>" end t)
10038 (replace-match (format-time-string "%Y" nil) t t))
10041 (while (search-forward "<title string>" end t)
10042 (replace-match file-title t t))
10046 (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
10047 (setq string (read-string (concat (match-string 1) ": ")))
10048 (replace-match string t t)))
10050 (when (and (not is-model) (search-forward "<cursor>" end t))
10051 (replace-match "" t t)
10052 (setq pos (point))))
10053 (when pos (goto-char pos))
10055 (when (or (not project-title) (equal project-title ""))
10056 (message "You can specify a project title in user option `vhdl-project-alist'"))
10057 (when (or (not project-desc) (equal project-desc ""))
10058 (message "You can specify a project description in user option `vhdl-project-alist'"))
10059 (when (equal vhdl-platform-spec "")
10060 (message "You can specify a platform in user option `vhdl-platform-spec'"))
10061 (when (equal vhdl-company-name "")
10062 (message "You can specify a company name in user option `vhdl-company-name'"))))))
10064 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10065 ;; Comment templates and functions
10067 (defun vhdl-comment-indent ()
10069 (let* ((position (point))
10073 (if (re-search-forward "--" position t)
10074 (- (current-column) 2) ; existing comment at bol stays there
10075 (goto-char position)
10076 (skip-chars-backward " \t")
10077 (max comment-column ; else indent to comment column
10078 (1+ (current-column))))))) ; except leave at least one space
10079 (goto-char position)
10082 (defun vhdl-comment-insert ()
10083 "Start a comment at the end of the line.
10084 If on line with code, indent at least `comment-column'.
10085 If starting after end-comment-column, start a new line."
10087 (when (> (current-column) end-comment-column) (newline-and-indent))
10088 (if (or (looking-at "\\s-*$") ; end of line
10089 (and (not unread-command-events) ; called with key binding or menu
10090 (not (end-of-line))))
10092 (while (= (preceding-char) ?-) (delete-char -1))
10093 (setq margin (current-column))
10094 (delete-horizontal-space)
10096 (progn (indent-to margin) (insert "--"))
10098 (indent-to comment-column)
10100 (if (not unread-command-events) (insert " ")))
10101 ;; else code following current point implies commenting out code
10102 (let (next-input code)
10103 (while (= (preceding-char) ?-) (delete-char -2))
10104 (while (= (setq next-input (read-char)) 13) ; CR
10105 (insert "--") ; or have a space after it?
10108 (message "Enter CR if commenting out a line of code.")
10111 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
10112 (setq unread-command-events
10113 (list (vhdl-character-to-event next-input)))))) ; pushback the char
10115 (defun vhdl-comment-display (&optional line-exists)
10116 "Add 2 comment lines at the current indent, making a display comment."
10118 (let ((margin (current-indentation)))
10119 (unless line-exists (vhdl-comment-display-line))
10120 (insert "\n") (indent-to margin)
10121 (insert "\n") (indent-to margin)
10122 (vhdl-comment-display-line)
10126 (defun vhdl-comment-display-line ()
10127 "Displays one line of dashes."
10129 (while (= (preceding-char) ?-) (delete-char -2))
10130 (let* ((col (current-column))
10131 (len (- end-comment-column col)))
10132 (insert-char ?- len)))
10134 (defun vhdl-comment-append-inline ()
10135 "Append empty inline comment to current line."
10138 (delete-horizontal-space)
10140 (indent-to comment-column)
10143 (defun vhdl-comment-insert-inline (&optional string always-insert)
10144 "Insert inline comment."
10145 (when (or (and string (or vhdl-self-insert-comments always-insert))
10146 (and (not string) vhdl-prompt-for-comments))
10147 (let ((position (point)))
10149 (indent-to comment-column)
10151 (if (not (or (and string (progn (insert string) t))
10152 (vhdl-template-field "[comment]" nil t)))
10153 (delete-region position (point))
10154 (while (= (preceding-char) ? ) (delete-backward-char 1))
10155 ; (when (> (current-column) end-comment-column)
10156 ; (setq position (point-marker))
10157 ; (re-search-backward "-- ")
10159 ; (indent-to comment-column)
10160 ; (goto-char position))
10163 (defun vhdl-comment-block ()
10164 "Insert comment for code block."
10165 (when vhdl-prompt-for-comments
10166 (let ((final-pos (point-marker)))
10167 (vhdl-prepare-search-2
10168 (when (and (re-search-backward "^\\s-*begin\\>" nil t)
10169 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
10171 (back-to-indentation)
10172 (setq margin (current-column))
10175 (progn (insert "\n") (forward-line -1))
10178 (insert "-- purpose: ")
10179 (unless (vhdl-template-field "[description]" nil t)
10180 (vhdl-line-kill-entire)))))
10181 (goto-char final-pos))))
10183 (defun vhdl-comment-uncomment-region (beg end &optional arg)
10184 "Comment out region if not commented out, uncomment otherwise."
10185 (interactive "r\nP")
10187 (goto-char (1- end))
10189 (setq end (point-marker))
10191 (beginning-of-line)
10193 (if (looking-at comment-start)
10194 (comment-region beg end '(4))
10195 (comment-region beg end))))
10197 (defun vhdl-comment-uncomment-line (&optional arg)
10198 "Comment out line if not commented out, uncomment otherwise."
10201 (beginning-of-line)
10202 (let ((position (point)))
10203 (forward-line (or arg 1))
10204 (vhdl-comment-uncomment-region position (point)))))
10206 (defun vhdl-comment-kill-region (beg end)
10207 "Kill comments in region."
10211 (setq end (point-marker))
10213 (beginning-of-line)
10214 (while (< (point) end)
10215 (if (looking-at "^\\(\\s-*--.*\n\\)")
10216 (progn (delete-region (match-beginning 1) (match-end 1)))
10217 (beginning-of-line 2)))))
10219 (defun vhdl-comment-kill-inline-region (beg end)
10220 "Kill inline comments in region."
10224 (setq end (point-marker))
10226 (beginning-of-line)
10227 (while (< (point) end)
10228 (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$")
10229 (delete-region (match-beginning 1) (match-end 1)))
10230 (beginning-of-line 2))))
10232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10235 (defun vhdl-template-begin-end (construct name margin &optional empty-lines)
10236 "Insert a begin ... end pair with optional name after the end.
10237 Point is left between them."
10239 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10241 (vhdl-insert-keyword "BEGIN")
10242 (when (and (or construct name) vhdl-self-insert-comments)
10244 (when construct (insert " ") (vhdl-insert-keyword construct))
10245 (when name (insert " " name)))
10247 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10248 (indent-to (+ margin vhdl-basic-offset))
10249 (setq position (point))
10251 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10253 (vhdl-insert-keyword "END")
10254 (when construct (insert " ") (vhdl-insert-keyword construct))
10255 (insert (if name (concat " " name) "") ";")
10256 (goto-char position)))
10258 (defun vhdl-template-argument-list (&optional is-function)
10259 "Read from user a procedure or function argument list."
10261 (let ((margin (current-column))
10264 not-empty interface semicolon-pos)
10265 (unless vhdl-argument-list-indent
10266 (setq margin (+ (current-indentation) vhdl-basic-offset))
10268 (indent-to margin))
10269 (setq interface (vhdl-template-field
10270 (concat "[CONSTANT | SIGNAL"
10271 (unless is-function " | VARIABLE") "]") " " t))
10272 (while (vhdl-template-field "[names]" nil t)
10275 (unless is-function
10276 (if (and interface (equal (upcase interface) "CONSTANT"))
10277 (vhdl-insert-keyword "IN ")
10278 (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
10279 (vhdl-template-field "type")
10280 (setq semicolon-pos (point))
10282 (vhdl-comment-insert-inline)
10283 (setq end-pos (point))
10286 (setq interface (vhdl-template-field
10287 (concat "[CONSTANT | SIGNAL"
10288 (unless is-function " | VARIABLE") "]") " " t)))
10289 (delete-region end-pos (point))
10290 (when semicolon-pos (goto-char semicolon-pos))
10292 (progn (delete-char 1) (insert ")"))
10293 (delete-backward-char 2))))
10295 (defun vhdl-template-generic-list (optional &optional no-value)
10296 "Read from user a generic spec argument list."
10299 (vhdl-insert-keyword "GENERIC (")
10300 (setq margin (current-column))
10301 (unless vhdl-argument-list-indent
10302 (let ((position (point)))
10303 (back-to-indentation)
10304 (setq margin (+ (current-column) vhdl-basic-offset))
10305 (goto-char position)
10307 (indent-to margin)))
10308 (let ((vhdl-generics (vhdl-template-field
10309 (concat (and optional "[") "name"
10310 (and no-value "s") (and optional "]"))
10312 (if (not vhdl-generics)
10314 (progn (vhdl-line-kill-entire) (end-of-line -0)
10315 (unless vhdl-argument-list-indent
10316 (vhdl-line-kill-entire) (end-of-line -0)))
10317 (vhdl-template-undo start (point))
10320 (let (semicolon-pos end-pos)
10321 (while vhdl-generics
10322 (vhdl-template-field "type")
10324 (progn (setq semicolon-pos (point))
10327 (unless (vhdl-template-field "[value]" nil t)
10329 (setq semicolon-pos (point))
10331 (vhdl-comment-insert-inline)
10332 (setq end-pos (point))
10335 (setq vhdl-generics (vhdl-template-field
10336 (concat "[name" (and no-value "s") "]")
10338 (delete-region end-pos (point))
10339 (goto-char semicolon-pos)
10342 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10345 (defun vhdl-template-port-list (optional)
10346 "Read from user a port spec argument list."
10347 (let ((start (point))
10348 margin vhdl-ports object)
10349 (vhdl-insert-keyword "PORT (")
10350 (setq margin (current-column))
10351 (unless vhdl-argument-list-indent
10352 (let ((position (point)))
10353 (back-to-indentation)
10354 (setq margin (+ (current-column) vhdl-basic-offset))
10355 (goto-char position)
10357 (indent-to margin)))
10358 (when (vhdl-standard-p 'ams)
10359 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10361 (setq vhdl-ports (vhdl-template-field
10362 (concat (and optional "[") "names" (and optional "]"))
10364 (if (not vhdl-ports)
10366 (progn (vhdl-line-kill-entire) (end-of-line -0)
10367 (unless vhdl-argument-list-indent
10368 (vhdl-line-kill-entire) (end-of-line -0)))
10369 (vhdl-template-undo start (point))
10372 (let (semicolon-pos end-pos)
10374 (cond ((or (null object) (equal "SIGNAL" (upcase object)))
10375 (vhdl-template-field "IN | OUT | INOUT" " "))
10376 ((equal "QUANTITY" (upcase object))
10377 (vhdl-template-field "[IN | OUT]" " " t)))
10378 (vhdl-template-field
10379 (if (and object (equal "TERMINAL" (upcase object)))
10381 (setq semicolon-pos (point))
10383 (vhdl-comment-insert-inline)
10384 (setq end-pos (point))
10387 (when (vhdl-standard-p 'ams)
10388 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10390 (setq vhdl-ports (vhdl-template-field "[names]" " : " t)))
10391 (delete-region end-pos (point))
10392 (goto-char semicolon-pos)
10395 (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
10398 (defun vhdl-template-generate-body (margin label)
10399 "Insert body for generate template."
10400 (vhdl-insert-keyword " GENERATE")
10401 ; (if (not (vhdl-standard-p '87))
10402 ; (vhdl-template-begin-end "GENERATE" label margin)
10405 (vhdl-insert-keyword "END GENERATE ")
10408 (indent-to (+ margin vhdl-basic-offset)))
10410 (defun vhdl-template-insert-date ()
10411 "Insert date in appropriate format."
10415 ;; 'american, 'european, 'scientific kept for backward compatibility
10416 ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
10417 ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
10418 ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
10419 (t (format-time-string vhdl-date-format nil)))))
10421 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10424 (defun vhdl-electric-space (count)
10425 "Expand abbreviations and self-insert space(s), do indent-new-comment-line
10426 if in comment and past end-comment-column."
10428 (cond ((vhdl-in-comment-p)
10429 (self-insert-command count)
10430 (cond ((>= (current-column) (+ 2 end-comment-column))
10432 (skip-chars-backward "^ \t\n")
10433 (indent-new-comment-line)
10434 (skip-chars-forward "^ \t\n")
10436 ((>= (current-column) end-comment-column)
10437 (indent-new-comment-line))
10439 ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
10440 (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
10441 (vhdl-prepare-search-1
10442 (or (expand-abbrev) (vhdl-fix-case-word -1)))
10443 (self-insert-command count))
10444 (t (self-insert-command count))))
10446 (defun vhdl-template-field (prompt &optional follow-string optional
10447 begin end is-string default)
10448 "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
10449 If OPTIONAL is nil, the prompt is left if an empty string is inserted. If
10450 an empty string is inserted, return nil and call `vhdl-template-undo' for
10451 the region between BEGIN and END. IS-STRING indicates whether a string
10452 with double-quotes is to be inserted. DEFAULT specifies a default string."
10453 (let ((position (point))
10455 (insert "<" prompt ">")
10458 (read-from-minibuffer (concat prompt ": ")
10459 (or (and is-string '("\"\"" . 2)) default)
10460 vhdl-minibuffer-local-map)
10461 (quit (if (and optional begin end)
10463 (keyboard-quit)))))
10464 (when (or (not (equal string "")) optional)
10465 (delete-region position (point)))
10466 (when (and (equal string "") optional begin end)
10467 (vhdl-template-undo begin end)
10468 (message "Template aborted"))
10469 (unless (equal string "")
10471 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
10472 vhdl-keywords-regexp)
10473 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
10475 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
10476 (concat "'" vhdl-attributes-regexp))
10477 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
10478 vhdl-enum-values-regexp))
10479 (when (or (not (equal string "")) (not optional))
10480 (insert (or follow-string "")))
10481 (if (equal string "") nil string)))
10483 (defun vhdl-decision-query (string prompt &optional optional)
10484 "Query a decision from the user."
10485 (let ((start (point)))
10486 (when string (vhdl-insert-keyword (concat string " ")))
10488 (let ((char (read-char)))
10489 (delete-region start (point))
10490 (if (and optional (eq char ?\r))
10491 (progn (insert " ")
10493 (throw 'abort "ERROR: Template aborted"))
10496 (defun vhdl-insert-keyword (keyword)
10497 "Insert KEYWORD and adjust case."
10498 (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))))
10500 (defun vhdl-case-keyword (keyword)
10501 "Adjust case of KEYWORD."
10502 (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
10504 (defun vhdl-case-word (num)
10505 "Adjust case or following NUM words."
10506 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
10508 (defun vhdl-minibuffer-tab (&optional prefix-arg)
10509 "If preceding character is part of a word or a paren then hippie-expand,
10510 else insert tab (used for word completion in VHDL minibuffer)."
10514 ((= (char-syntax (preceding-char)) ?w)
10515 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10517 (hippie-expand-only-buffers
10518 (or (and (boundp 'hippie-expand-only-buffers)
10519 hippie-expand-only-buffers)
10521 (vhdl-expand-abbrev prefix-arg)))
10522 ;; expand parenthesis
10523 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
10524 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10525 (case-replace nil))
10526 (vhdl-expand-paren prefix-arg)))
10530 (defun vhdl-template-search-prompt ()
10531 "Search for left out template prompts and query again."
10533 (vhdl-prepare-search-2
10534 (when (or (re-search-forward
10535 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
10536 (re-search-backward
10537 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
10538 (let ((string (match-string 1)))
10540 (vhdl-template-field string)))))
10542 (defun vhdl-template-undo (begin end)
10543 "Undo aborted template by deleting region and unexpanding the keyword."
10544 (cond (vhdl-template-invoked-by-hook
10547 (delete-region begin end)
10549 (t (delete-region begin end))))
10551 (defun vhdl-insert-string-or-file (string)
10552 "Insert STRING or file contents if STRING is an existing file name."
10553 (unless (equal string "")
10555 (progn (string-match "^\\([^\n]+\\)" string)
10556 (vhdl-resolve-env-variable (match-string 1 string)))))
10557 (if (file-exists-p file-name)
10558 (forward-char (cadr (insert-file-contents file-name)))
10559 (insert string)))))
10561 (defun vhdl-beginning-of-block ()
10562 "Move cursor to the beginning of the enclosing block."
10565 (beginning-of-line)
10566 ;; search backward for block beginning or end
10567 (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10568 ;; not consider subprogram declarations
10569 (or (and (match-string 5)
10572 (goto-char (match-end 5))
10574 (vhdl-forward-syntactic-ws)
10575 (when (looking-at "(")
10577 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10579 ;; not consider configuration specifications
10580 (and (match-string 6)
10583 (vhdl-end-of-block)
10584 (beginning-of-line)
10585 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10587 ;; skip subblock if block end found
10588 (vhdl-beginning-of-block)))
10589 (when pos (goto-char pos))))
10591 (defun vhdl-end-of-block ()
10592 "Move cursor to the end of the enclosing block."
10596 ;; search forward for block beginning or end
10597 (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10598 ;; not consider subprogram declarations
10599 (or (and (match-string 5)
10601 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10603 ;; not consider configuration specifications
10604 (and (match-string 6)
10607 (vhdl-end-of-block)
10608 (beginning-of-line)
10609 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10610 (not (match-string 2)))
10611 ;; skip subblock if block beginning found
10612 (vhdl-end-of-block)))
10613 (when pos (goto-char pos))))
10615 (defun vhdl-sequential-statement-p ()
10616 "Check if point is within sequential statement part."
10617 (let ((start (point)))
10619 (vhdl-prepare-search-2
10620 ;; is sequential statement if ...
10621 (and (re-search-backward "^\\s-*begin\\>" nil t)
10622 ;; ... point is between "begin" and "end" of ...
10623 (progn (vhdl-end-of-block)
10625 ;; ... a sequential block
10626 (progn (vhdl-beginning-of-block)
10627 (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
10629 (defun vhdl-in-argument-list-p ()
10630 "Check if within an argument list."
10632 (vhdl-prepare-search-2
10633 (or (string-match "arglist"
10634 (format "%s" (caar (vhdl-get-syntactic-context))))
10635 (progn (beginning-of-line)
10636 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
10638 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10641 (defun vhdl-hooked-abbrev (func)
10642 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
10643 but not if inside a comment or quote)."
10644 (if (or (vhdl-in-literal)
10647 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
10652 (if (not vhdl-electric-mode)
10659 (let ((invoke-char last-command-char)
10661 (vhdl-template-invoked-by-hook t))
10662 (let ((caught (catch 'abort
10664 (when (stringp caught) (message caught)))
10665 (when (= invoke-char ?-) (setq abbrev-start-location (point)))
10666 ;; delete CR which is still in event queue
10667 (if (fboundp 'enqueue-eval-event)
10668 (enqueue-eval-event 'delete-char -1)
10669 (setq unread-command-events ; push back a delete char
10670 (list (vhdl-character-to-event ?\177))))))))
10672 (defun vhdl-template-alias-hook ()
10673 (vhdl-hooked-abbrev 'vhdl-template-alias))
10674 (defun vhdl-template-architecture-hook ()
10675 (vhdl-hooked-abbrev 'vhdl-template-architecture))
10676 (defun vhdl-template-assert-hook ()
10677 (vhdl-hooked-abbrev 'vhdl-template-assert))
10678 (defun vhdl-template-attribute-hook ()
10679 (vhdl-hooked-abbrev 'vhdl-template-attribute))
10680 (defun vhdl-template-block-hook ()
10681 (vhdl-hooked-abbrev 'vhdl-template-block))
10682 (defun vhdl-template-break-hook ()
10683 (vhdl-hooked-abbrev 'vhdl-template-break))
10684 (defun vhdl-template-case-hook ()
10685 (vhdl-hooked-abbrev 'vhdl-template-case))
10686 (defun vhdl-template-component-hook ()
10687 (vhdl-hooked-abbrev 'vhdl-template-component))
10688 (defun vhdl-template-instance-hook ()
10689 (vhdl-hooked-abbrev 'vhdl-template-instance))
10690 (defun vhdl-template-conditional-signal-asst-hook ()
10691 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
10692 (defun vhdl-template-configuration-hook ()
10693 (vhdl-hooked-abbrev 'vhdl-template-configuration))
10694 (defun vhdl-template-constant-hook ()
10695 (vhdl-hooked-abbrev 'vhdl-template-constant))
10696 (defun vhdl-template-disconnect-hook ()
10697 (vhdl-hooked-abbrev 'vhdl-template-disconnect))
10698 (defun vhdl-template-display-comment-hook ()
10699 (vhdl-hooked-abbrev 'vhdl-comment-display))
10700 (defun vhdl-template-else-hook ()
10701 (vhdl-hooked-abbrev 'vhdl-template-else))
10702 (defun vhdl-template-elsif-hook ()
10703 (vhdl-hooked-abbrev 'vhdl-template-elsif))
10704 (defun vhdl-template-entity-hook ()
10705 (vhdl-hooked-abbrev 'vhdl-template-entity))
10706 (defun vhdl-template-exit-hook ()
10707 (vhdl-hooked-abbrev 'vhdl-template-exit))
10708 (defun vhdl-template-file-hook ()
10709 (vhdl-hooked-abbrev 'vhdl-template-file))
10710 (defun vhdl-template-for-hook ()
10711 (vhdl-hooked-abbrev 'vhdl-template-for))
10712 (defun vhdl-template-function-hook ()
10713 (vhdl-hooked-abbrev 'vhdl-template-function))
10714 (defun vhdl-template-generic-hook ()
10715 (vhdl-hooked-abbrev 'vhdl-template-generic))
10716 (defun vhdl-template-group-hook ()
10717 (vhdl-hooked-abbrev 'vhdl-template-group))
10718 (defun vhdl-template-library-hook ()
10719 (vhdl-hooked-abbrev 'vhdl-template-library))
10720 (defun vhdl-template-limit-hook ()
10721 (vhdl-hooked-abbrev 'vhdl-template-limit))
10722 (defun vhdl-template-if-hook ()
10723 (vhdl-hooked-abbrev 'vhdl-template-if))
10724 (defun vhdl-template-bare-loop-hook ()
10725 (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
10726 (defun vhdl-template-map-hook ()
10727 (vhdl-hooked-abbrev 'vhdl-template-map))
10728 (defun vhdl-template-nature-hook ()
10729 (vhdl-hooked-abbrev 'vhdl-template-nature))
10730 (defun vhdl-template-next-hook ()
10731 (vhdl-hooked-abbrev 'vhdl-template-next))
10732 (defun vhdl-template-others-hook ()
10733 (vhdl-hooked-abbrev 'vhdl-template-others))
10734 (defun vhdl-template-package-hook ()
10735 (vhdl-hooked-abbrev 'vhdl-template-package))
10736 (defun vhdl-template-port-hook ()
10737 (vhdl-hooked-abbrev 'vhdl-template-port))
10738 (defun vhdl-template-procedural-hook ()
10739 (vhdl-hooked-abbrev 'vhdl-template-procedural))
10740 (defun vhdl-template-procedure-hook ()
10741 (vhdl-hooked-abbrev 'vhdl-template-procedure))
10742 (defun vhdl-template-process-hook ()
10743 (vhdl-hooked-abbrev 'vhdl-template-process))
10744 (defun vhdl-template-quantity-hook ()
10745 (vhdl-hooked-abbrev 'vhdl-template-quantity))
10746 (defun vhdl-template-report-hook ()
10747 (vhdl-hooked-abbrev 'vhdl-template-report))
10748 (defun vhdl-template-return-hook ()
10749 (vhdl-hooked-abbrev 'vhdl-template-return))
10750 (defun vhdl-template-selected-signal-asst-hook ()
10751 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
10752 (defun vhdl-template-signal-hook ()
10753 (vhdl-hooked-abbrev 'vhdl-template-signal))
10754 (defun vhdl-template-subnature-hook ()
10755 (vhdl-hooked-abbrev 'vhdl-template-subnature))
10756 (defun vhdl-template-subtype-hook ()
10757 (vhdl-hooked-abbrev 'vhdl-template-subtype))
10758 (defun vhdl-template-terminal-hook ()
10759 (vhdl-hooked-abbrev 'vhdl-template-terminal))
10760 (defun vhdl-template-type-hook ()
10761 (vhdl-hooked-abbrev 'vhdl-template-type))
10762 (defun vhdl-template-use-hook ()
10763 (vhdl-hooked-abbrev 'vhdl-template-use))
10764 (defun vhdl-template-variable-hook ()
10765 (vhdl-hooked-abbrev 'vhdl-template-variable))
10766 (defun vhdl-template-wait-hook ()
10767 (vhdl-hooked-abbrev 'vhdl-template-wait))
10768 (defun vhdl-template-when-hook ()
10769 (vhdl-hooked-abbrev 'vhdl-template-when))
10770 (defun vhdl-template-while-loop-hook ()
10771 (vhdl-hooked-abbrev 'vhdl-template-while-loop))
10772 (defun vhdl-template-with-hook ()
10773 (vhdl-hooked-abbrev 'vhdl-template-with))
10774 (defun vhdl-template-and-hook ()
10775 (vhdl-hooked-abbrev 'vhdl-template-and))
10776 (defun vhdl-template-or-hook ()
10777 (vhdl-hooked-abbrev 'vhdl-template-or))
10778 (defun vhdl-template-nand-hook ()
10779 (vhdl-hooked-abbrev 'vhdl-template-nand))
10780 (defun vhdl-template-nor-hook ()
10781 (vhdl-hooked-abbrev 'vhdl-template-nor))
10782 (defun vhdl-template-xor-hook ()
10783 (vhdl-hooked-abbrev 'vhdl-template-xor))
10784 (defun vhdl-template-xnor-hook ()
10785 (vhdl-hooked-abbrev 'vhdl-template-xnor))
10786 (defun vhdl-template-not-hook ()
10787 (vhdl-hooked-abbrev 'vhdl-template-not))
10789 (defun vhdl-template-default-hook ()
10790 (vhdl-hooked-abbrev 'vhdl-template-default))
10791 (defun vhdl-template-default-indent-hook ()
10792 (vhdl-hooked-abbrev 'vhdl-template-default-indent))
10794 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10795 ;; Template insertion from completion list
10797 (defun vhdl-template-insert-construct (name)
10798 "Insert the built-in construct template with NAME."
10800 (list (let ((completion-ignore-case t))
10801 (completing-read "Construct name: "
10802 vhdl-template-construct-alist nil t))))
10803 (vhdl-template-insert-fun
10804 (cadr (assoc name vhdl-template-construct-alist))))
10806 (defun vhdl-template-insert-package (name)
10807 "Insert the built-in package template with NAME."
10809 (list (let ((completion-ignore-case t))
10810 (completing-read "Package name: "
10811 vhdl-template-package-alist nil t))))
10812 (vhdl-template-insert-fun
10813 (cadr (assoc name vhdl-template-package-alist))))
10815 (defun vhdl-template-insert-directive (name)
10816 "Insert the built-in directive template with NAME."
10818 (list (let ((completion-ignore-case t))
10819 (completing-read "Directive name: "
10820 vhdl-template-directive-alist nil t))))
10821 (vhdl-template-insert-fun
10822 (cadr (assoc name vhdl-template-directive-alist))))
10824 (defun vhdl-template-insert-fun (fun)
10825 "Call FUN to insert a built-in template."
10826 (let ((caught (catch 'abort (when fun (funcall fun)))))
10827 (when (stringp caught) (message caught))))
10830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10832 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10834 (defun vhdl-model-insert (model-name)
10835 "Insert the user model with name MODEL-NAME."
10837 (let ((completion-ignore-case t))
10838 (list (completing-read "Model name: " vhdl-model-alist))))
10839 (indent-according-to-mode)
10840 (let ((start (point-marker))
10841 (margin (current-indentation))
10842 model position prompt string end)
10843 (vhdl-prepare-search-2
10844 (when (setq model (assoc model-name vhdl-model-alist))
10846 (beginning-of-line)
10847 (delete-horizontal-space)
10849 (vhdl-insert-string-or-file (nth 1 model))
10850 (setq end (point-marker))
10853 (beginning-of-line)
10854 (while (< (point) end)
10855 (unless (looking-at "^$")
10856 (insert-char ? margin))
10857 (beginning-of-line 2))
10860 (unless (equal "" vhdl-clock-name)
10861 (while (re-search-forward "<clock>" end t)
10862 (replace-match vhdl-clock-name)))
10865 (unless (equal "" vhdl-reset-name)
10866 (while (re-search-forward "<reset>" end t)
10867 (replace-match vhdl-reset-name)))
10868 ;; replace header prompts
10869 (vhdl-template-replace-header-keywords start end nil t)
10871 ;; query other prompts
10872 (while (re-search-forward
10873 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
10874 (unless (equal "cursor" (match-string 1))
10875 (setq position (match-beginning 1))
10876 (setq prompt (match-string 1))
10878 (setq string (vhdl-template-field prompt nil t))
10879 ;; replace occurrences of same prompt
10880 (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
10881 (replace-match (or string "")))
10882 (goto-char position)))
10884 ;; goto final position
10885 (if (re-search-forward "<cursor>" end t)
10887 (goto-char end))))))
10889 (defun vhdl-model-defun ()
10890 "Define help and hook functions for user models."
10891 (let ((model-alist vhdl-model-alist)
10892 model-name model-keyword)
10894 ;; define functions for user models that can be invoked from menu and key
10895 ;; bindings and which themselves call `vhdl-model-insert' with the model
10896 ;; name as argument
10897 (setq model-name (nth 0 (car model-alist)))
10898 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
10899 ,(concat "Insert model for \"" model-name "\".")
10901 (vhdl-model-insert ,model-name)))
10902 ;; define hooks for user models that are invoked from keyword abbrevs
10903 (setq model-keyword (nth 3 (car model-alist)))
10904 (unless (equal model-keyword "")
10906 ,(vhdl-function-name
10907 "vhdl-model" model-name "hook") ()
10908 (vhdl-hooked-abbrev
10909 ',(vhdl-function-name "vhdl-model" model-name)))))
10910 (setq model-alist (cdr model-alist)))))
10915 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10916 ;;; Port translation
10917 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10919 (defvar vhdl-port-list nil
10920 "Variable to hold last port map parsed.")
10921 ;; structure: (parenthesised expression means list of such entries)
10923 ;; ((generic-names) generic-type generic-init generic-comment group-comment)
10924 ;; ((port-names) port-object port-direct port-type port-comment group-comment)
10925 ;; (lib-name pack-key))
10927 (defun vhdl-parse-string (string &optional optional)
10928 "Check that the text following point matches the regexp in STRING."
10929 (if (looking-at string)
10930 (goto-char (match-end 0))
10932 (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\""
10933 (vhdl-current-line) string)))
10936 (defun vhdl-replace-string (regexp-cons string &optional adjust-case)
10937 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
10938 (vhdl-prepare-search-1
10939 (if (string-match (car regexp-cons) string)
10941 (funcall vhdl-file-name-case
10942 (replace-match (cdr regexp-cons) t nil string))
10943 (replace-match (cdr regexp-cons) t nil string))
10946 (defun vhdl-parse-group-comment ()
10947 "Parse comment and empty lines between groups of lines."
10948 (let ((start (point))
10950 (vhdl-forward-comment (point-max))
10951 (setq string (buffer-substring-no-properties start (point)))
10952 (vhdl-forward-syntactic-ws)
10953 ;; strip off leading blanks and first newline
10954 (while (string-match "^\\(\\s-+\\)" string)
10955 (setq string (concat (substring string 0 (match-beginning 1))
10956 (substring string (match-end 1)))))
10957 (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
10958 (substring string 1)
10961 (defun vhdl-paste-group-comment (string indent)
10962 "Paste comment and empty lines from STRING between groups of lines
10964 (let ((pos (point-marker)))
10966 (while (string-match "^\\(--\\)" string)
10967 (setq string (concat (substring string 0 (match-beginning 1))
10968 (make-string indent ? )
10969 (substring string (match-beginning 1))))))
10970 (beginning-of-line)
10974 (defvar vhdl-port-flattened nil
10975 "Indicates whether a port has been flattened.")
10977 (defun vhdl-port-flatten (&optional as-alist)
10978 "Flatten port list so that only one generic/port exists per line.
10979 This operation is performed on an internally stored port and is only
10980 reflected in a subsequent paste operation."
10982 (if (not vhdl-port-list)
10983 (error "ERROR: No port has been read")
10984 (message "Flattening port for next paste...")
10985 (let ((new-vhdl-port-list (list (car vhdl-port-list)))
10986 (old-vhdl-port-list (cdr vhdl-port-list))
10987 old-port-list new-port-list old-port new-port names)
10988 ;; traverse port list and flatten entries
10989 (while (cdr old-vhdl-port-list)
10990 (setq old-port-list (car old-vhdl-port-list))
10991 (setq new-port-list nil)
10992 (while old-port-list
10993 (setq old-port (car old-port-list))
10994 (setq names (car old-port))
10996 (setq new-port (cons (if as-alist (car names) (list (car names)))
10998 (setq new-port-list (append new-port-list (list new-port)))
10999 (setq names (cdr names)))
11000 (setq old-port-list (cdr old-port-list)))
11001 (setq old-vhdl-port-list (cdr old-vhdl-port-list))
11002 (setq new-vhdl-port-list (append new-vhdl-port-list
11003 (list new-port-list))))
11004 (setq vhdl-port-list
11005 (append new-vhdl-port-list (list old-vhdl-port-list))
11006 vhdl-port-flattened t)
11007 (message "Flattening port for next paste...done"))))
11009 (defvar vhdl-port-reversed-direction nil
11010 "Indicates whether port directions are reversed.")
11012 (defun vhdl-port-reverse-direction ()
11013 "Reverse direction for all ports (useful in testbenches).
11014 This operation is performed on an internally stored port and is only
11015 reflected in a subsequent paste operation."
11017 (if (not vhdl-port-list)
11018 (error "ERROR: No port has been read")
11019 (message "Reversing port directions for next paste...")
11020 (let ((port-list (nth 2 vhdl-port-list))
11021 port-dir-car port-dir)
11022 ;; traverse port list and reverse directions
11024 (setq port-dir-car (cddr (car port-list))
11025 port-dir (car port-dir-car))
11026 (setcar port-dir-car
11027 (cond ((equal port-dir "in") "out")
11028 ((equal port-dir "out") "in")
11030 (setq port-list (cdr port-list)))
11031 (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
11032 (message "Reversing port directions for next paste...done"))))
11034 (defun vhdl-port-copy ()
11035 "Get generic and port information from an entity or component declaration."
11038 (let (parse-error end-of-list
11039 decl-type name generic-list port-list context-clause
11040 object names direct type init comment group-comment)
11041 (vhdl-prepare-search-2
11045 ;; check if within entity or component declaration
11047 (when (or (not (re-search-backward
11048 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
11049 (equal "END" (upcase (match-string 1))))
11050 (throw 'parse "ERROR: Not within an entity or component declaration"))
11051 (setq decl-type (downcase (match-string-no-properties 1)))
11053 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
11054 (setq name (match-string-no-properties 1))
11055 (message "Reading port of %s \"%s\"..." decl-type name)
11056 (vhdl-forward-syntactic-ws)
11057 ;; parse generic clause
11058 (when (vhdl-parse-string "generic[ \t\n]*(" t)
11059 ;; parse group comment and spacing
11060 (setq group-comment (vhdl-parse-group-comment))
11061 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
11062 (while (not end-of-list)
11063 ;; parse names (accept extended identifiers)
11064 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
11065 (setq names (list (match-string-no-properties 1)))
11066 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
11068 (append names (list (match-string-no-properties 1)))))
11070 (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
11071 (setq type (match-string-no-properties 1))
11072 (when (vhdl-in-comment-p) ; if stuck in comment
11073 (setq type (concat type (and (vhdl-parse-string ".*")
11074 (match-string-no-properties 0)))))
11076 (while (looking-at "(")
11079 (buffer-substring-no-properties
11080 (point) (progn (forward-sexp) (point)))
11081 (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11082 (match-string-no-properties 1)))))
11083 ;; special case: closing parenthesis is on separate line
11084 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11085 (setq comment (substring type (match-beginning 2)))
11086 (setq type (substring type 0 (match-beginning 1))))
11087 ;; strip of trailing group-comment
11088 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11089 (setq type (substring type 0 (match-end 1)))
11090 ;; parse initialization expression
11092 (when (vhdl-parse-string ":=[ \t\n]*" t)
11093 (vhdl-parse-string "\\([^();\n]*\\)")
11094 (setq init (match-string-no-properties 1))
11095 (while (looking-at "(")
11098 (buffer-substring-no-properties
11099 (point) (progn (forward-sexp) (point)))
11100 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11101 (match-string-no-properties 1))))))
11102 ;; special case: closing parenthesis is on separate line
11103 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11104 (setq comment (substring init (match-beginning 2)))
11105 (setq init (substring init 0 (match-beginning 1)))
11106 (vhdl-forward-syntactic-ws))
11107 (skip-chars-forward " \t")
11108 ;; parse inline comment, special case: as above, no initial.
11110 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11111 (match-string-no-properties 1))))
11112 (vhdl-forward-syntactic-ws)
11113 (setq end-of-list (vhdl-parse-string ")" t))
11114 (vhdl-parse-string "\\s-*;\\s-*")
11115 ;; parse inline comment
11117 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11118 (match-string-no-properties 1))))
11119 ;; save everything in list
11120 (setq generic-list (append generic-list
11121 (list (list names type init
11122 comment group-comment))))
11123 ;; parse group comment and spacing
11124 (setq group-comment (vhdl-parse-group-comment))))
11125 ;; parse port clause
11126 (when (vhdl-parse-string "port[ \t\n]*(" t)
11127 ;; parse group comment and spacing
11128 (setq group-comment (vhdl-parse-group-comment))
11129 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
11130 (while (not end-of-list)
11133 (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n]*" t)
11134 (match-string-no-properties 1)))
11135 ;; parse names (accept extended identifiers)
11136 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
11137 (setq names (list (match-string-no-properties 1)))
11138 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
11139 (setq names (append names (list (match-string-no-properties 1)))))
11141 (vhdl-parse-string ":[ \t\n]*")
11143 (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n]+" t)
11144 (match-string-no-properties 1)))
11146 (vhdl-parse-string "\\([^();\n]+\\)")
11147 (setq type (match-string-no-properties 1))
11148 (when (vhdl-in-comment-p) ; if stuck in comment
11149 (setq type (concat type (and (vhdl-parse-string ".*")
11150 (match-string-no-properties 0)))))
11152 (while (looking-at "(")
11153 (setq type (concat type
11154 (buffer-substring-no-properties
11155 (point) (progn (forward-sexp) (point)))
11156 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11157 (match-string-no-properties 1)))))
11158 ;; special case: closing parenthesis is on separate line
11159 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11160 (setq comment (substring type (match-beginning 2)))
11161 (setq type (substring type 0 (match-beginning 1))))
11162 ;; strip of trailing group-comment
11163 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11164 (setq type (substring type 0 (match-end 1)))
11165 (vhdl-forward-syntactic-ws)
11166 (setq end-of-list (vhdl-parse-string ")" t))
11167 (vhdl-parse-string "\\s-*;\\s-*")
11168 ;; parse inline comment
11170 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11171 (match-string-no-properties 1))))
11172 ;; save everything in list
11173 (setq port-list (append port-list
11174 (list (list names object direct type
11175 comment group-comment))))
11176 ;; parse group comment and spacing
11177 (setq group-comment (vhdl-parse-group-comment))))
11178 ; (vhdl-parse-string "end\\>")
11179 ;; parse context clause
11180 (setq context-clause (vhdl-scan-context-clause))
11181 ; ;; add surrounding package to context clause
11182 ; (when (and (equal decl-type "component")
11183 ; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
11184 ; (setq context-clause
11185 ; (append context-clause
11186 ; (list (cons (vhdl-work-library)
11187 ; (match-string-no-properties 1))))))
11188 (message "Reading port of %s \"%s\"...done" decl-type name)
11192 (error parse-error)
11193 (setq vhdl-port-list (list name generic-list port-list context-clause)
11194 vhdl-port-reversed-direction nil
11195 vhdl-port-flattened nil)))))
11197 (defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
11198 "Paste a context clause."
11199 (let ((margin (current-indentation))
11200 (clause-list (nth 3 vhdl-port-list))
11203 (setq clause (car clause-list))
11204 (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
11205 (downcase exclude-pack-name)))
11207 (re-search-backward
11208 (concat "^\\s-*use\\s-+" (car clause)
11209 "\." (cdr clause) "\\>") nil t)))
11210 (vhdl-template-standard-package (car clause) (cdr clause))
11212 (setq clause-list (cdr clause-list)))))
11214 (defun vhdl-port-paste-generic (&optional no-init)
11215 "Paste a generic clause."
11216 (let ((margin (current-indentation))
11217 (generic-list (nth 1 vhdl-port-list))
11218 list-margin start names generic)
11219 ;; paste generic clause
11221 (setq start (point))
11222 (vhdl-insert-keyword "GENERIC (")
11223 (unless vhdl-argument-list-indent
11224 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11225 (setq list-margin (current-column))
11226 (while generic-list
11227 (setq generic (car generic-list))
11228 ;; paste group comment and spacing
11229 (when (memq vhdl-include-group-comments '(decl always))
11230 (vhdl-paste-group-comment (nth 4 generic) list-margin))
11232 (setq names (nth 0 generic))
11234 (insert (car names))
11235 (setq names (cdr names))
11236 (when names (insert ", ")))
11238 (insert " : " (nth 1 generic))
11239 ;; paste initialization
11240 (when (and (not no-init) (nth 2 generic))
11241 (insert " := " (nth 2 generic)))
11242 (unless (cdr generic-list) (insert ")"))
11245 (when (and vhdl-include-port-comments (nth 3 generic))
11246 (vhdl-comment-insert-inline (nth 3 generic) t))
11247 (setq generic-list (cdr generic-list))
11248 (when generic-list (insert "\n") (indent-to list-margin)))
11249 ;; align generic clause
11250 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
11252 (defun vhdl-port-paste-port ()
11253 "Paste a port clause."
11254 (let ((margin (current-indentation))
11255 (port-list (nth 2 vhdl-port-list))
11256 list-margin start names port)
11257 ;; paste port clause
11259 (setq start (point))
11260 (vhdl-insert-keyword "PORT (")
11261 (unless vhdl-argument-list-indent
11262 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11263 (setq list-margin (current-column))
11265 (setq port (car port-list))
11266 ;; paste group comment and spacing
11267 (when (memq vhdl-include-group-comments '(decl always))
11268 (vhdl-paste-group-comment (nth 5 port) list-margin))
11270 (when (nth 1 port) (insert (nth 1 port) " "))
11272 (setq names (nth 0 port))
11274 (insert (car names))
11275 (setq names (cdr names))
11276 (when names (insert ", ")))
11279 (when (nth 2 port) (insert (nth 2 port) " "))
11281 (insert (nth 3 port))
11282 (unless (cdr port-list) (insert ")"))
11285 (when (and vhdl-include-port-comments (nth 4 port))
11286 (vhdl-comment-insert-inline (nth 4 port) t))
11287 (setq port-list (cdr port-list))
11288 (when port-list (insert "\n") (indent-to list-margin)))
11289 ;; align port clause
11290 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11292 (defun vhdl-port-paste-declaration (kind &optional no-indent)
11293 "Paste as an entity or component declaration."
11294 (unless no-indent (indent-according-to-mode))
11295 (let ((margin (current-indentation))
11296 (name (nth 0 vhdl-port-list)))
11297 (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11299 (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11300 (vhdl-insert-keyword " IS"))
11301 ;; paste generic and port clause
11302 (when (nth 1 vhdl-port-list)
11304 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11306 (indent-to (+ margin vhdl-basic-offset))
11307 (vhdl-port-paste-generic (eq kind 'component)))
11308 (when (nth 2 vhdl-port-list)
11310 (when (and (memq vhdl-insert-empty-lines '(unit all))
11313 (indent-to (+ margin vhdl-basic-offset)))
11314 (vhdl-port-paste-port)
11316 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11319 (vhdl-insert-keyword "END")
11320 (if (eq kind 'entity)
11322 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11324 (vhdl-insert-keyword " COMPONENT")
11325 (unless (vhdl-standard-p '87) (insert " " name)))
11328 (defun vhdl-port-paste-entity (&optional no-indent)
11329 "Paste as an entity declaration."
11331 (if (not vhdl-port-list)
11332 (error "ERROR: No port read")
11333 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11334 (vhdl-port-paste-declaration 'entity no-indent)
11335 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11337 (defun vhdl-port-paste-component (&optional no-indent)
11338 "Paste as a component declaration."
11340 (if (not vhdl-port-list)
11341 (error "ERROR: No port read")
11342 (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
11343 (vhdl-port-paste-declaration 'component no-indent)
11344 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
11346 (defun vhdl-port-paste-generic-map (&optional secondary no-constants)
11347 "Paste as a generic map."
11349 (unless secondary (indent-according-to-mode))
11350 (let ((margin (current-indentation))
11351 list-margin start generic
11352 (generic-list (nth 1 vhdl-port-list)))
11354 (setq start (point))
11355 (vhdl-insert-keyword "GENERIC MAP (")
11356 (if (not vhdl-association-list-with-formals)
11357 ;; paste list of actual generics
11358 (while generic-list
11359 (insert (if no-constants
11360 (car (nth 0 (car generic-list)))
11361 (or (nth 2 (car generic-list)) " ")))
11362 (setq generic-list (cdr generic-list))
11363 (insert (if generic-list ", " ")"))
11364 (when (and (not generic-list) secondary
11365 (null (nth 2 vhdl-port-list)))
11367 (unless vhdl-argument-list-indent
11368 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11369 (setq list-margin (current-column))
11370 (while generic-list
11371 (setq generic (car generic-list))
11372 ;; paste group comment and spacing
11373 (when (eq vhdl-include-group-comments 'always)
11374 (vhdl-paste-group-comment (nth 4 generic) list-margin))
11375 ;; paste formal and actual generic
11376 (insert (car (nth 0 generic)) " => "
11378 (car (nth 0 generic))
11379 (or (nth 2 generic) "")))
11380 (setq generic-list (cdr generic-list))
11381 (insert (if generic-list "," ")"))
11382 (when (and (not generic-list) secondary
11383 (null (nth 2 vhdl-port-list)))
11386 (when (or vhdl-include-type-comments
11387 (and vhdl-include-port-comments (nth 3 generic)))
11388 (vhdl-comment-insert-inline
11390 (when vhdl-include-type-comments
11391 (concat "[" (nth 1 generic) "] "))
11392 (when vhdl-include-port-comments (nth 3 generic))) t))
11393 (when generic-list (insert "\n") (indent-to list-margin)))
11394 ;; align generic map
11395 (when vhdl-auto-align
11396 (vhdl-align-region-groups start (point) 1 t))))))
11398 (defun vhdl-port-paste-port-map ()
11399 "Paste as a port map."
11400 (let ((margin (current-indentation))
11401 list-margin start port
11402 (port-list (nth 2 vhdl-port-list)))
11404 (setq start (point))
11405 (vhdl-insert-keyword "PORT MAP (")
11406 (if (not vhdl-association-list-with-formals)
11407 ;; paste list of actual ports
11409 (insert (vhdl-replace-string vhdl-actual-port-name
11410 (car (nth 0 (car port-list)))))
11411 (setq port-list (cdr port-list))
11412 (insert (if port-list ", " ")")))
11413 (unless vhdl-argument-list-indent
11414 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11415 (setq list-margin (current-column))
11417 (setq port (car port-list))
11418 ;; paste group comment and spacing
11419 (when (eq vhdl-include-group-comments 'always)
11420 (vhdl-paste-group-comment (nth 5 port) list-margin))
11421 ;; paste formal and actual port
11422 (insert (car (nth 0 port)) " => ")
11423 (insert (vhdl-replace-string vhdl-actual-port-name
11424 (car (nth 0 port))))
11425 (setq port-list (cdr port-list))
11426 (insert (if port-list "," ");"))
11428 (when (or vhdl-include-direction-comments
11429 vhdl-include-type-comments
11430 (and vhdl-include-port-comments (nth 4 port)))
11431 (vhdl-comment-insert-inline
11433 (cond ((and vhdl-include-direction-comments
11434 vhdl-include-type-comments)
11435 (concat "[" (format "%-4s" (concat (nth 2 port) " "))
11436 (nth 3 port) "] "))
11437 ((and vhdl-include-direction-comments (nth 2 port))
11438 (format "%-6s" (concat "[" (nth 2 port) "] ")))
11439 (vhdl-include-direction-comments " ")
11440 (vhdl-include-type-comments
11441 (concat "[" (nth 3 port) "] ")))
11442 (when vhdl-include-port-comments (nth 4 port))) t))
11443 (when port-list (insert "\n") (indent-to list-margin)))
11444 ;; align port clause
11445 (when vhdl-auto-align
11446 (vhdl-align-region-groups start (point) 1))))))
11448 (defun vhdl-port-paste-instance (&optional name no-indent title)
11449 "Paste as an instantiation."
11451 (if (not vhdl-port-list)
11452 (error "ERROR: No port read")
11453 (let ((orig-vhdl-port-list vhdl-port-list))
11454 ;; flatten local copy of port list (must be flat for port mapping)
11455 (vhdl-port-flatten)
11456 (unless no-indent (indent-according-to-mode))
11457 (let ((margin (current-indentation)))
11458 ;; paste instantiation
11461 ((equal (cdr vhdl-instance-name) "")
11462 (setq name (vhdl-template-field "instance name")))
11463 ((string-match "\%d" (cdr vhdl-instance-name))
11465 (while (save-excursion
11466 (setq name (format (vhdl-replace-string
11468 (nth 0 vhdl-port-list)) n))
11469 (goto-char (point-min))
11470 (vhdl-re-search-forward name nil t))
11473 (t (insert (vhdl-replace-string vhdl-instance-name
11474 (nth 0 vhdl-port-list)))))
11475 (message "Pasting port as instantiation \"%s\"..." name)
11479 (beginning-of-line)
11480 (indent-to vhdl-basic-offset)
11481 (insert "-- instance \"" name "\"\n")))
11482 (if (not (vhdl-use-direct-instantiation))
11483 (insert (nth 0 vhdl-port-list))
11484 (vhdl-insert-keyword "ENTITY ")
11485 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
11486 (when (nth 1 vhdl-port-list)
11487 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11488 (vhdl-port-paste-generic-map t t))
11489 (when (nth 2 vhdl-port-list)
11490 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11491 (vhdl-port-paste-port-map))
11492 (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list))
11494 (message "Pasting port as instantiation \"%s\"...done" name))
11495 (setq vhdl-port-list orig-vhdl-port-list))))
11497 (defun vhdl-port-paste-constants (&optional no-indent)
11498 "Paste generics as constants."
11500 (if (not vhdl-port-list)
11501 (error "ERROR: No port read")
11502 (let ((orig-vhdl-port-list vhdl-port-list))
11503 (message "Pasting port as constants...")
11504 ;; flatten local copy of port list (must be flat for constant initial.)
11505 (vhdl-port-flatten)
11506 (unless no-indent (indent-according-to-mode))
11507 (let ((margin (current-indentation))
11509 (generic-list (nth 1 vhdl-port-list)))
11511 (setq start (point))
11512 (while generic-list
11513 (setq generic (car generic-list))
11514 ;; paste group comment and spacing
11515 (when (memq vhdl-include-group-comments '(decl always))
11516 (vhdl-paste-group-comment (nth 4 generic) margin))
11517 (vhdl-insert-keyword "CONSTANT ")
11518 ;; paste generic constants
11519 (setq name (nth 0 generic))
11521 (insert (car name))
11523 (insert " : " (nth 1 generic))
11524 ;; paste initialization
11525 (when (nth 2 generic)
11526 (insert " := " (nth 2 generic)))
11529 (when (and vhdl-include-port-comments (nth 3 generic))
11530 (vhdl-comment-insert-inline (nth 3 generic) t))
11531 (setq generic-list (cdr generic-list))
11532 (when generic-list (insert "\n") (indent-to margin))))
11533 ;; align signal list
11534 (when vhdl-auto-align
11535 (vhdl-align-region-groups start (point) 1))))
11536 (message "Pasting port as constants...done")
11537 (setq vhdl-port-list orig-vhdl-port-list))))
11539 (defun vhdl-port-paste-signals (&optional initialize no-indent)
11540 "Paste ports as internal signals."
11542 (if (not vhdl-port-list)
11543 (error "ERROR: No port read")
11544 (message "Pasting port as signals...")
11545 (unless no-indent (indent-according-to-mode))
11546 (let ((margin (current-indentation))
11548 (port-list (nth 2 vhdl-port-list)))
11550 (setq start (point))
11552 (setq port (car port-list))
11553 ;; paste group comment and spacing
11554 (when (memq vhdl-include-group-comments '(decl always))
11555 (vhdl-paste-group-comment (nth 5 port) margin))
11558 (insert (nth 1 port) " ")
11559 (vhdl-insert-keyword "SIGNAL "))
11560 ;; paste actual port signals
11561 (setq names (nth 0 port))
11563 (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
11564 (setq names (cdr names))
11565 (when names (insert ", ")))
11567 (insert " : " (nth 3 port))
11568 ;; paste initialization (inputs only)
11569 (when (and initialize (equal "IN" (upcase (nth 2 port))))
11570 (insert " := " (if (string-match "(.+)" (nth 3 port))
11571 "(others => '0')" "'0'")))
11574 (when (or vhdl-include-direction-comments
11575 (and vhdl-include-port-comments (nth 4 port)))
11576 (vhdl-comment-insert-inline
11578 (cond ((and vhdl-include-direction-comments (nth 2 port))
11579 (format "%-6s" (concat "[" (nth 2 port) "] ")))
11580 (vhdl-include-direction-comments " "))
11581 (when vhdl-include-port-comments (nth 4 port))) t))
11582 (setq port-list (cdr port-list))
11583 (when port-list (insert "\n") (indent-to margin)))
11584 ;; align signal list
11585 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11586 (message "Pasting port as signals...done")))
11588 (defun vhdl-port-paste-initializations (&optional no-indent)
11589 "Paste ports as signal initializations."
11591 (if (not vhdl-port-list)
11592 (error "ERROR: No port read")
11593 (let ((orig-vhdl-port-list vhdl-port-list))
11594 (message "Pasting port as initializations...")
11595 ;; flatten local copy of port list (must be flat for signal initial.)
11596 (vhdl-port-flatten)
11597 (unless no-indent (indent-according-to-mode))
11598 (let ((margin (current-indentation))
11600 (port-list (nth 2 vhdl-port-list)))
11602 (setq start (point))
11604 (setq port (car port-list))
11605 ;; paste actual port signal (inputs only)
11606 (when (equal "IN" (upcase (nth 2 port)))
11607 (setq name (car (nth 0 port)))
11608 (insert (vhdl-replace-string vhdl-actual-port-name name))
11609 ;; paste initialization
11610 (insert " <= " (if (string-match "(.+)" (nth 3 port))
11611 "(others => '0')" "'0'") ";"))
11612 (setq port-list (cdr port-list))
11613 (when (and port-list
11614 (equal "IN" (upcase (nth 2 (car port-list)))))
11615 (insert "\n") (indent-to margin)))
11616 ;; align signal list
11617 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11618 (message "Pasting port as initializations...done")
11619 (setq vhdl-port-list orig-vhdl-port-list))))
11621 (defun vhdl-port-paste-testbench ()
11622 "Paste as a bare-bones testbench."
11624 (if (not vhdl-port-list)
11625 (error "ERROR: No port read")
11626 (let ((case-fold-search t)
11627 (ent-name (vhdl-replace-string vhdl-testbench-entity-name
11628 (nth 0 vhdl-port-list)))
11629 (source-buffer (current-buffer))
11630 arch-name config-name ent-file-name arch-file-name
11631 ent-buffer arch-buffer position)
11632 ;; open entity file
11633 (unless (eq vhdl-testbench-create-files 'none)
11634 (setq ent-file-name
11635 (concat (vhdl-replace-string vhdl-testbench-entity-file-name
11637 "." (file-name-extension (buffer-file-name))))
11638 (if (file-exists-p ent-file-name)
11640 (concat "File \"" ent-file-name "\" exists; overwrite? "))
11641 (progn (find-file ent-file-name)
11643 (set-buffer-modified-p nil))
11644 (if (eq vhdl-testbench-create-files 'separate)
11645 (setq ent-file-name nil)
11646 (error "ERROR: Pasting port as testbench...aborted")))
11647 (find-file ent-file-name)))
11648 (unless (and (eq vhdl-testbench-create-files 'separate)
11649 (null ent-file-name))
11650 ;; paste entity header
11651 (if vhdl-testbench-include-header
11652 (progn (vhdl-template-header
11653 (concat "Testbench for design \""
11654 (nth 0 vhdl-port-list) "\""))
11655 (goto-char (point-max)))
11656 (vhdl-comment-display-line) (insert "\n\n"))
11657 ;; paste std_logic_1164 package
11658 (when vhdl-testbench-include-library
11659 (vhdl-template-package-std-logic-1164)
11660 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
11661 ;; paste entity declaration
11662 (vhdl-insert-keyword "ENTITY ")
11664 (vhdl-insert-keyword " IS")
11665 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
11667 (vhdl-insert-keyword "END ")
11668 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
11669 (insert ent-name ";")
11671 (vhdl-comment-display-line) (insert "\n"))
11672 ;; get architecture name
11673 (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
11674 (read-from-minibuffer "architecture name: "
11675 nil vhdl-minibuffer-local-map)
11676 (vhdl-replace-string vhdl-testbench-architecture-name
11677 (nth 0 vhdl-port-list))))
11678 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
11679 ;; open architecture file
11680 (if (not (eq vhdl-testbench-create-files 'separate))
11682 (setq ent-buffer (current-buffer))
11683 (setq arch-file-name
11684 (concat (vhdl-replace-string vhdl-testbench-architecture-file-name
11685 (concat ent-name " " arch-name) t)
11686 "." (file-name-extension (buffer-file-name))))
11687 (when (and (file-exists-p arch-file-name)
11688 (not (y-or-n-p (concat "File \"" arch-file-name
11689 "\" exists; overwrite? "))))
11690 (error "ERROR: Pasting port as testbench...aborted"))
11691 (find-file arch-file-name)
11693 (set-buffer-modified-p nil)
11694 ;; paste architecture header
11695 (if vhdl-testbench-include-header
11696 (progn (vhdl-template-header
11697 (concat "Testbench architecture for design \""
11698 (nth 0 vhdl-port-list) "\""))
11699 (goto-char (point-max)))
11700 (vhdl-comment-display-line) (insert "\n\n")))
11701 ;; paste architecture body
11702 (vhdl-insert-keyword "ARCHITECTURE ")
11704 (vhdl-insert-keyword " OF ")
11706 (vhdl-insert-keyword " IS")
11707 (insert "\n\n") (indent-to vhdl-basic-offset)
11708 ;; paste component declaration
11709 (unless (vhdl-use-direct-instantiation)
11710 (vhdl-port-paste-component t)
11711 (insert "\n\n") (indent-to vhdl-basic-offset))
11713 (when (nth 1 vhdl-port-list)
11714 (insert "-- component generics\n") (indent-to vhdl-basic-offset)
11715 (vhdl-port-paste-constants t)
11716 (insert "\n\n") (indent-to vhdl-basic-offset))
11717 ;; paste internal signals
11718 (insert "-- component ports\n") (indent-to vhdl-basic-offset)
11719 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
11721 ;; paste custom declarations
11722 (unless (equal "" vhdl-testbench-declarations)
11724 (vhdl-insert-string-or-file vhdl-testbench-declarations))
11725 (setq position (point))
11727 (vhdl-comment-display-line) (insert "\n")
11728 (when vhdl-testbench-include-configuration
11729 (setq config-name (vhdl-replace-string
11730 vhdl-testbench-configuration-name
11731 (concat ent-name " " arch-name)))
11733 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
11734 (vhdl-insert-keyword " OF ") (insert ent-name)
11735 (vhdl-insert-keyword " IS\n")
11736 (indent-to vhdl-basic-offset)
11737 (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
11738 (indent-to vhdl-basic-offset)
11739 (vhdl-insert-keyword "END FOR;\n")
11740 (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
11741 (vhdl-comment-display-line) (insert "\n"))
11742 (goto-char position)
11743 (vhdl-template-begin-end
11744 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
11745 ;; paste instantiation
11746 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
11747 (vhdl-port-paste-instance
11748 (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
11750 ;; paste custom statements
11751 (unless (equal "" vhdl-testbench-statements)
11753 (vhdl-insert-string-or-file vhdl-testbench-statements))
11755 (indent-to vhdl-basic-offset)
11756 (unless (eq vhdl-testbench-create-files 'none)
11757 (setq arch-buffer (current-buffer))
11758 (when ent-buffer (set-buffer ent-buffer) (save-buffer))
11759 (set-buffer arch-buffer) (save-buffer))
11761 (concat (format "Pasting port as testbench \"%s(%s)\"...done"
11762 ent-name arch-name)
11764 (format "\n File created: \"%s\"" ent-file-name))
11765 (and arch-file-name
11766 (format "\n File created: \"%s\"" arch-file-name)))))))
11769 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11770 ;;; Subprogram interface translation
11771 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11773 (defvar vhdl-subprog-list nil
11774 "Variable to hold last subprogram interface parsed.")
11775 ;; structure: (parenthesised expression means list of such entries)
11776 ;; (subprog-name kind
11777 ;; ((names) object direct type init comment group-comment)
11778 ;; return-type return-comment group-comment)
11780 (defvar vhdl-subprog-flattened nil
11781 "Indicates whether an subprogram interface has been flattened.")
11783 (defun vhdl-subprog-flatten ()
11784 "Flatten interface list so that only one parameter exists per line."
11786 (if (not vhdl-subprog-list)
11787 (error "ERROR: No subprogram interface has been read")
11788 (message "Flattening subprogram interface...")
11789 (let ((old-subprog-list (nth 2 vhdl-subprog-list))
11790 new-subprog-list old-subprog new-subprog names)
11791 ;; traverse parameter list and flatten entries
11792 (while old-subprog-list
11793 (setq old-subprog (car old-subprog-list))
11794 (setq names (car old-subprog))
11796 (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
11797 (setq new-subprog-list (append new-subprog-list (list new-subprog)))
11798 (setq names (cdr names)))
11799 (setq old-subprog-list (cdr old-subprog-list)))
11800 (setq vhdl-subprog-list
11801 (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
11802 new-subprog-list (nth 3 vhdl-subprog-list)
11803 (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
11804 vhdl-subprog-flattened t)
11805 (message "Flattening subprogram interface...done"))))
11807 (defun vhdl-subprog-copy ()
11808 "Get interface information from a subprogram specification."
11811 (let (parse-error pos end-of-list
11812 name kind param-list object names direct type init
11813 comment group-comment
11814 return-type return-comment return-group-comment)
11815 (vhdl-prepare-search-2
11819 ;; check if within function declaration
11822 (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
11823 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
11824 (goto-char (match-end 0))
11825 (save-excursion (backward-char)
11828 (throw 'parse "ERROR: Not within a subprogram specification"))
11829 (setq name (match-string-no-properties 5))
11830 (setq kind (if (match-string 2) 'procedure 'function))
11831 (setq end-of-list (not (match-string 7)))
11832 (message "Reading interface of subprogram \"%s\"..." name)
11833 ;; parse parameter list
11834 (setq group-comment (vhdl-parse-group-comment))
11835 (setq end-of-list (or end-of-list
11836 (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
11837 (while (not end-of-list)
11840 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
11841 (match-string-no-properties 1)))
11842 ;; parse names (accept extended identifiers)
11843 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
11844 (setq names (list (match-string-no-properties 1)))
11845 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
11846 (setq names (append names (list (match-string-no-properties 1)))))
11848 (vhdl-parse-string ":[ \t\n]*")
11850 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
11851 (match-string-no-properties 1)))
11853 (vhdl-parse-string "\\([^():;\n]+\\)")
11854 (setq type (match-string-no-properties 1))
11856 (while (looking-at "(")
11859 (buffer-substring-no-properties
11860 (point) (progn (forward-sexp) (point)))
11861 (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11862 (match-string-no-properties 1)))))
11863 ;; special case: closing parenthesis is on separate line
11864 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11865 (setq comment (substring type (match-beginning 2)))
11866 (setq type (substring type 0 (match-beginning 1))))
11867 ;; strip off trailing group-comment
11868 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11869 (setq type (substring type 0 (match-end 1)))
11870 ;; parse initialization expression
11872 (when (vhdl-parse-string ":=[ \t\n]*" t)
11873 (vhdl-parse-string "\\([^();\n]*\\)")
11874 (setq init (match-string-no-properties 1))
11875 (while (looking-at "(")
11878 (buffer-substring-no-properties
11879 (point) (progn (forward-sexp) (point)))
11880 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11881 (match-string-no-properties 1))))))
11882 ;; special case: closing parenthesis is on separate line
11883 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11884 (setq comment (substring init (match-beginning 2)))
11885 (setq init (substring init 0 (match-beginning 1)))
11886 (vhdl-forward-syntactic-ws))
11887 (skip-chars-forward " \t")
11888 ;; parse inline comment, special case: as above, no initial.
11890 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11891 (match-string-no-properties 1))))
11892 (vhdl-forward-syntactic-ws)
11893 (setq end-of-list (vhdl-parse-string ")\\s-*" t))
11894 ;; parse inline comment
11896 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11897 (match-string-no-properties 1))))
11898 (setq return-group-comment (vhdl-parse-group-comment))
11899 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
11900 ;; parse return type
11901 (when (match-string 3)
11902 (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
11903 (setq return-type (match-string-no-properties 1))
11904 (when (and return-type
11905 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
11906 (setq return-comment (substring return-type (match-beginning 2)))
11907 (setq return-type (substring return-type 0 (match-beginning 1))))
11908 ;; strip of trailing group-comment
11909 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
11910 (setq return-type (substring return-type 0 (match-end 1)))
11911 ;; parse return comment
11912 (unless return-comment
11913 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11914 (match-string-no-properties 1)))))
11915 ;; parse inline comment
11917 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11918 (match-string-no-properties 1))))
11919 ;; save everything in list
11920 (setq param-list (append param-list
11921 (list (list names object direct type init
11922 comment group-comment))))
11923 ;; parse group comment and spacing
11924 (setq group-comment (vhdl-parse-group-comment)))
11925 (message "Reading interface of subprogram \"%s\"...done" name)
11929 (error parse-error)
11930 (setq vhdl-subprog-list
11931 (list name kind param-list return-type return-comment
11932 return-group-comment)
11933 vhdl-subprog-flattened nil)))))
11935 (defun vhdl-subprog-paste-specification (kind)
11936 "Paste as a subprogram specification."
11937 (indent-according-to-mode)
11938 (let ((margin (current-column))
11939 (param-list (nth 2 vhdl-subprog-list))
11940 list-margin start names param)
11941 ;; paste keyword and name
11942 (vhdl-insert-keyword
11943 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
11944 (insert (nth 0 vhdl-subprog-list))
11945 (if (not param-list)
11946 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11947 (setq start (point))
11948 ;; paste parameter list
11950 (unless vhdl-argument-list-indent
11951 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11952 (setq list-margin (current-column))
11954 (setq param (car param-list))
11955 ;; paste group comment and spacing
11956 (when (memq vhdl-include-group-comments (list kind 'always))
11957 (vhdl-paste-group-comment (nth 6 param) list-margin))
11959 (when (nth 1 param) (insert (nth 1 param) " "))
11961 (setq names (nth 0 param))
11963 (insert (car names))
11964 (setq names (cdr names))
11965 (when names (insert ", ")))
11968 (when (nth 2 param) (insert (nth 2 param) " "))
11970 (insert (nth 3 param))
11971 ;; paste initialization
11972 (when (nth 4 param) (insert " := " (nth 4 param)))
11974 (if (cdr param-list)
11977 (when (null (nth 3 vhdl-subprog-list))
11978 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
11980 (when (and vhdl-include-port-comments (nth 5 param))
11981 (vhdl-comment-insert-inline (nth 5 param) t))
11982 (setq param-list (cdr param-list))
11983 (when param-list (insert "\n") (indent-to list-margin)))
11984 (when (nth 3 vhdl-subprog-list)
11985 (insert "\n") (indent-to list-margin)
11986 ;; paste group comment and spacing
11987 (when (memq vhdl-include-group-comments (list kind 'always))
11988 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
11989 ;; paste return type
11990 (insert "return " (nth 3 vhdl-subprog-list))
11991 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11992 (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
11993 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
11994 ;; align parameter list
11995 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
11997 (when (eq kind 'body)
11999 (vhdl-template-begin-end
12000 (unless (vhdl-standard-p '87)
12001 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
12002 (nth 0 vhdl-subprog-list) margin))))
12004 (defun vhdl-subprog-paste-declaration ()
12005 "Paste as a subprogram declaration."
12007 (if (not vhdl-subprog-list)
12008 (error "ERROR: No subprogram interface read")
12009 (message "Pasting interface as subprogram declaration \"%s\"..."
12010 (car vhdl-subprog-list))
12011 ;; paste specification
12012 (vhdl-subprog-paste-specification 'decl)
12013 (message "Pasting interface as subprogram declaration \"%s\"...done"
12014 (car vhdl-subprog-list))))
12016 (defun vhdl-subprog-paste-body ()
12017 "Paste as a subprogram body."
12019 (if (not vhdl-subprog-list)
12020 (error "ERROR: No subprogram interface read")
12021 (message "Pasting interface as subprogram body \"%s\"..."
12022 (car vhdl-subprog-list))
12023 ;; paste specification and body
12024 (vhdl-subprog-paste-specification 'body)
12025 (message "Pasting interface as subprogram body \"%s\"...done"
12026 (car vhdl-subprog-list))))
12028 (defun vhdl-subprog-paste-call ()
12029 "Paste as a subprogram call."
12031 (if (not vhdl-subprog-list)
12032 (error "ERROR: No subprogram interface read")
12033 (let ((orig-vhdl-subprog-list vhdl-subprog-list)
12034 param-list margin list-margin param start)
12035 ;; flatten local copy of interface list (must be flat for parameter mapping)
12036 (vhdl-subprog-flatten)
12037 (setq param-list (nth 2 vhdl-subprog-list))
12038 (indent-according-to-mode)
12039 (setq margin (current-indentation))
12040 (message "Pasting interface as subprogram call \"%s\"..."
12041 (car vhdl-subprog-list))
12043 (insert (nth 0 vhdl-subprog-list))
12044 (if (not param-list)
12046 (setq start (point))
12047 ;; paste parameter list
12049 (unless vhdl-argument-list-indent
12050 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12051 (setq list-margin (current-column))
12053 (setq param (car param-list))
12054 ;; paste group comment and spacing
12055 (when (eq vhdl-include-group-comments 'always)
12056 (vhdl-paste-group-comment (nth 6 param) list-margin))
12057 ;; paste formal port
12058 (insert (car (nth 0 param)) " => ")
12059 (setq param-list (cdr param-list))
12060 (insert (if param-list "," ");"))
12062 (when (and vhdl-include-port-comments (nth 5 param))
12063 (vhdl-comment-insert-inline (nth 5 param)))
12064 (when param-list (insert "\n") (indent-to list-margin)))
12065 ;; align parameter list
12066 (when vhdl-auto-align
12067 (vhdl-align-region-groups start (point) 1)))
12068 (message "Pasting interface as subprogram call \"%s\"...done"
12069 (car vhdl-subprog-list))
12070 (setq vhdl-subprog-list orig-vhdl-subprog-list))))
12073 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12075 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12077 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12078 ;; Hippie expand customization
12080 (defvar vhdl-expand-upper-case nil)
12082 (defun vhdl-try-expand-abbrev (old)
12083 "Try expanding abbreviations from `vhdl-abbrev-list'."
12085 (he-init-string (he-dabbrev-beg) (point))
12086 (setq he-expand-list
12087 (let ((abbrev-list vhdl-abbrev-list)
12088 (sel-abbrev-list '()))
12090 (when (or (not (stringp (car abbrev-list)))
12092 (concat "^" he-search-string) (car abbrev-list)))
12093 (setq sel-abbrev-list
12094 (cons (car abbrev-list) sel-abbrev-list)))
12095 (setq abbrev-list (cdr abbrev-list)))
12096 (nreverse sel-abbrev-list))))
12097 (while (and he-expand-list
12098 (or (not (stringp (car he-expand-list)))
12099 (he-string-member (car he-expand-list) he-tried-table t)))
12100 ; (equal (car he-expand-list) he-search-string)))
12101 (unless (stringp (car he-expand-list))
12102 (setq vhdl-expand-upper-case (car he-expand-list)))
12103 (setq he-expand-list (cdr he-expand-list)))
12104 (if (null he-expand-list)
12105 (progn (when old (he-reset-string))
12107 (he-substitute-string
12108 (if vhdl-expand-upper-case
12109 (upcase (car he-expand-list))
12110 (car he-expand-list))
12112 (setq he-expand-list (cdr he-expand-list))
12115 (defun vhdl-he-list-beg ()
12116 "Also looks at the word before `(' in order to better match parenthesized
12117 expressions (e.g. for index ranges of types and signals)."
12120 (progn (backward-up-list 1)
12121 (skip-syntax-backward "w_")) ; crashes in `viper-mode'
12125 ;; override `he-list-beg' from `hippie-exp'
12126 (unless (and (boundp 'viper-mode) viper-mode)
12127 (defalias 'he-list-beg 'vhdl-he-list-beg))
12129 ;; function for expanding abbrevs and dabbrevs
12130 (defun vhdl-expand-abbrev (arg))
12131 (fset 'vhdl-expand-abbrev (make-hippie-expand-function
12132 '(try-expand-dabbrev
12133 try-expand-dabbrev-all-buffers
12134 vhdl-try-expand-abbrev)))
12136 ;; function for expanding parenthesis
12137 (defun vhdl-expand-paren (arg))
12138 (fset 'vhdl-expand-paren (make-hippie-expand-function
12140 try-expand-list-all-buffers)))
12142 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12145 (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
12146 "Convert all words matching word-regexp in region to lower or upper case,
12147 depending on parameter upper-case."
12148 (let ((case-replace nil)
12150 (vhdl-prepare-search-2
12153 (setq end (point-marker))
12155 (while (re-search-forward word-regexp end t)
12156 (or (vhdl-in-literal)
12159 (downcase-word -1)))
12160 (when (and count vhdl-progress-interval (not noninteractive)
12161 (< vhdl-progress-interval
12162 (- (nth 1 (current-time)) last-update)))
12163 (message "Fixing case... (%2d%s)"
12164 (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))
12166 (setq last-update (nth 1 (current-time)))))
12167 (goto-char end)))))
12169 (defun vhdl-fix-case-region (beg end &optional arg)
12170 "Convert all VHDL words in region to lower or upper case, depending on
12171 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
12172 (interactive "r\nP")
12173 (vhdl-fix-case-region-1
12174 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
12175 (vhdl-fix-case-region-1
12176 beg end vhdl-upper-case-types vhdl-types-regexp 1)
12177 (vhdl-fix-case-region-1
12178 beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
12179 (vhdl-fix-case-region-1
12180 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
12181 (when vhdl-progress-interval (message "Fixing case...done")))
12183 (defun vhdl-fix-case-buffer ()
12184 "Convert all VHDL words in buffer to lower or upper case, depending on
12185 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
12187 (vhdl-fix-case-region (point-min) (point-max)))
12189 (defun vhdl-fix-case-word (&optional arg)
12190 "Convert word after cursor to upper case if necessary."
12193 (when arg (backward-word 1))
12194 (vhdl-prepare-search-1
12195 (when (and vhdl-upper-case-keywords
12196 (looking-at vhdl-keywords-regexp))
12198 (when (and vhdl-upper-case-types
12199 (looking-at vhdl-types-regexp))
12201 (when (and vhdl-upper-case-attributes
12202 (looking-at vhdl-attributes-regexp))
12204 (when (and vhdl-upper-case-enum-values
12205 (looking-at vhdl-enum-values-regexp))
12206 (upcase-word 1)))))
12208 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12209 ;; Line handling functions
12211 (defun vhdl-current-line ()
12212 "Return the line number of the line containing point."
12216 (beginning-of-line)
12217 (1+ (count-lines 1 (point))))))
12219 (defun vhdl-line-kill-entire (&optional arg)
12220 "Delete entire line."
12222 (beginning-of-line)
12223 (kill-line (or arg 1)))
12225 (defun vhdl-line-kill (&optional arg)
12226 "Kill current line."
12228 (vhdl-line-kill-entire arg))
12230 (defun vhdl-line-copy (&optional arg)
12231 "Copy current line."
12234 (beginning-of-line)
12235 (let ((position (point)))
12236 (forward-line (or arg 1))
12237 (copy-region-as-kill position (point)))))
12239 (defun vhdl-line-yank ()
12240 "Yank entire line."
12242 (beginning-of-line)
12245 (defun vhdl-line-expand (&optional prefix-arg)
12246 "Hippie-expand current line."
12248 (let ((case-fold-search t) (case-replace nil)
12249 (hippie-expand-try-functions-list
12250 '(try-expand-line try-expand-line-all-buffers)))
12251 (hippie-expand prefix-arg)))
12253 (defun vhdl-line-transpose-next (&optional arg)
12254 "Interchange this line with next line."
12257 (transpose-lines (or arg 1))
12260 (defun vhdl-line-transpose-previous (&optional arg)
12261 "Interchange this line with previous line."
12264 (transpose-lines (- 0 (or arg 0)))
12267 (defun vhdl-line-open ()
12268 "Open a new line and indent."
12271 (newline-and-indent))
12273 (defun vhdl-delete-indentation ()
12274 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that
12275 it works within comments too."
12277 (let ((fill-prefix "-- "))
12278 (delete-indentation)))
12280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12283 (defun vhdl-forward-same-indent ()
12284 "Move forward to next line with same indent."
12286 (let ((pos (point))
12287 (indent (current-indentation)))
12288 (beginning-of-line 2)
12289 (while (and (not (eobp))
12290 (or (looking-at "^\\s-*\\(--.*\\)?$")
12291 (> (current-indentation) indent)))
12292 (beginning-of-line 2))
12293 (if (= (current-indentation) indent)
12294 (back-to-indentation)
12295 (message "No following line with same indent found in this block")
12299 (defun vhdl-backward-same-indent ()
12300 "Move backward to previous line with same indent."
12302 (let ((pos (point))
12303 (indent (current-indentation)))
12304 (beginning-of-line -0)
12305 (while (and (not (bobp))
12306 (or (looking-at "^\\s-*\\(--.*\\)?$")
12307 (> (current-indentation) indent)))
12308 (beginning-of-line -0))
12309 (if (= (current-indentation) indent)
12310 (back-to-indentation)
12311 (message "No preceding line with same indent found in this block")
12315 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12318 (defun vhdl-statistics-buffer ()
12319 "Get some file statistics."
12323 (no-lines (count-lines (point-min) (point-max))))
12325 ;; count statements
12326 (goto-char (point-min))
12327 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12328 (if (match-string 1)
12329 (goto-char (match-end 1))
12330 (setq no-stats (1+ no-stats))))
12331 ;; count code lines
12332 (goto-char (point-min))
12333 (while (not (eobp))
12334 (unless (looking-at "^\\s-*\\(--.*\\)?$")
12335 (setq no-code-lines (1+ no-code-lines)))
12336 (beginning-of-line 2)))
12339 File statistics: \"%s\"\n\
12340 ---------------------\n\
12341 # statements : %5d\n\
12342 # code lines : %5d\n\
12343 # total lines : %5d\n\ "
12344 (buffer-file-name) no-stats no-code-lines no-lines)
12345 (unless vhdl-emacs-21 (vhdl-show-messages))))
12347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12350 (defun vhdl-re-search-forward (regexp &optional bound noerror count)
12351 "Like `re-search-forward', but does not match within literals."
12354 (while (and (setq pos (re-search-forward regexp bound noerror count))
12355 (vhdl-in-literal))))
12356 (when pos (goto-char pos))
12359 (defun vhdl-re-search-backward (regexp &optional bound noerror count)
12360 "Like `re-search-backward', but does not match within literals."
12363 (while (and (setq pos (re-search-backward regexp bound noerror count))
12364 (vhdl-in-literal))))
12365 (when pos (goto-char pos))
12369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12371 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12373 (defun vhdl-set-project (name)
12374 "Set current project to NAME."
12376 (list (let ((completion-ignore-case t))
12377 (completing-read "Project name: " vhdl-project-alist nil t))))
12378 (cond ((equal name "")
12379 (setq vhdl-project nil)
12380 (message "Current VHDL project: None"))
12381 ((assoc name vhdl-project-alist)
12382 (setq vhdl-project name)
12383 (message "Current VHDL project: \"%s\"" name))
12385 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
12386 (vhdl-speedbar-update-current-project))
12388 (defun vhdl-set-default-project ()
12389 "Set current project as default on startup."
12391 (customize-set-variable 'vhdl-project vhdl-project)
12392 (customize-save-customized))
12394 (defun vhdl-toggle-project (name token indent)
12395 "Set current project to NAME or unset if NAME is current project."
12396 (vhdl-set-project (if (equal name vhdl-project) "" name)))
12398 (defun vhdl-export-project (file-name)
12399 "Write project setup for current project."
12401 (let ((name (vhdl-resolve-env-variable
12402 (vhdl-replace-string
12403 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12404 (concat (subst-char-in-string
12405 ? ?_ (or (vhdl-project-p)
12406 (error "ERROR: No current project")))
12407 " " (user-login-name))))))
12408 (list (read-file-name
12409 "Write project file: "
12410 (when (file-name-absolute-p name) "") nil nil name))))
12411 (setq file-name (abbreviate-file-name file-name))
12412 (let ((orig-buffer (current-buffer)))
12413 (unless (file-exists-p (file-name-directory file-name))
12414 (make-directory (file-name-directory file-name) t))
12415 (if (not (file-writable-p file-name))
12416 (error "ERROR: File not writable: \"%s\"" file-name)
12417 (set-buffer (find-file-noselect file-name t t))
12419 (insert ";; -*- Emacs-Lisp -*-\n\n"
12420 ";;; " (file-name-nondirectory file-name)
12421 " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
12422 ";; Project : " vhdl-project "\n"
12423 ";; Saved : " (format-time-string "%Y-%m-%d %T ")
12424 (user-login-name) "\n\n\n"
12425 ";; project name\n"
12426 "(setq vhdl-project \"" vhdl-project "\")\n\n"
12427 ";; project setup\n"
12428 "(aput 'vhdl-project-alist vhdl-project\n'")
12429 (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
12432 (kill-buffer (current-buffer))
12433 (set-buffer orig-buffer))))
12435 (defun vhdl-import-project (file-name &optional auto not-make-current)
12436 "Read project setup and set current project."
12438 (let ((name (vhdl-resolve-env-variable
12439 (vhdl-replace-string
12440 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12441 (concat "" " " (user-login-name))))))
12442 (list (read-file-name
12443 "Read project file: " (when (file-name-absolute-p name) "") nil t
12444 (file-name-directory name)))))
12445 (when (file-exists-p file-name)
12447 (let ((current-project vhdl-project))
12448 (load-file file-name)
12449 (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
12450 (adelete 'vhdl-project-alist vhdl-project)
12452 (when not-make-current
12453 (setq vhdl-project current-project))
12454 (vhdl-update-mode-menu)
12455 (vhdl-speedbar-refresh)
12456 (unless not-make-current
12457 (message "Current VHDL project: \"%s\"%s"
12458 vhdl-project (if auto " (auto-loaded)" ""))))
12459 (error (vhdl-warning
12460 (format "ERROR: Invalid project setup file: \"%s\"" file-name))))))
12462 (defun vhdl-duplicate-project ()
12463 "Duplicate setup of current project."
12465 (let ((new-name (read-from-minibuffer "New project name: "))
12466 (project-entry (aget vhdl-project-alist vhdl-project t)))
12467 (setq vhdl-project-alist
12468 (append vhdl-project-alist
12469 (list (cons new-name project-entry))))
12470 (vhdl-update-mode-menu)))
12472 (defun vhdl-auto-load-project ()
12473 "Automatically load project setup at startup."
12474 (let ((file-name-list vhdl-project-file-name)
12475 file-list list-length)
12476 (while file-name-list
12479 (file-expand-wildcards
12480 (vhdl-resolve-env-variable
12481 (vhdl-replace-string
12482 (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
12483 (concat "\*" " " (user-login-name)))))))
12484 (setq list-length (or list-length (length file-list)))
12485 (setq file-name-list (cdr file-name-list)))
12487 (vhdl-import-project (expand-file-name (car file-list)) t
12488 (not (> list-length 0)))
12489 (setq list-length (1- list-length))
12490 (setq file-list (cdr file-list)))))
12492 ;; automatically load project setup when idle after startup
12493 (when (memq 'startup vhdl-project-auto-load)
12495 (vhdl-auto-load-project)
12496 (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project)))
12499 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12501 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12502 ;; (using `hideshow.el')
12504 (defconst vhdl-hs-start-regexp
12507 ;; generic/port clause
12508 "\\(generic\\|port\\)[ \t\n]*(\\|"
12511 ;; component instantiation
12512 "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*"
12513 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12514 "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*"
12515 "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|"
12517 "\\(function\\|procedure\\)\\>\\|"
12519 "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|"
12520 ;; configuration declaration
12523 "Regexp to match start of construct to hide.")
12525 (defun vhdl-hs-forward-sexp-func (count)
12526 "Find end of construct to hide (for hideshow). Only searches forward."
12527 (let ((pos (point)))
12528 (vhdl-prepare-search-2
12529 (beginning-of-line)
12531 ;; generic/port clause
12532 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(")
12533 (goto-char (match-end 0))
12536 ;; component declaration
12537 ((looking-at "^\\s-*component\\>")
12538 (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
12539 ;; component instantiation
12542 "^\\s-*\\w+\\s-*:[ \t\n]*"
12543 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12544 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*"
12545 "\\(generic\\|port\\)\\s-+map[ \t\n]*("))
12546 (goto-char (match-end 0))
12550 (vhdl-forward-syntactic-ws)
12551 (when (looking-at "port\\s-+map[ \t\n]*(")
12552 (goto-char (match-end 0))
12555 (setq pos (point)))
12557 ;; subprogram declaration/body
12558 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
12559 (goto-char (match-end 0))
12560 (vhdl-forward-syntactic-ws)
12561 (when (looking-at "(")
12563 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
12564 (vhdl-in-literal)))
12566 (when (match-string 2)
12567 (re-search-forward "^\\s-*\\<begin\\>" nil t)
12569 (vhdl-forward-sexp)))
12570 ;; block (recursive)
12571 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
12572 (goto-char (match-end 0))
12573 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
12574 (match-beginning 2))
12575 (vhdl-hs-forward-sexp-func count)))
12577 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
12578 (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
12579 ;; configuration declaration
12580 ((looking-at "^\\s-*configuration\\>")
12582 (vhdl-forward-sexp))
12583 (t (goto-char pos))))))
12585 (defun vhdl-hideshow-init ()
12586 "Initialize `hideshow'."
12587 (when vhdl-hideshow-menu
12588 (vhdl-hs-minor-mode 1)))
12590 (defun vhdl-hs-minor-mode (&optional arg)
12591 "Toggle hideshow minor mode and update menu bar."
12593 (require 'hideshow)
12594 ;; check for hideshow version 5.x
12595 (if (not (boundp 'hs-block-start-mdata-select))
12596 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
12597 ;; initialize hideshow
12598 (unless (assoc 'vhdl-mode hs-special-modes-alist)
12599 (setq hs-special-modes-alist
12600 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
12601 'vhdl-hs-forward-sexp-func nil)
12602 hs-special-modes-alist)))
12603 (make-local-variable 'hs-minor-mode-hook)
12604 (if vhdl-hide-all-init
12605 (add-hook 'hs-minor-mode-hook 'hs-hide-all)
12606 (remove-hook 'hs-minor-mode-hook 'hs-hide-all))
12607 (hs-minor-mode arg)
12608 (vhdl-mode-line-update))) ; hack to update menu bar
12611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12613 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12614 ;; (using `font-lock.el')
12616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12619 (defun vhdl-within-translate-off ()
12620 "Return point if within translate-off region, else nil."
12621 (and (save-excursion
12622 (re-search-backward
12623 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t))
12624 (equal "off" (match-string 1))
12627 (defun vhdl-start-translate-off (limit)
12628 "Return point before translate-off pragma if before LIMIT, else nil."
12629 (when (re-search-forward
12630 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t)
12631 (match-beginning 0)))
12633 (defun vhdl-end-translate-off (limit)
12634 "Return point after translate-on pragma if before LIMIT, else nil."
12635 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t))
12637 (defun vhdl-match-translate-off (limit)
12638 "Match a translate-off block, setting match-data and returning t, else nil."
12639 (when (< (point) limit)
12640 (let ((start (or (vhdl-within-translate-off)
12641 (vhdl-start-translate-off limit)))
12642 (case-fold-search t))
12644 (let ((end (or (vhdl-end-translate-off limit) limit)))
12645 (set-match-data (list start end))
12646 (goto-char end))))))
12648 (defun vhdl-font-lock-match-item (limit)
12649 "Match, and move over, any declaration item after point. Adapted from
12650 `font-lock-match-c-style-declaration-item-and-skip-to-next'."
12651 (condition-case nil
12653 (narrow-to-region (point-min) limit)
12655 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
12657 (goto-char (match-end 1))
12658 ;; move to next item
12659 (if (looking-at "\\(\\s-*,\\)")
12660 (goto-char (match-end 1))
12661 (end-of-line) t))))
12664 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12665 ;; Syntax definitions
12667 (defconst vhdl-font-lock-syntactic-keywords
12668 '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
12669 "Mark single quotes as having string quote syntax in 'c' instances.")
12671 (defvar vhdl-font-lock-keywords nil
12672 "Regular expressions to highlight in VHDL Mode.")
12674 (defvar vhdl-font-lock-keywords-0
12675 ;; set in `vhdl-font-lock-init' because dependent on user options
12676 "For consideration as a value of `vhdl-font-lock-keywords'.
12677 This does highlighting of template prompts and directives (pragmas).")
12679 (defvar vhdl-font-lock-keywords-1 nil
12680 ;; set in `vhdl-font-lock-init' because dependent on user options
12681 "For consideration as a value of `vhdl-font-lock-keywords'.
12682 This does highlighting of keywords and standard identifiers.")
12684 (defconst vhdl-font-lock-keywords-2
12686 ;; highlight names of units, subprograms, and components when declared
12690 "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
12691 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
12692 "\\)\\s-+\\(\\w+\\)")
12693 5 'font-lock-function-name-face)
12695 ;; highlight entity names of architectures and configurations
12697 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
12698 2 'font-lock-function-name-face)
12700 ;; highlight labels of common constructs
12703 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\("
12704 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
12705 "postponed\\|process\\|"
12706 (when (vhdl-standard-p 'ams) "procedural\\|")
12708 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)")
12709 1 'font-lock-function-name-face)
12711 ;; highlight label and component name of component instantiations
12714 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)"
12715 "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)")
12716 '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
12718 ;; highlight label and instantiated unit of component instantiations
12721 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*"
12722 "\\(component\\|configuration\\|entity\\)\\s-+"
12723 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
12724 '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
12725 '(5 font-lock-function-name-face nil t)
12726 '(7 font-lock-function-name-face nil t))
12728 ;; highlight names and labels at end of constructs
12731 "^\\s-*end\\s-+\\(\\("
12732 "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
12733 "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
12734 "procedure\\|\\(postponed\\s-+\\)?process\\|"
12735 (when (vhdl-standard-p 'ams) "procedural\\|")
12737 "\\)\\s-+\\)?\\(\\w*\\)")
12738 5 'font-lock-function-name-face)
12740 ;; highlight labels in exit and next statements
12743 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
12744 3 'font-lock-function-name-face)
12746 ;; highlight entity name in attribute specifications
12749 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
12750 1 'font-lock-function-name-face)
12752 ;; highlight labels in block and component specifications
12755 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
12756 "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)")
12757 '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
12759 ;; highlight names in library clauses
12760 (list "^\\s-*library\\>"
12761 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
12763 ;; highlight names in use clauses
12766 "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
12767 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
12768 '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
12769 '(7 font-lock-function-name-face nil t))
12771 ;; highlight attribute name in attribute declarations/specifications
12774 "^\\s-*attribute\\s-+\\(\\w+\\)")
12775 1 'vhdl-font-lock-attribute-face)
12777 ;; highlight type/nature name in (sub)type/(sub)nature declarations
12780 "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)")
12781 3 'font-lock-type-face)
12783 ;; highlight signal/variable/constant declaration names
12784 (list "\\(:[^=]\\)"
12785 '(vhdl-font-lock-match-item
12786 (progn (goto-char (match-beginning 1))
12787 (skip-syntax-backward " ")
12788 (skip-syntax-backward "w_")
12789 (skip-syntax-backward " ")
12790 (while (= (preceding-char) ?,)
12792 (skip-syntax-backward " ")
12793 (skip-syntax-backward "w_")
12794 (skip-syntax-backward " ")))
12795 ; (skip-chars-backward "^-(\n\";")
12796 (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12798 ;; highlight formal parameters in component instantiations and subprogram
12801 '(vhdl-font-lock-match-item
12802 (progn (goto-char (match-beginning 1))
12803 (skip-syntax-backward " ")
12804 (while (= (preceding-char) ?\)) (backward-sexp))
12805 (skip-syntax-backward "w_")
12806 (skip-syntax-backward " ")
12807 (when (memq (preceding-char) '(?n ?N ?|))
12808 (goto-char (point-max))))
12809 (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12811 ;; highlight alias/group/quantity declaration names and for-loop/-generate
12813 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
12814 '(vhdl-font-lock-match-item
12815 (progn (goto-char (match-end 1)) (match-beginning 2))
12816 nil (1 font-lock-variable-name-face)))
12818 "For consideration as a value of `vhdl-font-lock-keywords'.
12819 This does context sensitive highlighting of names and labels.")
12821 (defvar vhdl-font-lock-keywords-3 nil
12822 ;; set in `vhdl-font-lock-init' because dependent on user options
12823 "For consideration as a value of `vhdl-font-lock-keywords'.
12824 This does highlighting of words with special syntax.")
12826 (defvar vhdl-font-lock-keywords-4 nil
12827 ;; set in `vhdl-font-lock-init' because dependent on user options
12828 "For consideration as a value of `vhdl-font-lock-keywords'.
12829 This does highlighting of additional reserved words.")
12831 (defconst vhdl-font-lock-keywords-5
12832 ;; background highlight translate-off regions
12833 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append)))
12834 "For consideration as a value of `vhdl-font-lock-keywords'.
12835 This does background highlighting of translate-off regions.")
12837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12838 ;; Font and color definitions
12840 (defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face
12841 "Face name to use for prompts.")
12843 (defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face
12844 "Face name to use for standardized attributes.")
12846 (defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face
12847 "Face name to use for standardized enumeration values.")
12849 (defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face
12850 "Face name to use for standardized functions and packages.")
12852 (defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face
12853 "Face name to use for directives.")
12855 (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face
12856 "Face name to use for additional reserved words.")
12858 (defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face
12859 "Face name to use for translate-off regions.")
12861 ;; face names to use for words with special syntax.
12862 (let ((syntax-alist vhdl-special-syntax-alist)
12864 (while syntax-alist
12865 (setq name (vhdl-function-name
12866 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
12867 (eval `(defvar ,name ',name
12868 ,(concat "Face name to use for "
12869 (nth 0 (car syntax-alist)) ".")))
12870 (setq syntax-alist (cdr syntax-alist))))
12872 (defgroup vhdl-highlight-faces nil
12873 "Faces for highlighting."
12874 :group 'vhdl-highlight)
12876 ;; add faces used from `font-lock'
12877 (custom-add-to-group
12878 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face)
12879 (custom-add-to-group
12880 'vhdl-highlight-faces 'font-lock-string-face 'custom-face)
12881 (custom-add-to-group
12882 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face)
12883 (custom-add-to-group
12884 'vhdl-highlight-faces 'font-lock-type-face 'custom-face)
12885 (custom-add-to-group
12886 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face)
12887 (custom-add-to-group
12888 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
12890 (defface vhdl-font-lock-prompt-face
12891 '(;(((min-colors 88) (class color) (background light)) ; Emacs 22
12892 ; (:foreground "Red1" :bold t))
12893 (((class color) (background light)) (:foreground "Red" :bold t))
12894 (((class color) (background dark)) (:foreground "Pink" :bold t))
12895 (t (:inverse-video t)))
12896 "Font lock mode face used to highlight prompts."
12897 :group 'vhdl-highlight-faces
12898 :group 'font-lock-highlighting-faces)
12900 (defface vhdl-font-lock-attribute-face
12901 '((((class color) (background light)) (:foreground "Orchid"))
12902 (((class color) (background dark)) (:foreground "LightSteelBlue"))
12903 (t (:italic t :bold t)))
12904 "Font lock mode face used to highlight standardized attributes."
12905 :group 'vhdl-highlight-faces
12906 :group 'font-lock-highlighting-faces)
12908 (defface vhdl-font-lock-enumvalue-face
12909 '((((class color) (background light)) (:foreground "SaddleBrown"))
12910 (((class color) (background dark)) (:foreground "BurlyWood"))
12911 (t (:italic t :bold t)))
12912 "Font lock mode face used to highlight standardized enumeration values."
12913 :group 'vhdl-highlight-faces
12914 :group 'font-lock-highlighting-faces)
12916 (defface vhdl-font-lock-function-face
12917 '((((class color) (background light)) (:foreground "Cyan4"))
12918 (((class color) (background dark)) (:foreground "Orchid1"))
12919 (t (:italic t :bold t)))
12920 "Font lock mode face used to highlight standardized functions and packages."
12921 :group 'vhdl-highlight-faces
12922 :group 'font-lock-highlighting-faces)
12924 (defface vhdl-font-lock-directive-face
12925 '((((class color) (background light)) (:foreground "CadetBlue"))
12926 (((class color) (background dark)) (:foreground "Aquamarine"))
12927 (t (:italic t :bold t)))
12928 "Font lock mode face used to highlight directives."
12929 :group 'vhdl-highlight-faces
12930 :group 'font-lock-highlighting-faces)
12932 (defface vhdl-font-lock-reserved-words-face
12933 '((((class color) (background light)) (:foreground "Orange" :bold t))
12934 ;(((min-colors 88) (class color) (background dark)) ; Emacs 22
12935 ; (:foreground "Yellow1" :bold t))
12936 (((class color) (background dark)) (:foreground "Yellow" :bold t))
12938 "Font lock mode face used to highlight additional reserved words."
12939 :group 'vhdl-highlight-faces
12940 :group 'font-lock-highlighting-faces)
12942 (defface vhdl-font-lock-translate-off-face
12943 '((((class color) (background light)) (:background "LightGray"))
12944 (((class color) (background dark)) (:background "DimGray"))
12946 "Font lock mode face used to background highlight translate-off regions."
12947 :group 'vhdl-highlight-faces
12948 :group 'font-lock-highlighting-faces)
12950 ;; font lock mode faces used to highlight words with special syntax.
12951 (let ((syntax-alist vhdl-special-syntax-alist))
12952 (while syntax-alist
12953 (eval `(defface ,(vhdl-function-name
12954 "vhdl-font-lock" (caar syntax-alist) "face")
12955 '((((class color) (background light))
12956 (:foreground ,(nth 2 (car syntax-alist))))
12957 (((class color) (background dark))
12958 (:foreground ,(nth 3 (car syntax-alist))))
12960 ,(concat "Font lock mode face used to highlight "
12961 (nth 0 (car syntax-alist)) ".")
12962 :group 'vhdl-highlight-faces
12963 :group 'font-lock-highlighting-faces))
12964 (setq syntax-alist (cdr syntax-alist))))
12966 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12967 ;; Font lock initialization
12969 (defun vhdl-font-lock-init ()
12970 "Initialize fontification."
12971 ;; highlight template prompts and directives
12972 (setq vhdl-font-lock-keywords-0
12973 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
12974 vhdl-template-prompt-syntax ">\\)")
12975 2 'vhdl-font-lock-prompt-face t)
12976 (list (concat "--\\s-*"
12977 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
12978 2 'vhdl-font-lock-directive-face t)
12979 ;; highlight c-preprocessor directives
12980 (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
12981 '(1 font-lock-builtin-face)
12982 '(3 font-lock-variable-name-face nil t))))
12983 ;; highlight keywords and standardized types, attributes, enumeration
12984 ;; values, and subprograms
12985 (setq vhdl-font-lock-keywords-1
12987 (list (concat "'" vhdl-attributes-regexp)
12988 1 'vhdl-font-lock-attribute-face)
12989 (list vhdl-types-regexp 1 'font-lock-type-face)
12990 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face)
12991 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face)
12992 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
12993 (list vhdl-keywords-regexp 1 'font-lock-keyword-face)))
12994 ;; highlight words with special syntax.
12995 (setq vhdl-font-lock-keywords-3
12996 (let ((syntax-alist vhdl-special-syntax-alist)
12998 (while syntax-alist
13001 (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>")
13002 (vhdl-function-name
13003 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
13005 (setq syntax-alist (cdr syntax-alist)))
13007 ;; highlight additional reserved words
13008 (setq vhdl-font-lock-keywords-4
13009 (list (list vhdl-reserved-words-regexp 1
13010 'vhdl-font-lock-reserved-words-face)))
13011 ;; highlight everything together
13012 (setq vhdl-font-lock-keywords
13014 vhdl-font-lock-keywords-0
13015 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1)
13016 (when (or vhdl-highlight-forbidden-words
13017 vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4)
13018 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3)
13019 (when vhdl-highlight-names vhdl-font-lock-keywords-2)
13020 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5))))
13022 ;; initialize fontification for VHDL Mode
13023 (vhdl-font-lock-init)
13025 (defun vhdl-fontify-buffer ()
13026 "Re-initialize fontification and fontify buffer."
13028 (setq font-lock-defaults
13030 'vhdl-font-lock-keywords nil
13031 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
13032 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
13033 (when (fboundp 'font-lock-unset-defaults)
13034 (font-lock-unset-defaults)) ; not implemented in XEmacs
13035 (font-lock-set-defaults)
13036 (font-lock-mode nil)
13037 (font-lock-mode t))
13039 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13040 ;; Initialization for postscript printing
13042 (defun vhdl-ps-print-settings ()
13043 "Initialize custom face and page settings for postscript printing."
13044 ;; define custom face settings
13045 (unless (or (not vhdl-print-customize-faces)
13047 (set (make-local-variable 'ps-bold-faces)
13048 '(font-lock-keyword-face
13049 font-lock-type-face
13050 vhdl-font-lock-attribute-face
13051 vhdl-font-lock-enumvalue-face
13052 vhdl-font-lock-directive-face))
13053 (set (make-local-variable 'ps-italic-faces)
13054 '(font-lock-comment-face
13055 font-lock-function-name-face
13056 font-lock-type-face
13057 vhdl-font-lock-attribute-face
13058 vhdl-font-lock-enumvalue-face
13059 vhdl-font-lock-directive-face))
13060 (set (make-local-variable 'ps-underlined-faces)
13061 '(font-lock-string-face))
13062 (setq ps-always-build-face-reference t))
13063 ;; define page settings, so that a line containing 79 characters (default)
13064 ;; fits into one column
13065 (when vhdl-print-two-column
13066 (set (make-local-variable 'ps-landscape-mode) t)
13067 (set (make-local-variable 'ps-number-of-columns) 2)
13068 (set (make-local-variable 'ps-font-size) 7.0)
13069 (set (make-local-variable 'ps-header-title-font-size) 10.0)
13070 (set (make-local-variable 'ps-header-font-size) 9.0)
13071 (set (make-local-variable 'ps-header-offset) 12.0)
13072 (when (eq ps-paper-type 'letter)
13073 (set (make-local-variable 'ps-inter-column) 40.0)
13074 (set (make-local-variable 'ps-left-margin) 40.0)
13075 (set (make-local-variable 'ps-right-margin) 40.0))))
13077 (defun vhdl-ps-print-init ()
13078 "Initialize postscript printing."
13080 (when (boundp 'ps-print-color-p)
13081 (vhdl-ps-print-settings))
13082 (make-local-variable 'ps-print-hook)
13083 (add-hook 'ps-print-hook 'vhdl-ps-print-settings)))
13086 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13087 ;;; Hierarchy browser (using `speedbar.el')
13088 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13089 ;; Allows displaying the hierarchy of all VHDL design units contained in a
13090 ;; directory by using the speedbar.
13092 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13095 (defvar vhdl-entity-alist nil
13096 "Cache with entities and corresponding architectures for each
13097 project/directory.")
13098 ;; structure: (parenthesised expression means list of such entries)
13100 ;; (ent-key ent-name ent-file ent-line
13101 ;; (arch-key arch-name arch-file arch-line
13102 ;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
13103 ;; inst-arch-key inst-conf-key inst-lib-key inst-path)
13104 ;; (lib-name pack-key))
13105 ;; mra-key (lib-name pack-key))
13107 (defvar vhdl-config-alist nil
13108 "Cache with configurations for each project/directory.")
13109 ;; structure: (parenthesised expression means list of such entries)
13111 ;; (conf-key conf-name conf-file conf-line ent-key arch-key
13112 ;; (inst-key inst-comp-name inst-ent-key inst-arch-key
13113 ;; inst-conf-key inst-lib-key)
13114 ;; (lib-name pack-key)))
13116 (defvar vhdl-package-alist nil
13117 "Cache with packages for each project/directory.")
13118 ;; structure: (parenthesised expression means list of such entries)
13120 ;; (pack-key pack-name pack-file pack-line
13121 ;; (comp-key comp-name comp-file comp-line)
13122 ;; (func-key func-name func-file func-line)
13123 ;; (lib-name pack-key)
13124 ;; pack-body-file pack-body-line
13125 ;; (func-key func-name func-body-file func-body-line)
13126 ;; (lib-name pack-key)))
13128 (defvar vhdl-ent-inst-alist nil
13129 "Cache with instantiated entities for each project/directory.")
13130 ;; structure: (parenthesised expression means list of such entries)
13131 ;; (cache-key (inst-ent-key))
13133 (defvar vhdl-file-alist nil
13134 "Cache with design units in each file for each project/directory.")
13135 ;; structure: (parenthesised expression means list of such entries)
13137 ;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
13138 ;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
13140 (defvar vhdl-directory-alist nil
13141 "Cache with source directories for each project.")
13142 ;; structure: (parenthesised expression means list of such entries)
13143 ;; (cache-key (directory))
13145 (defvar vhdl-speedbar-shown-unit-alist nil
13146 "Alist of design units simultaneously open in the current speedbar for each
13147 directory and project.")
13149 (defvar vhdl-speedbar-shown-project-list nil
13150 "List of projects simultaneously open in the current speedbar.")
13152 (defvar vhdl-updated-project-list nil
13153 "List of projects and directories with updated files.")
13155 (defvar vhdl-modified-file-list nil
13156 "List of modified files to be rescanned for hierarchy updating.")
13158 (defvar vhdl-speedbar-hierarchy-depth 0
13159 "Depth of instantiation hierarchy to display.")
13161 (defvar vhdl-speedbar-show-projects nil
13162 "Non-nil means project hierarchy is displayed in speedbar, directory
13163 hierarchy otherwise.")
13165 (defun vhdl-get-end-of-unit ()
13166 "Return position of end of current unit."
13167 (let ((pos (point)))
13169 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
13171 (goto-char (match-beginning 0))
13172 (vhdl-backward-syntactic-ws)
13173 (and (/= (preceding-char) ?\;) (not (bobp))))))
13174 (re-search-backward "^[ \t]*end\\>" pos 1)
13177 (defun vhdl-match-string-downcase (num &optional string)
13178 "Like `match-string-no-properties' with down-casing."
13179 (let ((match (match-string-no-properties num string)))
13180 (and match (downcase match))))
13183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13186 (defun vhdl-scan-context-clause ()
13187 "Scan the context clause that precedes a design unit."
13190 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
13191 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
13192 (equal "USE" (upcase (match-string 1))))
13193 (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
13194 (setq lib-alist (cons (cons (match-string-no-properties 1)
13195 (vhdl-match-string-downcase 2))
13199 (defun vhdl-scan-directory-contents (name &optional project update num-string
13201 "Scan contents of VHDL files in directory or file pattern DIR-NAME."
13202 (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
13203 ; (unless (file-directory-p (match-string 1 name))
13204 ; (message "No such directory: \"%s\"" (match-string 1 name)))
13205 (let* ((dir-name (match-string 1 name))
13206 (file-pattern (match-string 2 name))
13207 (is-directory (= 0 (length file-pattern)))
13212 (vhdl-get-source-files t dir-name)
13213 (vhdl-directory-files
13214 dir-name t (wildcard-to-regexp file-pattern)))))
13215 (key (or project dir-name))
13216 (file-exclude-regexp
13217 (or (nth 3 (aget vhdl-project-alist project)) ""))
13218 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
13219 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
13220 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
13221 ent-alist conf-alist pack-alist ent-inst-list file-alist
13222 tmp-list tmp-entry no-files files-exist big-files)
13223 (when (or project update)
13224 (setq ent-alist (aget vhdl-entity-alist key t)
13225 conf-alist (aget vhdl-config-alist key t)
13226 pack-alist (aget vhdl-package-alist key t)
13227 ent-inst-list (car (aget vhdl-ent-inst-alist key t))
13228 file-alist (aget vhdl-file-alist key t)))
13229 (when (and (not is-directory) (null file-list))
13230 (message "No such file: \"%s\"" name))
13231 (setq files-exist file-list)
13233 (setq no-files (length file-list))
13234 (message "Scanning %s %s\"%s\"..."
13235 (if is-directory "directory" "files") (or num-string "") name)
13237 (unless (equal file-exclude-regexp "")
13238 (let ((case-fold-search nil)
13241 (unless (string-match file-exclude-regexp (car file-list))
13242 (setq file-tmp-list (cons (car file-list) file-tmp-list)))
13243 (setq file-list (cdr file-list)))
13244 (setq file-list (nreverse file-tmp-list))))
13245 ;; do for all files
13247 (unless noninteractive
13248 (message "Scanning %s %s\"%s\"... (%2d%s)"
13249 (if is-directory "directory" "files")
13250 (or num-string "") name
13251 (/ (* 100 (- no-files (length file-list))) no-files) "%"))
13252 (let ((file-name (abbreviate-file-name (car file-list)))
13253 ent-list arch-list arch-ent-list conf-list
13254 pack-list pack-body-list inst-list inst-ent-list)
13258 (vhdl-prepare-search-2
13260 ;; scan for design units
13261 (if (and limit-design-file-size
13262 (< limit-design-file-size (buffer-size)))
13263 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name)
13264 (setq big-files t))
13265 ;; scan for entities
13266 (goto-char (point-min))
13267 (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13268 (let* ((ent-name (match-string-no-properties 1))
13269 (ent-key (downcase ent-name))
13270 (ent-entry (aget ent-alist ent-key t))
13271 (lib-alist (vhdl-scan-context-clause)))
13272 (if (nth 1 ent-entry)
13273 (vhdl-warning-when-idle
13274 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13275 ent-name (nth 1 ent-entry) (nth 2 ent-entry)
13276 file-name (vhdl-current-line))
13277 (setq ent-list (cons ent-key ent-list))
13278 (aput 'ent-alist ent-key
13279 (list ent-name file-name (vhdl-current-line)
13280 (nth 3 ent-entry) (nth 4 ent-entry)
13282 ;; scan for architectures
13283 (goto-char (point-min))
13284 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13285 (let* ((arch-name (match-string-no-properties 1))
13286 (arch-key (downcase arch-name))
13287 (ent-name (match-string-no-properties 2))
13288 (ent-key (downcase ent-name))
13289 (ent-entry (aget ent-alist ent-key t))
13290 (arch-alist (nth 3 ent-entry))
13291 (arch-entry (aget arch-alist arch-key t))
13292 (lib-arch-alist (vhdl-scan-context-clause)))
13294 (vhdl-warning-when-idle
13295 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13296 arch-name ent-name (nth 1 arch-entry)
13297 (nth 2 arch-entry) file-name (vhdl-current-line))
13298 (setq arch-list (cons arch-key arch-list)
13299 arch-ent-list (cons ent-key arch-ent-list))
13300 (aput 'arch-alist arch-key
13301 (list arch-name file-name (vhdl-current-line) nil
13303 (aput 'ent-alist ent-key
13304 (list (or (nth 0 ent-entry) ent-name)
13305 (nth 1 ent-entry) (nth 2 ent-entry)
13306 (vhdl-sort-alist arch-alist)
13307 arch-key (nth 5 ent-entry))))))
13308 ;; scan for configurations
13309 (goto-char (point-min))
13310 (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13311 (let* ((conf-name (match-string-no-properties 1))
13312 (conf-key (downcase conf-name))
13313 (conf-entry (aget conf-alist conf-key t))
13314 (ent-name (match-string-no-properties 2))
13315 (ent-key (downcase ent-name))
13316 (lib-alist (vhdl-scan-context-clause))
13317 (conf-line (vhdl-current-line))
13318 (end-of-unit (vhdl-get-end-of-unit))
13319 arch-key comp-conf-list inst-key-list
13320 inst-comp-key inst-ent-key inst-arch-key
13321 inst-conf-key inst-lib-key)
13322 (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)")
13323 (setq arch-key (vhdl-match-string-downcase 1)))
13325 (vhdl-warning-when-idle
13326 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13327 conf-name ent-name (nth 1 conf-entry)
13328 (nth 2 conf-entry) file-name conf-line)
13329 (setq conf-list (cons conf-key conf-list))
13330 ;; scan for subconfigurations and subentities
13331 (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t)
13332 (setq inst-comp-key (vhdl-match-string-downcase 3)
13333 inst-key-list (split-string
13334 (vhdl-match-string-downcase 1)
13335 "[ \t\n]*,[ \t\n]*"))
13336 (vhdl-forward-syntactic-ws)
13337 (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?")
13339 inst-lib-key (vhdl-match-string-downcase 3)
13340 inst-ent-key (and (match-string 2)
13341 (vhdl-match-string-downcase 4))
13342 inst-arch-key (and (match-string 2)
13343 (vhdl-match-string-downcase 6))
13344 inst-conf-key (and (not (match-string 2))
13345 (vhdl-match-string-downcase 4)))
13346 (while inst-key-list
13347 (setq comp-conf-list
13348 (cons (list (car inst-key-list)
13349 inst-comp-key inst-ent-key
13350 inst-arch-key inst-conf-key
13353 (setq inst-key-list (cdr inst-key-list)))))
13354 (aput 'conf-alist conf-key
13355 (list conf-name file-name conf-line ent-key
13356 arch-key comp-conf-list lib-alist)))))
13357 ;; scan for packages
13358 (goto-char (point-min))
13359 (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t)
13360 (let* ((pack-name (match-string-no-properties 2))
13361 (pack-key (downcase pack-name))
13362 (is-body (match-string-no-properties 1))
13363 (pack-entry (aget pack-alist pack-key t))
13364 (pack-line (vhdl-current-line))
13365 (end-of-unit (vhdl-get-end-of-unit))
13366 comp-name func-name comp-alist func-alist lib-alist)
13367 (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13368 (vhdl-warning-when-idle
13369 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13370 (if is-body " body" "") pack-name
13371 (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13372 (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
13373 file-name (vhdl-current-line))
13374 ;; scan for context clauses
13375 (setq lib-alist (vhdl-scan-context-clause))
13376 ;; scan for component and subprogram declarations/bodies
13377 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
13378 (if (equal (upcase (match-string 1)) "COMPONENT")
13379 (setq comp-name (match-string-no-properties 2)
13381 (cons (list (downcase comp-name) comp-name
13382 file-name (vhdl-current-line))
13384 (setq func-name (match-string-no-properties 2)
13386 (cons (list (downcase func-name) func-name
13387 file-name (vhdl-current-line))
13389 (setq func-alist (nreverse func-alist))
13390 (setq comp-alist (nreverse comp-alist))
13392 (setq pack-body-list (cons pack-key pack-body-list))
13393 (setq pack-list (cons pack-key pack-list)))
13395 'pack-alist pack-key
13397 (list (or (nth 0 pack-entry) pack-name)
13398 (nth 1 pack-entry) (nth 2 pack-entry)
13399 (nth 3 pack-entry) (nth 4 pack-entry)
13401 file-name pack-line func-alist lib-alist)
13402 (list pack-name file-name pack-line
13403 comp-alist func-alist lib-alist
13404 (nth 6 pack-entry) (nth 7 pack-entry)
13405 (nth 8 pack-entry) (nth 9 pack-entry))))))))
13406 ;; scan for hierarchy
13407 (if (and limit-hier-file-size
13408 (< limit-hier-file-size (buffer-size)))
13409 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name)
13410 (setq big-files t))
13411 ;; scan for architectures
13412 (goto-char (point-min))
13413 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13414 (let* ((ent-name (match-string-no-properties 2))
13415 (ent-key (downcase ent-name))
13416 (arch-name (match-string-no-properties 1))
13417 (arch-key (downcase arch-name))
13418 (ent-entry (aget ent-alist ent-key t))
13419 (arch-alist (nth 3 ent-entry))
13420 (arch-entry (aget arch-alist arch-key t))
13421 (beg-of-unit (point))
13422 (end-of-unit (vhdl-get-end-of-unit))
13424 inst-alist inst-path)
13425 ;; scan for contained instantiations
13426 (while (and (re-search-forward
13427 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
13428 "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|"
13429 "component[ \t\n]+\\(\\w+\\)\\|"
13430 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\|"
13431 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
13432 "\\(^[ \t]*end[ \t\n]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
13433 (or (not limit-hier-inst-no)
13434 (<= (setq inst-no (1+ inst-no))
13435 limit-hier-inst-no)))
13437 ;; block/generate beginning found
13440 (cons (match-string-no-properties 1) inst-path)))
13441 ;; block/generate end found
13443 (setq inst-path (cdr inst-path)))
13444 ;; instantiation found
13446 (let* ((inst-name (match-string-no-properties 1))
13447 (inst-key (downcase inst-name))
13449 (or (match-string-no-properties 3)
13450 (match-string-no-properties 6)))
13452 (or (and (match-string 8)
13453 (vhdl-match-string-downcase 11))
13454 (and inst-comp-name
13455 (downcase inst-comp-name))))
13456 (inst-arch-key (vhdl-match-string-downcase 13))
13458 (and (not (match-string 8))
13459 (vhdl-match-string-downcase 11)))
13460 (inst-lib-key (vhdl-match-string-downcase 10)))
13461 (goto-char (match-end 1))
13462 (setq inst-list (cons inst-key inst-list)
13464 (cons inst-ent-key inst-ent-list))
13468 (list (list inst-key inst-name file-name
13469 (vhdl-current-line) inst-comp-name
13470 inst-ent-key inst-arch-key
13471 inst-conf-key inst-lib-key
13472 (reverse inst-path)))))))))
13473 ;; scan for contained configuration specifications
13474 (goto-char beg-of-unit)
13475 (while (re-search-forward
13476 (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*"
13477 "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t)
13478 (let* ((inst-comp-name (match-string-no-properties 3))
13480 (and (match-string 6)
13481 (vhdl-match-string-downcase 9)))
13482 (inst-arch-key (vhdl-match-string-downcase 11))
13484 (and (not (match-string 6))
13485 (vhdl-match-string-downcase 9)))
13486 (inst-lib-key (vhdl-match-string-downcase 8))
13488 (split-string (vhdl-match-string-downcase 1)
13489 "[ \t\n]*,[ \t\n]*"))
13490 (tmp-inst-alist inst-alist)
13492 (while tmp-inst-alist
13493 (when (and (or (equal "all" (car inst-key-list))
13494 (member (nth 0 (car tmp-inst-alist))
13498 (or (nth 4 (car tmp-inst-alist)) ""))
13499 (downcase inst-comp-name)))
13500 (setq inst-entry (car tmp-inst-alist))
13501 (setq inst-ent-list
13502 (cons (or inst-ent-key (nth 5 inst-entry))
13504 (nth 5 inst-entry) inst-ent-list)))
13506 (list (nth 0 inst-entry) (nth 1 inst-entry)
13507 (nth 2 inst-entry) (nth 3 inst-entry)
13509 (or inst-ent-key (nth 5 inst-entry))
13510 (or inst-arch-key (nth 6 inst-entry))
13511 inst-conf-key inst-lib-key))
13512 (setcar tmp-inst-alist inst-entry))
13513 (setq tmp-inst-alist (cdr tmp-inst-alist)))))
13515 (aput 'arch-alist arch-key
13516 (list (nth 0 arch-entry) (nth 1 arch-entry)
13517 (nth 2 arch-entry) inst-alist
13518 (nth 4 arch-entry)))
13519 (aput 'ent-alist ent-key
13520 (list (nth 0 ent-entry) (nth 1 ent-entry)
13521 (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
13522 (nth 4 ent-entry) (nth 5 ent-entry)))
13523 (when (and limit-hier-inst-no
13524 (> inst-no limit-hier-inst-no))
13525 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name)
13526 (setq big-files t))
13527 (goto-char end-of-unit))))
13528 ;; remember design units for this file
13529 (aput 'file-alist file-name
13530 (list ent-list arch-list arch-ent-list conf-list
13531 pack-list pack-body-list inst-list inst-ent-list))
13532 (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
13533 (setq file-list (cdr file-list))))
13534 (when (or (and (not project) files-exist)
13535 (and project (not non-final)))
13536 ;; consistency checks:
13537 ;; check whether each architecture has a corresponding entity
13538 (setq tmp-list ent-alist)
13540 (when (null (nth 2 (car tmp-list)))
13541 (setq tmp-entry (car (nth 4 (car tmp-list))))
13542 (vhdl-warning-when-idle
13543 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
13544 (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
13545 (nth 3 tmp-entry)))
13546 (setq tmp-list (cdr tmp-list)))
13547 ;; check whether configuration has a corresponding entity/architecture
13548 (setq tmp-list conf-alist)
13550 (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
13551 (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
13552 (setq tmp-entry (car tmp-list))
13553 (vhdl-warning-when-idle
13554 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
13555 (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
13556 (nth 2 tmp-entry) (nth 3 tmp-entry)))
13557 (setq tmp-entry (car tmp-list))
13558 (vhdl-warning-when-idle
13559 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
13560 (nth 1 tmp-entry) (nth 4 tmp-entry)
13561 (nth 2 tmp-entry) (nth 3 tmp-entry)))
13562 (setq tmp-list (cdr tmp-list)))
13563 ;; check whether each package body has a package declaration
13564 (setq tmp-list pack-alist)
13566 (when (null (nth 2 (car tmp-list)))
13567 (setq tmp-entry (car tmp-list))
13568 (vhdl-warning-when-idle
13569 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)"
13570 (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
13571 (setq tmp-list (cdr tmp-list)))
13573 (setq ent-alist (vhdl-sort-alist ent-alist))
13574 (setq conf-alist (vhdl-sort-alist conf-alist))
13575 (setq pack-alist (vhdl-sort-alist pack-alist))
13576 ;; remember updated directory/project
13577 (add-to-list 'vhdl-updated-project-list (or project dir-name)))
13578 ;; clear directory alists
13580 (adelete 'vhdl-entity-alist key)
13581 (adelete 'vhdl-config-alist key)
13582 (adelete 'vhdl-package-alist key)
13583 (adelete 'vhdl-ent-inst-alist key)
13584 (adelete 'vhdl-file-alist key))
13585 ;; put directory contents into cache
13586 (aput 'vhdl-entity-alist key ent-alist)
13587 (aput 'vhdl-config-alist key conf-alist)
13588 (aput 'vhdl-package-alist key pack-alist)
13589 (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
13590 (aput 'vhdl-file-alist key file-alist)
13592 (message "Scanning %s %s\"%s\"...done"
13593 (if is-directory "directory" "files") (or num-string "") name)
13594 (unless project (message "Scanning directory...done"))
13596 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'"))
13597 ;; save cache when scanned non-interactively
13598 (when (or (not project) (not non-final))
13599 (when (and noninteractive vhdl-speedbar-save-cache)
13600 (vhdl-save-cache key)))
13603 (defun vhdl-scan-project-contents (project)
13604 "Scan the contents of all VHDL files found in the directories and files
13606 (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
13607 (default-dir (vhdl-resolve-env-variable
13608 (nth 1 (aget vhdl-project-alist project))))
13609 (file-exclude-regexp
13610 (or (nth 3 (aget vhdl-project-alist project)) ""))
13611 dir-list-tmp dir dir-name num-dir act-dir recursive)
13612 ;; clear project alists
13613 (adelete 'vhdl-entity-alist project)
13614 (adelete 'vhdl-config-alist project)
13615 (adelete 'vhdl-package-alist project)
13616 (adelete 'vhdl-ent-inst-alist project)
13617 (adelete 'vhdl-file-alist project)
13618 ;; expand directory names by default-directory
13619 (message "Collecting source files...")
13621 (setq dir (vhdl-resolve-env-variable (car dir-list)))
13622 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
13623 (setq recursive (match-string 1 dir)
13624 dir-name (match-string 3 dir))
13626 (cons (concat recursive
13627 (if (file-name-absolute-p dir-name) "" default-dir)
13630 (setq dir-list (cdr dir-list)))
13631 ;; resolve path wildcards
13632 (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
13633 ;; expand directories
13634 (while dir-list-tmp
13635 (setq dir (car dir-list-tmp))
13636 ;; get subdirectories
13637 (if (string-match "-r \\(.*[/\\]\\)" dir)
13638 (setq dir-list (append dir-list (vhdl-get-subdirs
13639 (match-string 1 dir))))
13640 (setq dir-list (append dir-list (list dir))))
13641 (setq dir-list-tmp (cdr dir-list-tmp)))
13643 (unless (equal file-exclude-regexp "")
13644 (let ((case-fold-search nil))
13646 (unless (string-match file-exclude-regexp (car dir-list))
13647 (setq dir-list-tmp (cons (car dir-list) dir-list-tmp)))
13648 (setq dir-list (cdr dir-list)))
13649 (setq dir-list (nreverse dir-list-tmp))))
13650 (message "Collecting source files...done")
13651 ;; scan for design units for each directory in DIR-LIST
13652 (setq dir-list-tmp nil
13653 num-dir (length dir-list)
13656 (setq dir-name (abbreviate-file-name
13657 (expand-file-name (car dir-list))))
13658 (vhdl-scan-directory-contents dir-name project nil
13659 (format "(%s/%s) " act-dir num-dir)
13661 (add-to-list 'dir-list-tmp (file-name-directory dir-name))
13662 (setq dir-list (cdr dir-list)
13663 act-dir (1+ act-dir)))
13664 (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
13665 (message "Scanning project \"%s\"...done" project)))
13667 (defun vhdl-update-file-contents (file-name)
13668 "Update hierarchy information by contents of current buffer."
13669 (setq file-name (abbreviate-file-name file-name))
13670 (let* ((dir-name (file-name-directory file-name))
13671 (directory-alist vhdl-directory-alist)
13673 (while directory-alist
13674 (when (member dir-name (nth 1 (car directory-alist)))
13675 (let* ((vhdl-project (nth 0 (car directory-alist)))
13676 (project (vhdl-project-p))
13677 (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
13678 (conf-alist (aget vhdl-config-alist (or project dir-name) t))
13679 (pack-alist (aget vhdl-package-alist (or project dir-name) t))
13680 (ent-inst-list (car (aget vhdl-ent-inst-alist
13681 (or project dir-name) t)))
13682 (file-alist (aget vhdl-file-alist (or project dir-name) t))
13683 (file-entry (aget file-alist file-name t))
13684 (ent-list (nth 0 file-entry))
13685 (arch-list (nth 1 file-entry))
13686 (arch-ent-list (nth 2 file-entry))
13687 (conf-list (nth 3 file-entry))
13688 (pack-list (nth 4 file-entry))
13689 (pack-body-list (nth 5 file-entry))
13690 (inst-ent-list (nth 7 file-entry))
13691 (cache-key (or project dir-name))
13692 arch-alist key ent-key entry)
13693 ;; delete design units previously contained in this file:
13696 (setq key (car ent-list)
13697 entry (aget ent-alist key t))
13698 (when (equal file-name (nth 1 entry))
13700 (aput 'ent-alist key
13701 (list (nth 0 entry) nil nil (nth 3 entry) nil))
13702 (adelete 'ent-alist key)))
13703 (setq ent-list (cdr ent-list)))
13706 (setq key (car arch-list)
13707 ent-key (car arch-ent-list)
13708 entry (aget ent-alist ent-key t)
13709 arch-alist (nth 3 entry))
13710 (when (equal file-name (nth 1 (aget arch-alist key t)))
13711 (adelete 'arch-alist key)
13712 (if (or (nth 1 entry) arch-alist)
13713 (aput 'ent-alist ent-key
13714 (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13715 arch-alist (nth 4 entry) (nth 5 entry)))
13716 (adelete 'ent-alist ent-key)))
13717 (setq arch-list (cdr arch-list)
13718 arch-ent-list (cdr arch-ent-list)))
13721 (setq key (car conf-list))
13722 (when (equal file-name (nth 1 (aget conf-alist key t)))
13723 (adelete 'conf-alist key))
13724 (setq conf-list (cdr conf-list)))
13725 ;; package declarations
13727 (setq key (car pack-list)
13728 entry (aget pack-alist key t))
13729 (when (equal file-name (nth 1 entry))
13731 (aput 'pack-alist key
13732 (list (nth 0 entry) nil nil nil nil nil
13733 (nth 6 entry) (nth 7 entry) (nth 8 entry)
13735 (adelete 'pack-alist key)))
13736 (setq pack-list (cdr pack-list)))
13738 (while pack-body-list
13739 (setq key (car pack-body-list)
13740 entry (aget pack-alist key t))
13741 (when (equal file-name (nth 6 entry))
13743 (aput 'pack-alist key
13744 (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13745 (nth 3 entry) (nth 4 entry) (nth 5 entry)
13747 (adelete 'pack-alist key)))
13748 (setq pack-body-list (cdr pack-body-list)))
13749 ;; instantiated entities
13750 (while inst-ent-list
13751 (setq ent-inst-list
13752 (vhdl-delete (car inst-ent-list) ent-inst-list))
13753 (setq inst-ent-list (cdr inst-ent-list)))
13755 (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
13756 (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
13757 (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
13758 (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
13760 (vhdl-scan-directory-contents file-name project t)
13761 (when (or (and vhdl-speedbar-show-projects project)
13762 (and (not vhdl-speedbar-show-projects) (not project)))
13763 (vhdl-speedbar-refresh project))
13765 (setq directory-alist (cdr directory-alist)))
13768 (defun vhdl-update-hierarchy ()
13769 "Update directory and hierarchy information in speedbar."
13770 (let ((file-list (reverse vhdl-modified-file-list))
13772 (when (and vhdl-speedbar-update-on-saving file-list)
13775 (or (vhdl-update-file-contents (car file-list))
13777 (setq file-list (cdr file-list)))
13778 (setq vhdl-modified-file-list nil)
13779 (vhdl-speedbar-update-current-unit)
13780 (when updated (message "Updating hierarchy...done")))))
13782 ;; structure (parenthesised expression means list of such entries)
13783 ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
13784 ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
13785 ;; comp-lib-name level)
13786 (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
13787 conf-inst-alist level indent
13788 &optional include-top ent-hier)
13789 "Get instantiation hierarchy beginning in architecture ARCH-KEY of
13791 (let* ((ent-entry (aget ent-alist ent-key t))
13792 (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
13793 (cdar (last (nth 3 ent-entry)))))
13794 (inst-alist (nth 3 arch-entry))
13795 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
13796 hier-list subcomp-list tmp-list inst-key inst-comp-name
13797 inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
13798 (when (= level 0) (message "Extract design hierarchy..."))
13800 (setq level (1+ level)))
13801 (when (member ent-key ent-hier)
13802 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
13803 ;; check configured architecture (already checked during scanning)
13804 ; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
13805 ; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
13806 ;; process all instances
13808 (setq inst-entry (car inst-alist)
13809 inst-key (nth 0 inst-entry)
13810 inst-comp-name (nth 4 inst-entry)
13811 inst-conf-key (nth 7 inst-entry))
13812 ;; search entry in configuration's instantiations list
13813 (setq tmp-list conf-inst-alist)
13814 (while (and tmp-list
13815 (not (and (member (nth 0 (car tmp-list))
13816 (list "all" inst-key))
13817 (equal (nth 1 (car tmp-list))
13818 (downcase (or inst-comp-name ""))))))
13819 (setq tmp-list (cdr tmp-list)))
13820 (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
13821 (setq inst-conf-entry (aget conf-alist inst-conf-key t))
13822 (when (and inst-conf-key (not inst-conf-entry))
13823 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
13824 ;; determine entity
13826 (or (nth 2 (car tmp-list)) ; from configuration
13827 (nth 3 inst-conf-entry) ; from subconfiguration
13828 (nth 3 (aget conf-alist (nth 7 inst-entry) t))
13829 ; from configuration spec.
13830 (nth 5 inst-entry))) ; from direct instantiation
13831 (setq inst-ent-entry (aget ent-alist inst-ent-key t))
13832 ;; determine architecture
13833 (setq inst-arch-key
13834 (or (nth 3 (car tmp-list)) ; from configuration
13835 (nth 4 inst-conf-entry) ; from subconfiguration
13836 (nth 6 inst-entry) ; from direct instantiation
13837 (nth 4 (aget conf-alist (nth 7 inst-entry)))
13838 ; from configuration spec.
13839 (nth 4 inst-ent-entry) ; MRA
13840 (caar (nth 3 inst-ent-entry)))) ; first alphabetically
13841 (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
13844 (or (nth 5 (car tmp-list)) ; from configuration
13845 (nth 8 inst-entry))) ; from direct instantiation
13846 ;; gather information for this instance
13848 (list (nth 1 inst-entry)
13849 (cons (nth 2 inst-entry) (nth 3 inst-entry))
13850 (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
13851 (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
13852 (or (nth 0 inst-arch-entry) inst-arch-key)
13853 (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
13854 (or (nth 0 inst-conf-entry) inst-conf-key)
13855 (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
13856 inst-lib-key level))
13857 ;; get subcomponent hierarchy
13858 (setq subcomp-list (vhdl-get-hierarchy
13859 ent-alist conf-alist
13860 inst-ent-key inst-arch-key inst-conf-key
13861 (nth 5 inst-conf-entry)
13862 (1+ level) indent nil (cons ent-key ent-hier)))
13864 (setq hier-list (append hier-list (list comp-entry) subcomp-list))
13865 (setq inst-alist (cdr inst-alist)))
13868 (cons (list nil nil (nth 0 ent-entry)
13869 (cons (nth 1 ent-entry) (nth 2 ent-entry))
13871 (cons (nth 1 arch-entry) (nth 2 arch-entry))
13875 (when (or (= level 0) (and include-top (= level 1))) (message ""))
13878 (defun vhdl-get-instantiations (ent-key indent)
13879 "Get all instantiations of entity ENT-KEY."
13880 (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
13881 arch-alist inst-alist ent-inst-list
13882 ent-entry arch-entry inst-entry)
13884 (setq ent-entry (car ent-alist))
13885 (setq arch-alist (nth 4 ent-entry))
13887 (setq arch-entry (car arch-alist))
13888 (setq inst-alist (nth 4 arch-entry))
13890 (setq inst-entry (car inst-alist))
13891 (when (equal ent-key (nth 5 inst-entry))
13892 (setq ent-inst-list
13893 (cons (list (nth 1 inst-entry)
13894 (cons (nth 2 inst-entry) (nth 3 inst-entry))
13896 (cons (nth 2 ent-entry) (nth 3 ent-entry))
13898 (cons (nth 2 arch-entry) (nth 3 arch-entry)))
13900 (setq inst-alist (cdr inst-alist)))
13901 (setq arch-alist (cdr arch-alist)))
13902 (setq ent-alist (cdr ent-alist)))
13903 (nreverse ent-inst-list)))
13905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13908 (defun vhdl-save-caches ()
13909 "Save all updated hierarchy caches to file."
13911 (condition-case nil
13912 (when vhdl-speedbar-save-cache
13913 ;; update hierarchy
13914 (vhdl-update-hierarchy)
13915 (let ((project-list vhdl-updated-project-list))
13916 (message "Saving hierarchy caches...")
13917 ;; write updated project caches
13918 (while project-list
13919 (vhdl-save-cache (car project-list))
13920 (setq project-list (cdr project-list)))
13921 (message "Saving hierarchy caches...done")))
13922 (error (progn (vhdl-warning "ERROR: An error occured while saving the hierarchy caches")
13925 (defun vhdl-save-cache (key)
13926 "Save current hierarchy cache to file."
13927 (let* ((orig-buffer (current-buffer))
13929 (project (vhdl-project-p))
13930 (default-directory key)
13931 (directory (abbreviate-file-name (vhdl-default-directory)))
13932 (file-name (vhdl-resolve-env-variable
13933 (vhdl-replace-string
13934 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
13936 (subst-char-in-string ? ?_ (or project "dir"))
13937 " " (user-login-name)))))
13938 (file-dir-name (expand-file-name file-name directory))
13939 (cache-key (or project directory))
13940 (key (if project "project" "directory")))
13941 (unless (file-exists-p (file-name-directory file-dir-name))
13942 (make-directory (file-name-directory file-dir-name) t))
13943 (if (not (file-writable-p file-dir-name))
13944 (progn (vhdl-warning (format "File not writable: \"%s\""
13945 (abbreviate-file-name file-dir-name)))
13947 (message "Saving cache: \"%s\"" file-dir-name)
13948 (set-buffer (find-file-noselect file-dir-name t t))
13950 (insert ";; -*- Emacs-Lisp -*-\n\n"
13951 ";;; " (file-name-nondirectory file-name)
13952 " - design hierarchy cache file for Emacs VHDL Mode "
13954 (insert "\n;; " (if project "Project " "Directory") " : ")
13955 (if project (insert project) (prin1 directory (current-buffer)))
13956 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ")
13957 (user-login-name) "\n\n"
13958 "\n;; version number\n"
13959 "(setq vhdl-cache-version \"" vhdl-version "\")\n"
13960 "\n;; " (if project "project" "directory") " name"
13961 "\n(setq " key " ")
13962 (prin1 (or project directory) (current-buffer))
13964 (when (member 'hierarchy vhdl-speedbar-save-cache)
13965 (insert "\n;; entity and architecture cache\n"
13966 "(aput 'vhdl-entity-alist " key " '")
13967 (print (aget vhdl-entity-alist cache-key t) (current-buffer))
13968 (insert ")\n\n;; configuration cache\n"
13969 "(aput 'vhdl-config-alist " key " '")
13970 (print (aget vhdl-config-alist cache-key t) (current-buffer))
13971 (insert ")\n\n;; package cache\n"
13972 "(aput 'vhdl-package-alist " key " '")
13973 (print (aget vhdl-package-alist cache-key t) (current-buffer))
13974 (insert ")\n\n;; instantiated entities cache\n"
13975 "(aput 'vhdl-ent-inst-alist " key " '")
13976 (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
13977 (insert ")\n\n;; design units per file cache\n"
13978 "(aput 'vhdl-file-alist " key " '")
13979 (print (aget vhdl-file-alist cache-key t) (current-buffer))
13981 (insert ")\n\n;; source directories in project cache\n"
13982 "(aput 'vhdl-directory-alist " key " '")
13983 (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
13985 (when (member 'display vhdl-speedbar-save-cache)
13986 (insert "\n;; shown design units cache\n"
13987 "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
13988 (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
13991 (setq vhdl-updated-project-list
13992 (delete cache-key vhdl-updated-project-list))
13994 (kill-buffer (current-buffer))
13995 (set-buffer orig-buffer))))
13997 (defun vhdl-load-cache (key)
13998 "Load hierarchy cache information from file."
13999 (let* ((vhdl-project key)
14000 (default-directory key)
14001 (directory (vhdl-default-directory))
14002 (file-name (vhdl-resolve-env-variable
14003 (vhdl-replace-string
14004 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14006 (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir"))
14007 " " (user-login-name)))))
14008 (file-dir-name (expand-file-name file-name directory))
14009 vhdl-cache-version)
14010 (unless (memq 'vhdl-save-caches kill-emacs-hook)
14011 (add-hook 'kill-emacs-hook 'vhdl-save-caches))
14012 (when (file-exists-p file-dir-name)
14014 (progn (load-file file-dir-name)
14015 (string< (mapconcat
14016 (lambda (a) (format "%3d" (string-to-number a)))
14017 (split-string "3.33" "\\.") "")
14019 (lambda (a) (format "%3d" (string-to-number a)))
14020 (split-string vhdl-cache-version "\\.") "")))
14021 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name))
14024 (defun vhdl-require-hierarchy-info ()
14025 "Make sure that hierarchy information is available. Load cache or scan files
14027 (if (vhdl-project-p)
14028 (unless (or (assoc vhdl-project vhdl-file-alist)
14029 (vhdl-load-cache vhdl-project))
14030 (vhdl-scan-project-contents vhdl-project))
14031 (let ((directory (abbreviate-file-name default-directory)))
14032 (unless (or (assoc directory vhdl-file-alist)
14033 (vhdl-load-cache directory))
14034 (vhdl-scan-directory-contents directory)))))
14036 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14037 ;; Add hierarchy browser functionality to speedbar
14039 (defvar vhdl-speedbar-key-map nil
14040 "Keymap used when in the VHDL hierarchy browser mode.")
14042 (defvar vhdl-speedbar-menu-items nil
14043 "Additional menu-items to add to speedbar frame.")
14045 (defun vhdl-speedbar-initialize ()
14046 "Initialize speedbar."
14047 ;; general settings
14048 ; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil)
14049 ;; VHDL file extensions (extracted from `auto-mode-alist')
14050 (let ((mode-alist auto-mode-alist))
14052 (when (eq (cdar mode-alist) 'vhdl-mode)
14053 (speedbar-add-supported-extension (caar mode-alist)))
14054 (setq mode-alist (cdr mode-alist))))
14055 ;; hierarchy browser settings
14056 (when (boundp 'speedbar-mode-functions-list)
14057 ;; special functions
14058 (speedbar-add-mode-functions-list
14060 (speedbar-item-info . vhdl-speedbar-item-info)
14061 (speedbar-line-path . speedbar-files-line-path)))
14062 (speedbar-add-mode-functions-list
14064 (speedbar-item-info . vhdl-speedbar-item-info)
14065 (speedbar-line-path . vhdl-speedbar-line-project)))
14067 (unless vhdl-speedbar-key-map
14068 (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap))
14069 (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line)
14070 (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line)
14071 (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line)
14072 (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line)
14073 (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level)
14074 (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all)
14075 (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy)
14076 (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component)
14077 (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration)
14078 (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra)
14079 (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design)
14080 (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy)
14081 (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches)
14084 (define-key vhdl-speedbar-key-map (int-to-string key)
14085 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
14086 (setq key (1+ key)))))
14087 (define-key speedbar-key-map "h"
14088 (lambda () (interactive)
14089 (speedbar-change-initial-expansion-list "vhdl directory")))
14090 (define-key speedbar-key-map "H"
14091 (lambda () (interactive)
14092 (speedbar-change-initial-expansion-list "vhdl project")))
14094 (unless vhdl-speedbar-menu-items
14096 vhdl-speedbar-menu-items
14097 `(["Edit" speedbar-edit-line t]
14098 ["Expand" speedbar-expand-line
14099 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
14100 ["Contract" vhdl-speedbar-contract-level t]
14101 ["Expand All" vhdl-speedbar-expand-all t]
14102 ["Contract All" vhdl-speedbar-contract-all t]
14103 ,(let ((key 0) (menu-list '("Hierarchy Depth")))
14106 (cons `[,(if (= key 0) "All" (int-to-string key))
14107 (vhdl-speedbar-set-depth ,key)
14109 :selected (= vhdl-speedbar-hierarchy-depth ,key)
14110 :keys ,(int-to-string key)]
14112 (setq key (1+ key)))
14113 (nreverse menu-list))
14115 ["Copy Port/Subprogram" vhdl-speedbar-port-copy
14116 (or (vhdl-speedbar-check-unit 'entity)
14117 (vhdl-speedbar-check-unit 'subprogram))]
14118 ["Place Component" vhdl-speedbar-place-component
14119 (vhdl-speedbar-check-unit 'entity)]
14120 ["Generate Configuration" vhdl-speedbar-configuration
14121 (vhdl-speedbar-check-unit 'architecture)]
14122 ["Select as MRA" vhdl-speedbar-select-mra
14123 (vhdl-speedbar-check-unit 'architecture)]
14124 ["Make" vhdl-speedbar-make-design
14125 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
14126 ["Generate Makefile" vhdl-speedbar-generate-makefile
14127 (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
14128 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
14129 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14130 ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)]
14131 ["Rescan Project" vhdl-speedbar-rescan-hierarchy
14132 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14133 ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects]
14134 ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
14136 (speedbar-add-expansion-list
14137 '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map
14138 vhdl-speedbar-display-directory))
14139 (speedbar-add-expansion-list
14140 '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map
14141 vhdl-speedbar-display-projects))
14142 (setq speedbar-stealthy-function-list
14144 '(("vhdl directory" vhdl-speedbar-update-current-unit)
14145 ("vhdl project" vhdl-speedbar-update-current-project
14146 vhdl-speedbar-update-current-unit)
14147 ; ("files" (lambda () (setq speedbar-ignored-path-regexp
14148 ; (speedbar-extension-list-to-regex
14149 ; speedbar-ignored-path-expressions))))
14151 speedbar-stealthy-function-list))
14152 (when (eq vhdl-speedbar-display-mode 'directory)
14153 (setq speedbar-initial-expansion-list-name "vhdl directory"))
14154 (when (eq vhdl-speedbar-display-mode 'project)
14155 (setq speedbar-initial-expansion-list-name "vhdl project"))
14156 (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
14158 (defun vhdl-speedbar (&optional arg)
14159 "Open/close speedbar."
14161 (if (not (fboundp 'speedbar))
14162 (error "WARNING: Speedbar is not available or not installed")
14164 (speedbar-frame-mode arg)
14165 (error (error "WARNING: An error occurred while opening speedbar")))))
14167 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14168 ;; Display functions
14170 (defvar vhdl-speedbar-last-selected-project nil
14171 "Name of last selected project.")
14173 ;; XEmacs change: Upstream vhdl-mode.el copied speedbar-with-writable (a
14174 ;; macro) here from speedbar.el. We just make sure that we evaluate
14175 ;; speedbar.el before compiling this file.
14177 (defun vhdl-speedbar-display-directory (directory depth &optional rescan)
14178 "Display directory and hierarchy information in speedbar."
14179 (setq vhdl-speedbar-show-projects nil)
14180 (setq speedbar-ignored-path-regexp
14181 (speedbar-extension-list-to-regex speedbar-ignored-path-expressions))
14182 (setq directory (abbreviate-file-name (file-name-as-directory directory)))
14183 (setq speedbar-last-selected-file nil)
14184 (speedbar-with-writable
14185 (condition-case nil
14187 ;; insert directory path
14188 (speedbar-directory-buttons directory depth)
14189 ;; insert subdirectories
14190 (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
14191 ;; scan and insert hierarchy of current directory
14192 (vhdl-speedbar-insert-dir-hierarchy directory depth
14193 speedbar-power-click)
14194 ;; expand subdirectories
14195 (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
14196 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))))
14198 (defun vhdl-speedbar-display-projects (project depth &optional rescan)
14199 "Display projects and hierarchy information in speedbar."
14200 (setq vhdl-speedbar-show-projects t)
14201 (setq speedbar-ignored-path-regexp ".")
14202 (setq speedbar-last-selected-file nil)
14203 (setq vhdl-speedbar-last-selected-project nil)
14204 (speedbar-with-writable
14205 (condition-case nil
14207 (vhdl-speedbar-insert-projects)
14208 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))
14209 (setq speedbar-full-text-cache nil)) ; prevent caching
14211 (defun vhdl-speedbar-insert-projects ()
14212 "Insert all projects in speedbar."
14213 (vhdl-speedbar-make-title-line "Projects:")
14214 (let ((project-alist (if vhdl-project-sort
14215 (vhdl-sort-alist (copy-alist vhdl-project-alist))
14216 vhdl-project-alist))
14217 (vhdl-speedbar-update-current-unit nil))
14219 (while project-alist
14220 (speedbar-make-tag-line
14221 'angle ?+ 'vhdl-speedbar-expand-project
14222 (caar project-alist) (caar project-alist)
14223 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
14224 (setq project-alist (cdr project-alist)))
14225 (setq project-alist vhdl-project-alist)
14227 (while project-alist
14228 (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
14229 (goto-char (point-min))
14230 (when (re-search-forward
14231 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
14232 (goto-char (match-end 1))
14233 (speedbar-do-function-pointer)))
14234 (setq project-alist (cdr project-alist))))
14235 ; (vhdl-speedbar-update-current-project)
14236 ; (vhdl-speedbar-update-current-unit nil t)
14239 (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
14240 "Insert hierarchy of project. Rescan directories if RESCAN is non-nil,
14241 otherwise use cached data."
14242 (when (or rescan (and (not (assoc project vhdl-file-alist))
14243 (not (vhdl-load-cache project))))
14244 (vhdl-scan-project-contents project))
14245 ;; insert design hierarchy
14246 (vhdl-speedbar-insert-hierarchy
14247 (aget vhdl-entity-alist project t)
14248 (aget vhdl-config-alist project t)
14249 (aget vhdl-package-alist project t)
14250 (car (aget vhdl-ent-inst-alist project t)) indent)
14251 (insert (int-to-string indent) ":\n")
14252 (put-text-property (- (point) 3) (1- (point)) 'invisible t)
14253 (put-text-property (1- (point)) (point) 'invisible nil)
14254 ;; expand design units
14255 (vhdl-speedbar-expand-units project))
14257 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
14258 "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil,
14259 otherwise use cached data."
14260 (when (or rescan (and (not (assoc directory vhdl-file-alist))
14261 (not (vhdl-load-cache directory))))
14262 (vhdl-scan-directory-contents directory))
14263 ;; insert design hierarchy
14264 (vhdl-speedbar-insert-hierarchy
14265 (aget vhdl-entity-alist directory t)
14266 (aget vhdl-config-alist directory t)
14267 (aget vhdl-package-alist directory t)
14268 (car (aget vhdl-ent-inst-alist directory t)) depth)
14269 ;; expand design units
14270 (vhdl-speedbar-expand-units directory)
14271 (aput 'vhdl-directory-alist directory (list (list directory))))
14273 (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
14274 ent-inst-list depth)
14275 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14276 (if (not (or ent-alist conf-alist pack-alist))
14277 (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
14278 (let (ent-entry conf-entry pack-entry)
14280 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
14282 (setq ent-entry (car ent-alist))
14283 (speedbar-make-tag-line
14284 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
14285 (nth 1 ent-entry) 'vhdl-speedbar-find-file
14286 (cons (nth 2 ent-entry) (nth 3 ent-entry))
14287 'vhdl-speedbar-entity-face depth)
14288 (unless (nth 2 ent-entry)
14289 (end-of-line 0) (insert "!") (forward-char 1))
14290 (unless (member (nth 0 ent-entry) ent-inst-list)
14291 (end-of-line 0) (insert " (top)") (forward-char 1))
14292 (setq ent-alist (cdr ent-alist)))
14293 ;; insert configurations
14294 (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
14296 (setq conf-entry (car conf-alist))
14297 (speedbar-make-tag-line
14298 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
14299 (nth 1 conf-entry) 'vhdl-speedbar-find-file
14300 (cons (nth 2 conf-entry) (nth 3 conf-entry))
14301 'vhdl-speedbar-configuration-face depth)
14302 (setq conf-alist (cdr conf-alist)))
14304 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
14306 (setq pack-entry (car pack-alist))
14307 (vhdl-speedbar-make-pack-line
14308 (nth 0 pack-entry) (nth 1 pack-entry)
14309 (cons (nth 2 pack-entry) (nth 3 pack-entry))
14310 (cons (nth 7 pack-entry) (nth 8 pack-entry))
14312 (setq pack-alist (cdr pack-alist))))))
14314 (defun vhdl-speedbar-rescan-hierarchy ()
14315 "Rescan hierarchy for the directory or project under the cursor."
14320 (vhdl-speedbar-show-projects
14321 (setq key (vhdl-speedbar-line-project))
14322 (vhdl-scan-project-contents key))
14323 ;; top-level directory
14324 ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14325 (re-search-forward "[0-9]+:" nil t)
14326 (vhdl-scan-directory-contents
14327 (abbreviate-file-name (speedbar-line-path))))
14328 ;; current directory
14329 (t (setq path (speedbar-line-path))
14330 (string-match "^\\(.+[/\\]\\)" path)
14331 (vhdl-scan-directory-contents
14332 (abbreviate-file-name (match-string 1 path)))))
14333 (vhdl-speedbar-refresh key)))
14335 (defun vhdl-speedbar-expand-dirs (directory)
14336 "Expand subdirectories in DIRECTORY according to
14337 `speedbar-shown-directories'."
14338 ;; (nicked from `speedbar-default-directory-list')
14339 (let ((sf (cdr (reverse speedbar-shown-directories)))
14340 (vhdl-speedbar-update-current-unit nil))
14341 (setq speedbar-shown-directories
14342 (list (expand-file-name default-directory)))
14344 (when (speedbar-goto-this-file (car sf))
14345 (beginning-of-line)
14346 (when (looking-at "[0-9]+:\\s-*<")
14347 (goto-char (match-end 0))
14348 (speedbar-do-function-pointer)))
14349 (setq sf (cdr sf))))
14350 (vhdl-speedbar-update-current-unit nil t))
14352 (defun vhdl-speedbar-expand-units (key)
14353 "Expand design units in directory/project KEY according to
14354 `vhdl-speedbar-shown-unit-alist'."
14355 (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14356 (vhdl-speedbar-update-current-unit nil)
14357 vhdl-updated-project-list)
14358 (adelete 'vhdl-speedbar-shown-unit-alist key)
14359 (vhdl-prepare-search-1
14360 (while unit-alist ; expand units
14361 (vhdl-speedbar-goto-this-unit key (caar unit-alist))
14362 (beginning-of-line)
14363 (let ((arch-alist (nth 1 (car unit-alist)))
14365 (when (looking-at "^[0-9]+:\\s-*\\[")
14366 (goto-char (match-end 0))
14367 (setq position (point))
14368 (speedbar-do-function-pointer)
14369 (select-frame speedbar-frame)
14370 (while arch-alist ; expand architectures
14371 (goto-char position)
14372 (when (re-search-forward
14373 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
14374 (car arch-alist) "\\>\\)") nil t)
14375 (beginning-of-line)
14376 (when (looking-at "^[0-9]+:\\s-*{")
14377 (goto-char (match-end 0))
14378 (speedbar-do-function-pointer)
14379 (select-frame speedbar-frame)))
14380 (setq arch-alist (cdr arch-alist))))
14381 (setq unit-alist (cdr unit-alist))))))
14382 (vhdl-speedbar-update-current-unit nil t))
14384 (defun vhdl-speedbar-contract-level ()
14385 "Contract current level in current directory/project."
14387 (when (or (save-excursion
14388 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
14389 (and (save-excursion
14390 (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
14391 (re-search-backward
14392 (format "^[0-%d]:\\s-*[[{<]-"
14393 (max (1- (string-to-number (match-string 1))) 0)) nil t)))
14394 (goto-char (match-end 0))
14395 (speedbar-do-function-pointer)
14396 (speedbar-center-buffer-smartly)))
14398 (defun vhdl-speedbar-contract-all ()
14399 "Contract all expanded design units in current directory/project."
14401 (if (and vhdl-speedbar-show-projects
14402 (save-excursion (beginning-of-line) (looking-at "^0:")))
14403 (progn (setq vhdl-speedbar-shown-project-list nil)
14404 (vhdl-speedbar-refresh))
14405 (let ((key (vhdl-speedbar-line-key)))
14406 (adelete 'vhdl-speedbar-shown-unit-alist key)
14407 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
14408 (when (memq 'display vhdl-speedbar-save-cache)
14409 (add-to-list 'vhdl-updated-project-list key)))))
14411 (defun vhdl-speedbar-expand-all ()
14412 "Expand all design units in current directory/project."
14414 (let* ((key (vhdl-speedbar-line-key))
14415 (ent-alist (aget vhdl-entity-alist key t))
14416 (conf-alist (aget vhdl-config-alist key t))
14417 (pack-alist (aget vhdl-package-alist key t))
14418 arch-alist unit-alist subunit-alist)
14419 (add-to-list 'vhdl-speedbar-shown-project-list key)
14421 (setq arch-alist (nth 4 (car ent-alist)))
14422 (setq subunit-alist nil)
14424 (setq subunit-alist (cons (caar arch-alist) subunit-alist))
14425 (setq arch-alist (cdr arch-alist)))
14426 (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist))
14427 (setq ent-alist (cdr ent-alist)))
14429 (setq unit-alist (cons (list (caar conf-alist)) unit-alist))
14430 (setq conf-alist (cdr conf-alist)))
14432 (setq unit-alist (cons (list (caar pack-alist)) unit-alist))
14433 (setq pack-alist (cdr pack-alist)))
14434 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14435 (vhdl-speedbar-refresh)
14436 (when (memq 'display vhdl-speedbar-save-cache)
14437 (add-to-list 'vhdl-updated-project-list key))))
14439 (defun vhdl-speedbar-expand-project (text token indent)
14440 "Expand/contract the project under the cursor."
14442 ((string-match "+" text) ; expand project
14443 (speedbar-change-expand-button-char ?-)
14444 (unless (member token vhdl-speedbar-shown-project-list)
14445 (setq vhdl-speedbar-shown-project-list
14446 (cons token vhdl-speedbar-shown-project-list)))
14447 (speedbar-with-writable
14449 (end-of-line) (forward-char 1)
14450 (vhdl-speedbar-insert-project-hierarchy token (1+ indent)
14451 speedbar-power-click))))
14452 ((string-match "-" text) ; contract project
14453 (speedbar-change-expand-button-char ?+)
14454 (setq vhdl-speedbar-shown-project-list
14455 (delete token vhdl-speedbar-shown-project-list))
14456 (speedbar-delete-subblock indent))
14457 (t (error "Nothing to display")))
14458 (when (equal (selected-frame) speedbar-frame)
14459 (speedbar-center-buffer-smartly)))
14461 (defun vhdl-speedbar-expand-entity (text token indent)
14462 "Expand/contract the entity under the cursor."
14464 ((string-match "+" text) ; expand entity
14465 (let* ((key (vhdl-speedbar-line-key indent))
14466 (ent-alist (aget vhdl-entity-alist key t))
14467 (ent-entry (aget ent-alist token t))
14468 (arch-alist (nth 3 ent-entry))
14469 (inst-alist (vhdl-get-instantiations token indent))
14470 (subpack-alist (nth 5 ent-entry))
14471 (multiple-arch (> (length arch-alist) 1))
14472 arch-entry inst-entry)
14473 (if (not (or arch-alist inst-alist subpack-alist))
14474 (speedbar-change-expand-button-char ??)
14475 (speedbar-change-expand-button-char ?-)
14476 ;; add entity to `vhdl-speedbar-shown-unit-alist'
14477 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14478 (aput 'unit-alist token nil)
14479 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14480 (speedbar-with-writable
14482 (end-of-line) (forward-char 1)
14483 ;; insert architectures
14485 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
14487 (setq arch-entry (car arch-alist))
14488 (speedbar-make-tag-line
14489 'curly ?+ 'vhdl-speedbar-expand-architecture
14490 (cons token (nth 0 arch-entry))
14491 (nth 1 arch-entry) 'vhdl-speedbar-find-file
14492 (cons (nth 2 arch-entry) (nth 3 arch-entry))
14493 'vhdl-speedbar-architecture-face (1+ indent))
14494 (when (and multiple-arch
14495 (equal (nth 0 arch-entry) (nth 4 ent-entry)))
14496 (end-of-line 0) (insert " (mra)") (forward-char 1))
14497 (setq arch-alist (cdr arch-alist)))
14498 ;; insert instantiations
14500 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
14502 (setq inst-entry (car inst-alist))
14503 (vhdl-speedbar-make-inst-line
14504 (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
14505 (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
14506 nil nil nil (1+ indent) 0 " in ")
14507 (setq inst-alist (cdr inst-alist)))
14508 ;; insert required packages
14509 (vhdl-speedbar-insert-subpackages
14510 subpack-alist (1+ indent) indent)))
14511 (when (memq 'display vhdl-speedbar-save-cache)
14512 (add-to-list 'vhdl-updated-project-list key))
14513 (vhdl-speedbar-update-current-unit t t))))
14514 ((string-match "-" text) ; contract entity
14515 (speedbar-change-expand-button-char ?+)
14516 ;; remove entity from `vhdl-speedbar-shown-unit-alist'
14517 (let* ((key (vhdl-speedbar-line-key indent))
14518 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14519 (adelete 'unit-alist token)
14521 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14522 (adelete 'vhdl-speedbar-shown-unit-alist key))
14523 (speedbar-delete-subblock indent)
14524 (when (memq 'display vhdl-speedbar-save-cache)
14525 (add-to-list 'vhdl-updated-project-list key))))
14526 (t (error "Nothing to display")))
14527 (when (equal (selected-frame) speedbar-frame)
14528 (speedbar-center-buffer-smartly)))
14530 (defun vhdl-speedbar-expand-architecture (text token indent)
14531 "Expand/contract the architecture under the cursor."
14533 ((string-match "+" text) ; expand architecture
14534 (let* ((key (vhdl-speedbar-line-key (1- indent)))
14535 (ent-alist (aget vhdl-entity-alist key t))
14536 (conf-alist (aget vhdl-config-alist key t))
14537 (hier-alist (vhdl-get-hierarchy
14538 ent-alist conf-alist (car token) (cdr token) nil nil
14540 (ent-entry (aget ent-alist (car token) t))
14541 (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
14542 (subpack-alist (nth 4 arch-entry))
14544 (if (not (or hier-alist subpack-alist))
14545 (speedbar-change-expand-button-char ??)
14546 (speedbar-change-expand-button-char ?-)
14547 ;; add architecture to `vhdl-speedbar-shown-unit-alist'
14548 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14549 (arch-alist (nth 0 (aget unit-alist (car token) t))))
14550 (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
14551 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14552 (speedbar-with-writable
14554 (end-of-line) (forward-char 1)
14555 ;; insert instance hierarchy
14557 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
14560 (setq entry (car hier-alist))
14561 (when (or (= vhdl-speedbar-hierarchy-depth 0)
14562 (< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14563 (vhdl-speedbar-make-inst-line
14564 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14565 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14566 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
14567 (setq hier-alist (cdr hier-alist)))
14568 ;; insert required packages
14569 (vhdl-speedbar-insert-subpackages
14570 subpack-alist (1+ indent) (1- indent))))
14571 (when (memq 'display vhdl-speedbar-save-cache)
14572 (add-to-list 'vhdl-updated-project-list key))
14573 (vhdl-speedbar-update-current-unit t t))))
14574 ((string-match "-" text) ; contract architecture
14575 (speedbar-change-expand-button-char ?+)
14576 ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
14577 (let* ((key (vhdl-speedbar-line-key (1- indent)))
14578 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14579 (arch-alist (nth 0 (aget unit-alist (car token) t))))
14580 (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
14581 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14582 (speedbar-delete-subblock indent)
14583 (when (memq 'display vhdl-speedbar-save-cache)
14584 (add-to-list 'vhdl-updated-project-list key))))
14585 (t (error "Nothing to display")))
14586 (when (equal (selected-frame) speedbar-frame)
14587 (speedbar-center-buffer-smartly)))
14589 (defun vhdl-speedbar-expand-config (text token indent)
14590 "Expand/contract the configuration under the cursor."
14592 ((string-match "+" text) ; expand configuration
14593 (let* ((key (vhdl-speedbar-line-key indent))
14594 (conf-alist (aget vhdl-config-alist key t))
14595 (conf-entry (aget conf-alist token))
14596 (ent-alist (aget vhdl-entity-alist key t))
14597 (hier-alist (vhdl-get-hierarchy
14598 ent-alist conf-alist (nth 3 conf-entry)
14599 (nth 4 conf-entry) token (nth 5 conf-entry)
14601 (subpack-alist (nth 6 conf-entry))
14603 (if (not (or hier-alist subpack-alist))
14604 (speedbar-change-expand-button-char ??)
14605 (speedbar-change-expand-button-char ?-)
14606 ;; add configuration to `vhdl-speedbar-shown-unit-alist'
14607 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14608 (aput 'unit-alist token nil)
14609 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14610 (speedbar-with-writable
14612 (end-of-line) (forward-char 1)
14613 ;; insert instance hierarchy
14615 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
14617 (setq entry (car hier-alist))
14618 (when (or (= vhdl-speedbar-hierarchy-depth 0)
14619 (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14620 (vhdl-speedbar-make-inst-line
14621 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14622 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14623 (nth 8 entry) (1+ indent) (nth 9 entry) ": "))
14624 (setq hier-alist (cdr hier-alist)))
14625 ;; insert required packages
14626 (vhdl-speedbar-insert-subpackages
14627 subpack-alist (1+ indent) indent)))
14628 (when (memq 'display vhdl-speedbar-save-cache)
14629 (add-to-list 'vhdl-updated-project-list key))
14630 (vhdl-speedbar-update-current-unit t t))))
14631 ((string-match "-" text) ; contract configuration
14632 (speedbar-change-expand-button-char ?+)
14633 ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
14634 (let* ((key (vhdl-speedbar-line-key indent))
14635 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14636 (adelete 'unit-alist token)
14638 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14639 (adelete 'vhdl-speedbar-shown-unit-alist key))
14640 (speedbar-delete-subblock indent)
14641 (when (memq 'display vhdl-speedbar-save-cache)
14642 (add-to-list 'vhdl-updated-project-list key))))
14643 (t (error "Nothing to display")))
14644 (when (equal (selected-frame) speedbar-frame)
14645 (speedbar-center-buffer-smartly)))
14647 (defun vhdl-speedbar-expand-package (text token indent)
14648 "Expand/contract the package under the cursor."
14650 ((string-match "+" text) ; expand package
14651 (let* ((key (vhdl-speedbar-line-key indent))
14652 (pack-alist (aget vhdl-package-alist key t))
14653 (pack-entry (aget pack-alist token t))
14654 (comp-alist (nth 3 pack-entry))
14655 (func-alist (nth 4 pack-entry))
14656 (func-body-alist (nth 8 pack-entry))
14657 (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
14658 comp-entry func-entry func-body-entry)
14659 (if (not (or comp-alist func-alist subpack-alist))
14660 (speedbar-change-expand-button-char ??)
14661 (speedbar-change-expand-button-char ?-)
14662 ;; add package to `vhdl-speedbar-shown-unit-alist'
14663 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14664 (aput 'unit-alist token nil)
14665 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14666 (speedbar-with-writable
14668 (end-of-line) (forward-char 1)
14669 ;; insert components
14671 (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
14673 (setq comp-entry (car comp-alist))
14674 (speedbar-make-tag-line
14676 (cons token (nth 0 comp-entry))
14677 (nth 1 comp-entry) 'vhdl-speedbar-find-file
14678 (cons (nth 2 comp-entry) (nth 3 comp-entry))
14679 'vhdl-speedbar-entity-face (1+ indent))
14680 (setq comp-alist (cdr comp-alist)))
14681 ;; insert subprograms
14683 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
14685 (setq func-entry (car func-alist)
14686 func-body-entry (aget func-body-alist (car func-entry) t))
14687 (when (nth 2 func-entry)
14688 (vhdl-speedbar-make-subprogram-line
14690 (cons (nth 2 func-entry) (nth 3 func-entry))
14691 (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
14693 (setq func-alist (cdr func-alist)))
14694 ;; insert required packages
14695 (vhdl-speedbar-insert-subpackages
14696 subpack-alist (1+ indent) indent)))
14697 (when (memq 'display vhdl-speedbar-save-cache)
14698 (add-to-list 'vhdl-updated-project-list key))
14699 (vhdl-speedbar-update-current-unit t t))))
14700 ((string-match "-" text) ; contract package
14701 (speedbar-change-expand-button-char ?+)
14702 ;; remove package from `vhdl-speedbar-shown-unit-alist'
14703 (let* ((key (vhdl-speedbar-line-key indent))
14704 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14705 (adelete 'unit-alist token)
14707 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14708 (adelete 'vhdl-speedbar-shown-unit-alist key))
14709 (speedbar-delete-subblock indent)
14710 (when (memq 'display vhdl-speedbar-save-cache)
14711 (add-to-list 'vhdl-updated-project-list key))))
14712 (t (error "Nothing to display")))
14713 (when (equal (selected-frame) speedbar-frame)
14714 (speedbar-center-buffer-smartly)))
14716 (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
14717 "Insert required packages."
14718 (let* ((pack-alist (aget vhdl-package-alist
14719 (vhdl-speedbar-line-key dir-indent) t))
14720 pack-key lib-name pack-entry)
14721 (when subpack-alist
14722 (vhdl-speedbar-make-title-line "Packages Used:" indent))
14723 (while subpack-alist
14724 (setq pack-key (cdar subpack-alist)
14725 lib-name (caar subpack-alist))
14726 (setq pack-entry (aget pack-alist pack-key t))
14727 (vhdl-speedbar-make-subpack-line
14728 (or (nth 0 pack-entry) pack-key) lib-name
14729 (cons (nth 1 pack-entry) (nth 2 pack-entry))
14730 (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent)
14731 (setq subpack-alist (cdr subpack-alist)))))
14733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14734 ;; Display help functions
14736 (defvar vhdl-speedbar-update-current-unit t
14737 "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
14739 (defun vhdl-speedbar-update-current-project ()
14740 "Highlight project that is currently active."
14741 (when (and vhdl-speedbar-show-projects
14742 (not (equal vhdl-speedbar-last-selected-project vhdl-project))
14743 (and (boundp 'speedbar-frame)
14744 (frame-live-p speedbar-frame)))
14745 (let ((last-frame (selected-frame))
14746 (project-alist vhdl-project-alist)
14748 (select-frame speedbar-frame)
14749 (speedbar-with-writable
14751 (while project-alist
14752 (goto-char (point-min))
14753 (when (re-search-forward
14754 (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
14755 (put-text-property (match-beginning 1) (match-end 1) 'face
14756 (if (equal (caar project-alist) vhdl-project)
14757 'speedbar-selected-face
14758 'speedbar-directory-face))
14759 (when (equal (caar project-alist) vhdl-project)
14760 (setq pos (1- (match-beginning 1)))))
14761 (setq project-alist (cdr project-alist))))
14762 (when pos (goto-char pos)))
14763 (select-frame last-frame)
14764 (setq vhdl-speedbar-last-selected-project vhdl-project)))
14767 (defun vhdl-speedbar-update-current-unit (&optional no-position always)
14768 "Highlight all design units that are contained in the current file.
14769 NO-POSITION non-nil means do not re-position cursor."
14770 (let ((last-frame (selected-frame))
14771 (project-list vhdl-speedbar-shown-project-list)
14772 file-alist pos file-name)
14773 ;; get current file name
14774 (if (fboundp 'speedbar-select-attached-frame)
14775 (speedbar-select-attached-frame)
14776 (select-frame speedbar-attached-frame))
14777 (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
14778 (when (and vhdl-speedbar-update-current-unit
14779 (or always (not (equal file-name speedbar-last-selected-file))))
14780 (if vhdl-speedbar-show-projects
14781 (while project-list
14782 (setq file-alist (append file-alist (aget vhdl-file-alist
14783 (car project-list) t)))
14784 (setq project-list (cdr project-list)))
14785 (setq file-alist (aget vhdl-file-alist
14786 (abbreviate-file-name default-directory) t)))
14787 (select-frame speedbar-frame)
14788 (set-buffer speedbar-buffer)
14789 (speedbar-with-writable
14790 (vhdl-prepare-search-1
14792 ;; unhighlight last units
14793 (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
14794 (vhdl-speedbar-update-units
14795 "\\[.\\] " (nth 0 file-entry)
14796 speedbar-last-selected-file 'vhdl-speedbar-entity-face)
14797 (vhdl-speedbar-update-units
14798 "{.} " (nth 1 file-entry)
14799 speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
14800 (vhdl-speedbar-update-units
14801 "\\[.\\] " (nth 3 file-entry)
14802 speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
14803 (vhdl-speedbar-update-units
14804 "[]>] " (nth 4 file-entry)
14805 speedbar-last-selected-file 'vhdl-speedbar-package-face)
14806 (vhdl-speedbar-update-units
14807 "\\[.\\].+(" '("body")
14808 speedbar-last-selected-file 'vhdl-speedbar-package-face)
14809 (vhdl-speedbar-update-units
14810 "> " (nth 6 file-entry)
14811 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
14812 ;; highlight current units
14813 (let* ((file-entry (aget file-alist file-name t)))
14815 pos (vhdl-speedbar-update-units
14816 "\\[.\\] " (nth 0 file-entry)
14817 file-name 'vhdl-speedbar-entity-selected-face pos)
14818 pos (vhdl-speedbar-update-units
14819 "{.} " (nth 1 file-entry)
14820 file-name 'vhdl-speedbar-architecture-selected-face pos)
14821 pos (vhdl-speedbar-update-units
14822 "\\[.\\] " (nth 3 file-entry)
14823 file-name 'vhdl-speedbar-configuration-selected-face pos)
14824 pos (vhdl-speedbar-update-units
14825 "[]>] " (nth 4 file-entry)
14826 file-name 'vhdl-speedbar-package-selected-face pos)
14827 pos (vhdl-speedbar-update-units
14828 "\\[.\\].+(" '("body")
14829 file-name 'vhdl-speedbar-package-selected-face pos)
14830 pos (vhdl-speedbar-update-units
14831 "> " (nth 6 file-entry)
14832 file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
14833 ;; move speedbar so the first highlighted unit is visible
14834 (when (and pos (not no-position))
14836 (speedbar-center-buffer-smartly)
14837 (speedbar-position-cursor-on-line))
14838 (setq speedbar-last-selected-file file-name))
14839 (select-frame last-frame)
14842 (defun vhdl-speedbar-update-units (text unit-list file-name face
14844 "Help function to highlight design units."
14846 (goto-char (point-min))
14847 (while (re-search-forward
14848 (concat text "\\(" (car unit-list) "\\)\\>") nil t)
14849 (when (equal file-name (car (get-text-property
14850 (match-beginning 1) 'speedbar-token)))
14851 (setq pos (or pos (point-marker)))
14852 (put-text-property (match-beginning 1) (match-end 1) 'face face)))
14853 (setq unit-list (cdr unit-list)))
14856 (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
14857 ent-name ent-file-marker
14858 arch-name arch-file-marker
14859 conf-name conf-file-marker
14860 lib-name depth offset delimiter)
14861 "Insert instantiation entry."
14862 (let ((start (point))
14864 (insert (int-to-string depth) ":")
14865 (put-text-property start (point) 'invisible t)
14866 (setq visible-start (point))
14867 (insert-char ? (* depth speedbar-indentation-width))
14868 (while (> offset 0)
14870 (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
14871 (setq offset (1- offset)))
14872 (put-text-property visible-start (point) 'invisible nil)
14873 (setq start (point))
14875 (speedbar-make-button start (point) nil nil nil)
14876 (setq visible-start (point))
14878 (setq start (point))
14879 (if (not inst-name)
14882 (speedbar-make-button
14883 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
14884 'vhdl-speedbar-find-file inst-file-marker))
14887 (setq start (point))
14889 (speedbar-make-button
14890 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
14891 'vhdl-speedbar-find-file ent-file-marker)
14894 (setq start (point))
14896 (speedbar-make-button
14897 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
14898 'vhdl-speedbar-find-file arch-file-marker)
14902 (setq start (point))
14904 (speedbar-make-button
14905 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
14906 'vhdl-speedbar-find-file conf-file-marker)
14908 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
14909 (setq start (point))
14910 (insert " (" lib-name ")")
14911 (put-text-property (+ 2 start) (1- (point)) 'face
14912 'vhdl-speedbar-library-face))
14913 (insert-char ?\n 1)
14914 (put-text-property visible-start (point) 'invisible nil)))
14916 (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
14917 body-file-marker depth)
14918 "Insert package entry."
14919 (let ((start (point))
14921 (insert (int-to-string depth) ":")
14922 (put-text-property start (point) 'invisible t)
14923 (setq visible-start (point))
14924 (insert-char ? (* depth speedbar-indentation-width))
14925 (put-text-property visible-start (point) 'invisible nil)
14926 (setq start (point))
14928 (speedbar-make-button
14929 start (point) 'speedbar-button-face 'speedbar-highlight-face
14930 'vhdl-speedbar-expand-package pack-key)
14931 (setq visible-start (point))
14932 (insert-char ? 1 nil)
14933 (setq start (point))
14935 (speedbar-make-button
14936 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14937 'vhdl-speedbar-find-file pack-file-marker)
14938 (unless (car pack-file-marker)
14940 (when (car body-file-marker)
14942 (setq start (point))
14944 (speedbar-make-button
14945 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14946 'vhdl-speedbar-find-file body-file-marker)
14948 (insert-char ?\n 1)
14949 (put-text-property visible-start (point) 'invisible nil)))
14951 (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
14952 pack-body-file-marker depth)
14953 "Insert used package entry."
14954 (let ((start (point))
14956 (insert (int-to-string depth) ":")
14957 (put-text-property start (point) 'invisible t)
14958 (setq visible-start (point))
14959 (insert-char ? (* depth speedbar-indentation-width))
14960 (put-text-property visible-start (point) 'invisible nil)
14961 (setq start (point))
14963 (speedbar-make-button start (point) nil nil nil)
14964 (setq visible-start (point))
14966 (setq start (point))
14968 (speedbar-make-button
14969 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14970 'vhdl-speedbar-find-file pack-file-marker)
14971 (when (car pack-body-file-marker)
14973 (setq start (point))
14975 (speedbar-make-button
14976 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14977 'vhdl-speedbar-find-file pack-body-file-marker)
14979 (setq start (point))
14980 (insert " (" lib-name ")")
14981 (put-text-property (+ 2 start) (1- (point)) 'face
14982 'vhdl-speedbar-library-face)
14983 (insert-char ?\n 1)
14984 (put-text-property visible-start (point) 'invisible nil)))
14986 (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
14987 func-body-file-marker
14989 "Insert subprogram entry."
14990 (let ((start (point))
14992 (insert (int-to-string depth) ":")
14993 (put-text-property start (point) 'invisible t)
14994 (setq visible-start (point))
14995 (insert-char ? (* depth speedbar-indentation-width))
14996 (put-text-property visible-start (point) 'invisible nil)
14997 (setq start (point))
14999 (speedbar-make-button start (point) nil nil nil)
15000 (setq visible-start (point))
15002 (setq start (point))
15004 (speedbar-make-button
15005 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15006 'vhdl-speedbar-find-file func-file-marker)
15007 (when (car func-body-file-marker)
15009 (setq start (point))
15011 (speedbar-make-button
15012 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15013 'vhdl-speedbar-find-file func-body-file-marker)
15015 (insert-char ?\n 1)
15016 (put-text-property visible-start (point) 'invisible nil)))
15018 (defun vhdl-speedbar-make-title-line (text &optional depth)
15019 "Insert design unit title entry."
15020 (let ((start (point))
15023 (insert (int-to-string depth) ":")
15024 (put-text-property start (point) 'invisible t))
15025 (setq visible-start (point))
15026 (insert-char ? (* (or depth 0) speedbar-indentation-width))
15027 (setq start (point))
15029 (speedbar-make-button start (point) nil nil nil nil)
15030 (insert-char ?\n 1)
15031 (put-text-property visible-start (point) 'invisible nil)))
15033 (defun vhdl-speedbar-insert-dirs (files level)
15034 "Insert subdirectories."
15035 (let ((dirs (car files)))
15037 (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs)
15038 (car dirs) 'speedbar-dir-follow nil
15039 'speedbar-directory-face level)
15040 (setq dirs (cdr dirs)))))
15042 (defun vhdl-speedbar-dired (text token indent)
15043 "Speedbar click handler for directory expand button in hierarchy mode."
15044 (cond ((string-match "+" text) ; we have to expand this dir
15045 (setq speedbar-shown-directories
15046 (cons (expand-file-name
15047 (concat (speedbar-line-path indent) token "/"))
15048 speedbar-shown-directories))
15049 (speedbar-change-expand-button-char ?-)
15050 (speedbar-reset-scanners)
15051 (speedbar-with-writable
15053 (end-of-line) (forward-char 1)
15054 (vhdl-speedbar-insert-dirs
15055 (speedbar-file-lists
15056 (concat (speedbar-line-path indent) token "/"))
15058 (speedbar-reset-scanners)
15059 (vhdl-speedbar-insert-dir-hierarchy
15060 (abbreviate-file-name
15061 (concat (speedbar-line-path indent) token "/"))
15062 (1+ indent) speedbar-power-click)))
15063 (vhdl-speedbar-update-current-unit t t))
15064 ((string-match "-" text) ; we have to contract this node
15065 (speedbar-reset-scanners)
15066 (let ((oldl speedbar-shown-directories)
15068 (td (expand-file-name
15069 (concat (speedbar-line-path indent) token))))
15071 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
15072 (setq newl (cons (car oldl) newl)))
15073 (setq oldl (cdr oldl)))
15074 (setq speedbar-shown-directories (nreverse newl)))
15075 (speedbar-change-expand-button-char ?+)
15076 (speedbar-delete-subblock indent))
15077 (t (error "Nothing to display")))
15078 (when (equal (selected-frame) speedbar-frame)
15079 (speedbar-center-buffer-smartly)))
15081 (defun vhdl-speedbar-item-info ()
15082 "Derive and display information about this line item."
15084 (beginning-of-line)
15085 ;; skip invisible number info
15086 (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
15088 ;; project/directory entry
15089 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
15090 (if vhdl-speedbar-show-projects
15091 (message "Project \"%s\"" (match-string-no-properties 1))
15092 (speedbar-files-item-info)))
15093 ;; design unit entry
15094 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
15095 (goto-char (match-end 1))
15096 (let ((face (get-text-property (point) 'face)))
15098 "%s \"%s\" in \"%s\""
15099 ;; design unit kind
15100 (cond ((or (eq face 'vhdl-speedbar-entity-face)
15101 (eq face 'vhdl-speedbar-entity-selected-face))
15102 (if (equal (match-string 2) ">") "Component" "Entity"))
15103 ((or (eq face 'vhdl-speedbar-architecture-face)
15104 (eq face 'vhdl-speedbar-architecture-selected-face))
15106 ((or (eq face 'vhdl-speedbar-configuration-face)
15107 (eq face 'vhdl-speedbar-configuration-selected-face))
15109 ((or (eq face 'vhdl-speedbar-package-face)
15110 (eq face 'vhdl-speedbar-package-selected-face))
15112 ((or (eq face 'vhdl-speedbar-instantiation-face)
15113 (eq face 'vhdl-speedbar-instantiation-selected-face))
15115 ((eq face 'vhdl-speedbar-subprogram-face)
15118 ;; design unit name
15119 (buffer-substring-no-properties
15120 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
15123 (file-relative-name
15124 (or (car (get-text-property (point) 'speedbar-token))
15126 (vhdl-default-directory)))))
15127 (t (message "")))))
15129 (defun vhdl-speedbar-line-text ()
15130 "Calls `speedbar-line-text' and removes text properties."
15131 (let ((string (speedbar-line-text)))
15132 (set-text-properties 0 (length string) nil string)
15135 (defun vhdl-speedbar-higher-text ()
15136 "Get speedbar-line-text of higher level."
15137 (let (depth string)
15139 (beginning-of-line)
15140 (looking-at "^\\([0-9]+\\):")
15141 (setq depth (string-to-number (match-string 1)))
15142 (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t)
15143 (setq string (match-string 1))
15144 (set-text-properties 0 (length string) nil string)
15147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15150 (defun vhdl-speedbar-line-key (&optional indent)
15151 "Get currently displayed directory of project name."
15152 (if vhdl-speedbar-show-projects
15153 (vhdl-speedbar-line-project)
15154 (abbreviate-file-name
15155 (file-name-as-directory (speedbar-line-path indent)))))
15157 (defun vhdl-speedbar-line-project (&optional indent)
15158 "Get currently displayed project name."
15159 (and vhdl-speedbar-show-projects
15162 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
15163 (match-string-no-properties 1))))
15165 (defun vhdl-add-modified-file ()
15166 "Add file to `vhdl-modified-file-list'."
15167 (when vhdl-file-alist
15168 (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
15171 (defun vhdl-resolve-paths (path-list)
15172 "Resolve path wildcards in PATH-LIST."
15173 (let (path-list-1 path-list-2 path-beg path-end dir)
15174 ;; eliminate non-existent directories
15176 (setq dir (car path-list))
15177 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
15178 (if (file-directory-p (match-string 2 dir))
15179 (setq path-list-1 (cons dir path-list-1))
15180 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
15181 (setq path-list (cdr path-list)))
15182 ;; resolve path wildcards
15184 (setq dir (car path-list-1))
15185 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
15187 (setq path-beg (match-string 1 dir)
15188 path-end (match-string 5 dir))
15193 (lambda (var) (concat path-beg var path-end)))
15194 (let ((all-list (vhdl-directory-files
15195 (match-string 2 dir) t
15196 (concat "\\<" (wildcard-to-regexp
15197 (match-string 4 dir)))))
15200 (when (file-directory-p (car all-list))
15201 (setq dir-list (cons (car all-list) dir-list)))
15202 (setq all-list (cdr all-list)))
15204 (cdr path-list-1))))
15205 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
15206 (when (file-directory-p (match-string 2 dir))
15207 (setq path-list-2 (cons dir path-list-2)))
15208 (setq path-list-1 (cdr path-list-1))))
15209 (nreverse path-list-2)))
15211 (defun vhdl-speedbar-goto-this-unit (directory unit)
15212 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
15213 (let ((dest (point)))
15214 (if (and (if vhdl-speedbar-show-projects
15215 (progn (goto-char (point-min)) t)
15216 (speedbar-goto-this-file directory))
15217 (re-search-forward (concat "[]}] " unit "\\>") nil t))
15218 (progn (speedbar-position-cursor-on-line)
15223 (defun vhdl-speedbar-find-file (text token indent)
15224 "When user clicks on TEXT, load file with name and position in TOKEN.
15225 Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15226 is already shown in a buffer."
15227 (if (not (car token))
15228 (error "ERROR: File cannot be found")
15229 (let ((buffer (get-file-buffer (car token))))
15230 (speedbar-find-file-in-frame (car token))
15231 (when (or vhdl-speedbar-jump-to-unit buffer)
15232 (goto-line (cdr token))
15234 (vhdl-speedbar-update-current-unit t t)
15235 (speedbar-set-timer speedbar-update-speed)
15236 (speedbar-maybee-jump-to-attached-frame))))
15238 (defun vhdl-speedbar-port-copy ()
15239 "Copy the port of the entity/component or subprogram under the cursor."
15241 (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
15242 (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
15243 (error "ERROR: No entity/component or subprogram under cursor")
15244 (beginning-of-line)
15245 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
15246 (condition-case info
15247 (let ((token (get-text-property
15248 (match-beginning 3) 'speedbar-token)))
15249 (vhdl-visit-file (car token) t
15250 (progn (goto-line (cdr token))
15254 (vhdl-subprog-copy)))))
15255 (error (error "ERROR: %s not scanned successfully\n (%s)"
15256 (if is-entity "Port" "Interface") (cadr info))))
15257 (error "ERROR: No entity/component or subprogram on current line")))))
15259 (defun vhdl-speedbar-place-component ()
15260 "Place the entity/component under the cursor as component."
15262 (if (not (vhdl-speedbar-check-unit 'entity))
15263 (error "ERROR: No entity/component under cursor")
15264 (vhdl-speedbar-port-copy)
15265 (if (fboundp 'speedbar-select-attached-frame)
15266 (speedbar-select-attached-frame)
15267 (select-frame speedbar-attached-frame))
15268 (vhdl-compose-place-component)
15269 (select-frame speedbar-frame)))
15271 (defun vhdl-speedbar-configuration ()
15272 "Generate configuration for the architecture under the cursor."
15274 (if (not (vhdl-speedbar-check-unit 'architecture))
15275 (error "ERROR: No architecture under cursor")
15276 (let ((arch-name (vhdl-speedbar-line-text))
15277 (ent-name (vhdl-speedbar-higher-text)))
15278 (if (fboundp 'speedbar-select-attached-frame)
15279 (speedbar-select-attached-frame)
15280 (select-frame speedbar-attached-frame))
15281 (vhdl-compose-configuration ent-name arch-name))))
15283 (defun vhdl-speedbar-select-mra ()
15284 "Select the architecture under the cursor as MRA."
15286 (if (not (vhdl-speedbar-check-unit 'architecture))
15287 (error "ERROR: No architecture under cursor")
15288 (let* ((arch-key (downcase (vhdl-speedbar-line-text)))
15289 (ent-key (downcase (vhdl-speedbar-higher-text)))
15290 (ent-alist (aget vhdl-entity-alist
15291 (or (vhdl-project-p) default-directory) t))
15292 (ent-entry (aget ent-alist ent-key t)))
15293 (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
15294 (speedbar-refresh))))
15296 (defun vhdl-speedbar-make-design ()
15297 "Make (compile) design unit or directory/project under the cursor."
15299 (if (not (save-excursion (beginning-of-line)
15300 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
15301 (error "ERROR: No primary design unit or directory/project under cursor")
15302 (let ((is-unit (match-string 2))
15303 (unit-name (vhdl-speedbar-line-text))
15304 (vhdl-project (vhdl-speedbar-line-project))
15305 (directory (file-name-as-directory
15306 (or (speedbar-line-file) (speedbar-line-path)))))
15307 (if (fboundp 'speedbar-select-attached-frame)
15308 (speedbar-select-attached-frame)
15309 (select-frame speedbar-attached-frame))
15310 (let ((default-directory directory))
15311 (vhdl-make (and is-unit unit-name))))))
15313 (defun vhdl-speedbar-generate-makefile ()
15314 "Generate Makefile for directory/project under the cursor."
15316 (let ((vhdl-project (vhdl-speedbar-line-project))
15317 (default-directory (file-name-as-directory
15318 (or (speedbar-line-file) (speedbar-line-path)))))
15319 (vhdl-generate-makefile)))
15321 (defun vhdl-speedbar-check-unit (design-unit)
15322 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
15323 expansion function)."
15325 (speedbar-position-cursor-on-line)
15326 (cond ((eq design-unit 'entity)
15327 (memq (get-text-property (match-end 0) 'face)
15328 '(vhdl-speedbar-entity-face
15329 vhdl-speedbar-entity-selected-face)))
15330 ((eq design-unit 'architecture)
15331 (memq (get-text-property (match-end 0) 'face)
15332 '(vhdl-speedbar-architecture-face
15333 vhdl-speedbar-architecture-selected-face)))
15334 ((eq design-unit 'subprogram)
15335 (eq (get-text-property (match-end 0) 'face)
15336 'vhdl-speedbar-subprogram-face))
15339 (defun vhdl-speedbar-set-depth (depth)
15340 "Set hierarchy display depth to DEPTH and refresh speedbar."
15341 (setq vhdl-speedbar-hierarchy-depth depth)
15342 (speedbar-refresh))
15344 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15347 (defface vhdl-speedbar-entity-face
15348 '((((class color) (background light)) (:foreground "ForestGreen"))
15349 (((class color) (background dark)) (:foreground "PaleGreen")))
15350 "Face used for displaying entity names."
15351 :group 'speedbar-faces)
15353 (defface vhdl-speedbar-architecture-face
15354 '(;(((min-colors 88) (class color) (background light)) (:foreground "Blue1")) ; Emacs 22
15355 (((class color) (background light)) (:foreground "Blue"))
15356 (((class color) (background dark)) (:foreground "LightSkyBlue")))
15357 "Face used for displaying architecture names."
15358 :group 'speedbar-faces)
15360 (defface vhdl-speedbar-configuration-face
15361 '((((class color) (background light)) (:foreground "DarkGoldenrod"))
15362 (((class color) (background dark)) (:foreground "Salmon")))
15363 "Face used for displaying configuration names."
15364 :group 'speedbar-faces)
15366 (defface vhdl-speedbar-package-face
15367 '((((class color) (background light)) (:foreground "Grey50"))
15368 (((class color) (background dark)) (:foreground "Grey80")))
15369 "Face used for displaying package names."
15370 :group 'speedbar-faces)
15372 (defface vhdl-speedbar-library-face
15373 '((((class color) (background light)) (:foreground "Purple"))
15374 (((class color) (background dark)) (:foreground "Orchid1")))
15375 "Face used for displaying library names."
15376 :group 'speedbar-faces)
15378 (defface vhdl-speedbar-instantiation-face
15379 '((((class color) (background light)) (:foreground "Brown"))
15380 ;(((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) ; Emacs 22
15381 (((class color) (background dark)) (:foreground "Yellow")))
15382 "Face used for displaying instantiation names."
15383 :group 'speedbar-faces)
15385 (defface vhdl-speedbar-subprogram-face
15386 '((((class color) (background light)) (:foreground "Orchid4"))
15387 (((class color) (background dark)) (:foreground "BurlyWood2")))
15388 "Face used for displaying subprogram names."
15389 :group 'speedbar-faces)
15391 (defface vhdl-speedbar-entity-selected-face
15392 '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
15393 (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
15394 "Face used for displaying entity names."
15395 :group 'speedbar-faces)
15397 (defface vhdl-speedbar-architecture-selected-face
15398 '(;(((min-colors 88) (class color) (background light)) ; Emacs 22
15399 ; (:foreground "Blue1" :underline t))
15400 (((class color) (background light)) (:foreground "Blue" :underline t))
15401 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
15402 "Face used for displaying architecture names."
15403 :group 'speedbar-faces)
15405 (defface vhdl-speedbar-configuration-selected-face
15406 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
15407 (((class color) (background dark)) (:foreground "Salmon" :underline t)))
15408 "Face used for displaying configuration names."
15409 :group 'speedbar-faces)
15411 (defface vhdl-speedbar-package-selected-face
15412 '((((class color) (background light)) (:foreground "Grey50" :underline t))
15413 (((class color) (background dark)) (:foreground "Grey80" :underline t)))
15414 "Face used for displaying package names."
15415 :group 'speedbar-faces)
15417 (defface vhdl-speedbar-instantiation-selected-face
15418 '((((class color) (background light)) (:foreground "Brown" :underline t))
15419 (((class color) (background dark)) (:foreground "Yellow" :underline t)))
15420 "Face used for displaying instantiation names."
15421 :group 'speedbar-faces)
15423 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15427 (when (fboundp 'speedbar)
15429 (when (and vhdl-speedbar-auto-open
15430 (not (and (boundp 'speedbar-frame)
15431 (frame-live-p speedbar-frame))))
15432 (speedbar-frame-mode 1)
15433 (if (fboundp 'speedbar-select-attached-frame)
15434 (speedbar-select-attached-frame)
15435 (select-frame speedbar-attached-frame)))
15436 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))))
15438 ;; initialize speedbar
15439 (if (not (boundp 'speedbar-frame))
15440 (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
15441 (vhdl-speedbar-initialize)
15442 (when speedbar-frame (vhdl-speedbar-refresh)))
15445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15446 ;;; Structural composition
15447 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15449 (defun vhdl-get-components-package-name ()
15450 "Return the name of the components package."
15451 (let ((project (vhdl-project-p)))
15453 (vhdl-replace-string (car vhdl-components-package-name)
15454 (subst-char-in-string ? ?_ project))
15455 (cdr vhdl-components-package-name))))
15457 (defun vhdl-compose-new-component ()
15458 "Create entity and architecture for new component."
15460 (let* ((case-fold-search t)
15461 (ent-name (read-from-minibuffer "entity name: "
15462 nil vhdl-minibuffer-local-map))
15464 (if (equal (cdr vhdl-compose-architecture-name) "")
15465 (read-from-minibuffer "architecture name: "
15466 nil vhdl-minibuffer-local-map)
15467 (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
15468 ent-file-name arch-file-name ent-buffer arch-buffer project)
15469 (message "Creating component \"%s(%s)\"..." ent-name arch-name)
15470 ;; open entity file
15471 (unless (eq vhdl-compose-create-files 'none)
15472 (setq ent-file-name
15473 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
15474 "." (file-name-extension (buffer-file-name))))
15475 (when (and (file-exists-p ent-file-name)
15476 (not (y-or-n-p (concat "File \"" ent-file-name
15477 "\" exists; overwrite? "))))
15478 (error "ERROR: Creating component...aborted"))
15479 (find-file ent-file-name)
15481 (set-buffer-modified-p nil))
15483 (if vhdl-compose-include-header
15484 (progn (vhdl-template-header)
15485 (goto-char (point-max)))
15486 (vhdl-comment-display-line) (insert "\n\n"))
15487 ;; insert library clause
15488 (vhdl-template-package-std-logic-1164)
15489 (when vhdl-use-components-package
15491 (vhdl-template-standard-package (vhdl-work-library)
15492 (vhdl-get-components-package-name)))
15493 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
15494 ;; insert entity declaration
15495 (vhdl-insert-keyword "ENTITY ") (insert ent-name)
15496 (vhdl-insert-keyword " IS\n")
15497 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15498 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
15499 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15500 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15501 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
15502 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15503 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15504 (vhdl-insert-keyword "END ")
15505 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
15506 (insert ent-name ";\n\n")
15507 (vhdl-comment-display-line) (insert "\n")
15508 ;; open architecture file
15509 (if (not (eq vhdl-compose-create-files 'separate))
15511 (setq ent-buffer (current-buffer))
15512 (setq arch-file-name
15513 (concat (vhdl-replace-string vhdl-architecture-file-name
15514 (concat ent-name " " arch-name) t)
15515 "." (file-name-extension (buffer-file-name))))
15516 (when (and (file-exists-p arch-file-name)
15517 (not (y-or-n-p (concat "File \"" arch-file-name
15518 "\" exists; overwrite? "))))
15519 (error "ERROR: Creating component...aborted"))
15520 (find-file arch-file-name)
15522 (set-buffer-modified-p nil)
15524 (if vhdl-compose-include-header
15525 (progn (vhdl-template-header)
15526 (goto-char (point-max)))
15527 (vhdl-comment-display-line) (insert "\n\n")))
15528 ;; insert architecture body
15529 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
15530 (vhdl-insert-keyword " OF ") (insert ent-name)
15531 (vhdl-insert-keyword " IS\n\n")
15532 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15533 (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
15534 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15535 (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
15536 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15537 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15538 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
15539 (vhdl-insert-keyword "BEGIN")
15540 (when vhdl-self-insert-comments
15542 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15543 (insert arch-name))
15545 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15546 (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
15547 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15548 (vhdl-insert-keyword "END ")
15549 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15550 (insert arch-name ";\n\n")
15551 ;; insert footer and save
15552 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15553 (vhdl-template-footer)
15554 (vhdl-comment-display-line) (insert "\n"))
15555 (goto-char (point-min))
15556 (setq arch-buffer (current-buffer))
15557 (when ent-buffer (set-buffer ent-buffer) (save-buffer))
15558 (set-buffer arch-buffer) (save-buffer)
15560 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
15562 (format "\n File created: \"%s\"" ent-file-name))
15563 (and arch-file-name
15564 (format "\n File created: \"%s\"" arch-file-name))))))
15566 (defun vhdl-compose-place-component ()
15567 "Place new component by pasting current port as component declaration and
15568 component instantiation."
15570 (if (not vhdl-port-list)
15571 (error "ERROR: No port has been read")
15573 (vhdl-prepare-search-2
15574 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15575 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15576 (error "ERROR: No architecture found"))
15577 (let* ((ent-name (match-string 1))
15579 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
15580 "." (file-name-extension (buffer-file-name))))
15581 (orig-buffer (current-buffer)))
15582 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
15583 ;; place component declaration
15584 (unless (or vhdl-use-components-package
15585 (vhdl-use-direct-instantiation)
15588 (concat "^\\s-*component\\s-+"
15589 (car vhdl-port-list) "\\>") nil t)))
15590 (re-search-forward "^begin\\>" nil)
15591 (beginning-of-line)
15592 (skip-chars-backward " \t\n")
15593 (insert "\n\n") (indent-to vhdl-basic-offset)
15594 (vhdl-port-paste-component t))
15595 ;; place component instantiation
15596 (re-search-forward "^end\\>" nil)
15597 (beginning-of-line)
15598 (skip-chars-backward " \t\n")
15599 (insert "\n\n") (indent-to vhdl-basic-offset)
15600 (vhdl-port-paste-instance nil t t)
15601 ;; place use clause for used packages
15602 (when (nth 3 vhdl-port-list)
15603 ;; open entity file
15604 (when (file-exists-p ent-file-name)
15605 (find-file ent-file-name))
15606 (goto-char (point-min))
15607 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15608 (error "ERROR: Entity not found: \"%s\"" ent-name))
15609 (goto-char (match-beginning 0))
15610 (if (and (save-excursion
15611 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
15613 (progn (goto-char (match-end 0))
15614 (beginning-of-line 2))
15617 (vhdl-port-paste-context-clause)
15618 (switch-to-buffer orig-buffer))
15619 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
15621 (defun vhdl-compose-wire-components ()
15622 "Connect components."
15625 (vhdl-prepare-search-2
15626 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15627 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15628 (error "ERROR: No architecture found"))
15629 (let* ((ent-name (match-string 1))
15631 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
15632 "." (file-name-extension (buffer-file-name))))
15633 (arch-decl-pos (point-marker))
15634 (arch-stat-pos (re-search-forward "^begin\\>" nil))
15635 (arch-end-pos (re-search-forward "^end\\>" nil))
15636 (pack-name (vhdl-get-components-package-name))
15638 (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
15639 "." (file-name-extension (buffer-file-name))))
15640 inst-name comp-name comp-ent-name comp-ent-file-name has-generic
15641 port-alist generic-alist inst-alist
15642 signal-name signal-entry signal-alist local-list written-list
15643 single-in-list multi-in-list single-out-list multi-out-list
15644 constant-name constant-entry constant-alist single-list multi-list
15645 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
15646 generic-beg-pos generic-pos generic-inst-pos generic-end-pos
15647 signal-beg-pos signal-pos
15648 constant-temp-pos port-temp-pos signal-temp-pos)
15649 (message "Wiring components...")
15650 ;; process all instances
15651 (goto-char arch-stat-pos)
15652 (while (re-search-forward
15653 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
15654 "\\(component[ \t\n]+\\)?\\(\\w+\\)"
15655 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|"
15656 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?"
15657 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t)
15658 (setq inst-name (match-string-no-properties 1)
15659 comp-name (match-string-no-properties 4)
15660 comp-ent-name (match-string-no-properties 12)
15661 has-generic (or (match-string 7) (match-string 17)))
15664 ;; ... from component declaration
15666 (when vhdl-use-components-package pack-file-name) t
15668 (goto-char (point-min))
15669 (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t)
15670 (error "ERROR: Component declaration not found: \"%s\"" comp-name))
15672 ;; ... from entity declaration (direct instantiation)
15673 (setq comp-ent-file-name
15674 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
15675 "." (file-name-extension (buffer-file-name))))
15677 comp-ent-file-name t
15679 (goto-char (point-min))
15680 (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t)
15681 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name))
15682 (vhdl-port-copy))))
15683 (vhdl-port-flatten t)
15684 (setq generic-alist (nth 1 vhdl-port-list)
15685 port-alist (nth 2 vhdl-port-list)
15686 vhdl-port-list nil)
15687 (setq constant-alist nil
15690 ;; process all constants in generic map
15691 (vhdl-forward-syntactic-ws)
15692 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15693 (setq constant-name (match-string-no-properties 3))
15694 (setq constant-entry
15695 (cons constant-name
15696 (if (match-string 1)
15697 (or (aget generic-alist (match-string 2) t)
15698 (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
15699 (cdar generic-alist))))
15700 (setq constant-alist (cons constant-entry constant-alist))
15701 (setq constant-name (downcase constant-name))
15702 (if (or (member constant-name single-list)
15703 (member constant-name multi-list))
15704 (progn (setq single-list (delete constant-name single-list))
15705 (add-to-list 'multi-list constant-name))
15706 (add-to-list 'single-list constant-name))
15707 (unless (match-string 1)
15708 (setq generic-alist (cdr generic-alist)))
15709 (vhdl-forward-syntactic-ws))
15710 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t))
15711 ;; process all signals in port map
15712 (vhdl-forward-syntactic-ws)
15713 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15714 (setq signal-name (match-string-no-properties 3))
15715 (setq signal-entry (cons signal-name
15716 (if (match-string 1)
15717 (or (aget port-alist (match-string 2) t)
15718 (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
15719 (cdar port-alist))))
15720 (setq signal-alist (cons signal-entry signal-alist))
15721 (setq signal-name (downcase signal-name))
15722 (if (equal (upcase (nth 2 signal-entry)) "IN")
15725 ((member signal-name local-list)
15727 ((or (member signal-name single-out-list)
15728 (member signal-name multi-out-list))
15729 (setq single-out-list (delete signal-name single-out-list))
15730 (setq multi-out-list (delete signal-name multi-out-list))
15731 (add-to-list 'local-list signal-name))
15732 ((member signal-name single-in-list)
15733 (setq single-in-list (delete signal-name single-in-list))
15734 (add-to-list 'multi-in-list signal-name))
15735 ((not (member signal-name multi-in-list))
15736 (add-to-list 'single-in-list signal-name)))
15739 ((member signal-name local-list)
15741 ((or (member signal-name single-in-list)
15742 (member signal-name multi-in-list))
15743 (setq single-in-list (delete signal-name single-in-list))
15744 (setq multi-in-list (delete signal-name multi-in-list))
15745 (add-to-list 'local-list signal-name))
15746 ((member signal-name single-out-list)
15747 (setq single-out-list (delete signal-name single-out-list))
15748 (add-to-list 'multi-out-list signal-name))
15749 ((not (member signal-name multi-out-list))
15750 (add-to-list 'single-out-list signal-name))))
15751 (unless (match-string 1)
15752 (setq port-alist (cdr port-alist)))
15753 (vhdl-forward-syntactic-ws))
15754 (setq inst-alist (cons (list inst-name (nreverse constant-alist)
15755 (nreverse signal-alist)) inst-alist)))
15756 ;; prepare signal insertion
15757 (vhdl-goto-marker arch-decl-pos)
15759 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t)
15760 (setq signal-pos (point-marker))
15761 (while (progn (vhdl-forward-syntactic-ws)
15762 (looking-at "signal\\>"))
15763 (beginning-of-line 2)
15764 (delete-region signal-pos (point)))
15765 (setq signal-beg-pos signal-pos)
15766 ;; open entity file
15767 (when (file-exists-p ent-file-name)
15768 (find-file ent-file-name))
15769 (goto-char (point-min))
15770 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15771 (error "ERROR: Entity not found: \"%s\"" ent-name))
15772 ;; prepare generic clause insertion
15773 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t)
15775 (goto-char (match-beginning 0))
15776 (indent-to vhdl-basic-offset)
15777 (insert "generic ();\n\n")
15780 (setq generic-pos (point-marker))
15781 (forward-sexp) (end-of-line)
15782 (delete-region generic-pos (point)) (delete-char 1)
15786 (indent-to (* 2 vhdl-basic-offset))
15787 (insert "-- global generics\n"))
15788 (setq generic-beg-pos (point-marker) generic-pos (point-marker)
15789 generic-inst-pos (point-marker) generic-end-pos (point-marker))
15790 ;; prepare port clause insertion
15791 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t)
15793 (goto-char (match-beginning 0))
15794 (indent-to vhdl-basic-offset)
15795 (insert "port ();\n\n")
15798 (setq port-in-pos (point-marker))
15799 (forward-sexp) (end-of-line)
15800 (delete-region port-in-pos (point)) (delete-char 1)
15802 (when (or multi-in-list multi-out-list)
15804 (indent-to (* 2 vhdl-basic-offset))
15805 (insert "-- global ports\n"))
15806 (setq port-beg-pos (point-marker) port-in-pos (point-marker)
15807 port-out-pos (point-marker) port-inst-pos (point-marker)
15808 port-end-pos (point-marker))
15809 ;; insert generics, ports and signals
15810 (setq inst-alist (nreverse inst-alist))
15812 (setq inst-name (nth 0 (car inst-alist))
15813 constant-alist (nth 1 (car inst-alist))
15814 signal-alist (nth 2 (car inst-alist))
15815 constant-temp-pos generic-inst-pos
15816 port-temp-pos port-inst-pos
15817 signal-temp-pos signal-pos)
15819 (while constant-alist
15820 (setq constant-name (downcase (caar constant-alist))
15821 constant-entry (car constant-alist))
15822 (cond ((member constant-name written-list)
15824 ((member constant-name multi-list)
15825 (vhdl-goto-marker generic-pos)
15826 (setq generic-end-pos
15829 (vhdl-compose-insert-generic constant-entry)))
15830 (setq generic-pos (point-marker))
15831 (add-to-list 'written-list constant-name))
15834 (vhdl-max-marker generic-inst-pos generic-pos))
15835 (setq generic-end-pos
15836 (vhdl-compose-insert-generic constant-entry))
15837 (setq generic-inst-pos (point-marker))
15838 (add-to-list 'written-list constant-name)))
15839 (setq constant-alist (cdr constant-alist)))
15840 (when (/= constant-temp-pos generic-inst-pos)
15841 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
15842 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15843 (insert "-- generics for \"" inst-name "\"\n")
15844 (vhdl-goto-marker generic-inst-pos))
15845 ;; ports and signals
15846 (while signal-alist
15847 (setq signal-name (downcase (caar signal-alist))
15848 signal-entry (car signal-alist))
15849 (cond ((member signal-name written-list)
15851 ((member signal-name multi-in-list)
15852 (vhdl-goto-marker port-in-pos)
15855 port-end-pos (vhdl-compose-insert-port signal-entry)))
15856 (setq port-in-pos (point-marker))
15857 (add-to-list 'written-list signal-name))
15858 ((member signal-name multi-out-list)
15859 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
15862 port-end-pos (vhdl-compose-insert-port signal-entry)))
15863 (setq port-out-pos (point-marker))
15864 (add-to-list 'written-list signal-name))
15865 ((or (member signal-name single-in-list)
15866 (member signal-name single-out-list))
15870 (vhdl-max-marker port-out-pos port-in-pos)))
15871 (setq port-end-pos (vhdl-compose-insert-port signal-entry))
15872 (setq port-inst-pos (point-marker))
15873 (add-to-list 'written-list signal-name))
15874 ((equal (upcase (nth 2 signal-entry)) "OUT")
15875 (vhdl-goto-marker signal-pos)
15876 (vhdl-compose-insert-signal signal-entry)
15877 (setq signal-pos (point-marker))
15878 (add-to-list 'written-list signal-name)))
15879 (setq signal-alist (cdr signal-alist)))
15880 (when (/= port-temp-pos port-inst-pos)
15882 (vhdl-max-marker port-temp-pos
15883 (vhdl-max-marker port-in-pos port-out-pos)))
15884 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15885 (insert "-- ports to \"" inst-name "\"\n")
15886 (vhdl-goto-marker port-inst-pos))
15887 (when (/= signal-temp-pos signal-pos)
15888 (vhdl-goto-marker signal-temp-pos)
15889 (insert "\n") (indent-to vhdl-basic-offset)
15890 (insert "-- outputs of \"" inst-name "\"\n")
15891 (vhdl-goto-marker signal-pos))
15892 (setq inst-alist (cdr inst-alist)))
15893 ;; finalize generic/port clause
15894 (vhdl-goto-marker generic-end-pos) (backward-char)
15895 (when (= generic-beg-pos generic-end-pos)
15896 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15897 (insert ";") (backward-char))
15899 (vhdl-goto-marker port-end-pos) (backward-char)
15900 (when (= port-beg-pos port-end-pos)
15901 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15902 (insert ";") (backward-char))
15904 ;; align everything
15905 (when vhdl-auto-align
15906 (vhdl-goto-marker generic-beg-pos)
15907 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
15908 (vhdl-align-region-groups port-beg-pos port-end-pos 1)
15909 (vhdl-goto-marker signal-beg-pos)
15910 (vhdl-align-region-groups signal-beg-pos signal-pos))
15911 (switch-to-buffer (marker-buffer signal-beg-pos))
15912 (message "Wiring components...done")))))
15914 (defun vhdl-compose-insert-generic (entry)
15915 "Insert ENTRY as generic declaration."
15917 (indent-to (* 2 vhdl-basic-offset))
15918 (insert (nth 0 entry) " : " (nth 1 entry))
15919 (when (nth 2 entry)
15920 (insert " := " (nth 2 entry)))
15922 (setq pos (point-marker))
15923 (when (and vhdl-include-port-comments (nth 3 entry))
15924 (vhdl-comment-insert-inline (nth 3 entry) t))
15928 (defun vhdl-compose-insert-port (entry)
15929 "Insert ENTRY as port declaration."
15931 (indent-to (* 2 vhdl-basic-offset))
15932 (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
15933 (setq pos (point-marker))
15934 (when (and vhdl-include-port-comments (nth 4 entry))
15935 (vhdl-comment-insert-inline (nth 4 entry) t))
15939 (defun vhdl-compose-insert-signal (entry)
15940 "Insert ENTRY as signal declaration."
15941 (indent-to vhdl-basic-offset)
15942 (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
15943 (when (and vhdl-include-port-comments (nth 4 entry))
15944 (vhdl-comment-insert-inline (nth 4 entry) t))
15947 (defun vhdl-compose-components-package ()
15948 "Generate a package containing component declarations for all entities in the
15949 current project/directory."
15951 (vhdl-require-hierarchy-info)
15952 (let* ((project (vhdl-project-p))
15953 (pack-name (vhdl-get-components-package-name))
15955 (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
15956 "." (file-name-extension (buffer-file-name))))
15957 (ent-alist (aget vhdl-entity-alist
15958 (or project default-directory) t))
15959 (lazy-lock-minimum-size 0)
15960 clause-pos component-pos)
15961 (message "Generating components package \"%s\"..." pack-name)
15962 ;; open package file
15963 (when (and (file-exists-p pack-file-name)
15964 (not (y-or-n-p (concat "File \"" pack-file-name
15965 "\" exists; overwrite? "))))
15966 (error "ERROR: Generating components package...aborted"))
15967 (find-file pack-file-name)
15970 (if vhdl-compose-include-header
15971 (progn (vhdl-template-header
15972 (concat "Components package (generated by Emacs VHDL Mode "
15974 (goto-char (point-max)))
15975 (vhdl-comment-display-line) (insert "\n\n"))
15976 ;; insert std_logic_1164 package
15977 (vhdl-template-package-std-logic-1164)
15978 (insert "\n") (setq clause-pos (point-marker))
15979 (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
15980 ;; insert package declaration
15981 (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
15982 (vhdl-insert-keyword " IS\n\n")
15983 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15984 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15985 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15986 (indent-to vhdl-basic-offset)
15987 (setq component-pos (point-marker))
15988 (insert "\n\n") (vhdl-insert-keyword "END ")
15989 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
15990 (insert pack-name ";\n\n")
15992 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15993 (vhdl-template-footer)
15994 (vhdl-comment-display-line) (insert "\n"))
15995 ;; insert component declarations
15997 (vhdl-visit-file (nth 2 (car ent-alist)) nil
15998 (progn (goto-line (nth 3 (car ent-alist)))
16001 (goto-char component-pos)
16002 (vhdl-port-paste-component t)
16003 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
16004 (setq component-pos (point-marker))
16005 (goto-char clause-pos)
16006 (vhdl-port-paste-context-clause pack-name)
16007 (setq clause-pos (point-marker))
16008 (setq ent-alist (cdr ent-alist)))
16009 (goto-char (point-min))
16011 (message "Generating components package \"%s\"...done\n File created: \"%s\""
16012 pack-name pack-file-name)))
16014 (defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist
16015 &optional insert-conf)
16016 "Generate block configuration for architecture."
16017 (let ((margin (current-indentation))
16018 (beg (save-excursion (beginning-of-line) (point)))
16019 ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
16020 ;; insert block configuration (for architecture)
16021 (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
16022 (setq margin (+ margin vhdl-basic-offset))
16023 ;; process all instances
16025 (setq inst-entry (car inst-alist))
16027 (when (nth 4 inst-entry)
16028 (setq insert-conf t)
16029 (setq inst-path (nth 9 inst-entry))
16030 ;; skip common path with previous instance
16031 (while (and inst-path (equal (car inst-path) (car inst-prev-path)))
16032 (setq inst-path (cdr inst-path)
16033 inst-prev-path (cdr inst-prev-path)))
16034 ;; insert block configuration end (for previous block/generate)
16035 (while inst-prev-path
16036 (setq margin (- margin vhdl-basic-offset))
16038 (vhdl-insert-keyword "END FOR;\n")
16039 (setq inst-prev-path (cdr inst-prev-path)))
16040 ;; insert block configuration beginning (for current block/generate)
16043 (setq margin (+ margin vhdl-basic-offset))
16044 (vhdl-insert-keyword "FOR ")
16045 (insert (car inst-path) "\n")
16047 (setq inst-path (cdr inst-path)))
16048 ;; insert component configuration beginning
16049 (vhdl-insert-keyword "FOR ")
16050 (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n")
16051 ;; find subconfiguration
16052 (setq conf-key (nth 7 inst-entry))
16053 (setq tmp-alist conf-alist)
16054 ;; use first configuration found for instance's entity
16055 (while (and tmp-alist (null conf-key))
16056 (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
16057 (setq conf-key (nth 0 (car tmp-alist))))
16058 (setq tmp-alist (cdr tmp-alist)))
16059 (setq conf-entry (aget conf-alist conf-key t))
16060 ;; insert binding indication ...
16061 ;; ... with subconfiguration (if exists)
16062 (if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
16064 (indent-to (+ margin vhdl-basic-offset))
16065 (vhdl-insert-keyword "USE CONFIGURATION ")
16066 (insert (vhdl-work-library) "." (nth 0 conf-entry))
16068 ;; ... with entity (if exists)
16069 (setq ent-entry (aget ent-alist (nth 5 inst-entry) t))
16071 (indent-to (+ margin vhdl-basic-offset))
16072 (vhdl-insert-keyword "USE ENTITY ")
16073 (insert (vhdl-work-library) "." (nth 0 ent-entry))
16074 ;; insert architecture name (if architecture exists)
16075 (when (nth 3 ent-entry)
16077 ;; choose architecture name a) from configuration,
16078 ;; b) from mra, or c) from first architecture
16079 (or (nth 0 (aget (nth 3 ent-entry)
16080 (or (nth 6 inst-entry)
16081 (nth 4 ent-entry)) t))
16082 (nth 1 (car (nth 3 ent-entry)))))
16083 (insert "(" arch-name ")"))
16085 ;; insert block configuration (for architecture of subcomponent)
16086 (when (and vhdl-compose-configuration-hierarchical
16088 (indent-to (+ margin vhdl-basic-offset))
16089 (vhdl-compose-configuration-architecture
16090 (nth 0 ent-entry) arch-name
16091 (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
16092 ;; insert component configuration end
16094 (vhdl-insert-keyword "END FOR;\n")
16095 (setq inst-prev-path (nth 9 inst-entry)))
16096 (setq inst-alist (cdr inst-alist)))
16097 ;; insert block configuration end (for block/generate)
16098 (while inst-prev-path
16099 (setq margin (- margin vhdl-basic-offset))
16101 (vhdl-insert-keyword "END FOR;\n")
16102 (setq inst-prev-path (cdr inst-prev-path)))
16103 (indent-to (- margin vhdl-basic-offset))
16104 ;; insert block configuration end or remove beginning (for architecture)
16106 (vhdl-insert-keyword "END FOR;\n")
16107 (delete-region beg (point)))))
16109 (defun vhdl-compose-configuration (&optional ent-name arch-name)
16110 "Generate configuration declaration."
16112 (vhdl-require-hierarchy-info)
16113 (let ((ent-alist (aget vhdl-entity-alist
16114 (or (vhdl-project-p) default-directory) t))
16115 (conf-alist (aget vhdl-config-alist
16116 (or (vhdl-project-p) default-directory) t))
16117 (from-speedbar ent-name)
16118 inst-alist conf-name conf-file-name pos)
16119 (vhdl-prepare-search-2
16120 ;; get entity and architecture name
16123 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
16124 (not (equal "END" (upcase (match-string 1))))
16125 (setq ent-name (match-string-no-properties 3))
16126 (setq arch-name (match-string-no-properties 2)))
16127 (error "ERROR: Not within an architecture"))))
16128 (setq conf-name (vhdl-replace-string
16129 vhdl-compose-configuration-name
16130 (concat ent-name " " arch-name)))
16132 (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t))
16133 (downcase arch-name) t))))
16134 (message "Generating configuration \"%s\"..." conf-name)
16135 (if vhdl-compose-configuration-create-file
16136 ;; open configuration file
16138 (setq conf-file-name
16139 (concat (vhdl-replace-string vhdl-configuration-file-name
16141 "." (file-name-extension (buffer-file-name))))
16142 (when (and (file-exists-p conf-file-name)
16143 (not (y-or-n-p (concat "File \"" conf-file-name
16144 "\" exists; overwrite? "))))
16145 (error "ERROR: Creating configuration...aborted"))
16146 (find-file conf-file-name)
16148 (set-buffer-modified-p nil)
16150 (if vhdl-compose-include-header
16151 (progn (vhdl-template-header
16152 (concat "Configuration declaration for design \""
16153 ent-name "(" arch-name ")\""))
16154 (goto-char (point-max)))
16155 (vhdl-comment-display-line) (insert "\n\n")))
16156 ;; goto end of architecture
16157 (unless from-speedbar
16158 (re-search-forward "^end\\>" nil)
16159 (end-of-line) (insert "\n\n")
16160 (vhdl-comment-display-line) (insert "\n\n")))
16161 ;; insert library clause
16163 (vhdl-template-standard-package (vhdl-work-library) nil)
16164 (when (/= pos (point))
16166 ;; insert configuration
16167 (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name)
16168 (vhdl-insert-keyword " OF ") (insert ent-name)
16169 (vhdl-insert-keyword " IS\n")
16170 (indent-to vhdl-basic-offset)
16171 ;; insert block configuration (for architecture)
16172 (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t)
16173 (vhdl-insert-keyword "END ") (insert conf-name ";")
16174 (when conf-file-name
16175 ;; insert footer and save
16177 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16178 (vhdl-template-footer)
16179 (vhdl-comment-display-line) (insert "\n"))
16182 (concat (format "Generating configuration \"%s\"...done" conf-name)
16183 (and conf-file-name
16184 (format "\n File created: \"%s\"" conf-file-name))))))
16187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16188 ;;; Compilation / Makefile generation
16189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16190 ;; (using `compile.el')
16192 (defun vhdl-makefile-name ()
16193 "Return the Makefile name of the current project or the current compiler if
16194 no project is defined."
16195 (let ((project-alist (aget vhdl-project-alist vhdl-project))
16196 (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
16197 (vhdl-replace-string
16198 (cons "\\(.*\\)\n\\(.*\\)"
16199 (or (nth 8 project-alist) (nth 8 compiler-alist)))
16200 (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
16202 (defun vhdl-compile-directory ()
16203 "Return the directory where compilation/make should be run."
16204 (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
16205 (compiler (aget vhdl-compiler-alist vhdl-compiler))
16206 (directory (vhdl-resolve-env-variable
16208 (vhdl-replace-string
16209 (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
16210 (nth 6 compiler)))))
16211 (file-name-as-directory
16212 (if (file-name-absolute-p directory)
16214 (expand-file-name directory (vhdl-default-directory))))))
16216 (defun vhdl-uniquify (in-list)
16217 "Remove duplicate elements from IN-LIST."
16220 (add-to-list 'out-list (car in-list))
16221 (setq in-list (cdr in-list)))
16224 (defun vhdl-set-compiler (name)
16225 "Set current compiler to NAME."
16227 (list (let ((completion-ignore-case t))
16228 (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
16229 (if (assoc name vhdl-compiler-alist)
16230 (progn (setq vhdl-compiler name)
16231 (message "Current compiler: \"%s\"" vhdl-compiler))
16232 (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
16234 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16237 (defvar vhdl-compile-absolute-path nil
16238 "If non-nil, use absolute instead of relative path for compiled files.")
16240 (defun vhdl-compile-init ()
16241 "Initialize for compilation."
16242 (when (or (null compilation-error-regexp-alist)
16243 (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
16244 compilation-error-regexp-alist)))
16245 ;; `compilation-error-regexp-alist'
16246 (let ((commands-alist vhdl-compiler-alist)
16247 regexp-alist sublist)
16248 (while commands-alist
16249 (setq sublist (nth 11 (car commands-alist)))
16250 (unless (or (equal "" (car sublist))
16251 (assoc (car sublist) regexp-alist))
16252 (setq regexp-alist (cons (list (nth 0 sublist)
16253 (if (= 0 (nth 1 sublist))
16254 (if vhdl-xemacs 9 nil)
16256 (nth 2 sublist) (nth 3 sublist))
16258 (setq commands-alist (cdr commands-alist)))
16259 (setq compilation-error-regexp-alist
16260 (append compilation-error-regexp-alist (nreverse regexp-alist))))
16261 ;; `compilation-file-regexp-alist'
16262 (let ((commands-alist vhdl-compiler-alist)
16263 regexp-alist sublist)
16264 ;; matches vhdl-mode file name output
16265 (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
16266 (while commands-alist
16267 (setq sublist (nth 12 (car commands-alist)))
16268 (unless (or (equal "" (car sublist))
16269 (assoc (car sublist) regexp-alist))
16270 (setq regexp-alist (cons sublist regexp-alist)))
16271 (setq commands-alist (cdr commands-alist)))
16272 (setq compilation-file-regexp-alist
16273 (append compilation-file-regexp-alist (nreverse regexp-alist))))))
16275 (defvar vhdl-compile-file-name nil
16276 "Name of file to be compiled.")
16278 (defun vhdl-compile-print-file-name ()
16279 "Function called within `compile' to print out file name for compilers that
16280 do not print any file names."
16281 (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
16283 (defun vhdl-get-compile-options (project compiler file-name
16284 &optional file-options-only)
16285 "Get compiler options. Returning nil means do not compile this file."
16286 (let* ((compiler-options (nth 1 compiler))
16287 (project-entry (aget (nth 4 project) vhdl-compiler))
16288 (project-options (nth 0 project-entry))
16289 (exception-list (and file-name (nth 2 project-entry)))
16290 (work-library (vhdl-work-library))
16291 (case-fold-search nil)
16293 (while (and exception-list
16294 (not (string-match (caar exception-list) file-name)))
16295 (setq exception-list (cdr exception-list)))
16296 (if (and exception-list (not (cdar exception-list)))
16298 (if (and file-options-only (not exception-list))
16300 (setq file-options (cdar exception-list))
16301 ;; insert library name in compiler-specific options
16302 (setq compiler-options
16303 (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
16305 ;; insert compiler-specific options in project-specific options
16306 (when project-options
16307 (setq project-options
16308 (vhdl-replace-string
16309 (cons "\\(.*\\)\n\\(.*\\)" project-options)
16310 (concat work-library "\n" compiler-options))))
16311 ;; insert project-specific options in file-specific options
16314 (vhdl-replace-string
16315 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
16316 (concat work-library "\n" compiler-options "\n"
16317 project-options))))
16319 (or file-options project-options compiler-options)))))
16321 (defun vhdl-get-make-options (project compiler)
16322 "Get make options."
16323 (let* ((compiler-options (nth 3 compiler))
16324 (project-entry (aget (nth 4 project) vhdl-compiler))
16325 (project-options (nth 1 project-entry))
16326 (makefile-name (vhdl-makefile-name)))
16327 ;; insert Makefile name in compiler-specific options
16328 (setq compiler-options
16329 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
16331 ;; insert compiler-specific options in project-specific options
16332 (when project-options
16333 (setq project-options
16334 (vhdl-replace-string
16335 (cons "\\(.*\\)\n\\(.*\\)" project-options)
16336 (concat makefile-name "\n" compiler-options))))
16338 (or project-options compiler-options)))
16340 (defun vhdl-compile ()
16341 "Compile current buffer using the VHDL compiler specified in
16344 (vhdl-compile-init)
16345 (let* ((project (aget vhdl-project-alist vhdl-project))
16346 (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
16347 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
16348 (command (nth 0 compiler))
16349 (default-directory (vhdl-compile-directory))
16350 (file-name (if vhdl-compile-absolute-path
16352 (file-relative-name (buffer-file-name))))
16353 (options (vhdl-get-compile-options project compiler file-name))
16354 compilation-process-setup-function)
16355 (unless (file-directory-p default-directory)
16356 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
16357 ;; put file name into quotes if it contains spaces
16358 (when (string-match " " file-name)
16359 (setq file-name (concat "\"" file-name "\"")))
16360 ;; print out file name if compiler does not
16361 (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
16363 (file-relative-name (buffer-file-name))))
16364 (when (and (= 0 (nth 1 (nth 10 compiler)))
16365 (= 0 (nth 1 (nth 11 compiler))))
16366 (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
16370 (compile (concat command " " options " " file-name)))
16371 (vhdl-warning "Your project settings tell me not to compile this file"))))
16373 (defvar vhdl-make-target "all"
16374 "Default target for `vhdl-make' command.")
16376 (defun vhdl-make (&optional target)
16377 "Call make command for compilation of all updated source files (requires
16378 `Makefile'). Optional argument TARGET allows to compile the design
16379 specified by a target."
16381 (setq vhdl-make-target
16382 (or target (read-from-minibuffer "Target: " vhdl-make-target
16383 vhdl-minibuffer-local-map)))
16384 (vhdl-compile-init)
16385 (let* ((project (aget vhdl-project-alist vhdl-project))
16386 (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
16387 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
16388 (command (nth 2 compiler))
16389 (options (vhdl-get-make-options project compiler))
16390 (default-directory (vhdl-compile-directory)))
16391 (unless (file-directory-p default-directory)
16392 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
16394 (compile (concat (if (equal command "") "make" command)
16395 " " options " " vhdl-make-target))))
16397 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16398 ;; Makefile generation
16400 (defun vhdl-generate-makefile ()
16401 "Generate `Makefile'."
16403 (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
16404 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
16405 (command (nth 4 compiler)))
16406 ;; generate makefile
16408 (let ((default-directory (vhdl-compile-directory)))
16409 (compile (vhdl-replace-string
16410 (cons "\\(.*\\) \\(.*\\)" command)
16411 (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
16412 (vhdl-generate-makefile-1))))
16414 (defun vhdl-get-packages (lib-alist work-library)
16415 "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
16418 (when (equal (downcase (caar lib-alist)) (downcase work-library))
16419 (setq pack-list (cons (cdar lib-alist) pack-list)))
16420 (setq lib-alist (cdr lib-alist)))
16423 (defun vhdl-generate-makefile-1 ()
16424 "Generate Makefile for current project or directory."
16425 ;; scan hierarchy if required
16426 (if (vhdl-project-p)
16427 (unless (or (assoc vhdl-project vhdl-file-alist)
16428 (vhdl-load-cache vhdl-project))
16429 (vhdl-scan-project-contents vhdl-project))
16430 (let ((directory (abbreviate-file-name default-directory)))
16431 (unless (or (assoc directory vhdl-file-alist)
16432 (vhdl-load-cache directory))
16433 (vhdl-scan-directory-contents directory))))
16434 (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
16435 (project (vhdl-project-p))
16436 (ent-alist (aget vhdl-entity-alist (or project directory) t))
16437 (conf-alist (aget vhdl-config-alist (or project directory) t))
16438 (pack-alist (aget vhdl-package-alist (or project directory) t))
16439 (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
16440 (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
16441 (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
16442 (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
16443 (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
16444 (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
16445 (adjust-case (nth 5 regexp-list))
16446 (work-library (downcase (vhdl-work-library)))
16447 (compile-directory (expand-file-name (vhdl-compile-directory)
16448 default-directory))
16449 (makefile-name (vhdl-makefile-name))
16450 rule-alist arch-alist inst-alist
16451 target-list depend-list unit-list prim-list second-list subcomp-list
16452 lib-alist lib-body-alist pack-list all-pack-list
16453 ent-key ent-file-name arch-key arch-file-name ent-arch-key
16454 conf-key conf-file-name pack-key pack-file-name
16455 ent-entry arch-entry conf-entry pack-entry inst-entry
16456 pack-body-key pack-body-file-name inst-ent-key inst-conf-key
16457 tmp-key tmp-list rule)
16458 ;; check prerequisites
16459 (unless (file-exists-p compile-directory)
16460 (make-directory compile-directory t))
16461 (unless regexp-list
16462 (error "Please contact the VHDL Mode maintainer for support of \"%s\""
16464 (message "Generating makefile \"%s\"..." makefile-name)
16465 ;; rules for all entities
16466 (setq tmp-list ent-alist)
16468 (setq ent-entry (car ent-alist)
16469 ent-key (nth 0 ent-entry))
16470 (when (nth 2 ent-entry)
16471 (setq ent-file-name (file-relative-name
16472 (nth 2 ent-entry) compile-directory)
16473 arch-alist (nth 4 ent-entry)
16474 lib-alist (nth 6 ent-entry)
16475 rule (aget rule-alist ent-file-name)
16476 target-list (nth 0 rule)
16477 depend-list (nth 1 rule)
16480 (setq tmp-key (vhdl-replace-string
16481 ent-regexp (funcall adjust-case ent-key)))
16482 (setq unit-list (cons (cons ent-key tmp-key) unit-list))
16483 ;; rule target for this entity
16484 (setq target-list (cons ent-key target-list))
16485 ;; rule dependencies for all used packages
16486 (setq pack-list (vhdl-get-packages lib-alist work-library))
16487 (setq depend-list (append depend-list pack-list))
16488 (setq all-pack-list pack-list)
16490 (aput 'rule-alist ent-file-name (list target-list depend-list))
16491 ;; rules for all corresponding architectures
16493 (setq arch-entry (car arch-alist)
16494 arch-key (nth 0 arch-entry)
16495 ent-arch-key (concat ent-key "-" arch-key)
16496 arch-file-name (file-relative-name (nth 2 arch-entry)
16498 inst-alist (nth 4 arch-entry)
16499 lib-alist (nth 5 arch-entry)
16500 rule (aget rule-alist arch-file-name)
16501 target-list (nth 0 rule)
16502 depend-list (nth 1 rule))
16503 (setq tmp-key (vhdl-replace-string
16505 (funcall adjust-case (concat arch-key " " ent-key))))
16507 (cons (cons ent-arch-key tmp-key) unit-list))
16508 (setq second-list (cons ent-arch-key second-list))
16509 ;; rule target for this architecture
16510 (setq target-list (cons ent-arch-key target-list))
16511 ;; rule dependency for corresponding entity
16512 (setq depend-list (cons ent-key depend-list))
16513 ;; rule dependencies for contained component instantiations
16515 (setq inst-entry (car inst-alist))
16516 (when (or (null (nth 8 inst-entry))
16517 (equal (downcase (nth 8 inst-entry)) work-library))
16518 (setq inst-ent-key (or (nth 7 inst-entry)
16519 (nth 5 inst-entry)))
16520 (setq depend-list (cons inst-ent-key depend-list)
16521 subcomp-list (cons inst-ent-key subcomp-list)))
16522 (setq inst-alist (cdr inst-alist)))
16523 ;; rule dependencies for all used packages
16524 (setq pack-list (vhdl-get-packages lib-alist work-library))
16525 (setq depend-list (append depend-list pack-list))
16526 (setq all-pack-list (append all-pack-list pack-list))
16528 (aput 'rule-alist arch-file-name (list target-list depend-list))
16529 (setq arch-alist (cdr arch-alist)))
16530 (setq prim-list (cons (list ent-key second-list
16531 (append subcomp-list all-pack-list))
16533 (setq ent-alist (cdr ent-alist)))
16534 (setq ent-alist tmp-list)
16535 ;; rules for all configurations
16536 (setq tmp-list conf-alist)
16538 (setq conf-entry (car conf-alist)
16539 conf-key (nth 0 conf-entry)
16540 conf-file-name (file-relative-name
16541 (nth 2 conf-entry) compile-directory)
16542 ent-key (nth 4 conf-entry)
16543 arch-key (nth 5 conf-entry)
16544 inst-alist (nth 6 conf-entry)
16545 lib-alist (nth 7 conf-entry)
16546 rule (aget rule-alist conf-file-name)
16547 target-list (nth 0 rule)
16548 depend-list (nth 1 rule)
16549 subcomp-list (list ent-key))
16550 (setq tmp-key (vhdl-replace-string
16551 conf-regexp (funcall adjust-case conf-key)))
16552 (setq unit-list (cons (cons conf-key tmp-key) unit-list))
16553 ;; rule target for this configuration
16554 (setq target-list (cons conf-key target-list))
16555 ;; rule dependency for corresponding entity and architecture
16557 (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
16558 ;; rule dependencies for used packages
16559 (setq pack-list (vhdl-get-packages lib-alist work-library))
16560 (setq depend-list (append depend-list pack-list))
16561 ;; rule dependencies for contained component configurations
16563 (setq inst-entry (car inst-alist))
16564 (setq inst-ent-key (nth 2 inst-entry)
16565 ; comp-arch-key (nth 2 inst-entry))
16566 inst-conf-key (nth 4 inst-entry))
16567 (when (equal (downcase (nth 5 inst-entry)) work-library)
16569 (setq depend-list (cons inst-ent-key depend-list)
16570 subcomp-list (cons inst-ent-key subcomp-list)))
16571 ; (when comp-arch-key
16572 ; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key)
16574 (when inst-conf-key
16575 (setq depend-list (cons inst-conf-key depend-list)
16576 subcomp-list (cons inst-conf-key subcomp-list))))
16577 (setq inst-alist (cdr inst-alist)))
16579 (aput 'rule-alist conf-file-name (list target-list depend-list))
16580 (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list))
16582 (setq conf-alist (cdr conf-alist)))
16583 (setq conf-alist tmp-list)
16584 ;; rules for all packages
16585 (setq tmp-list pack-alist)
16587 (setq pack-entry (car pack-alist)
16588 pack-key (nth 0 pack-entry)
16590 (when (nth 2 pack-entry)
16591 (setq pack-file-name (file-relative-name (nth 2 pack-entry)
16593 lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
16594 rule (aget rule-alist pack-file-name)
16595 target-list (nth 0 rule) depend-list (nth 1 rule))
16596 (setq tmp-key (vhdl-replace-string
16597 pack-regexp (funcall adjust-case pack-key)))
16598 (setq unit-list (cons (cons pack-key tmp-key) unit-list))
16599 ;; rule target for this package
16600 (setq target-list (cons pack-key target-list))
16601 ;; rule dependencies for all used packages
16602 (setq pack-list (vhdl-get-packages lib-alist work-library))
16603 (setq depend-list (append depend-list pack-list))
16604 (setq all-pack-list pack-list)
16606 (aput 'rule-alist pack-file-name (list target-list depend-list))
16607 ;; rules for this package's body
16608 (when (nth 7 pack-entry)
16609 (setq pack-body-key (concat pack-key "-body")
16610 pack-body-file-name (file-relative-name (nth 7 pack-entry)
16612 rule (aget rule-alist pack-body-file-name)
16613 target-list (nth 0 rule)
16614 depend-list (nth 1 rule))
16615 (setq tmp-key (vhdl-replace-string
16616 pack-body-regexp (funcall adjust-case pack-key)))
16618 (cons (cons pack-body-key tmp-key) unit-list))
16619 ;; rule target for this package's body
16620 (setq target-list (cons pack-body-key target-list))
16621 ;; rule dependency for corresponding package declaration
16622 (setq depend-list (cons pack-key depend-list))
16623 ;; rule dependencies for all used packages
16624 (setq pack-list (vhdl-get-packages lib-body-alist work-library))
16625 (setq depend-list (append depend-list pack-list))
16626 (setq all-pack-list (append all-pack-list pack-list))
16628 (aput 'rule-alist pack-body-file-name
16629 (list target-list depend-list)))
16631 (cons (list pack-key (when pack-body-key (list pack-body-key))
16634 (setq pack-alist (cdr pack-alist)))
16635 (setq pack-alist tmp-list)
16636 ;; generate Makefile
16637 (let* ((project (aget vhdl-project-alist project))
16638 (compiler (aget vhdl-compiler-alist vhdl-compiler))
16639 (compiler-id (nth 9 compiler))
16641 (vhdl-resolve-env-variable
16642 (vhdl-replace-string
16643 (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
16645 (makefile-path-name (expand-file-name
16646 makefile-name compile-directory))
16647 (orig-buffer (current-buffer))
16648 cell second-list subcomp-list options unit-key unit-name)
16650 (setq unit-list (vhdl-sort-alist unit-list))
16651 (setq prim-list (vhdl-sort-alist prim-list))
16652 (setq tmp-list rule-alist)
16653 (while tmp-list ; pre-sort rule targets
16654 (setq cell (cdar tmp-list))
16655 (setcar cell (sort (car cell) 'string<))
16656 (setq tmp-list (cdr tmp-list)))
16657 (setq rule-alist ; sort by first rule target
16659 (function (lambda (a b)
16660 (string< (car (cadr a)) (car (cadr b)))))))
16661 ;; open and clear Makefile
16662 (set-buffer (find-file-noselect makefile-path-name t t))
16664 (insert "# -*- Makefile -*-\n"
16665 "### " (file-name-nondirectory makefile-name)
16666 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
16669 (insert "\n# Project : " (nth 0 project))
16670 (insert "\n# Directory : \"" directory "\""))
16671 (insert "\n# Platform : " vhdl-compiler
16672 "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
16673 (user-login-name) "\n")
16674 ;; insert compile and option variable settings
16675 (insert "\n\n# Define compilation command and options\n"
16676 "\nCOMPILE = " (nth 0 compiler)
16677 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
16679 ;; insert library paths
16680 (setq library-directory
16681 (directory-file-name
16682 (if (file-name-absolute-p library-directory)
16684 (file-relative-name
16685 (expand-file-name library-directory directory)
16686 compile-directory))))
16687 (insert "\n\n# Define library paths\n"
16688 "\nLIBRARY-" work-library " = " library-directory "\n")
16689 ;; insert variable definitions for all library unit files
16690 (insert "\n\n# Define library unit files\n")
16691 (setq tmp-list unit-list)
16693 (insert "\nUNIT-" work-library "-" (caar unit-list)
16694 " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
16695 (setq unit-list (cdr unit-list)))
16696 ;; insert variable definition for list of all library unit files
16697 (insert "\n\n\n# Define list of all library unit files\n"
16699 (setq unit-list tmp-list)
16701 (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
16702 (setq unit-list (cdr unit-list)))
16704 (setq unit-list tmp-list)
16705 ;; insert `make all' rule
16706 (insert "\n\n\n# Rule for compiling entire design\n"
16709 " \\\n\t\t$(ALL_UNITS)\n")
16710 ;; insert `make clean' rule
16711 (insert "\n\n# Rule for cleaning entire design\n"
16713 "\n\t-rm -f $(ALL_UNITS)\n")
16714 ;; insert `make library' rule
16715 (insert "\n\n# Rule for creating library directory\n"
16717 " \\\n\t\t$(LIBRARY-" work-library ")\n"
16718 "\n$(LIBRARY-" work-library ") :"
16720 (vhdl-replace-string
16721 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
16722 (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
16724 ;; insert rule for each library unit
16725 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
16727 (setq second-list (sort (nth 1 (car prim-list)) 'string<))
16729 (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
16730 (setq unit-key (caar prim-list)
16731 unit-name (or (nth 0 (aget ent-alist unit-key t))
16732 (nth 0 (aget conf-alist unit-key t))
16733 (nth 0 (aget pack-alist unit-key t))))
16734 (insert "\n" unit-key)
16735 (unless (equal unit-key unit-name)
16736 (insert " \\\n" unit-name))
16739 " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
16741 (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
16742 (setq second-list (cdr second-list)))
16743 (while subcomp-list
16744 (when (and (assoc (car subcomp-list) unit-list)
16745 (not (equal unit-key (car subcomp-list))))
16746 (insert " \\\n\t\t" (car subcomp-list)))
16747 (setq subcomp-list (cdr subcomp-list)))
16749 (setq prim-list (cdr prim-list)))
16750 ;; insert rule for each library unit file
16751 (insert "\n\n# Rules for compiling single library unit files\n")
16753 (setq rule (car rule-alist))
16754 ;; get compiler options for this file
16756 (vhdl-get-compile-options project compiler (nth 0 rule) t))
16757 ;; insert rule if file is supposed to be compiled
16758 (setq target-list (nth 1 rule)
16759 depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
16761 (setq tmp-list target-list)
16763 (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
16764 (if (cdr target-list) " \\" " :"))
16765 (setq target-list (cdr target-list)))
16766 (setq target-list tmp-list)
16767 ;; insert file name as first dependency
16768 (insert " \\\n\t\t" (nth 0 rule))
16769 ;; insert dependencies (except if also target or unit does not exist)
16771 (when (and (not (member (car depend-list) target-list))
16772 (assoc (car depend-list) unit-list))
16773 (insert " \\\n\t\t"
16774 "$(UNIT-" work-library "-" (car depend-list) ")"))
16775 (setq depend-list (cdr depend-list)))
16776 ;; insert compile command
16778 (insert "\n\t$(COMPILE) "
16779 (if (eq options 'default) "$(OPTIONS)" options) " "
16781 (setq tmp-list target-list)
16783 (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
16784 (if (cdr target-list) " \\" "\n"))
16785 (setq target-list (cdr target-list)))
16786 (setq target-list tmp-list))
16787 (setq rule-alist (cdr rule-alist)))
16788 (insert "\n\n### " makefile-name " ends here\n")
16789 ;; run Makefile generation hook
16790 (run-hooks 'vhdl-makefile-generation-hook)
16791 (message "Generating makefile \"%s\"...done" makefile-name)
16792 ;; save and close file
16793 (if (file-writable-p makefile-path-name)
16794 (progn (save-buffer)
16795 (kill-buffer (current-buffer))
16796 (set-buffer orig-buffer)
16797 (setq file-name-history
16798 (cons makefile-path-name file-name-history)))
16799 (vhdl-warning-when-idle
16800 (format "File not writable: \"%s\""
16801 (abbreviate-file-name makefile-path-name)))
16802 (switch-to-buffer (current-buffer))))))
16805 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16807 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16808 ;; (using `reporter.el')
16810 (defconst vhdl-mode-help-address
16811 "Reto Zimmermann <reto@gnu.org>"
16812 "Address for VHDL Mode bug reports.")
16814 (defun vhdl-submit-bug-report ()
16815 "Submit via mail a bug report on VHDL Mode."
16817 ;; load in reporter
16819 (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
16820 (let ((reporter-prompt-for-summary-p t))
16821 (reporter-submit-bug-report
16822 vhdl-mode-help-address
16823 (concat "VHDL Mode " vhdl-version)
16825 ;; report all important user options
16826 'vhdl-offsets-alist
16827 'vhdl-comment-only-line-offset
16829 'vhdl-electric-mode
16831 'vhdl-indent-tabs-mode
16832 'vhdl-project-alist
16834 'vhdl-project-file-name
16835 'vhdl-project-auto-load
16837 'vhdl-compiler-alist
16839 'vhdl-compile-use-local-error-regexp
16840 'vhdl-makefile-generation-hook
16841 'vhdl-default-library
16844 'vhdl-upper-case-keywords
16845 'vhdl-upper-case-types
16846 'vhdl-upper-case-attributes
16847 'vhdl-upper-case-enum-values
16848 'vhdl-upper-case-constants
16849 'vhdl-use-direct-instantiation
16850 'vhdl-compose-configuration-name
16851 'vhdl-entity-file-name
16852 'vhdl-architecture-file-name
16853 'vhdl-configuration-file-name
16854 'vhdl-package-file-name
16855 'vhdl-file-name-case
16856 'vhdl-electric-keywords
16857 'vhdl-optional-labels
16858 'vhdl-insert-empty-lines
16859 'vhdl-argument-list-indent
16860 'vhdl-association-list-with-formals
16861 'vhdl-conditions-in-parenthesis
16867 'vhdl-copyright-string
16868 'vhdl-platform-spec
16870 'vhdl-modify-date-prefix-string
16871 'vhdl-modify-date-on-saving
16873 'vhdl-reset-active-high
16874 'vhdl-clock-rising-edge
16875 'vhdl-clock-edge-condition
16879 'vhdl-include-port-comments
16880 'vhdl-include-direction-comments
16881 'vhdl-include-type-comments
16882 'vhdl-include-group-comments
16883 'vhdl-actual-port-name
16884 'vhdl-instance-name
16885 'vhdl-testbench-entity-name
16886 'vhdl-testbench-architecture-name
16887 'vhdl-testbench-configuration-name
16888 'vhdl-testbench-dut-name
16889 'vhdl-testbench-include-header
16890 'vhdl-testbench-declarations
16891 'vhdl-testbench-statements
16892 'vhdl-testbench-initialize-signals
16893 'vhdl-testbench-include-library
16894 'vhdl-testbench-include-configuration
16895 'vhdl-testbench-create-files
16896 'vhdl-testbench-entity-file-name
16897 'vhdl-testbench-architecture-file-name
16898 'vhdl-compose-create-files
16899 'vhdl-compose-configuration-create-file
16900 'vhdl-compose-configuration-hierarchical
16901 'vhdl-compose-configuration-use-subconfiguration
16902 'vhdl-compose-include-header
16903 'vhdl-compose-architecture-name
16904 'vhdl-components-package-name
16905 'vhdl-use-components-package
16906 'vhdl-self-insert-comments
16907 'vhdl-prompt-for-comments
16908 'vhdl-inline-comment-column
16909 'vhdl-end-comment-column
16912 'vhdl-align-group-separate
16913 'vhdl-align-same-indent
16914 'vhdl-highlight-keywords
16915 'vhdl-highlight-names
16916 'vhdl-highlight-special-words
16917 'vhdl-highlight-forbidden-words
16918 'vhdl-highlight-verilog-keywords
16919 'vhdl-highlight-translate-off
16920 'vhdl-highlight-case-sensitive
16921 'vhdl-special-syntax-alist
16922 'vhdl-forbidden-words
16923 'vhdl-forbidden-syntax
16924 'vhdl-directive-keywords
16925 'vhdl-speedbar-auto-open
16926 'vhdl-speedbar-display-mode
16927 'vhdl-speedbar-scan-limit
16928 'vhdl-speedbar-jump-to-unit
16929 'vhdl-speedbar-update-on-saving
16930 'vhdl-speedbar-save-cache
16931 'vhdl-speedbar-cache-file-name
16933 'vhdl-source-file-menu
16934 'vhdl-hideshow-menu
16935 'vhdl-hide-all-init
16936 'vhdl-print-two-column
16937 'vhdl-print-customize-faces
16938 'vhdl-intelligent-tab
16939 'vhdl-indent-syntax-based
16940 'vhdl-word-completion-case-sensitive
16941 'vhdl-word-completion-in-minibuffer
16942 'vhdl-underscore-is-part-of-word
16947 (if vhdl-special-indent-hook
16948 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
16949 "vhdl-special-indent-hook is set to '"
16950 (format "%s" vhdl-special-indent-hook)
16951 ".\nPerhaps this is your problem?\n"
16952 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
16958 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16960 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16962 (defconst vhdl-doc-release-notes nil
16964 Release Notes for VHDL Mode 3.33
16965 ================================
16974 CONFIGURATION DECLARATION GENERATION:
16975 - Automatic generation of a configuration declaration for a design.
16976 (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
16982 `vhdl-configuration-file-name': (new)
16983 Specify how the configuration file name is obtained.
16984 `vhdl-compose-configuration-name': (new)
16985 Specify how the configuration name is optained.
16986 `vhdl-compose-configuration-create-file': (new)
16987 Specify whether a new file should be created for a configuration.
16988 `vhdl-compose-configuration-hierarchical': (new)
16989 Specify whether hierarchical configurations should be created.
16990 `vhdl-compose-configuration-use-subconfiguration': (new)
16991 Specify whether subconfigurations should be used inside configurations.
16995 (defconst vhdl-doc-keywords nil
16997 Reserved words in VHDL
16998 ----------------------
17000 VHDL'93/02 (IEEE Std 1076-1993/2002):
17001 `vhdl-02-keywords' : keywords
17002 `vhdl-02-types' : standardized types
17003 `vhdl-02-attributes' : standardized attributes
17004 `vhdl-02-enum-values' : standardized enumeration values
17005 `vhdl-02-functions' : standardized functions
17006 `vhdl-02-packages' : standardized packages and libraries
17008 VHDL-AMS (IEEE Std 1076.1):
17009 `vhdl-ams-keywords' : keywords
17010 `vhdl-ams-types' : standardized types
17011 `vhdl-ams-attributes' : standardized attributes
17012 `vhdl-ams-enum-values' : standardized enumeration values
17013 `vhdl-ams-functions' : standardized functions
17015 Math Packages (IEEE Std 1076.2):
17016 `vhdl-math-types' : standardized types
17017 `vhdl-math-constants' : standardized constants
17018 `vhdl-math-functions' : standardized functions
17019 `vhdl-math-packages' : standardized packages
17022 `vhdl-verilog-keywords' : Verilog reserved words
17024 NOTE: click `mouse-2' on variable names above (not in XEmacs).")
17027 (defconst vhdl-doc-coding-style nil
17029 For VHDL coding style and naming convention guidelines, see the following
17033 \"VHDL Coding Styles and Methodologies\".
17034 Kluwer Academic Publishers, 1999.
17035 http://members.aol.com/vhdlcohen/vhdl/
17037 \[2] Michael Keating and Pierre Bricaud.
17038 \"Reuse Methodology Manual, Second Edition\".
17039 Kluwer Academic Publishers, 1999.
17040 http://www.openmore.com/openmore/rmm2.html
17042 \[3] European Space Agency.
17043 \"VHDL Modelling Guidelines\".
17044 ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
17046 Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
17047 to visually support naming conventions.")
17050 (defun vhdl-version ()
17051 "Echo the current version of VHDL Mode in the minibuffer."
17053 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
17054 (vhdl-keep-region-active))
17056 (defun vhdl-doc-variable (variable)
17057 "Display VARIABLE's documentation in *Help* buffer."
17059 (unless vhdl-xemacs
17060 (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
17061 (with-output-to-temp-buffer
17062 (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17063 (princ (documentation-property variable 'variable-documentation))
17064 (with-current-buffer standard-output
17066 (print-help-return-message)))
17068 (defun vhdl-doc-mode ()
17069 "Display VHDL Mode documentation in *Help* buffer."
17071 (unless vhdl-xemacs
17072 (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
17073 (with-output-to-temp-buffer
17074 (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17077 (princ (documentation 'vhdl-mode))
17078 (with-current-buffer standard-output
17080 (print-help-return-message)))
17083 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17085 ;; XEmacs additions
17086 ;;;###autoload(add-to-list 'auto-mode-alist '("\\.vhdl?\\'" . vhdl-mode))
17088 (provide 'vhdl-mode)
17090 ;;; vhdl-mode.el ends here