(ibuffer-backward-line, ibuffer-forward-line)
[emacs.git] / lisp / progmodes / vhdl-mode.el
blob80803999bc4538a2376d3790d240e98d87d2db02
1 ;;; vhdl-mode.el --- major mode for editing VHDL code
3 ;; Copyright (C) 1992-2003 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 32.51 2002/11/12 18:10:27 reto Exp reto $
9 ;; Keywords: languages vhdl
10 ;; WWW: http://opensource.ethz.ch/emacs/vhdl-mode.html
12 (defconst vhdl-version "3.32.12"
13 "VHDL Mode version number.")
15 (defconst vhdl-time-stamp "2003-02-28"
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)
23 ;; any later version.
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., 59 Temple Place - Suite 330,
33 ;; Boston, MA 02111-1307, USA.
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;;; Commentary:
37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
39 ;; This package provides an Emacs major mode for editing VHDL code.
40 ;; It includes the following features:
42 ;; - Syntax highlighting
43 ;; - Indentation
44 ;; - Template insertion (electrification)
45 ;; - Insertion of file headers
46 ;; - Insertion of user-specified models
47 ;; - Port translation / testbench generation
48 ;; - Sensitivity list updating
49 ;; - File browser
50 ;; - Design hierarchy browser
51 ;; - Source file compilation (syntax analysis)
52 ;; - Makefile generation
53 ;; - Code hiding
54 ;; - Word/keyword completion
55 ;; - Block commenting
56 ;; - Code fixing/alignment/beautification
57 ;; - Postscript printing
58 ;; - VHDL'87/'93 and VHDL-AMS supported
59 ;; - Comprehensive menu
60 ;; - Fully customizable
61 ;; - Works under GNU Emacs (recommended) and XEmacs
63 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64 ;; Documentation
66 ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
68 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69 ;; Emacs Versions
71 ;; supported: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X
72 ;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
74 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75 ;; Installation
77 ;; Prerequisites: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X.
79 ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
80 ;; or into an arbitrary directory that is added to the load path by the
81 ;; following line in your Emacs start-up file `.emacs':
83 ;; (setq load-path (cons (expand-file-name "<directory-name>") load-path))
85 ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
86 ;; directory. Otherwise, byte-compile the source file:
87 ;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET
88 ;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
90 ;; Add the following lines to the `site-start.el' file in the `site-lisp'
91 ;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
92 ;; (not required in Emacs 20.X):
94 ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
95 ;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
97 ;; More detailed installation instructions are included in the official
98 ;; VHDL Mode distribution.
100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
101 ;; Acknowledgements
103 ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
104 ;; and Steve Grout.
106 ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
107 ;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
109 ;; Many thanks to all the users who sent me bug reports and enhancement
110 ;; requests.
111 ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
112 ;; enhancement suggestions and the fruitful discussions.
113 ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
114 ;; Thanks to Ulf Klaperski for the indentation speedup hint.
116 ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated
117 ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for
118 ;; giving me the opportunity to develop this code.
119 ;; This work has been funded in part by MICROSWISS, a Microelectronics Program
120 ;; of the Swiss Government.
122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124 ;;; Code:
126 ;; XEmacs handling
127 (defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
128 "Non-nil if XEmacs is used.")
129 ;; Emacs 21 handling
130 (defconst vhdl-emacs-21 (and (= emacs-major-version 21) (not vhdl-xemacs))
131 "Non-nil if GNU Emacs 21 is used.")
134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135 ;;; Variables
136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
138 ;; help function for user options
139 (defun vhdl-custom-set (variable value &rest functions)
140 "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
141 (if (fboundp 'custom-set-default)
142 (custom-set-default variable value)
143 (set-default variable value))
144 (while functions
145 (when (fboundp (car functions)) (funcall (car functions)))
146 (setq functions (cdr functions))))
148 (defun vhdl-widget-directory-validate (widget)
149 "Check that the value of WIDGET is a valid directory entry (i.e. ends with
150 '/' or is empty)."
151 (let ((val (widget-value widget)))
152 (unless (string-match "^\\(\\|.*/\\)$" val)
153 (widget-put widget :error "Invalid directory entry: must end with '/'")
154 widget)))
156 ;; help string for user options
157 (defconst vhdl-name-doc-string "
159 FROM REGEXP is a regular expression matching the original name:
160 \".*\" matches the entire string
161 \"\\(...\\)\" matches a substring
162 TO STRING specifies the string to be inserted as new name:
163 \"\\&\" means substitute entire matched text
164 \"\\N\" means substitute what matched the Nth \"\\(...\\)\"
165 Examples:
166 \".*\" \"\\&\" inserts original string
167 \".*\" \"\\&_i\" attaches \"_i\" to original string
168 \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string
169 \".*\" \"foo\" inserts constant string \"foo\"
170 \".*\" \"\" inserts empty string")
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
173 ;; User variables
175 (defgroup vhdl nil
176 "Customizations for VHDL Mode."
177 :prefix "vhdl-"
178 :group 'languages
179 ; :version "20.4" ; comment out for XEmacs
182 (defgroup vhdl-mode nil
183 "Customizations for modes."
184 :group 'vhdl)
186 (defcustom vhdl-electric-mode t
187 "*Non-nil enables electrification (automatic template generation).
188 If nil, template generators can still be invoked through key bindings and
189 menu. Is indicated in the modeline by \"/e\" after the mode name and can be
190 toggled by `\\[vhdl-electric-mode]'."
191 :type 'boolean
192 :group 'vhdl-mode)
194 (defcustom vhdl-stutter-mode t
195 "*Non-nil enables stuttering.
196 Is indicated in the modeline by \"/s\" after the mode name and can be toggled
197 by `\\[vhdl-stutter-mode]'."
198 :type 'boolean
199 :group 'vhdl-mode)
201 (defcustom vhdl-indent-tabs-mode nil
202 "*Non-nil means indentation can insert tabs.
203 Overrides local variable `indent-tabs-mode'."
204 :type 'boolean
205 :group 'vhdl-mode)
208 (defgroup vhdl-compile nil
209 "Customizations for compilation."
210 :group 'vhdl)
212 (defcustom vhdl-compiler-alist
214 ;; Cadence Leapfrog: cv -file test.vhd
215 ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
216 ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
217 nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
218 ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0)
219 ("\\1/entity" "\\2/\\1" "\\1/configuration"
220 "\\1/package" "\\1/body" downcase))
221 ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
222 ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
223 ;; (PLL_400X_TOP) is not declared [10.3].
224 ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
225 nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
226 ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
227 nil)
228 ;; Ikos Voyager: analyze test.vhd
229 ;; analyze test.vhd
230 ;; E L4/C5: this library unit is inaccessible
231 ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
232 nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
233 ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2)
234 ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
235 nil)
236 ;; ModelSim, Model Technology: vcom test.vhd
237 ;; ERROR: test.vhd(14): Unknown identifier: positiv
238 ;; WARNING[2]: test.vhd(85): Possible infinite loop
239 ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
240 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
241 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
242 ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
243 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
244 "\\1/_primary.dat" "\\1/body.dat" downcase))
245 ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
246 ;; test.vhd:34: error message
247 ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
248 nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
249 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
250 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
251 "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
252 ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
253 ;; ERROR: test.vhd(24): near "dnd": expecting: END
254 ;; WARNING[4]: test.vhd(30): A space is required between ...
255 ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
256 nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
257 ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
258 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
259 "\\1/_primary.dat" "\\1/body.dat" downcase))
260 ;; Savant: scram -publish-cc test.vhd
261 ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
262 ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
263 nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
264 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
265 ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
266 "\\1_config.vhdl" "\\1_package.vhdl"
267 "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
268 ;; Simili: vhdlp -work test.vhd
269 ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
270 ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
271 nil "mkdir \\1" "./" "work/" "Makefile" "simili"
272 ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0)
273 ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
274 "\\1/prim.var" "\\1/_body.var" downcase))
275 ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
276 ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
277 ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
278 nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
279 ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0)
280 nil)
281 ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
282 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
283 ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
284 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
285 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
286 ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
287 ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
288 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
289 ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
290 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
291 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
292 ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
293 ;; Synplify:
294 ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
295 ("Synplify" "n/a" "n/a" "make" "-f \\1"
296 nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
297 ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
298 nil)
299 ;; Vantage: analyze -libfile vsslib.ini -src test.vhd
300 ;; Compiling "test.vhd" line 1...
301 ;; **Error: LINE 49 *** No aggregate value is valid in this context.
302 ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
303 nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
304 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
305 ("^ *Compiling \"\\(.+\\)\" " 1)
306 nil)
307 ;; VeriBest: vc vhdl test.vhd
308 ;; (no file name printed out!)
309 ;; 32: Z <= A and BitA ;
310 ;; ^^^^
311 ;; [Error] Name BITA is unknown
312 ("VeriBest" "vc" "vhdl" "make" "-f \\1"
313 nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
314 ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0)
315 nil)
316 ;; Viewlogic: 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 ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
320 nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
321 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
322 ("^ *Compiling \"\\(.+\\)\" " 1)
323 nil)
325 "*List of available VHDL compilers and their properties.
326 Each list entry specifies the following items for a compiler:
327 Compiler:
328 Compiler name : name used in option `vhdl-compiler' to choose compiler
329 Compile command : command used for source file compilation
330 Compile options : compile options (\"\\1\" inserts library name)
331 Make command : command used for compilation using a Makefile
332 Make options : make options (\"\\1\" inserts Makefile name)
333 Generate Makefile: use built-in function or command to generate a Makefile
334 \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
335 Library command : command to create library directory \(\"\\1\" inserts
336 library directory, \"\\2\" inserts library name)
337 Compile directory: where compilation is run and the Makefile is placed
338 Library directory: directory of default library
339 Makefile name : name of Makefile (default is \"Makefile\")
340 ID string : compiler identification string (see `vhdl-project-alist')
341 Error message:
342 Regexp : regular expression to match error messages
343 File subexp index: index of subexpression that matches the file name
344 Line subexp index: index of subexpression that matches the line number
345 Column subexp idx: index of subexpression that matches the column number
346 File message:
347 Regexp : regular expression to match a file name message
348 File subexp index: index of subexpression that matches the file name
349 Unit-to-file name mapping: mapping of library unit names to names of files
350 generated by the compiler (used for Makefile generation)
351 To string : string a name is mapped to (\"\\1\" inserts the unit name,
352 \"\\2\" inserts the entity name for architectures)
353 Case adjustment : adjust case of inserted unit names
355 Compile options allows insertion of the library name (see `vhdl-project-alist')
356 in order to set the compilers library option (e.g. \"vcom -work my_lib\").
358 For Makefile generation, the built-in function can be used (requires
359 specification of the unit-to-file name mapping). Alternatively, an
360 external command can be specified. Work directory allows specification of
361 an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
362 used for Makefile generation). To use another library name than \"work\",
363 customize `vhdl-project-alist'. The library command is inserted in Makefiles
364 to automatically create the library directory if not existent.
366 Compile options, compile directory, library directory, and Makefile name are
367 overwritten by the project settings if a project is defined (see
368 `vhdl-project-alist'). Directory paths are relative to the source file
369 directory.
371 Some compilers do not include the file name in the error message, but print
372 out a file name message in advance. In this case, set \"File Subexp Index\"
373 under \"Error Message\" to 0 and fill out the \"File Message\" entries.
374 If no file name at all is printed out, set both \"File Message\" entries to 0
375 \(a default file name message will be printed out instead, does not work in
376 XEmacs).
378 A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
379 assigning its name to option `vhdl-compiler'.
381 Please send any missing or erroneous compiler properties to the maintainer for
382 updating.
384 NOTE: Reflect the new setting in the choice list of option `vhdl-compiler'
385 by restarting Emacs."
386 :type '(repeat
387 (list :tag "Compiler" :indent 2
388 (string :tag "Compiler name ")
389 (string :tag "Compile command ")
390 (string :tag "Compile options " "-work \\1")
391 (string :tag "Make command " "make")
392 (string :tag "Make options " "-f \\1")
393 (choice :tag "Generate Makefile "
394 (const :tag "Built-in function" nil)
395 (string :tag "Command" "vmake \\2 > \\1"))
396 (string :tag "Library command " "mkdir \\1")
397 (directory :tag "Compile directory "
398 :validate vhdl-widget-directory-validate "./")
399 (directory :tag "Library directory "
400 :validate vhdl-widget-directory-validate "work/")
401 (file :tag "Makefile name " "Makefile")
402 (string :tag "ID string ")
403 (list :tag "Error message" :indent 4
404 (regexp :tag "Regexp ")
405 (integer :tag "File subexp index")
406 (integer :tag "Line subexp index")
407 (integer :tag "Column subexp idx"))
408 (list :tag "File message" :indent 4
409 (regexp :tag "Regexp ")
410 (integer :tag "File subexp index"))
411 (choice :tag "Unit-to-file name mapping"
412 :format "%t: %[Value Menu%] %v\n"
413 (const :tag "Not defined" nil)
414 (list :tag "To string" :indent 4
415 (string :tag "Entity " "\\1.vhd")
416 (string :tag "Architecture " "\\2_\\1.vhd")
417 (string :tag "Configuration " "\\1.vhd")
418 (string :tag "Package " "\\1.vhd")
419 (string :tag "Package Body " "\\1_body.vhd")
420 (choice :tag "Case adjustment "
421 (const :tag "None" identity)
422 (const :tag "Upcase" upcase)
423 (const :tag "Downcase" downcase))))))
424 :set (lambda (variable value)
425 (vhdl-custom-set variable value 'vhdl-update-mode-menu))
426 :group 'vhdl-compile)
428 (defcustom vhdl-compiler "ModelSim"
429 "*Specifies the VHDL compiler to be used for syntax analysis.
430 Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
431 :type (let ((alist vhdl-compiler-alist) list)
432 (while alist
433 (setq list (cons (list 'const (caar alist)) list))
434 (setq alist (cdr alist)))
435 (append '(choice) (nreverse list)))
436 :group 'vhdl-compile)
438 (defcustom vhdl-compile-use-local-error-regexp t
439 "*Non-nil means use buffer-local `compilation-error-regexp-alist'.
440 In this case, only error message regexps for VHDL compilers are active if
441 compilation is started from a VHDL buffer. Otherwise, the error message
442 regexps are appended to the predefined global regexps, and all regexps are
443 active all the time. Note that by doing that, the predefined global regexps
444 might result in erroneous parsing of error messages for some VHDL compilers.
446 NOTE: Activate the new setting by restarting Emacs."
447 :type 'boolean
448 :group 'vhdl-compile)
450 (defcustom vhdl-makefile-generation-hook nil
451 "*Functions to run at the end of Makefile generation.
452 Allows to insert user specific parts into a Makefile.
454 Example:
455 \(lambda nil
456 \(re-search-backward \"^# Rule for compiling entire design\")
457 \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
458 :type 'hook
459 :group 'vhdl-compile)
461 (defcustom vhdl-default-library "work"
462 "*Name of default library.
463 Is overwritten by project settings if a project is active."
464 :type 'string
465 :group 'vhdl-compile)
468 (defgroup vhdl-project nil
469 "Customizations for projects."
470 :group 'vhdl)
472 (defcustom vhdl-project-alist
473 '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
474 "~/example1/" ("src/system/" "src/components/") ""
475 (("ModelSim" "-87 \\2" "-f \\1 top_level" nil)
476 ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
477 "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
478 ("Example 2" "Individual source files, multiple compilers in different directories"
479 "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
480 nil "\\1/" "work" "\\1/work/" "Makefile" "")
481 ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
482 "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
483 nil "./" "work" "work-\\1/" "Makefile-\\1" "\
484 -------------------------------------------------------------------------------
485 -- This is a multi-line project description
486 -- that can be used as a project dependent part of the file header.
488 "*List of projects and their properties.
489 Name : name used in option `vhdl-project' to choose project
490 Title : title of project (single-line string)
491 Default directory: default project directory (absolute path)
492 Sources : a) source files : path + \"/\" + file name
493 b) directory : path + \"/\"
494 c) directory tree: \"-r \" + path + \"/\"
495 Exclude regexp : matches file/directory names to be excluded as sources
496 Compile options : project-specific options for each compiler
497 Compiler name : name of compiler for which these options are valid
498 Compile options: project-specific compiler options
499 (\"\\1\" inserts library name, \"\\2\" default options)
500 Make options: project-specific make options
501 (\"\\1\" inserts Makefile name, \"\\2\" default options)
502 Exceptions : file-specific exceptions
503 File name regexp: matches file names for which exceptions are valid
504 - Options : file-specific compiler options string
505 (\"\\1\" inserts library name, \"\\2\" default options,
506 \"\\3\" project-specific options)
507 - Do not compile: do not compile this file (in Makefile)
508 Compile directory: where compilation is run and the Makefile is placed
509 \(\"\\1\" inserts compiler ID string)
510 Library name : name of library (default is \"work\")
511 Library directory: path to library (\"\\1\" inserts compiler ID string)
512 Makefile name : name of Makefile
513 (\"\\1\" inserts compiler ID string, \"\\2\" library name)
514 Description : description of project (multi-line string)
516 Project title and description are used to insert into the file header (see
517 option `vhdl-file-header').
519 The default directory must have an absolute path (use `M-TAB' for completion).
520 All other paths can be absolute or relative to the default directory. All
521 paths must end with '/'.
523 The design units found in the sources (files and directories) are shown in the
524 hierarchy browser. Path and file name can contain wildcards `*' and `?' as
525 well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute.
526 Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are
527 specified, the default directory is taken as source directory. Otherwise,
528 the default directory is only taken as source directory if there is a sources
529 entry with the empty string or \"./\". Exclude regexp allows to filter out
530 specific file and directory names from the list of sources (e.g. CVS
531 directories).
533 Files are compiled in the compile directory. Makefiles are also placed into
534 the compile directory. Library directory specifies which directory the
535 compiler compiles into (used to generate the Makefile).
537 Since different compile/library directories and Makefiles may exist for
538 different compilers within one project, these paths and names allow the
539 insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
540 Compile options, compile directory, library directory, and Makefile name
541 overwrite the settings of the current compiler.
543 File-specific compiler options (highest priority) overwrite project-specific
544 options which overwrite default options (lowest priority). Lower priority
545 options can be inserted in higher priority options. This allows to reuse
546 default options (e.g. \"-file\") in project- or file-specific options (e.g.
547 \"-93 -file\").
549 NOTE: Reflect the new setting in the choice list of option `vhdl-project'
550 by restarting Emacs."
551 :type `(repeat
552 (list :tag "Project" :indent 2
553 (string :tag "Name ")
554 (string :tag "Title ")
555 (directory :tag "Default directory"
556 :validate vhdl-widget-directory-validate
557 ,(abbreviate-file-name default-directory))
558 (repeat :tag "Sources " :indent 4
559 (directory :format " %v" "./"))
560 (regexp :tag "Exclude regexp ")
561 (repeat
562 :tag "Compile options " :indent 4
563 (list :tag "Compiler" :indent 6
564 ,(let ((alist vhdl-compiler-alist) list)
565 (while alist
566 (setq list (cons (list 'const (caar alist)) list))
567 (setq alist (cdr alist)))
568 (append '(choice :tag "Compiler name")
569 (nreverse list)))
570 (string :tag "Compile options" "\\2")
571 (string :tag "Make options " "\\2")
572 (repeat
573 :tag "Exceptions " :indent 8
574 (cons :format "%v"
575 (regexp :tag "File name regexp ")
576 (choice :format "%[Value Menu%] %v"
577 (string :tag "Options" "\\3")
578 (const :tag "Do not compile" nil))))))
579 (directory :tag "Compile directory"
580 :validate vhdl-widget-directory-validate "./")
581 (string :tag "Library name " "work")
582 (directory :tag "Library directory"
583 :validate vhdl-widget-directory-validate "work/")
584 (file :tag "Makefile name " "Makefile")
585 (string :tag "Description: (type `C-j' for newline)"
586 :format "%t\n%v\n")))
587 :set (lambda (variable value)
588 (vhdl-custom-set variable value
589 'vhdl-update-mode-menu
590 'vhdl-speedbar-refresh))
591 :group 'vhdl-project)
593 (defcustom vhdl-project nil
594 "*Specifies the default for the current project.
595 Select a project name from the ones defined in option `vhdl-project-alist'.
596 Is used to determine the project title and description to be inserted in file
597 headers and the source files/directories to be scanned in the hierarchy
598 browser. The current project can also be changed temporarily in the menu."
599 :type (let ((alist vhdl-project-alist) list)
600 (while alist
601 (setq list (cons (list 'const (caar alist)) list))
602 (setq alist (cdr alist)))
603 (append '(choice (const :tag "None" nil) (const :tag "--"))
604 (nreverse list)))
605 :group 'vhdl-project)
607 (defcustom vhdl-project-file-name '("\\1.prj")
608 "*List of file names/paths for importing/exporting project setups.
609 \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
610 replaced by the user name (allows to have user-specific project setups).
611 The first entry is used as file name to import/export individual project
612 setups. All entries are used to automatically import project setups at
613 startup (see option `vhdl-project-auto-load'). Projects loaded from the
614 first entry are automatically made current. Hint: specify local project
615 setups in first entry, global setups in following entries; loading a local
616 project setup will make it current, while loading the global setups
617 is done without changing the current project.
618 Names can also have an absolute path (i.e. project setups can be stored
619 in global directories)."
620 :type '(repeat (string :tag "File name" "\\1.prj"))
621 :group 'vhdl-project)
623 (defcustom vhdl-project-auto-load '(startup)
624 "*Automatically load project setups from files.
625 All project setup files that match the file names specified in option
626 `vhdl-project-file-name' are automatically loaded. The project of the
627 \(alphabetically) last loaded setup of the first `vhdl-project-file-name'
628 entry is activated.
629 A project setup file can be obtained by exporting a project (see menu).
630 At startup: project setup file is loaded at Emacs startup"
631 :type '(set (const :tag "At startup" startup))
632 :group 'vhdl-project)
634 (defcustom vhdl-project-sort t
635 "*Non-nil means projects are displayed in alphabetical order."
636 :type 'boolean
637 :group 'vhdl-project)
640 (defgroup vhdl-style nil
641 "Customizations for coding styles."
642 :group 'vhdl
643 :group 'vhdl-template
644 :group 'vhdl-port
645 :group 'vhdl-compose)
647 (defcustom vhdl-standard '(87 nil)
648 "*VHDL standards used.
649 Basic standard:
650 VHDL'87 : IEEE Std 1076-1987
651 VHDL'93 : IEEE Std 1076-1993
652 Additional standards:
653 VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal)
654 Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
656 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
657 \"Activate Options\"."
658 :type '(list (choice :tag "Basic standard"
659 (const :tag "VHDL'87" 87)
660 (const :tag "VHDL'93" 93))
661 (set :tag "Additional standards" :indent 2
662 (const :tag "VHDL-AMS" ams)
663 (const :tag "Math packages" math)))
664 :set (lambda (variable value)
665 (vhdl-custom-set variable value
666 'vhdl-template-map-init
667 'vhdl-mode-abbrev-table-init
668 'vhdl-template-construct-alist-init
669 'vhdl-template-package-alist-init
670 'vhdl-update-mode-menu
671 'vhdl-words-init 'vhdl-font-lock-init))
672 :group 'vhdl-style)
674 (defcustom vhdl-basic-offset 2
675 "*Amount of basic offset used for indentation.
676 This value is used by + and - symbols in `vhdl-offsets-alist'."
677 :type 'integer
678 :group 'vhdl-style)
680 (defcustom vhdl-upper-case-keywords nil
681 "*Non-nil means convert keywords to upper case.
682 This is done when typed or expanded or by the fix case functions."
683 :type 'boolean
684 :set (lambda (variable value)
685 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
686 :group 'vhdl-style)
688 (defcustom vhdl-upper-case-types nil
689 "*Non-nil means convert standardized types to upper case.
690 This is done when expanded or by the fix case functions."
691 :type 'boolean
692 :set (lambda (variable value)
693 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
694 :group 'vhdl-style)
696 (defcustom vhdl-upper-case-attributes nil
697 "*Non-nil means convert standardized attributes to upper case.
698 This is done when expanded or by the fix case functions."
699 :type 'boolean
700 :set (lambda (variable value)
701 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
702 :group 'vhdl-style)
704 (defcustom vhdl-upper-case-enum-values nil
705 "*Non-nil means convert standardized enumeration values to upper case.
706 This is done when expanded or by the fix case functions."
707 :type 'boolean
708 :set (lambda (variable value)
709 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
710 :group 'vhdl-style)
712 (defcustom vhdl-upper-case-constants t
713 "*Non-nil means convert standardized constants to upper case.
714 This is done when expanded."
715 :type 'boolean
716 :set (lambda (variable value)
717 (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
718 :group 'vhdl-style)
720 (defcustom vhdl-use-direct-instantiation 'standard
721 "*Non-nil means use VHDL'93 direct component instantiation.
722 Never : never
723 Standard: only in VHDL standards that allow it (VHDL'93 and higher)
724 Always : always"
725 :type '(choice (const :tag "Never" never)
726 (const :tag "Standard" standard)
727 (const :tag "Always" always))
728 :group 'vhdl-style)
731 (defgroup vhdl-naming nil
732 "Customizations for naming conventions."
733 :group 'vhdl)
735 (defcustom vhdl-entity-file-name '(".*" . "\\&")
736 (concat
737 "*Specifies how the entity file name is obtained.
738 The entity file name can be obtained by modifying the entity name (e.g.
739 attaching or stripping off a substring). The file extension is automatically
740 taken from the file name of the current buffer."
741 vhdl-name-doc-string)
742 :type '(cons (regexp :tag "From regexp")
743 (string :tag "To string "))
744 :group 'vhdl-naming
745 :group 'vhdl-compose)
747 (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
748 (concat
749 "*Specifies how the architecture file name is obtained.
750 The architecture file name can be obtained by modifying the entity
751 and/or architecture name (e.g. attaching or stripping off a substring). The
752 string that is matched against the regexp is the concatenation of the entity
753 and the architecture name separated by a space. This gives access to both
754 names (see default setting as example)."
755 vhdl-name-doc-string)
756 :type '(cons (regexp :tag "From regexp")
757 (string :tag "To string "))
758 :group 'vhdl-naming
759 :group 'vhdl-compose)
761 (defcustom vhdl-package-file-name '(".*" . "\\&")
762 (concat
763 "*Specifies how the package file name is obtained.
764 The package file name can be obtained by modifying the package 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 "))
770 :group 'vhdl-naming
771 :group 'vhdl-compose)
773 (defcustom vhdl-file-name-case 'identity
774 "*Specifies how to change case for obtaining file names.
775 When deriving a file name from a VHDL unit name, case can be changed as
776 follows:
777 As Is: case is not changed (taken as is)
778 Lower Case: whole name is changed to lower case
779 Upper Case: whole name is changed to upper case
780 Capitalize: first letter of each word in name is capitalized"
781 :type '(choice (const :tag "As Is" identity)
782 (const :tag "Lower Case" downcase)
783 (const :tag "Upper Case" upcase)
784 (const :tag "Capitalize" capitalize))
785 :group 'vhdl-naming
786 :group 'vhdl-compose)
789 (defgroup vhdl-template nil
790 "Customizations for electrification."
791 :group 'vhdl)
793 (defcustom vhdl-electric-keywords '(vhdl user)
794 "*Type of keywords for which electrification is enabled.
795 VHDL keywords: invoke built-in templates
796 User keywords: invoke user models (see option `vhdl-model-alist')"
797 :type '(set (const :tag "VHDL keywords" vhdl)
798 (const :tag "User model keywords" user))
799 :set (lambda (variable value)
800 (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
801 :group 'vhdl-template)
803 (defcustom vhdl-optional-labels 'process
804 "*Constructs for which labels are to be queried.
805 Template generators prompt for optional labels for:
806 None : no constructs
807 Processes only: processes only (also procedurals in VHDL-AMS)
808 All constructs: all constructs with optional labels and keyword END"
809 :type '(choice (const :tag "None" none)
810 (const :tag "Processes only" process)
811 (const :tag "All constructs" all))
812 :group 'vhdl-template)
814 (defcustom vhdl-insert-empty-lines 'unit
815 "*Specifies whether to insert empty lines in some templates.
816 This improves readability of code. Empty lines are inserted in:
817 None : no constructs
818 Design units only: entities, architectures, configurations, packages only
819 All constructs : also all constructs with BEGIN...END parts
821 Replaces option `vhdl-additional-empty-lines'."
822 :type '(choice (const :tag "None" none)
823 (const :tag "Design units only" unit)
824 (const :tag "All constructs" all))
825 :group 'vhdl-template
826 :group 'vhdl-port
827 :group 'vhdl-compose)
829 (defcustom vhdl-argument-list-indent nil
830 "*Non-nil means indent argument lists relative to opening parenthesis.
831 That is, argument, association, and port lists start on the same line as the
832 opening parenthesis and subsequent lines are indented accordingly.
833 Otherwise, lists start on a new line and are indented as normal code."
834 :type 'boolean
835 :group 'vhdl-template
836 :group 'vhdl-port
837 :group 'vhdl-compose)
839 (defcustom vhdl-association-list-with-formals t
840 "*Non-nil means write association lists with formal parameters.
841 Templates prompt for formal and actual parameters (ports/generics).
842 When pasting component instantiations, formals are included.
843 If nil, only a list of actual parameters is entered."
844 :type 'boolean
845 :group 'vhdl-template
846 :group 'vhdl-port
847 :group 'vhdl-compose)
849 (defcustom vhdl-conditions-in-parenthesis nil
850 "*Non-nil means place parenthesis around condition expressions."
851 :type 'boolean
852 :group 'vhdl-template)
854 (defcustom vhdl-zero-string "'0'"
855 "*String to use for a logic zero."
856 :type 'string
857 :group 'vhdl-template)
859 (defcustom vhdl-one-string "'1'"
860 "*String to use for a logic one."
861 :type 'string
862 :group 'vhdl-template)
865 (defgroup vhdl-header nil
866 "Customizations for file header."
867 :group 'vhdl-template
868 :group 'vhdl-compose)
870 (defcustom vhdl-file-header "\
871 -------------------------------------------------------------------------------
872 -- Title : <title string>
873 -- Project : <project>
874 -------------------------------------------------------------------------------
875 -- File : <filename>
876 -- Author : <author>
877 -- Company : <company>
878 -- Created : <date>
879 -- Last update: <date>
880 -- Platform : <platform>
881 -- Standard : <standard>
882 <projectdesc>-------------------------------------------------------------------------------
883 -- Description: <cursor>
884 <copyright>-------------------------------------------------------------------------------
885 -- Revisions :
886 -- Date Version Author Description
887 -- <date> 1.0 <login>\tCreated
888 -------------------------------------------------------------------------------
891 "*String or file to insert as file header.
892 If the string specifies an existing file name, the contents of the file is
893 inserted, otherwise the string itself is inserted as file header.
894 Type `C-j' for newlines.
895 If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
896 if the header needs to be version controlled.
898 The following keywords for template generation are supported:
899 <filename> : replaced by the name of the buffer
900 <author> : replaced by the user name and email address
901 \(`user-full-name',`mail-host-address', `user-mail-address')
902 <login> : replaced by user login name (`user-login-name')
903 <company> : replaced by contents of option `vhdl-company-name'
904 <date> : replaced by the current date
905 <year> : replaced by the current year
906 <project> : replaced by title of current project (`vhdl-project')
907 <projectdesc> : replaced by description of current project (`vhdl-project')
908 <copyright> : replaced by copyright string (`vhdl-copyright-string')
909 <platform> : replaced by contents of option `vhdl-platform-spec'
910 <standard> : replaced by the VHDL language standard(s) used
911 <... string> : replaced by a queried string (\"...\" is the prompt word)
912 <title string>: replaced by file title in automatically generated files
913 <cursor> : final cursor position
915 The (multi-line) project description <projectdesc> can be used as a project
916 dependent part of the file header and can also contain the above keywords."
917 :type 'string
918 :group 'vhdl-header)
920 (defcustom vhdl-file-footer ""
921 "*String or file to insert as file footer.
922 If the string specifies an existing file name, the contents of the file is
923 inserted, otherwise the string itself is inserted as file footer (i.e. at
924 the end of the file).
925 Type `C-j' for newlines.
926 The same keywords as in option `vhdl-file-header' can be used."
927 :type 'string
928 :group 'vhdl-header)
930 (defcustom vhdl-company-name ""
931 "*Name of company to insert in file header.
932 See option `vhdl-file-header'."
933 :type 'string
934 :group 'vhdl-header)
936 (defcustom vhdl-copyright-string "\
937 -------------------------------------------------------------------------------
938 -- Copyright (c) <year> <company>
940 "*Copyright string to insert in file header.
941 Can be multi-line string (type `C-j' for newline) and contain other file
942 header keywords (see option `vhdl-file-header')."
943 :type 'string
944 :group 'vhdl-header)
946 (defcustom vhdl-platform-spec ""
947 "*Specification of VHDL platform to insert in file header.
948 The platform specification should contain names and versions of the
949 simulation and synthesis tools used.
950 See option `vhdl-file-header'."
951 :type 'string
952 :group 'vhdl-header)
954 (defcustom vhdl-date-format "%Y-%m-%d"
955 "*Specifies the date format to use in the header.
956 This string is passed as argument to the command `format-time-string'.
957 For more information on format strings, see the documentation for the
958 `format-time-string' command (C-h f `format-time-string')."
959 :type 'string
960 :group 'vhdl-header)
962 (defcustom vhdl-modify-date-prefix-string "-- Last update: "
963 "*Prefix string of modification date in VHDL file header.
964 If actualization of the modification date is called (menu,
965 `\\[vhdl-template-modify]'), this string is searched and the rest
966 of the line replaced by the current date."
967 :type 'string
968 :group 'vhdl-header)
970 (defcustom vhdl-modify-date-on-saving t
971 "*Non-nil means update the modification date when the buffer is saved.
972 Calls function `\\[vhdl-template-modify]').
974 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
975 \"Activate Options\"."
976 :type 'boolean
977 :group 'vhdl-header)
980 (defgroup vhdl-sequential-process nil
981 "Customizations for sequential processes."
982 :group 'vhdl-template)
984 (defcustom vhdl-reset-kind 'async
985 "*Specifies which kind of reset to use in sequential processes."
986 :type '(choice (const :tag "None" none)
987 (const :tag "Synchronous" sync)
988 (const :tag "Asynchronous" async))
989 :group 'vhdl-sequential-process)
991 (defcustom vhdl-reset-active-high nil
992 "*Non-nil means reset in sequential processes is active high.
993 Nil means active low."
994 :type 'boolean
995 :group 'vhdl-sequential-process)
997 (defcustom vhdl-clock-rising-edge t
998 "*Non-nil means rising edge of clock triggers sequential processes.
999 Nil means falling edge."
1000 :type 'boolean
1001 :group 'vhdl-sequential-process)
1003 (defcustom vhdl-clock-edge-condition 'standard
1004 "*Syntax of the clock edge condition.
1005 Standard: \"clk'event and clk = '1'\"
1006 Function: \"rising_edge(clk)\""
1007 :type '(choice (const :tag "Standard" standard)
1008 (const :tag "Function" function))
1009 :group 'vhdl-sequential-process)
1011 (defcustom vhdl-clock-name ""
1012 "*Name of clock signal to use in templates."
1013 :type 'string
1014 :group 'vhdl-sequential-process)
1016 (defcustom vhdl-reset-name ""
1017 "*Name of reset signal to use in templates."
1018 :type 'string
1019 :group 'vhdl-sequential-process)
1022 (defgroup vhdl-model nil
1023 "Customizations for user models."
1024 :group 'vhdl)
1026 (defcustom vhdl-model-alist
1027 '(("Example Model"
1028 "<label> : process (<clock>, <reset>)
1029 begin -- process <label>
1030 if <reset> = '0' then -- asynchronous reset (active low)
1031 <cursor>
1032 elsif <clock>'event and <clock> = '1' then -- rising clock edge
1033 if <enable> = '1' then -- synchronous load
1035 end if;
1036 end if;
1037 end process <label>;"
1038 "e" ""))
1039 "*List of user models.
1040 VHDL models (templates) can be specified by the user in this list. They can be
1041 invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1042 electrification (i.e. overriding existing or creating new keywords, see
1043 option `vhdl-electric-keywords').
1044 Name : name of model (string of words and spaces)
1045 String : string or name of file to be inserted as model (newline: `C-j')
1046 Key Binding: key binding to invoke model, added to prefix `C-c C-m'
1047 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\")
1048 Keyword : keyword to invoke model
1050 The models can contain prompts to be queried. A prompt is of the form \"<...>\".
1051 A prompt that appears several times is queried once and replaced throughout
1052 the model. Special prompts are:
1053 <clock> : name specified in `vhdl-clock-name' (if not empty)
1054 <reset> : name specified in `vhdl-reset-name' (if not empty)
1055 <cursor>: final cursor position
1056 File header prompts (see variable `vhdl-file-header') are automatically
1057 replaced, so that user models can also be used to insert different types of
1058 headers.
1060 If the string specifies an existing file name, the contents of the file is
1061 inserted, otherwise the string itself is inserted.
1062 The code within the models should be correctly indented.
1063 Type `C-j' for newlines.
1065 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1066 \"Activate Options\"."
1067 :type '(repeat (list :tag "Model" :indent 2
1068 (string :tag "Name ")
1069 (string :tag "String : (type `C-j' for newline)"
1070 :format "%t\n%v")
1071 (sexp :tag "Key binding" x)
1072 (string :tag "Keyword " :format "%t: %v\n")))
1073 :set (lambda (variable value)
1074 (vhdl-custom-set variable value
1075 'vhdl-model-map-init
1076 'vhdl-model-defun
1077 'vhdl-mode-abbrev-table-init
1078 'vhdl-update-mode-menu))
1079 :group 'vhdl-model)
1082 (defgroup vhdl-port nil
1083 "Customizations for port translation functions."
1084 :group 'vhdl
1085 :group 'vhdl-compose)
1087 (defcustom vhdl-include-port-comments nil
1088 "*Non-nil means include port comments when a port is pasted."
1089 :type 'boolean
1090 :group 'vhdl-port)
1092 (defcustom vhdl-include-direction-comments nil
1093 "*Non-nil means include port direction in instantiations as comments."
1094 :type 'boolean
1095 :group 'vhdl-port)
1097 (defcustom vhdl-include-type-comments nil
1098 "*Non-nil means include generic/port type in instantiations as comments."
1099 :type 'boolean
1100 :group 'vhdl-port)
1102 (defcustom vhdl-include-group-comments 'never
1103 "*Specifies whether to include group comments and spacings.
1104 The comments and empty lines between groups of ports are pasted:
1105 Never : never
1106 Declarations: in entity/component/constant/signal declarations only
1107 Always : also in generic/port maps"
1108 :type '(choice (const :tag "Never" never)
1109 (const :tag "Declarations" decl)
1110 (const :tag "Always" always))
1111 :group 'vhdl-port)
1113 (defcustom vhdl-actual-port-name '(".*" . "\\&")
1114 (concat
1115 "*Specifies how actual port names are obtained from formal port names.
1116 In a component instantiation, an actual port name can be obtained by
1117 modifying the formal port name (e.g. attaching or stripping off a substring)."
1118 vhdl-name-doc-string)
1119 :type '(cons (regexp :tag "From regexp")
1120 (string :tag "To string "))
1121 :group 'vhdl-port)
1123 (defcustom vhdl-instance-name '(".*" . "\\&_%d")
1124 (concat
1125 "*Specifies how an instance name is obtained.
1126 The instance name can be obtained by modifying the name of the component to be
1127 instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced
1128 by a unique number (starting with 1).
1129 If TO STRING is empty, the instance name is queried."
1130 vhdl-name-doc-string)
1131 :type '(cons (regexp :tag "From regexp")
1132 (string :tag "To string "))
1133 :group 'vhdl-port)
1136 (defgroup vhdl-testbench nil
1137 "Customizations for testbench generation ."
1138 :group 'vhdl-port)
1140 (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
1141 (concat
1142 "*Specifies how the testbench entity name is obtained.
1143 The entity name of a testbench can be obtained by modifying the name of
1144 the component to be tested (e.g. attaching or stripping off a substring)."
1145 vhdl-name-doc-string)
1146 :type '(cons (regexp :tag "From regexp")
1147 (string :tag "To string "))
1148 :group 'vhdl-testbench)
1150 (defcustom vhdl-testbench-architecture-name '(".*" . "")
1151 (concat
1152 "*Specifies how the testbench architecture name is obtained.
1153 The testbench architecture name can be obtained by modifying the name of
1154 the component to be tested (e.g. attaching or stripping off a substring).
1155 If TO STRING is empty, the architecture name is queried."
1156 vhdl-name-doc-string)
1157 :type '(cons (regexp :tag "From regexp")
1158 (string :tag "To string "))
1159 :group 'vhdl-testbench)
1161 (defcustom vhdl-testbench-configuration-name
1162 '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
1163 (concat
1164 "*Specifies how the testbench configuration name is obtained.
1165 The configuration name of a testbench can be obtained by modifying the entity
1166 and/or architecture name (e.g. attaching or stripping off a substring). The
1167 string that is matched against the regexp is the concatenation of the entity
1168 and the architecture name separated by a space. This gives access to both
1169 names (see default setting as example)."
1170 vhdl-name-doc-string)
1171 :type '(cons (regexp :tag "From regexp")
1172 (string :tag "To string "))
1173 :group 'vhdl-testbench)
1175 (defcustom vhdl-testbench-dut-name '(".*" . "DUT")
1176 (concat
1177 "*Specifies how a DUT instance name is obtained.
1178 The design-under-test instance name (i.e. the component instantiated in the
1179 testbench) can be obtained by modifying the component name (e.g. attaching
1180 or stripping off a substring)."
1181 vhdl-name-doc-string)
1182 :type '(cons (regexp :tag "From regexp")
1183 (string :tag "To string "))
1184 :group 'vhdl-testbench)
1186 (defcustom vhdl-testbench-include-header t
1187 "*Non-nil means include a header in automatically generated files."
1188 :type 'boolean
1189 :group 'vhdl-testbench)
1191 (defcustom vhdl-testbench-declarations "\
1192 -- clock
1193 signal Clk : std_logic := '1';
1195 "*String or file to be inserted in the testbench declarative part.
1196 If the string specifies an existing file name, the contents of the file is
1197 inserted, otherwise the string itself is inserted in the testbench
1198 architecture before the BEGIN keyword.
1199 Type `C-j' for newlines."
1200 :type 'string
1201 :group 'vhdl-testbench)
1203 (defcustom vhdl-testbench-statements "\
1204 -- clock generation
1205 Clk <= not Clk after 10 ns;
1207 -- waveform generation
1208 WaveGen_Proc: process
1209 begin
1210 -- insert signal assignments here
1212 wait until Clk = '1';
1213 end process WaveGen_Proc;
1215 "*String or file to be inserted in the testbench statement part.
1216 If the string specifies an existing file name, the contents of the file is
1217 inserted, otherwise the string itself is inserted in the testbench
1218 architecture before the END keyword.
1219 Type `C-j' for newlines."
1220 :type 'string
1221 :group 'vhdl-testbench)
1223 (defcustom vhdl-testbench-initialize-signals nil
1224 "*Non-nil means initialize signals with `0' when declared in testbench."
1225 :type 'boolean
1226 :group 'vhdl-testbench)
1228 (defcustom vhdl-testbench-include-library t
1229 "*Non-nil means a library/use clause for std_logic_1164 is included."
1230 :type 'boolean
1231 :group 'vhdl-testbench)
1233 (defcustom vhdl-testbench-include-configuration t
1234 "*Non-nil means a testbench configuration is attached at the end."
1235 :type 'boolean
1236 :group 'vhdl-testbench)
1238 (defcustom vhdl-testbench-create-files 'single
1239 "*Specifies whether new files should be created for the testbench.
1240 testbench entity and architecture are inserted:
1241 None : in current buffer
1242 Single file : in new single file
1243 Separate files: in two separate files
1244 Note that the files have the same name as the contained design unit."
1245 :type '(choice (const :tag "None" none)
1246 (const :tag "Single file" single)
1247 (const :tag "Separate files" separate))
1248 :group 'vhdl-testbench)
1251 (defgroup vhdl-compose nil
1252 "Customizations for structural composition."
1253 :group 'vhdl)
1255 (defcustom vhdl-compose-create-files 'single
1256 "*Specifies whether new files should be created for the new component.
1257 The component's entity and architecture are inserted:
1258 None : in current buffer
1259 Single file : in new single file
1260 Separate files: in two separate files
1261 The file names are obtained from variables `vhdl-entity-file-name' and
1262 `vhdl-architecture-file-name'."
1263 :type '(choice (const :tag "None" none)
1264 (const :tag "Single file" single)
1265 (const :tag "Separate files" separate))
1266 :group 'vhdl-compose)
1268 (defcustom vhdl-compose-include-header t
1269 "*Non-nil means include a header in automatically generated files."
1270 :type 'boolean
1271 :group 'vhdl-compose)
1273 (defcustom vhdl-compose-architecture-name '(".*" . "str")
1274 (concat
1275 "*Specifies how the component architecture name is obtained.
1276 The component architecture name can be obtained by modifying the entity name
1277 \(e.g. attaching or stripping off a substring).
1278 If TO STRING is empty, the architecture name is queried."
1279 vhdl-name-doc-string)
1280 :type '(cons (regexp :tag "From regexp")
1281 (string :tag "To string "))
1282 :group 'vhdl-compose)
1284 (defcustom vhdl-components-package-name
1285 '((".*" . "\\&_components") . "components")
1286 (concat
1287 "*Specifies how the name for the components package is obtained.
1288 The components package is a package containing all component declarations for
1289 the current design. Its name can be obtained by modifying the project name
1290 \(e.g. attaching or stripping off a substring). If no project is defined, the
1291 DIRECTORY entry is chosen."
1292 vhdl-name-doc-string)
1293 :type '(cons (cons :tag "Project" :indent 2
1294 (regexp :tag "From regexp")
1295 (string :tag "To string "))
1296 (string :tag "Directory:\n String "))
1297 :group 'vhdl-compose)
1299 (defcustom vhdl-use-components-package nil
1300 "*Non-nil means use a separate components package for component declarations.
1301 Otherwise, component declarations are inserted and searched for in the
1302 architecture declarative parts."
1303 :type 'boolean
1304 :group 'vhdl-compose)
1307 (defgroup vhdl-comment nil
1308 "Customizations for comments."
1309 :group 'vhdl)
1311 (defcustom vhdl-self-insert-comments t
1312 "*Non-nil means various templates automatically insert help comments."
1313 :type 'boolean
1314 :group 'vhdl-comment)
1316 (defcustom vhdl-prompt-for-comments t
1317 "*Non-nil means various templates prompt for user definable comments."
1318 :type 'boolean
1319 :group 'vhdl-comment)
1321 (defcustom vhdl-inline-comment-column 40
1322 "*Column to indent and align inline comments to.
1323 Overrides local option `comment-column'.
1325 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1326 \"Activate Options\"."
1327 :type 'integer
1328 :group 'vhdl-comment)
1330 (defcustom vhdl-end-comment-column 79
1331 "*End of comment column.
1332 Comments that exceed this column number are wrapped.
1334 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1335 \"Activate Options\"."
1336 :type 'integer
1337 :group 'vhdl-comment)
1339 (defvar end-comment-column)
1342 (defgroup vhdl-align nil
1343 "Customizations for alignment."
1344 :group 'vhdl)
1346 (defcustom vhdl-auto-align t
1347 "*Non-nil means align some templates automatically after generation."
1348 :type 'boolean
1349 :group 'vhdl-align)
1351 (defcustom vhdl-align-groups t
1352 "*Non-nil means align groups of code lines separately.
1353 A group of code lines is a region of consecutive lines between two lines that
1354 match the regexp in option `vhdl-align-group-separate'."
1355 :type 'boolean
1356 :group 'vhdl-align)
1358 (defcustom vhdl-align-group-separate "^\\s-*$"
1359 "*Regexp for matching a line that separates groups of lines for alignment.
1360 Examples:
1361 \"^\\s-*$\": matches an empty line
1362 \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1363 :type 'regexp
1364 :group 'vhdl-align)
1366 (defcustom vhdl-align-same-indent t
1367 "*Non-nil means align blocks with same indent separately.
1368 When a region or the entire buffer is aligned, the code is divided into
1369 blocks of same indent which are aligned separately (except for argument/port
1370 lists). This gives nicer alignment in most cases.
1371 Option `vhdl-align-groups' still applies within these blocks."
1372 :type 'boolean
1373 :group 'vhdl-align)
1376 (defgroup vhdl-highlight nil
1377 "Customizations for highlighting."
1378 :group 'vhdl)
1380 (defcustom vhdl-highlight-keywords t
1381 "*Non-nil means highlight VHDL keywords and other standardized words.
1382 The following faces are used:
1383 `font-lock-keyword-face' : keywords
1384 `font-lock-type-face' : standardized types
1385 `vhdl-font-lock-attribute-face': standardized attributes
1386 `vhdl-font-lock-enumvalue-face': standardized enumeration values
1387 `vhdl-font-lock-function-face' : standardized function and package names
1389 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1390 entry \"Fontify Buffer\")."
1391 :type 'boolean
1392 :set (lambda (variable value)
1393 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1394 :group 'vhdl-highlight)
1396 (defcustom vhdl-highlight-names t
1397 "*Non-nil means highlight declaration names and construct labels.
1398 The following faces are used:
1399 `font-lock-function-name-face' : names in declarations of units,
1400 subprograms, components, as well as labels of VHDL constructs
1401 `font-lock-type-face' : names in type/nature declarations
1402 `vhdl-font-lock-attribute-face': names in attribute declarations
1403 `font-lock-variable-name-face' : names in declarations of signals,
1404 variables, constants, subprogram parameters, generics, and ports
1406 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1407 entry \"Fontify Buffer\")."
1408 :type 'boolean
1409 :set (lambda (variable value)
1410 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1411 :group 'vhdl-highlight)
1413 (defcustom vhdl-highlight-special-words nil
1414 "*Non-nil means highlight words with special syntax.
1415 The words with syntax and color specified in option `vhdl-special-syntax-alist'
1416 are highlighted accordingly.
1417 Can be used for visual support of naming conventions.
1419 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1420 entry \"Fontify Buffer\")."
1421 :type 'boolean
1422 :set (lambda (variable value)
1423 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1424 :group 'vhdl-highlight)
1426 (defcustom vhdl-highlight-forbidden-words nil
1427 "*Non-nil means highlight forbidden words.
1428 The reserved words specified in option `vhdl-forbidden-words' or having the
1429 syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1430 warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1431 use them.
1433 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1434 entry \"Fontify Buffer\")."
1435 :type 'boolean
1436 :set (lambda (variable value)
1437 (vhdl-custom-set variable value
1438 'vhdl-words-init 'vhdl-font-lock-init))
1439 :group 'vhdl-highlight)
1441 (defcustom vhdl-highlight-verilog-keywords nil
1442 "*Non-nil means highlight Verilog keywords as reserved words.
1443 Verilog keywords are highlighted in a warning color (face
1444 `vhdl-font-lock-reserved-words-face') to indicate not to use them.
1446 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1447 entry \"Fontify Buffer\")."
1448 :type 'boolean
1449 :set (lambda (variable value)
1450 (vhdl-custom-set variable value
1451 'vhdl-words-init 'vhdl-font-lock-init))
1452 :group 'vhdl-highlight)
1454 (defcustom vhdl-highlight-translate-off nil
1455 "*Non-nil means background-highlight code excluded from translation.
1456 That is, all code between \"-- pragma translate_off\" and
1457 \"-- pragma translate_on\" is highlighted using a different background color
1458 \(face `vhdl-font-lock-translate-off-face').
1459 Note: this might slow down on-the-fly fontification (and thus editing).
1461 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1462 entry \"Fontify Buffer\")."
1463 :type 'boolean
1464 :set (lambda (variable value)
1465 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1466 :group 'vhdl-highlight)
1468 (defcustom vhdl-highlight-case-sensitive nil
1469 "*Non-nil means consider case for highlighting.
1470 Possible trade-off:
1471 non-nil also upper-case VHDL words are highlighted, but case of words with
1472 special syntax is not considered
1473 nil only lower-case VHDL words are highlighted, but case of words with
1474 special syntax is considered
1475 Overrides local option `font-lock-keywords-case-fold-search'.
1477 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1478 entry \"Fontify Buffer\")."
1479 :type 'boolean
1480 :group 'vhdl-highlight)
1482 (defcustom vhdl-special-syntax-alist
1483 '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1")
1484 ("type" "\\w+_t" "ForestGreen" "PaleGreen")
1485 ("variable" "\\w+_v" "Grey50" "Grey80"))
1486 "*List of special syntax to be highlighted.
1487 If option `vhdl-highlight-special-words' is non-nil, words with the specified
1488 syntax (as regular expression) are highlighted in the corresponding color.
1490 Name : string of words and spaces
1491 Regexp : regular expression describing word syntax
1492 (e.g. \"\\\w+_c\" matches word with suffix \"_c\")
1493 Color (light): foreground color for light background
1494 (matching color examples: Gold3, Grey50, LimeGreen, Tomato,
1495 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
1496 Color (dark) : foreground color for dark background
1497 (matching color examples: BurlyWood1, Grey80, Green, Coral,
1498 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1500 Can be used for visual support of naming conventions, such as highlighting
1501 different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1502 \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1503 common substrings or name suffices.
1504 For each entry, a new face is generated with the specified colors and name
1505 \"vhdl-font-lock-\" + name + \"-face\".
1507 NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1508 entry \"Fontify Buffer\"). All other changes require restarting Emacs."
1509 :type '(repeat (list :tag "Face" :indent 2
1510 (string :tag "Name ")
1511 (regexp :tag "Regexp " "\\w+_")
1512 (string :tag "Color (light)")
1513 (string :tag "Color (dark) ")))
1514 :set (lambda (variable value)
1515 (vhdl-custom-set variable value 'vhdl-font-lock-init))
1516 :group 'vhdl-highlight)
1518 (defcustom vhdl-forbidden-words '()
1519 "*List of forbidden words to be highlighted.
1520 If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1521 words are highlighted in a warning color to indicate not to use them.
1523 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1524 entry \"Fontify Buffer\")."
1525 :type '(repeat (string :format "%v"))
1526 :set (lambda (variable value)
1527 (vhdl-custom-set variable value
1528 'vhdl-words-init 'vhdl-font-lock-init))
1529 :group 'vhdl-highlight)
1531 (defcustom vhdl-forbidden-syntax ""
1532 "*Syntax of forbidden words to be highlighted.
1533 If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1534 syntax are highlighted in a warning color to indicate not to use them.
1535 Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1536 highlights identifiers with 10 or more characters).
1538 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1539 entry \"Fontify Buffer\")."
1540 :type 'regexp
1541 :set (lambda (variable value)
1542 (vhdl-custom-set variable value
1543 'vhdl-words-init 'vhdl-font-lock-init))
1544 :group 'vhdl-highlight)
1546 (defcustom vhdl-directive-keywords '("pragma" "synopsys")
1547 "*List of compiler directive keywords recognized for highlighting.
1549 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1550 entry \"Fontify Buffer\")."
1551 :type '(repeat (string :format "%v"))
1552 :set (lambda (variable value)
1553 (vhdl-custom-set variable value
1554 'vhdl-words-init 'vhdl-font-lock-init))
1555 :group 'vhdl-highlight)
1558 (defgroup vhdl-speedbar nil
1559 "Customizations for speedbar."
1560 :group 'vhdl)
1562 (defcustom vhdl-speedbar-auto-open nil
1563 "*Non-nil means automatically open speedbar at startup.
1564 Alternatively, the speedbar can be opened from the VHDL menu."
1565 :type 'boolean
1566 :group 'vhdl-speedbar)
1568 (defcustom vhdl-speedbar-display-mode 'files
1569 "*Specifies the default displaying mode when opening speedbar.
1570 Alternatively, the displaying mode can be selected from the speedbar menu or
1571 by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1572 :type '(choice (const :tag "Files" files)
1573 (const :tag "Directory hierarchy" directory)
1574 (const :tag "Project hierarchy" project))
1575 :group 'vhdl-speedbar)
1577 (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
1578 "*Limits scanning of large files and netlists.
1579 Design units: maximum file size to scan for design units
1580 Hierarchy (instances of subcomponents):
1581 File size: maximum file size to scan for instances (in bytes)
1582 Instances per arch: maximum number of instances to scan per architecture
1584 \"None\" always means that there is no limit.
1585 In case of files not or incompletely scanned, a warning message and the file
1586 names are printed out.
1587 Background: scanning for instances is considerably slower than scanning for
1588 design units, especially when there are many instances. These limits should
1589 prevent the scanning of large netlists."
1590 :type '(list (choice :tag "Design units"
1591 :format "%t : %[Value Menu%] %v"
1592 (const :tag "None" nil)
1593 (integer :tag "File size"))
1594 (list :tag "Hierarchy" :indent 2
1595 (choice :tag "File size"
1596 :format "%t : %[Value Menu%] %v"
1597 (const :tag "None" nil)
1598 (integer :tag "Size "))
1599 (choice :tag "Instances per arch"
1600 (const :tag "None" nil)
1601 (integer :tag "Number "))))
1602 :group 'vhdl-speedbar)
1604 (defcustom vhdl-speedbar-jump-to-unit t
1605 "*Non-nil means jump to the design unit code when opened in a buffer.
1606 The buffer cursor position is left unchanged otherwise."
1607 :type 'boolean
1608 :group 'vhdl-speedbar)
1610 (defcustom vhdl-speedbar-update-on-saving t
1611 "*Automatically update design hierarchy when buffer is saved."
1612 :type 'boolean
1613 :group 'vhdl-speedbar)
1615 (defcustom vhdl-speedbar-save-cache '(hierarchy display)
1616 "*Automatically save modified hierarchy caches when exiting Emacs.
1617 Hierarchy: design hierarchy information
1618 Display: displaying information (which design units to expand)"
1619 :type '(set (const :tag "Hierarchy" hierarchy)
1620 (const :tag "Display" display))
1621 :group 'vhdl-speedbar)
1623 (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
1624 "*Name of file for saving hierarchy cache.
1625 \"\\1\" is replaced by the project name if a project is specified,
1626 \"directory\" otherwise. \"\\2\" is replaced by the user name (allows for
1627 different users to have cache files in the same directory). Can also have
1628 an absolute path (i.e. all caches can be stored in one global directory)."
1629 :type 'string
1630 :group 'vhdl-speedbar)
1633 (defgroup vhdl-menu nil
1634 "Customizations for menues."
1635 :group 'vhdl)
1637 (defcustom vhdl-index-menu nil
1638 "*Non-nil means add an index menu for a source file when loading.
1639 Alternatively, the speedbar can be used. Note that the index menu scans a file
1640 when it is opened, while speedbar only scans the file upon request."
1641 :type 'boolean
1642 :group 'vhdl-menu)
1644 (defcustom vhdl-source-file-menu nil
1645 "*Non-nil means add a menu of all source files in current directory.
1646 Alternatively, the speedbar can be used."
1647 :type 'boolean
1648 :group 'vhdl-menu)
1650 (defcustom vhdl-hideshow-menu nil
1651 "*Non-nil means add hideshow menu and functionality at startup.
1652 Hideshow can also be enabled from the VHDL Mode menu.
1653 Hideshow allows hiding code of various VHDL constructs.
1655 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1656 \"Activate Options\"."
1657 :type 'boolean
1658 :group 'vhdl-menu)
1660 (defcustom vhdl-hide-all-init nil
1661 "*Non-nil means hide all design units initially after a file is loaded."
1662 :type 'boolean
1663 :group 'vhdl-menu)
1666 (defgroup vhdl-print nil
1667 "Customizations for printing."
1668 :group 'vhdl)
1670 (defcustom vhdl-print-two-column t
1671 "*Non-nil means print code in two columns and landscape format.
1672 Adjusts settings in a way that postscript printing (\"File\" menu, `ps-print')
1673 prints VHDL files in a nice two-column landscape style.
1675 NOTE: Activate the new setting by restarting Emacs.
1676 Overrides `ps-print' settings locally."
1677 :type 'boolean
1678 :group 'vhdl-print)
1680 (defcustom vhdl-print-customize-faces t
1681 "*Non-nil means use an optimized set of faces for postscript printing.
1683 NOTE: Activate the new setting by restarting Emacs.
1684 Overrides `ps-print' settings locally."
1685 :type 'boolean
1686 :group 'vhdl-print)
1689 (defgroup vhdl-misc nil
1690 "Miscellaneous customizations."
1691 :group 'vhdl)
1693 (defcustom vhdl-intelligent-tab t
1694 "*Non-nil means `TAB' does indentation, word completion and tab insertion.
1695 That is, if preceeding character is part of a word then complete word,
1696 else if not at beginning of line then insert tab,
1697 else if last command was a `TAB' or `RET' then dedent one step,
1698 else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1699 If nil, TAB always indents current line (i.e. `TAB' is bound to
1700 `indent-according-to-mode').
1702 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1703 \"Activate Options\"."
1704 :type 'boolean
1705 :group 'vhdl-misc)
1707 (defcustom vhdl-indent-syntax-based t
1708 "*Non-nil means indent lines of code based on their syntactic context.
1709 Otherwise, a line is indented like the previous nonblank line. This can be
1710 useful in large files where syntax-based indentation gets very slow."
1711 :type 'boolean
1712 :group 'vhdl-misc)
1714 (defcustom vhdl-word-completion-case-sensitive nil
1715 "*Non-nil means word completion using `TAB' is case sensitive.
1716 That is, `TAB' completes words that start with the same letters and case.
1717 Otherwise, case is ignored."
1718 :type 'boolean
1719 :group 'vhdl-misc)
1721 (defcustom vhdl-word-completion-in-minibuffer t
1722 "*Non-nil enables word completion in minibuffer (for template prompts).
1724 NOTE: Activate the new setting by restarting Emacs."
1725 :type 'boolean
1726 :group 'vhdl-misc)
1728 (defcustom vhdl-underscore-is-part-of-word nil
1729 "*Non-nil means consider the underscore character `_' as part of word.
1730 An identifier containing underscores is then treated as a single word in
1731 select and move operations. All parts of an identifier separated by underscore
1732 are treated as single words otherwise.
1734 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1735 \"Activate Options\"."
1736 :type 'boolean
1737 :set (lambda (variable value)
1738 (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init))
1739 :group 'vhdl-misc)
1742 (defgroup vhdl-related nil
1743 "Related general customizations."
1744 :group 'vhdl)
1746 ;; add related general customizations
1747 (custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
1748 (if vhdl-xemacs
1749 (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
1750 (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
1751 (custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
1752 (custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
1753 (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
1754 (unless vhdl-xemacs
1755 (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
1756 (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
1757 (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
1758 (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
1760 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1761 ;; Internal variables
1763 (defvar vhdl-menu-max-size 20
1764 "*Specifies the maximum size of a menu before splitting it into submenues.")
1766 (defvar vhdl-progress-interval 1
1767 "*Interval used to update progress status during long operations.
1768 If a number, percentage complete gets updated after each interval of
1769 that many seconds. To inhibit all messages, set this option to nil.")
1771 (defvar vhdl-inhibit-startup-warnings-p nil
1772 "*If non-nil, inhibits start up compatibility warnings.")
1774 (defvar vhdl-strict-syntax-p nil
1775 "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
1776 If the syntactic symbol for a particular line does not match a symbol
1777 in the offsets alist, an error is generated, otherwise no error is
1778 reported and the syntactic symbol is ignored.")
1780 (defvar vhdl-echo-syntactic-information-p nil
1781 "*If non-nil, syntactic info is echoed when the line is indented.")
1783 (defconst vhdl-offsets-alist-default
1784 '((string . -1000)
1785 (block-open . 0)
1786 (block-close . 0)
1787 (statement . 0)
1788 (statement-cont . vhdl-lineup-statement-cont)
1789 (statement-block-intro . +)
1790 (statement-case-intro . +)
1791 (case-alternative . +)
1792 (comment . vhdl-lineup-comment)
1793 (arglist-intro . +)
1794 (arglist-cont . 0)
1795 (arglist-cont-nonempty . vhdl-lineup-arglist)
1796 (arglist-close . vhdl-lineup-arglist)
1797 (entity . 0)
1798 (configuration . 0)
1799 (package . 0)
1800 (architecture . 0)
1801 (package-body . 0)
1803 "Default settings for offsets of syntactic elements.
1804 Do not change this constant! See the variable `vhdl-offsets-alist' for
1805 more information.")
1807 (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
1808 "*Association list of syntactic element symbols and indentation offsets.
1809 As described below, each cons cell in this list has the form:
1811 (SYNTACTIC-SYMBOL . OFFSET)
1813 When a line is indented, `vhdl-mode' first determines the syntactic
1814 context of the line by generating a list of symbols called syntactic
1815 elements. This list can contain more than one syntactic element and
1816 the global variable `vhdl-syntactic-context' contains the context list
1817 for the line being indented. Each element in this list is actually a
1818 cons cell of the syntactic symbol and a buffer position. This buffer
1819 position is call the relative indent point for the line. Some
1820 syntactic symbols may not have a relative indent point associated with
1821 them.
1823 After the syntactic context list for a line is generated, `vhdl-mode'
1824 calculates the absolute indentation for the line by looking at each
1825 syntactic element in the list. First, it compares the syntactic
1826 element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it
1827 finds a match, it adds the OFFSET to the column of the relative indent
1828 point. The sum of this calculation for each element in the syntactic
1829 list is the absolute offset for line being indented.
1831 If the syntactic element does not match any in the `vhdl-offsets-alist',
1832 an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
1833 the element is ignored.
1835 Actually, OFFSET can be an integer, a function, a variable, or one of
1836 the following symbols: `+', `-', `++', or `--'. These latter
1837 designate positive or negative multiples of `vhdl-basic-offset',
1838 respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is
1839 called with a single argument containing the cons of the syntactic
1840 element symbol and the relative indent point. The function should
1841 return an integer offset.
1843 Here is the current list of valid syntactic element symbols:
1845 string -- inside multi-line string
1846 block-open -- statement block open
1847 block-close -- statement block close
1848 statement -- a VHDL statement
1849 statement-cont -- a continuation of a VHDL statement
1850 statement-block-intro -- the first line in a new statement block
1851 statement-case-intro -- the first line in a case alternative block
1852 case-alternative -- a case statement alternative clause
1853 comment -- a line containing only a comment
1854 arglist-intro -- the first line in an argument list
1855 arglist-cont -- subsequent argument list lines when no
1856 arguments follow on the same line as the
1857 the arglist opening paren
1858 arglist-cont-nonempty -- subsequent argument list lines when at
1859 least one argument follows on the same
1860 line as the arglist opening paren
1861 arglist-close -- the solo close paren of an argument list
1862 entity -- inside an entity declaration
1863 configuration -- inside a configuration declaration
1864 package -- inside a package declaration
1865 architecture -- inside an architecture body
1866 package-body -- inside a package body")
1868 (defvar vhdl-comment-only-line-offset 0
1869 "*Extra offset for line which contains only the start of a comment.
1870 Can contain an integer or a cons cell of the form:
1872 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
1874 Where NON-ANCHORED-OFFSET is the amount of offset given to
1875 non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
1876 the amount of offset to give column-zero anchored comment-only lines.
1877 Just an integer as value is equivalent to (<val> . 0)")
1879 (defvar vhdl-special-indent-hook nil
1880 "*Hook for user defined special indentation adjustments.
1881 This hook gets called after a line is indented by the mode.")
1883 (defvar vhdl-style-alist
1884 '(("IEEE"
1885 (vhdl-basic-offset . 4)
1886 (vhdl-offsets-alist . ())))
1887 "Styles of Indentation.
1888 Elements of this alist are of the form:
1890 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
1892 where STYLE-STRING is a short descriptive string used to select a
1893 style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended
1894 value for that variable when using the selected style.
1896 There is one special case when VARIABLE is `vhdl-offsets-alist'. In this
1897 case, the VALUE is a list containing elements of the form:
1899 (SYNTACTIC-SYMBOL . VALUE)
1901 as described in `vhdl-offsets-alist'. These are passed directly to
1902 `vhdl-set-offset' so there is no need to set every syntactic symbol in
1903 your style, only those that are different from the default.")
1905 ;; dynamically append the default value of most variables
1906 (or (assoc "Default" vhdl-style-alist)
1907 (let* ((varlist '(vhdl-inhibit-startup-warnings-p
1908 vhdl-strict-syntax-p
1909 vhdl-echo-syntactic-information-p
1910 vhdl-basic-offset
1911 vhdl-offsets-alist
1912 vhdl-comment-only-line-offset))
1913 (default (cons "Default"
1914 (mapcar
1915 (function
1916 (lambda (var)
1917 (cons var (symbol-value var))))
1918 varlist))))
1919 (setq vhdl-style-alist (cons default vhdl-style-alist))))
1921 (defvar vhdl-mode-hook nil
1922 "*Hook called by `vhdl-mode'.")
1925 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1926 ;;; Required packages
1927 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1929 ;; mandatory
1930 (require 'assoc)
1931 (require 'compile) ; XEmacs
1932 (require 'easymenu)
1933 (require 'hippie-exp)
1935 ;; optional (minimize warning messages during compile)
1936 (eval-when-compile
1937 (require 'font-lock)
1938 (require 'ps-print)
1939 (require 'speedbar))
1942 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1943 ;;; Compatibility
1944 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1946 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1947 ;; XEmacs compatibility
1949 ;; active regions
1950 (defun vhdl-keep-region-active ()
1951 "Do whatever is necessary to keep the region active in XEmacs.
1952 Ignore byte-compiler warnings you might see."
1953 (and (boundp 'zmacs-region-stays)
1954 (setq zmacs-region-stays t)))
1956 ;; `wildcard-to-regexp' is included only in XEmacs 21
1957 (unless (fboundp 'wildcard-to-regexp)
1958 (defun wildcard-to-regexp (wildcard)
1959 "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'."
1960 (let* ((i (string-match "[*?]" wildcard))
1961 (result (substring wildcard 0 i))
1962 (len (length wildcard)))
1963 (when i
1964 (while (< i len)
1965 (let ((ch (aref wildcard i)))
1966 (setq result (concat result
1967 (cond ((eq ch ?*) "[^\000]*")
1968 ((eq ch ??) "[^\000]")
1969 (t (char-to-string ch)))))
1970 (setq i (1+ i)))))
1971 (concat "\\`" result "\\'"))))
1973 ;; `regexp-opt' undefined (`xemacs-devel' not installed)
1974 ;; `regexp-opt' accelerates fontification by 10-20%
1975 (unless (fboundp 'regexp-opt)
1976 ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
1977 (defun regexp-opt (strings &optional paren)
1978 (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
1979 (concat open (mapconcat 'regexp-quote strings "\\|") close))))
1981 ;; `match-string-no-properties' undefined (XEmacs, what else?)
1982 (unless (fboundp 'match-string-no-properties)
1983 (defalias 'match-string-no-properties 'match-string))
1985 ;; `subst-char-in-string' undefined (XEmacs)
1986 (unless (fboundp 'subst-char-in-string)
1987 (defun subst-char-in-string (fromchar tochar string &optional inplace)
1988 (let ((i (length string))
1989 (newstr (if inplace string (copy-sequence string))))
1990 (while (> i 0)
1991 (setq i (1- i))
1992 (if (eq (aref newstr i) fromchar) (aset newstr i tochar)))
1993 newstr)))
1995 ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
1996 (when (and vhdl-xemacs (string< itimer-version "1.09")
1997 (not noninteractive))
1998 (load "itimer")
1999 (when (string< itimer-version "1.09")
2000 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)")
2001 (beep) (sit-for 5)))
2003 ;; `file-expand-wildcards' undefined (XEmacs)
2004 (unless (fboundp 'file-expand-wildcards)
2005 (defun file-expand-wildcards (pattern &optional full)
2006 "Taken from Emacs' `files.el'."
2007 (let* ((nondir (file-name-nondirectory pattern))
2008 (dirpart (file-name-directory pattern))
2009 (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2010 (mapcar 'file-name-as-directory
2011 (file-expand-wildcards (directory-file-name dirpart)))
2012 (list dirpart)))
2013 contents)
2014 (while dirs
2015 (when (or (null (car dirs)) ; Possible if DIRPART is not wild.
2016 (file-directory-p (directory-file-name (car dirs))))
2017 (let ((this-dir-contents
2018 (delq nil
2019 (mapcar #'(lambda (name)
2020 (unless (string-match "\\`\\.\\.?\\'"
2021 (file-name-nondirectory name))
2022 name))
2023 (directory-files (or (car dirs) ".") full
2024 (wildcard-to-regexp nondir))))))
2025 (setq contents
2026 (nconc
2027 (if (and (car dirs) (not full))
2028 (mapcar (function (lambda (name) (concat (car dirs) name)))
2029 this-dir-contents)
2030 this-dir-contents)
2031 contents))))
2032 (setq dirs (cdr dirs)))
2033 contents)))
2035 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2036 ;; Compatibility with older VHDL Mode versions
2038 (defvar vhdl-warnings nil
2039 "Warnings to tell the user during start up.")
2041 (defun vhdl-run-when-idle (secs repeat function)
2042 "Wait until idle, then run FUNCTION."
2043 (if vhdl-xemacs
2044 (start-itimer "vhdl-mode" function secs repeat t)
2045 ; (run-with-idle-timer secs repeat function)))
2046 ;; explicitely activate timer (necessary when Emacs is already idle)
2047 (aset (run-with-idle-timer secs repeat function) 0 nil)))
2049 (defun vhdl-warning-when-idle (&rest args)
2050 "Wait until idle, then print out warning STRING and beep."
2051 (if noninteractive
2052 (vhdl-warning (apply 'format args) t)
2053 (unless vhdl-warnings
2054 (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2055 (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings))))
2057 (defun vhdl-warning (string &optional nobeep)
2058 "Print out warning STRING and beep."
2059 (message (concat "WARNING: " string))
2060 (unless (or nobeep noninteractive) (beep)))
2062 (defun vhdl-print-warnings ()
2063 "Print out messages in variable `vhdl-warnings'."
2064 (let ((no-warnings (length vhdl-warnings)))
2065 (setq vhdl-warnings (nreverse vhdl-warnings))
2066 (while vhdl-warnings
2067 (message (concat "WARNING: " (car vhdl-warnings)))
2068 (setq vhdl-warnings (cdr vhdl-warnings)))
2069 (beep)
2070 (when (> no-warnings 1)
2071 (message "WARNING: See warnings in message buffer (type `C-c M-m')."))))
2073 ;; Backward compatibility checks and fixes
2074 ;; option `vhdl-compiler' changed format
2075 (unless (stringp vhdl-compiler)
2076 (setq vhdl-compiler "ModelSim")
2077 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2079 ;; option `vhdl-standard' changed format
2080 (unless (listp vhdl-standard)
2081 (setq vhdl-standard '(87 nil))
2082 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2084 ;; option `vhdl-model-alist' changed format
2085 (when (= (length (car vhdl-model-alist)) 3)
2086 (let ((old-alist vhdl-model-alist)
2087 new-alist)
2088 (while old-alist
2089 (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2090 (setq old-alist (cdr old-alist)))
2091 (setq vhdl-model-alist (nreverse new-alist)))
2092 (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2094 ;; option `vhdl-project-alist' changed format
2095 (when (= (length (car vhdl-project-alist)) 3)
2096 (let ((old-alist vhdl-project-alist)
2097 new-alist)
2098 (while old-alist
2099 (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2100 (setq old-alist (cdr old-alist)))
2101 (setq vhdl-project-alist (nreverse new-alist)))
2102 (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2104 ;; option `vhdl-project-alist' changed format (3.31.1)
2105 (when (= (length (car vhdl-project-alist)) 4)
2106 (let ((old-alist vhdl-project-alist)
2107 new-alist elem)
2108 (while old-alist
2109 (setq elem (car old-alist))
2110 (setq new-alist
2111 (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2112 nil "./" "work" "work/" "Makefile" (nth 3 elem))
2113 new-alist))
2114 (setq old-alist (cdr old-alist)))
2115 (setq vhdl-project-alist (nreverse new-alist)))
2116 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2118 ;; option `vhdl-project-alist' changed format (3.31.12)
2119 (when (= (length (car vhdl-project-alist)) 10)
2120 (let ((tmp-alist vhdl-project-alist))
2121 (while tmp-alist
2122 (setcdr (nthcdr 3 (car tmp-alist))
2123 (cons "" (nthcdr 4 (car tmp-alist))))
2124 (setq tmp-alist (cdr tmp-alist))))
2125 (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2127 ;; option `vhdl-compiler-alist' changed format (3.31.1)
2128 (when (= (length (car vhdl-compiler-alist)) 7)
2129 (let ((old-alist vhdl-compiler-alist)
2130 new-alist elem)
2131 (while old-alist
2132 (setq elem (car old-alist))
2133 (setq new-alist
2134 (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2135 (if (equal (nth 3 elem) "") nil (nth 3 elem))
2136 (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2137 (nth 5 elem) (nth 6 elem) nil)
2138 new-alist))
2139 (setq old-alist (cdr old-alist)))
2140 (setq vhdl-compiler-alist (nreverse new-alist)))
2141 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2143 ;; option `vhdl-compiler-alist' changed format (3.31.10)
2144 (when (= (length (car vhdl-compiler-alist)) 12)
2145 (let ((tmp-alist vhdl-compiler-alist))
2146 (while tmp-alist
2147 (setcdr (nthcdr 4 (car tmp-alist))
2148 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2149 (setq tmp-alist (cdr tmp-alist))))
2150 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2152 ;; option `vhdl-compiler-alist' changed format (3.31.11)
2153 (when (= (length (car vhdl-compiler-alist)) 13)
2154 (let ((tmp-alist vhdl-compiler-alist))
2155 (while tmp-alist
2156 (setcdr (nthcdr 3 (car tmp-alist))
2157 (cons "" (nthcdr 4 (car tmp-alist))))
2158 (setq tmp-alist (cdr tmp-alist))))
2159 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2161 ;; option `vhdl-compiler-alist' changed format (3.32.7)
2162 (when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2163 (let ((tmp-alist vhdl-compiler-alist))
2164 (while tmp-alist
2165 (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2166 '(0 . nil))
2167 (setq tmp-alist (cdr tmp-alist))))
2168 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2170 ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2171 (when (equal vhdl-project "")
2172 (setq vhdl-project nil)
2173 (customize-save-variable 'vhdl-project vhdl-project))
2175 ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2176 (when (stringp vhdl-project-file-name)
2177 (setq vhdl-project-file-name (list vhdl-project-file-name))
2178 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2180 ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2181 (if (not (boundp 'speedbar-indentation-width))
2182 (defvar speedbar-indentation-width 2)
2183 ;; set default to 2 if not already customized
2184 (unless (get 'speedbar-indentation-width 'saved-value)
2185 (setq speedbar-indentation-width 2)))
2188 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2189 ;;; Help functions / inline substitutions / macros
2190 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2192 (defun vhdl-standard-p (standard)
2193 "Check if STANDARD is specified as used standard."
2194 (or (eq standard (car vhdl-standard))
2195 (memq standard (cadr vhdl-standard))))
2197 (defun vhdl-project-p (&optional warning)
2198 "Return non-nil if a project is displayed, i.e. directories or files are
2199 specified."
2200 (if (assoc vhdl-project vhdl-project-alist)
2201 vhdl-project
2202 (when (and vhdl-project warning)
2203 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2204 nil))
2206 (defun vhdl-resolve-env-variable (string)
2207 "Resolve environment variables in STRING."
2208 (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2209 (setq string (concat (match-string 1 string)
2210 (getenv (match-string 2 string))
2211 (match-string 4 string))))
2212 string)
2214 (defun vhdl-default-directory ()
2215 "Return the default directory of the current project or the directory of the
2216 current buffer if no project is defined."
2217 (if (vhdl-project-p)
2218 (expand-file-name (vhdl-resolve-env-variable
2219 (nth 1 (aget vhdl-project-alist vhdl-project))))
2220 default-directory))
2222 (defmacro vhdl-prepare-search-1 (&rest body)
2223 "Enable case insensitive search and switch to syntax table that includes '_',
2224 then execute BODY, and finally restore the old environment. Used for
2225 consistent searching."
2226 `(let ((case-fold-search t) ; case insensitive search
2227 (current-syntax-table (syntax-table))
2228 result
2229 (restore-prog ; program to restore enviroment
2230 '(progn
2231 ;; restore syntax table
2232 (set-syntax-table current-syntax-table))))
2233 ;; use extended syntax table
2234 (set-syntax-table vhdl-mode-ext-syntax-table)
2235 ;; execute BODY safely
2236 (setq result
2237 (condition-case info
2238 (progn ,@body)
2239 (error (eval restore-prog) ; restore environment on error
2240 (error (cadr info))))) ; pass error up
2241 ;; restore environment
2242 (eval restore-prog)
2243 result))
2245 (defmacro vhdl-prepare-search-2 (&rest body)
2246 "Enable case insensitive search, switch to syntax table that includes '_',
2247 and remove `intangible' overlays, then execute BODY, and finally restore the
2248 old environment. Used for consistent searching."
2249 `(let ((case-fold-search t) ; case insensitive search
2250 (current-syntax-table (syntax-table))
2251 result overlay-all-list overlay-intangible-list overlay
2252 (restore-prog ; program to restore enviroment
2253 '(progn
2254 ;; restore syntax table
2255 (set-syntax-table current-syntax-table)
2256 ;; restore `intangible' overlays
2257 (when (fboundp 'overlay-lists)
2258 (while overlay-intangible-list
2259 (overlay-put (car overlay-intangible-list) 'intangible t)
2260 (setq overlay-intangible-list
2261 (cdr overlay-intangible-list)))))))
2262 ;; use extended syntax table
2263 (set-syntax-table vhdl-mode-ext-syntax-table)
2264 ;; remove `intangible' overlays
2265 (when (fboundp 'overlay-lists)
2266 (setq overlay-all-list (overlay-lists))
2267 (setq overlay-all-list
2268 (append (car overlay-all-list) (cdr overlay-all-list)))
2269 (while overlay-all-list
2270 (setq overlay (car overlay-all-list))
2271 (when (memq 'intangible (overlay-properties overlay))
2272 (setq overlay-intangible-list
2273 (cons overlay overlay-intangible-list))
2274 (overlay-put overlay 'intangible nil))
2275 (setq overlay-all-list (cdr overlay-all-list))))
2276 ;; execute BODY safely
2277 (setq result
2278 (condition-case info
2279 (progn ,@body)
2280 (error (eval restore-prog) ; restore environment on error
2281 (error (cadr info))))) ; pass error up
2282 ;; restore environment
2283 (eval restore-prog)
2284 result))
2286 (defmacro vhdl-visit-file (file-name issue-error &rest body)
2287 "Visit file FILE-NAME and execute BODY."
2288 `(if (null ,file-name)
2289 (progn ,@body)
2290 (unless (file-directory-p ,file-name)
2291 (let ((source-buffer (current-buffer))
2292 (visiting-buffer (find-buffer-visiting ,file-name))
2293 file-opened)
2294 (when (or (and visiting-buffer (set-buffer visiting-buffer))
2295 (condition-case ()
2296 (progn (set-buffer (create-file-buffer ,file-name))
2297 (setq file-opened t)
2298 (vhdl-insert-file-contents ,file-name)
2299 (modify-syntax-entry ?\- ". 12" (syntax-table))
2300 (modify-syntax-entry ?\n ">" (syntax-table))
2301 (modify-syntax-entry ?\^M ">" (syntax-table))
2302 (modify-syntax-entry ?_ "w" (syntax-table))
2304 (error
2305 (if ,issue-error
2306 (progn
2307 (when file-opened (kill-buffer (current-buffer)))
2308 (set-buffer source-buffer)
2309 (error (format "ERROR: File cannot be opened: \"%s\"" ,file-name)))
2310 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
2311 nil))))
2312 (condition-case info
2313 (progn ,@body)
2314 (error
2315 (if ,issue-error
2316 (progn
2317 (when file-opened (kill-buffer (current-buffer)))
2318 (set-buffer source-buffer)
2319 (error (cadr info)))
2320 (vhdl-warning (cadr info))))))
2321 (when file-opened (kill-buffer (current-buffer)))
2322 (set-buffer source-buffer)))))
2324 (defun vhdl-insert-file-contents (filename)
2325 "Nicked from `insert-file-contents-literally', but allow coding system
2326 conversion."
2327 (let ((format-alist nil)
2328 (after-insert-file-functions nil)
2329 (jka-compr-compression-info-list nil))
2330 (insert-file-contents filename t)))
2332 (defun vhdl-sort-alist (alist)
2333 "Sort alist."
2334 (sort alist (function (lambda (a b) (string< (car a) (car b))))))
2336 (defun vhdl-get-subdirs (directory)
2337 "Recursively get subdirectories of DIRECTORY."
2338 (let ((dir-list (list (file-name-as-directory directory)))
2339 file-list)
2340 (setq file-list (vhdl-directory-files directory t "\\w.*"))
2341 (while file-list
2342 (when (file-directory-p (car file-list))
2343 (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2344 (setq file-list (cdr file-list)))
2345 dir-list))
2347 (defun vhdl-aput (alist-symbol key &optional value)
2348 "As `aput', but delete key-value pair if VALUE is nil."
2349 (if value
2350 (aput alist-symbol key value)
2351 (adelete alist-symbol key)))
2353 (defun vhdl-delete (elt list)
2354 "Delete by side effect the first occurrence of ELT as a member of LIST."
2355 (setq list (cons nil list))
2356 (let ((list1 list))
2357 (while (and (cdr list1) (not (equal elt (cadr list1))))
2358 (setq list1 (cdr list1)))
2359 (when list
2360 (setcdr list1 (cddr list1))))
2361 (cdr list))
2363 (defun vhdl-speedbar-refresh (&optional key)
2364 "Refresh directory or project with name KEY."
2365 (when (and (boundp 'speedbar-frame)
2366 (frame-live-p speedbar-frame))
2367 (let ((pos (point))
2368 (last-frame (selected-frame)))
2369 (if (null key)
2370 (speedbar-refresh)
2371 (select-frame speedbar-frame)
2372 (when (save-excursion
2373 (goto-char (point-min))
2374 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2375 (goto-char (match-end 1))
2376 (speedbar-do-function-pointer)
2377 (backward-char 2)
2378 (speedbar-do-function-pointer)
2379 (message "Refreshing speedbar...done"))
2380 (select-frame last-frame)))))
2382 (defun vhdl-show-messages ()
2383 "Get *Messages* buffer to show recent messages."
2384 (interactive)
2385 (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*")))
2387 (defun vhdl-use-direct-instantiation ()
2388 "Return whether direct instantiation is used."
2389 (or (eq vhdl-use-direct-instantiation 'always)
2390 (and (eq vhdl-use-direct-instantiation 'standard)
2391 (not (vhdl-standard-p '87)))))
2393 (defun vhdl-max-marker (marker1 marker2)
2394 "Return larger marker."
2395 (if (> marker1 marker2) marker1 marker2))
2397 (defun vhdl-goto-marker (marker)
2398 "Goto marker in appropriate buffer."
2399 (when (markerp marker)
2400 (set-buffer (marker-buffer marker)))
2401 (goto-char marker))
2403 (defun vhdl-menu-split (list title)
2404 "Split menu LIST into several submenues, if number of
2405 elements > `vhdl-menu-max-size'."
2406 (if (> (length list) vhdl-menu-max-size)
2407 (let ((remain list)
2408 (result '())
2409 (sublist '())
2410 (menuno 1)
2411 (i 0))
2412 (while remain
2413 (setq sublist (cons (car remain) sublist))
2414 (setq remain (cdr remain))
2415 (setq i (+ i 1))
2416 (if (= i vhdl-menu-max-size)
2417 (progn
2418 (setq result (cons (cons (format "%s %s" title menuno)
2419 (nreverse sublist)) result))
2420 (setq i 0)
2421 (setq menuno (+ menuno 1))
2422 (setq sublist '()))))
2423 (and sublist
2424 (setq result (cons (cons (format "%s %s" title menuno)
2425 (nreverse sublist)) result)))
2426 (nreverse result))
2427 list))
2430 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2431 ;;; Bindings
2432 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2434 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2435 ;; Key bindings
2437 (defvar vhdl-template-map nil
2438 "Keymap for VHDL templates.")
2440 (defun vhdl-template-map-init ()
2441 "Initialize `vhdl-template-map'."
2442 (setq vhdl-template-map (make-sparse-keymap))
2443 ;; key bindings for VHDL templates
2444 (define-key vhdl-template-map "al" 'vhdl-template-alias)
2445 (define-key vhdl-template-map "ar" 'vhdl-template-architecture)
2446 (define-key vhdl-template-map "at" 'vhdl-template-assert)
2447 (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl)
2448 (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec)
2449 (define-key vhdl-template-map "bl" 'vhdl-template-block)
2450 (define-key vhdl-template-map "ca" 'vhdl-template-case-is)
2451 (define-key vhdl-template-map "cd" 'vhdl-template-component-decl)
2452 (define-key vhdl-template-map "ci" 'vhdl-template-component-inst)
2453 (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst)
2454 (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration)
2455 (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf)
2456 (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl)
2457 (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec)
2458 (define-key vhdl-template-map "co" 'vhdl-template-constant)
2459 (define-key vhdl-template-map "di" 'vhdl-template-disconnect)
2460 (define-key vhdl-template-map "el" 'vhdl-template-else)
2461 (define-key vhdl-template-map "ei" 'vhdl-template-elsif)
2462 (define-key vhdl-template-map "en" 'vhdl-template-entity)
2463 (define-key vhdl-template-map "ex" 'vhdl-template-exit)
2464 (define-key vhdl-template-map "fi" 'vhdl-template-file)
2465 (define-key vhdl-template-map "fg" 'vhdl-template-for-generate)
2466 (define-key vhdl-template-map "fl" 'vhdl-template-for-loop)
2467 (define-key vhdl-template-map "\C-f" 'vhdl-template-footer)
2468 (define-key vhdl-template-map "fb" 'vhdl-template-function-body)
2469 (define-key vhdl-template-map "fd" 'vhdl-template-function-decl)
2470 (define-key vhdl-template-map "ge" 'vhdl-template-generic)
2471 (define-key vhdl-template-map "gd" 'vhdl-template-group-decl)
2472 (define-key vhdl-template-map "gt" 'vhdl-template-group-template)
2473 (define-key vhdl-template-map "\C-h" 'vhdl-template-header)
2474 (define-key vhdl-template-map "ig" 'vhdl-template-if-generate)
2475 (define-key vhdl-template-map "it" 'vhdl-template-if-then)
2476 (define-key vhdl-template-map "li" 'vhdl-template-library)
2477 (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop)
2478 (define-key vhdl-template-map "\C-m" 'vhdl-template-modify)
2479 (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date)
2480 (define-key vhdl-template-map "ma" 'vhdl-template-map)
2481 (define-key vhdl-template-map "ne" 'vhdl-template-next)
2482 (define-key vhdl-template-map "ot" 'vhdl-template-others)
2483 (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl)
2484 (define-key vhdl-template-map "Pb" 'vhdl-template-package-body)
2485 (define-key vhdl-template-map "(" 'vhdl-template-paired-parens)
2486 (define-key vhdl-template-map "po" 'vhdl-template-port)
2487 (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body)
2488 (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl)
2489 (define-key vhdl-template-map "pc" 'vhdl-template-process-comb)
2490 (define-key vhdl-template-map "ps" 'vhdl-template-process-seq)
2491 (define-key vhdl-template-map "rp" 'vhdl-template-report)
2492 (define-key vhdl-template-map "rt" 'vhdl-template-return)
2493 (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst)
2494 (define-key vhdl-template-map "si" 'vhdl-template-signal)
2495 (define-key vhdl-template-map "su" 'vhdl-template-subtype)
2496 (define-key vhdl-template-map "ty" 'vhdl-template-type)
2497 (define-key vhdl-template-map "us" 'vhdl-template-use)
2498 (define-key vhdl-template-map "va" 'vhdl-template-variable)
2499 (define-key vhdl-template-map "wa" 'vhdl-template-wait)
2500 (define-key vhdl-template-map "wl" 'vhdl-template-while-loop)
2501 (define-key vhdl-template-map "wi" 'vhdl-template-with)
2502 (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait)
2503 (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
2504 (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
2505 (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
2506 (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
2507 (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
2508 (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed)
2509 (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio)
2510 (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned)
2511 (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
2512 (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
2513 (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
2514 (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
2515 (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
2516 (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt)
2517 (when (vhdl-standard-p 'ams)
2518 (define-key vhdl-template-map "br" 'vhdl-template-break)
2519 (define-key vhdl-template-map "cu" 'vhdl-template-case-use)
2520 (define-key vhdl-template-map "iu" 'vhdl-template-if-use)
2521 (define-key vhdl-template-map "lm" 'vhdl-template-limit)
2522 (define-key vhdl-template-map "na" 'vhdl-template-nature)
2523 (define-key vhdl-template-map "pa" 'vhdl-template-procedural)
2524 (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free)
2525 (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch)
2526 (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source)
2527 (define-key vhdl-template-map "sn" 'vhdl-template-subnature)
2528 (define-key vhdl-template-map "te" 'vhdl-template-terminal)
2530 (when (vhdl-standard-p 'math)
2531 (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
2532 (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
2535 ;; initialize template map for VHDL Mode
2536 (vhdl-template-map-init)
2538 (defun vhdl-function-name (prefix string &optional postfix)
2539 "Generate a Lisp function name.
2540 PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in
2541 STRING are replaced by `-' and substrings are converted to lower case."
2542 (let ((name prefix))
2543 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
2544 (setq name
2545 (concat name "-" (downcase (substring string 0 (match-end 1)))))
2546 (setq string (substring string (match-beginning 2))))
2547 (when postfix (setq name (concat name "-" postfix)))
2548 (intern name)))
2550 (defvar vhdl-model-map nil
2551 "Keymap for VHDL models.")
2553 (defun vhdl-model-map-init ()
2554 "Initialize `vhdl-model-map'."
2555 (setq vhdl-model-map (make-sparse-keymap))
2556 ;; key bindings for VHDL models
2557 (let ((model-alist vhdl-model-alist) model)
2558 (while model-alist
2559 (setq model (car model-alist))
2560 (define-key vhdl-model-map (nth 2 model)
2561 (vhdl-function-name "vhdl-model" (nth 0 model)))
2562 (setq model-alist (cdr model-alist)))))
2564 ;; initialize user model map for VHDL Mode
2565 (vhdl-model-map-init)
2567 (defvar vhdl-mode-map nil
2568 "Keymap for VHDL Mode.")
2570 (defun vhdl-mode-map-init ()
2571 "Initialize `vhdl-mode-map'."
2572 (setq vhdl-mode-map (make-sparse-keymap))
2573 ;; template key bindings
2574 (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map)
2575 ;; model key bindings
2576 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map)
2577 ;; standard key bindings
2578 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement)
2579 (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement)
2580 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp)
2581 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp)
2582 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
2583 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
2584 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
2585 (unless vhdl-xemacs ; would override `M-backspace' in XEmacs
2586 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
2587 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
2588 (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
2589 ;; backspace/delete key bindings
2590 (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify)
2591 (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
2592 (define-key vhdl-mode-map [delete] 'delete-char)
2593 (define-key vhdl-mode-map [(meta delete)] 'kill-word))
2594 ;; mode specific key bindings
2595 (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
2596 (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
2597 (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
2598 (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
2599 (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
2600 (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
2601 (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
2602 (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile)
2603 (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make)
2604 (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile)
2605 (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
2606 (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
2607 (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
2608 (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
2609 (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
2610 (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
2611 (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
2612 (if vhdl-xemacs ; `... C-g' not allowed in XEmacs
2613 (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
2614 (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
2615 (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
2616 (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
2617 (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
2618 (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
2619 (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
2620 (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
2621 (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
2622 (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
2623 (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
2624 (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
2625 (define-key vhdl-mode-map "\C-c\C-c\C-n" 'vhdl-compose-new-component)
2626 (define-key vhdl-mode-map "\C-c\C-c\C-p" 'vhdl-compose-place-component)
2627 (define-key vhdl-mode-map "\C-c\C-c\C-w" 'vhdl-compose-wire-components)
2628 (define-key vhdl-mode-map "\C-c\C-c\C-k" 'vhdl-compose-components-package)
2629 (define-key vhdl-mode-map "\C-cc" 'vhdl-comment-uncomment-region)
2630 (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline)
2631 (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line)
2632 (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
2633 (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
2634 (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region)
2635 (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
2636 (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
2637 (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
2638 (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
2639 (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
2640 (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
2641 (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
2642 (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
2643 (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
2644 (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
2645 (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
2646 (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
2647 (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
2648 (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
2649 (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
2650 (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
2651 (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
2652 (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
2653 (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand)
2654 (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
2655 (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
2656 (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
2657 (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
2658 (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
2659 (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
2660 (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
2661 (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
2662 (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
2663 (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
2664 (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region)
2665 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer)
2666 (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
2667 (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
2668 (define-key vhdl-mode-map "\C-cf" 'vhdl-fontify-buffer)
2669 (define-key vhdl-mode-map "\C-cs" 'vhdl-statistics-buffer)
2670 (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages)
2671 (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode)
2672 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
2673 (define-key vhdl-mode-map "\M-\t" 'insert-tab)
2674 ;; insert commands bindings
2675 (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
2676 (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
2677 (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
2678 (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
2679 ;; electric key bindings
2680 (define-key vhdl-mode-map " " 'vhdl-electric-space)
2681 (if vhdl-intelligent-tab
2682 (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)
2683 (define-key vhdl-mode-map "\t" 'indent-according-to-mode))
2684 (define-key vhdl-mode-map "\r" 'vhdl-electric-return)
2685 (define-key vhdl-mode-map "-" 'vhdl-electric-dash)
2686 (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket)
2687 (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket)
2688 (define-key vhdl-mode-map "'" 'vhdl-electric-quote)
2689 (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon)
2690 (define-key vhdl-mode-map "," 'vhdl-electric-comma)
2691 (define-key vhdl-mode-map "." 'vhdl-electric-period)
2692 (when (vhdl-standard-p 'ams)
2693 (define-key vhdl-mode-map "=" 'vhdl-electric-equal)))
2695 ;; initialize mode map for VHDL Mode
2696 (vhdl-mode-map-init)
2698 ;; define special minibuffer keymap for enabling word completion in minibuffer
2699 ;; (useful in template generator prompts)
2700 (defvar vhdl-minibuffer-local-map (copy-keymap minibuffer-local-map)
2701 "Keymap for minibuffer used in VHDL Mode.")
2703 (when vhdl-word-completion-in-minibuffer
2704 (define-key vhdl-minibuffer-local-map "\t" 'vhdl-minibuffer-tab))
2706 ;; set up electric character functions to work with
2707 ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2708 (mapcar
2709 (function
2710 (lambda (sym)
2711 (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
2712 (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs)
2713 '(vhdl-electric-space
2714 vhdl-electric-tab
2715 vhdl-electric-return
2716 vhdl-electric-dash
2717 vhdl-electric-open-bracket
2718 vhdl-electric-close-bracket
2719 vhdl-electric-quote
2720 vhdl-electric-semicolon
2721 vhdl-electric-comma
2722 vhdl-electric-period
2723 vhdl-electric-equal))
2725 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2726 ;; Syntax table
2728 (defvar vhdl-mode-syntax-table nil
2729 "Syntax table used in `vhdl-mode' buffers.")
2731 (defvar vhdl-mode-ext-syntax-table nil
2732 "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2734 (defun vhdl-mode-syntax-table-init ()
2735 "Initialize `vhdl-mode-syntax-table'."
2736 (setq vhdl-mode-syntax-table (make-syntax-table))
2737 ;; define punctuation
2738 (modify-syntax-entry ?\# "." vhdl-mode-syntax-table)
2739 (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table)
2740 (modify-syntax-entry ?\% "." vhdl-mode-syntax-table)
2741 (modify-syntax-entry ?\& "." vhdl-mode-syntax-table)
2742 (modify-syntax-entry ?\' "." vhdl-mode-syntax-table)
2743 (modify-syntax-entry ?\* "." vhdl-mode-syntax-table)
2744 (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table)
2745 (modify-syntax-entry ?\. "." vhdl-mode-syntax-table)
2746 (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table)
2747 (modify-syntax-entry ?\: "." vhdl-mode-syntax-table)
2748 (modify-syntax-entry ?\; "." vhdl-mode-syntax-table)
2749 (modify-syntax-entry ?\< "." vhdl-mode-syntax-table)
2750 (modify-syntax-entry ?\= "." vhdl-mode-syntax-table)
2751 (modify-syntax-entry ?\> "." vhdl-mode-syntax-table)
2752 (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table)
2753 (modify-syntax-entry ?\| "." vhdl-mode-syntax-table)
2754 ;; define string
2755 (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table)
2756 ;; define underscore
2757 (when vhdl-underscore-is-part-of-word
2758 (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table))
2759 ;; a single hyphen is punctuation, but a double hyphen starts a comment
2760 (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)
2761 ;; and \n and \^M end a comment
2762 (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table)
2763 (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table)
2764 ;; define parentheses to match
2765 (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table)
2766 (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table)
2767 (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table)
2768 (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table)
2769 (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table)
2770 (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table)
2771 ;; extended syntax table including '_' (for simpler search regexps)
2772 (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table))
2773 (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table))
2775 ;; initialize syntax table for VHDL Mode
2776 (vhdl-mode-syntax-table-init)
2778 (defvar vhdl-syntactic-context nil
2779 "Buffer local variable containing syntactic analysis list.")
2780 (make-variable-buffer-local 'vhdl-syntactic-context)
2782 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2783 ;; Abbrev ook bindings
2785 (defvar vhdl-mode-abbrev-table nil
2786 "Abbrev table to use in `vhdl-mode' buffers.")
2788 (defun vhdl-mode-abbrev-table-init ()
2789 "Initialize `vhdl-mode-abbrev-table'."
2790 (when vhdl-mode-abbrev-table (clear-abbrev-table vhdl-mode-abbrev-table))
2791 (define-abbrev-table 'vhdl-mode-abbrev-table
2792 (append
2793 (when (memq 'vhdl vhdl-electric-keywords)
2794 ;; VHDL'93 keywords
2796 ("--" "" vhdl-template-display-comment-hook 0)
2797 ("abs" "" vhdl-template-default-hook 0)
2798 ("access" "" vhdl-template-default-hook 0)
2799 ("after" "" vhdl-template-default-hook 0)
2800 ("alias" "" vhdl-template-alias-hook 0)
2801 ("all" "" vhdl-template-default-hook 0)
2802 ("and" "" vhdl-template-default-hook 0)
2803 ("arch" "" vhdl-template-architecture-hook 0)
2804 ("architecture" "" vhdl-template-architecture-hook 0)
2805 ("array" "" vhdl-template-default-hook 0)
2806 ("assert" "" vhdl-template-assert-hook 0)
2807 ("attr" "" vhdl-template-attribute-hook 0)
2808 ("attribute" "" vhdl-template-attribute-hook 0)
2809 ("begin" "" vhdl-template-default-indent-hook 0)
2810 ("block" "" vhdl-template-block-hook 0)
2811 ("body" "" vhdl-template-default-hook 0)
2812 ("buffer" "" vhdl-template-default-hook 0)
2813 ("bus" "" vhdl-template-default-hook 0)
2814 ("case" "" vhdl-template-case-hook 0)
2815 ("comp" "" vhdl-template-component-hook 0)
2816 ("component" "" vhdl-template-component-hook 0)
2817 ("cond" "" vhdl-template-conditional-signal-asst-hook 0)
2818 ("conditional" "" vhdl-template-conditional-signal-asst-hook 0)
2819 ("conf" "" vhdl-template-configuration-hook 0)
2820 ("configuration" "" vhdl-template-configuration-hook 0)
2821 ("cons" "" vhdl-template-constant-hook 0)
2822 ("constant" "" vhdl-template-constant-hook 0)
2823 ("disconnect" "" vhdl-template-disconnect-hook 0)
2824 ("downto" "" vhdl-template-default-hook 0)
2825 ("else" "" vhdl-template-else-hook 0)
2826 ("elseif" "" vhdl-template-elsif-hook 0)
2827 ("elsif" "" vhdl-template-elsif-hook 0)
2828 ("end" "" vhdl-template-default-indent-hook 0)
2829 ("entity" "" vhdl-template-entity-hook 0)
2830 ("exit" "" vhdl-template-exit-hook 0)
2831 ("file" "" vhdl-template-file-hook 0)
2832 ("for" "" vhdl-template-for-hook 0)
2833 ("func" "" vhdl-template-function-hook 0)
2834 ("function" "" vhdl-template-function-hook 0)
2835 ("generic" "" vhdl-template-generic-hook 0)
2836 ("group" "" vhdl-template-group-hook 0)
2837 ("guarded" "" vhdl-template-default-hook 0)
2838 ("if" "" vhdl-template-if-hook 0)
2839 ("impure" "" vhdl-template-default-hook 0)
2840 ("in" "" vhdl-template-default-hook 0)
2841 ("inertial" "" vhdl-template-default-hook 0)
2842 ("inout" "" vhdl-template-default-hook 0)
2843 ("inst" "" vhdl-template-instance-hook 0)
2844 ("instance" "" vhdl-template-instance-hook 0)
2845 ("is" "" vhdl-template-default-hook 0)
2846 ("label" "" vhdl-template-default-hook 0)
2847 ("library" "" vhdl-template-library-hook 0)
2848 ("linkage" "" vhdl-template-default-hook 0)
2849 ("literal" "" vhdl-template-default-hook 0)
2850 ("loop" "" vhdl-template-bare-loop-hook 0)
2851 ("map" "" vhdl-template-map-hook 0)
2852 ("mod" "" vhdl-template-default-hook 0)
2853 ("nand" "" vhdl-template-default-hook 0)
2854 ("new" "" vhdl-template-default-hook 0)
2855 ("next" "" vhdl-template-next-hook 0)
2856 ("nor" "" vhdl-template-default-hook 0)
2857 ("not" "" vhdl-template-default-hook 0)
2858 ("null" "" vhdl-template-default-hook 0)
2859 ("of" "" vhdl-template-default-hook 0)
2860 ("on" "" vhdl-template-default-hook 0)
2861 ("open" "" vhdl-template-default-hook 0)
2862 ("or" "" vhdl-template-default-hook 0)
2863 ("others" "" vhdl-template-others-hook 0)
2864 ("out" "" vhdl-template-default-hook 0)
2865 ("pack" "" vhdl-template-package-hook 0)
2866 ("package" "" vhdl-template-package-hook 0)
2867 ("port" "" vhdl-template-port-hook 0)
2868 ("postponed" "" vhdl-template-default-hook 0)
2869 ("procedure" "" vhdl-template-procedure-hook 0)
2870 ("process" "" vhdl-template-process-hook 0)
2871 ("pure" "" vhdl-template-default-hook 0)
2872 ("range" "" vhdl-template-default-hook 0)
2873 ("record" "" vhdl-template-default-hook 0)
2874 ("register" "" vhdl-template-default-hook 0)
2875 ("reject" "" vhdl-template-default-hook 0)
2876 ("rem" "" vhdl-template-default-hook 0)
2877 ("report" "" vhdl-template-report-hook 0)
2878 ("return" "" vhdl-template-return-hook 0)
2879 ("rol" "" vhdl-template-default-hook 0)
2880 ("ror" "" vhdl-template-default-hook 0)
2881 ("select" "" vhdl-template-selected-signal-asst-hook 0)
2882 ("severity" "" vhdl-template-default-hook 0)
2883 ("shared" "" vhdl-template-default-hook 0)
2884 ("sig" "" vhdl-template-signal-hook 0)
2885 ("signal" "" vhdl-template-signal-hook 0)
2886 ("sla" "" vhdl-template-default-hook 0)
2887 ("sll" "" vhdl-template-default-hook 0)
2888 ("sra" "" vhdl-template-default-hook 0)
2889 ("srl" "" vhdl-template-default-hook 0)
2890 ("subtype" "" vhdl-template-subtype-hook 0)
2891 ("then" "" vhdl-template-default-hook 0)
2892 ("to" "" vhdl-template-default-hook 0)
2893 ("transport" "" vhdl-template-default-hook 0)
2894 ("type" "" vhdl-template-type-hook 0)
2895 ("unaffected" "" vhdl-template-default-hook 0)
2896 ("units" "" vhdl-template-default-hook 0)
2897 ("until" "" vhdl-template-default-hook 0)
2898 ("use" "" vhdl-template-use-hook 0)
2899 ("var" "" vhdl-template-variable-hook 0)
2900 ("variable" "" vhdl-template-variable-hook 0)
2901 ("wait" "" vhdl-template-wait-hook 0)
2902 ("when" "" vhdl-template-when-hook 0)
2903 ("while" "" vhdl-template-while-loop-hook 0)
2904 ("with" "" vhdl-template-with-hook 0)
2905 ("xnor" "" vhdl-template-default-hook 0)
2906 ("xor" "" vhdl-template-default-hook 0)
2908 ;; VHDL-AMS keywords
2909 (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
2911 ("across" "" vhdl-template-default-hook 0)
2912 ("break" "" vhdl-template-break-hook 0)
2913 ("limit" "" vhdl-template-limit-hook 0)
2914 ("nature" "" vhdl-template-nature-hook 0)
2915 ("noise" "" vhdl-template-default-hook 0)
2916 ("procedural" "" vhdl-template-procedural-hook 0)
2917 ("quantity" "" vhdl-template-quantity-hook 0)
2918 ("reference" "" vhdl-template-default-hook 0)
2919 ("spectrum" "" vhdl-template-default-hook 0)
2920 ("subnature" "" vhdl-template-subnature-hook 0)
2921 ("terminal" "" vhdl-template-terminal-hook 0)
2922 ("through" "" vhdl-template-default-hook 0)
2923 ("tolerance" "" vhdl-template-default-hook 0)
2925 ;; user model keywords
2926 (when (memq 'user vhdl-electric-keywords)
2927 (let ((alist vhdl-model-alist)
2928 abbrev-list keyword)
2929 (while alist
2930 (setq keyword (nth 3 (car alist)))
2931 (unless (equal keyword "")
2932 (setq abbrev-list
2933 (cons (list keyword ""
2934 (vhdl-function-name
2935 "vhdl-model" (nth 0 (car alist)) "hook") 0)
2936 abbrev-list)))
2937 (setq alist (cdr alist)))
2938 abbrev-list)))))
2940 ;; initialize abbrev table for VHDL Mode
2941 (vhdl-mode-abbrev-table-init)
2943 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2944 ;; Template completion lists
2946 (defvar vhdl-template-construct-alist nil
2947 "List of built-in construct templates.")
2949 (defun vhdl-template-construct-alist-init ()
2950 "Initialize `vhdl-template-construct-alist'."
2951 (setq
2952 vhdl-template-construct-alist
2953 (append
2955 ("alias declaration" vhdl-template-alias)
2956 ("architecture body" vhdl-template-architecture)
2957 ("assertion" vhdl-template-assert)
2958 ("attribute declaration" vhdl-template-attribute-decl)
2959 ("attribute specification" vhdl-template-attribute-spec)
2960 ("block configuration" vhdl-template-block-configuration)
2961 ("block statement" vhdl-template-block)
2962 ("case statement" vhdl-template-case-is)
2963 ("component configuration" vhdl-template-component-conf)
2964 ("component declaration" vhdl-template-component-decl)
2965 ("component instantiation statement" vhdl-template-component-inst)
2966 ("conditional signal assignment" vhdl-template-conditional-signal-asst)
2967 ("configuration declaration" vhdl-template-configuration-decl)
2968 ("configuration specification" vhdl-template-configuration-spec)
2969 ("constant declaration" vhdl-template-constant)
2970 ("disconnection specification" vhdl-template-disconnect)
2971 ("entity declaration" vhdl-template-entity)
2972 ("exit statement" vhdl-template-exit)
2973 ("file declaration" vhdl-template-file)
2974 ("generate statement" vhdl-template-generate)
2975 ("generic clause" vhdl-template-generic)
2976 ("group declaration" vhdl-template-group-decl)
2977 ("group template declaration" vhdl-template-group-template)
2978 ("if statement" vhdl-template-if-then)
2979 ("library clause" vhdl-template-library)
2980 ("loop statement" vhdl-template-loop)
2981 ("next statement" vhdl-template-next)
2982 ("package declaration" vhdl-template-package-decl)
2983 ("package body" vhdl-template-package-body)
2984 ("port clause" vhdl-template-port)
2985 ("process statement" vhdl-template-process)
2986 ("report statement" vhdl-template-report)
2987 ("return statement" vhdl-template-return)
2988 ("selected signal assignment" vhdl-template-selected-signal-asst)
2989 ("signal declaration" vhdl-template-signal)
2990 ("subprogram declaration" vhdl-template-subprogram-decl)
2991 ("subprogram body" vhdl-template-subprogram-body)
2992 ("subtype declaration" vhdl-template-subtype)
2993 ("type declaration" vhdl-template-type)
2994 ("use clause" vhdl-template-use)
2995 ("variable declaration" vhdl-template-variable)
2996 ("wait statement" vhdl-template-wait)
2998 (when (vhdl-standard-p 'ams)
3000 ("break statement" vhdl-template-break)
3001 ("nature declaration" vhdl-template-nature)
3002 ("quantity declaration" vhdl-template-quantity)
3003 ("simultaneous case statement" vhdl-template-case-use)
3004 ("simultaneous if statement" vhdl-template-if-use)
3005 ("simultaneous procedural statement" vhdl-template-procedural)
3006 ("step limit specification" vhdl-template-limit)
3007 ("subnature declaration" vhdl-template-subnature)
3008 ("terminal declaration" vhdl-template-terminal)
3009 )))))
3011 ;; initialize for VHDL Mode
3012 (vhdl-template-construct-alist-init)
3014 (defvar vhdl-template-package-alist nil
3015 "List of built-in package templates.")
3017 (defun vhdl-template-package-alist-init ()
3018 "Initialize `vhdl-template-package-alist'."
3019 (setq
3020 vhdl-template-package-alist
3021 (append
3023 ("numeric_bit" vhdl-template-package-numeric-bit)
3024 ("numeric_std" vhdl-template-package-numeric-std)
3025 ("std_logic_1164" vhdl-template-package-std-logic-1164)
3026 ("std_logic_arith" vhdl-template-package-std-logic-arith)
3027 ("std_logic_misc" vhdl-template-package-std-logic-misc)
3028 ("std_logic_signed" vhdl-template-package-std-logic-signed)
3029 ("std_logic_textio" vhdl-template-package-std-logic-textio)
3030 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned)
3031 ("textio" vhdl-template-package-textio)
3033 (when (vhdl-standard-p 'math)
3035 ("math_complex" vhdl-template-package-math-complex)
3036 ("math_real" vhdl-template-package-math-real)
3037 )))))
3039 ;; initialize for VHDL Mode
3040 (vhdl-template-package-alist-init)
3042 (defvar vhdl-template-directive-alist
3044 ("translate_on" vhdl-template-directive-translate-on)
3045 ("translate_off" vhdl-template-directive-translate-off)
3046 ("synthesis_on" vhdl-template-directive-synthesis-on)
3047 ("synthesis_off" vhdl-template-directive-synthesis-off)
3049 "List of built-in directive templates.")
3052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3053 ;;; Menues
3054 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3056 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3057 ;; VHDL menu (using `easy-menu.el')
3059 (defun vhdl-customize ()
3060 "Call the customize function with `vhdl' as argument."
3061 (interactive)
3062 (customize-browse 'vhdl))
3064 (defun vhdl-create-mode-menu ()
3065 "Create VHDL Mode menu."
3066 `("VHDL"
3067 ,(append
3068 '("Project"
3069 ["None" (vhdl-set-project "")
3070 :style radio :selected (null vhdl-project)]
3071 "--")
3072 ;; add menu entries for defined projects
3073 (let ((project-alist vhdl-project-alist) menu-list name)
3074 (while project-alist
3075 (setq name (caar project-alist))
3076 (setq menu-list
3077 (cons `[,name (vhdl-set-project ,name)
3078 :style radio :selected (equal ,name vhdl-project)]
3079 menu-list))
3080 (setq project-alist (cdr project-alist)))
3081 (setq menu-list
3082 (if vhdl-project-sort
3083 (sort menu-list
3084 (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
3085 (nreverse menu-list)))
3086 (vhdl-menu-split menu-list "Project"))
3087 '("--" "--"
3088 ["Select Project..." vhdl-set-project t]
3089 "--"
3090 ["Duplicate Project" vhdl-duplicate-project vhdl-project]
3091 ["Import Project..." vhdl-import-project
3092 :keys "C-c C-p C-m" :active t]
3093 ["Export Project" vhdl-export-project vhdl-project]
3094 "--"
3095 ["Customize Project..." (customize-option 'vhdl-project-alist) t]))
3096 "--"
3097 ("Compile"
3098 ["Compile Buffer" vhdl-compile t]
3099 ["Stop Compilation" kill-compilation t]
3100 "--"
3101 ["Make" vhdl-make t]
3102 ["Generate Makefile" vhdl-generate-makefile t]
3103 "--"
3104 ["Next Error" next-error t]
3105 ["Previous Error" previous-error t]
3106 ["First Error" first-error t]
3107 "--"
3108 ,(append
3109 '("Compiler")
3110 ;; add menu entries for defined compilers
3111 (let ((comp-alist vhdl-compiler-alist) menu-list name)
3112 (while comp-alist
3113 (setq name (caar comp-alist))
3114 (setq menu-list
3115 (cons `[,name (setq vhdl-compiler ,name)
3116 :style radio :selected (equal ,name vhdl-compiler)]
3117 menu-list))
3118 (setq comp-alist (cdr comp-alist)))
3119 (setq menu-list (nreverse menu-list))
3120 (vhdl-menu-split menu-list "Compiler"))
3121 '("--" "--"
3122 ["Select Compiler..." vhdl-set-compiler t]
3123 "--"
3124 ["Customize Compiler..."
3125 (customize-option 'vhdl-compiler-alist) t])))
3126 "--"
3127 ,(append
3128 '("Template"
3129 ("VHDL Construct 1"
3130 ["Alias" vhdl-template-alias t]
3131 ["Architecture" vhdl-template-architecture t]
3132 ["Assert" vhdl-template-assert t]
3133 ["Attribute (Decl)" vhdl-template-attribute-decl t]
3134 ["Attribute (Spec)" vhdl-template-attribute-spec t]
3135 ["Block" vhdl-template-block t]
3136 ["Case" vhdl-template-case-is t]
3137 ["Component (Decl)" vhdl-template-component-decl t]
3138 ["(Component) Instance" vhdl-template-component-inst t]
3139 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t]
3140 ["Configuration (Block)" vhdl-template-block-configuration t]
3141 ["Configuration (Comp)" vhdl-template-component-conf t]
3142 ["Configuration (Decl)" vhdl-template-configuration-decl t]
3143 ["Configuration (Spec)" vhdl-template-configuration-spec t]
3144 ["Constant" vhdl-template-constant t]
3145 ["Disconnect" vhdl-template-disconnect t]
3146 ["Else" vhdl-template-else t]
3147 ["Elsif" vhdl-template-elsif t]
3148 ["Entity" vhdl-template-entity t]
3149 ["Exit" vhdl-template-exit t]
3150 ["File" vhdl-template-file t]
3151 ["For (Generate)" vhdl-template-for-generate t]
3152 ["For (Loop)" vhdl-template-for-loop t]
3153 ["Function (Body)" vhdl-template-function-body t]
3154 ["Function (Decl)" vhdl-template-function-decl t]
3155 ["Generic" vhdl-template-generic t]
3156 ["Group (Decl)" vhdl-template-group-decl t]
3157 ["Group (Template)" vhdl-template-group-template t])
3158 ("VHDL Construct 2"
3159 ["If (Generate)" vhdl-template-if-generate t]
3160 ["If (Then)" vhdl-template-if-then t]
3161 ["Library" vhdl-template-library t]
3162 ["Loop" vhdl-template-bare-loop t]
3163 ["Map" vhdl-template-map t]
3164 ["Next" vhdl-template-next t]
3165 ["Others (Aggregate)" vhdl-template-others t]
3166 ["Package (Decl)" vhdl-template-package-decl t]
3167 ["Package (Body)" vhdl-template-package-body t]
3168 ["Port" vhdl-template-port t]
3169 ["Procedure (Body)" vhdl-template-procedure-body t]
3170 ["Procedure (Decl)" vhdl-template-procedure-decl t]
3171 ["Process (Comb)" vhdl-template-process-comb t]
3172 ["Process (Seq)" vhdl-template-process-seq t]
3173 ["Report" vhdl-template-report t]
3174 ["Return" vhdl-template-return t]
3175 ["Select" vhdl-template-selected-signal-asst t]
3176 ["Signal" vhdl-template-signal t]
3177 ["Subtype" vhdl-template-subtype t]
3178 ["Type" vhdl-template-type t]
3179 ["Use" vhdl-template-use t]
3180 ["Variable" vhdl-template-variable t]
3181 ["Wait" vhdl-template-wait t]
3182 ["(Clocked Wait)" vhdl-template-clocked-wait t]
3183 ["When" vhdl-template-when t]
3184 ["While (Loop)" vhdl-template-while-loop t]
3185 ["With" vhdl-template-with t]))
3186 (when (vhdl-standard-p 'ams)
3187 '(("VHDL-AMS Construct"
3188 ["Break" vhdl-template-break t]
3189 ["Case (Use)" vhdl-template-case-use t]
3190 ["If (Use)" vhdl-template-if-use t]
3191 ["Limit" vhdl-template-limit t]
3192 ["Nature" vhdl-template-nature t]
3193 ["Procedural" vhdl-template-procedural t]
3194 ["Quantity (Free)" vhdl-template-quantity-free t]
3195 ["Quantity (Branch)" vhdl-template-quantity-branch t]
3196 ["Quantity (Source)" vhdl-template-quantity-source t]
3197 ["Subnature" vhdl-template-subnature t]
3198 ["Terminal" vhdl-template-terminal t])))
3199 '(["Insert Construct..." vhdl-template-insert-construct
3200 :keys "C-c C-i C-t"]
3201 "--")
3202 (list
3203 (append
3204 '("Package")
3205 (when (vhdl-standard-p 'math)
3206 '(["math_complex" vhdl-template-package-math-complex t]
3207 ["math_real" vhdl-template-package-math-real t]))
3208 '(["numeric_bit" vhdl-template-package-numeric-bit t]
3209 ["numeric_std" vhdl-template-package-numeric-std t]
3210 ["std_logic_1164" vhdl-template-package-std-logic-1164 t]
3211 ["textio" vhdl-template-package-textio t]
3212 "--"
3213 ["std_logic_arith" vhdl-template-package-std-logic-arith t]
3214 ["std_logic_signed" vhdl-template-package-std-logic-signed t]
3215 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
3216 ["std_logic_misc" vhdl-template-package-std-logic-misc t]
3217 ["std_logic_textio" vhdl-template-package-std-logic-textio t]
3218 "--"
3219 ["Insert Package..." vhdl-template-insert-package
3220 :keys "C-c C-i C-p"])))
3221 '(("Directive"
3222 ["translate_on" vhdl-template-directive-translate-on t]
3223 ["translate_off" vhdl-template-directive-translate-off t]
3224 ["synthesis_on" vhdl-template-directive-synthesis-on t]
3225 ["synthesis_off" vhdl-template-directive-synthesis-off t]
3226 "--"
3227 ["Insert Directive..." vhdl-template-insert-directive
3228 :keys "C-c C-i C-d"])
3229 "--"
3230 ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"]
3231 ["Insert Footer" vhdl-template-footer t]
3232 ["Insert Date" vhdl-template-insert-date t]
3233 ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"]
3234 "--"
3235 ["Query Next Prompt" vhdl-template-search-prompt t]))
3236 ,(append
3237 '("Model")
3238 ;; add menu entries for defined models
3239 (let ((model-alist vhdl-model-alist) menu-list model)
3240 (while model-alist
3241 (setq model (car model-alist))
3242 (setq menu-list
3243 (cons
3244 (vector
3245 (nth 0 model)
3246 (vhdl-function-name "vhdl-model" (nth 0 model))
3247 :keys (concat "C-c C-m " (key-description (nth 2 model))))
3248 menu-list))
3249 (setq model-alist (cdr model-alist)))
3250 (setq menu-list (nreverse menu-list))
3251 (vhdl-menu-split menu-list "Model"))
3252 '("--" "--"
3253 ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"]
3254 ["Customize Model..." (customize-option 'vhdl-model-alist) t]))
3255 ("Port"
3256 ["Copy" vhdl-port-copy t]
3257 "--"
3258 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list]
3259 ["Paste As Component" vhdl-port-paste-component vhdl-port-list]
3260 ["Paste As Instance" vhdl-port-paste-instance
3261 :keys "C-c C-p C-i" :active vhdl-port-list]
3262 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list]
3263 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list]
3264 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list]
3265 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3266 "--"
3267 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list]
3268 "--"
3269 ["Flatten" vhdl-port-flatten
3270 :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3271 ["Reverse Direction" vhdl-port-reverse-direction
3272 :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3273 ("Compose"
3274 ["New Component" vhdl-compose-new-component t]
3275 ["Place Component" vhdl-compose-place-component vhdl-port-list]
3276 ["Wire Components" vhdl-compose-wire-components t]
3277 "--"
3278 ["Generate Components Package" vhdl-compose-components-package t])
3279 ("Subprogram"
3280 ["Copy" vhdl-subprog-copy t]
3281 "--"
3282 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list]
3283 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list]
3284 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list]
3285 "--"
3286 ["Flatten" vhdl-subprog-flatten
3287 :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3288 "--"
3289 ("Comment"
3290 ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)]
3291 "--"
3292 ["Insert Inline Comment" vhdl-comment-append-inline t]
3293 ["Insert Horizontal Line" vhdl-comment-display-line t]
3294 ["Insert Display Comment" vhdl-comment-display t]
3295 "--"
3296 ["Fill Comment" fill-paragraph t]
3297 ["Fill Comment Region" fill-region (mark)]
3298 ["Kill Comment Region" vhdl-comment-kill-region (mark)]
3299 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3300 ("Line"
3301 ["Kill" vhdl-line-kill t]
3302 ["Copy" vhdl-line-copy t]
3303 ["Yank" vhdl-line-yank t]
3304 ["Expand" vhdl-line-expand t]
3305 "--"
3306 ["Transpose Next" vhdl-line-transpose-next t]
3307 ["Transpose Prev" vhdl-line-transpose-previous t]
3308 ["Open" vhdl-line-open t]
3309 ["Join" vhdl-delete-indentation t]
3310 "--"
3311 ["Goto" goto-line t]
3312 ["(Un)Comment Out" vhdl-comment-uncomment-line t])
3313 ("Move"
3314 ["Forward Statement" vhdl-end-of-statement t]
3315 ["Backward Statement" vhdl-beginning-of-statement t]
3316 ["Forward Expression" vhdl-forward-sexp t]
3317 ["Backward Expression" vhdl-backward-sexp t]
3318 ["Forward Same Indent" vhdl-forward-same-indent t]
3319 ["Backward Same Indent" vhdl-backward-same-indent t]
3320 ["Forward Function" vhdl-end-of-defun t]
3321 ["Backward Function" vhdl-beginning-of-defun t]
3322 ["Mark Function" vhdl-mark-defun t])
3323 "--"
3324 ("Indent"
3325 ["Line" indent-according-to-mode :keys "C-c C-i C-l"]
3326 ["Group" vhdl-indent-group :keys "C-c C-i C-g"]
3327 ["Region" vhdl-indent-region (mark)]
3328 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"])
3329 ("Align"
3330 ["Group" vhdl-align-group t]
3331 ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"]
3332 ["List" vhdl-align-list t]
3333 ["Declarations" vhdl-align-declarations t]
3334 ["Region" vhdl-align-region (mark)]
3335 ["Buffer" vhdl-align-buffer t]
3336 "--"
3337 ["Inline Comment Group" vhdl-align-inline-comment-group t]
3338 ["Inline Comment Region" vhdl-align-inline-comment-region (mark)]
3339 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t])
3340 ("Fill"
3341 ["List" vhdl-fill-list t]
3342 ["Group" vhdl-fill-group t]
3343 ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"]
3344 ["Region" vhdl-fill-region (mark)])
3345 ("Beautify"
3346 ["Region" vhdl-beautify-region (mark)]
3347 ["Buffer" vhdl-beautify-buffer t])
3348 ("Fix"
3349 ["Generic/Port Clause" vhdl-fix-clause t]
3350 "--"
3351 ["Case Region" vhdl-fix-case-region (mark)]
3352 ["Case Buffer" vhdl-fix-case-buffer t]
3353 "--"
3354 ["Whitespace Region" vhdl-fixup-whitespace-region (mark)]
3355 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t]
3356 "--"
3357 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t])
3358 ("Update"
3359 ["Sensitivity List" vhdl-update-sensitivity-list-process t]
3360 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t])
3361 "--"
3362 ["Fontify Buffer" vhdl-fontify-buffer t]
3363 ["Statistics Buffer" vhdl-statistics-buffer t]
3364 ["Show Messages" vhdl-show-messages t]
3365 ["Syntactic Info" vhdl-show-syntactic-information t]
3366 "--"
3367 ["Speedbar" vhdl-speedbar t]
3368 ["Hide/Show" vhdl-hs-minor-mode t]
3369 "--"
3370 ("Documentation"
3371 ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"]
3372 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t]
3373 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t]
3374 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t])
3375 ["Version" vhdl-version t]
3376 ["Bug Report..." vhdl-submit-bug-report t]
3377 "--"
3378 ("Options"
3379 ("Mode"
3380 ["Electric Mode"
3381 (progn (customize-set-variable 'vhdl-electric-mode
3382 (not vhdl-electric-mode))
3383 (vhdl-mode-line-update))
3384 :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3385 ["Stutter Mode"
3386 (progn (customize-set-variable 'vhdl-stutter-mode
3387 (not vhdl-stutter-mode))
3388 (vhdl-mode-line-update))
3389 :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3390 ["Indent Tabs Mode"
3391 (progn (customize-set-variable 'vhdl-indent-tabs-mode
3392 (not vhdl-indent-tabs-mode))
3393 (setq indent-tabs-mode vhdl-indent-tabs-mode))
3394 :style toggle :selected vhdl-indent-tabs-mode]
3395 "--"
3396 ["Customize Group..." (customize-group 'vhdl-mode) t])
3397 ("Project"
3398 ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3399 ,(append
3400 '("Selected Project at Startup"
3401 ["None" (progn (customize-set-variable 'vhdl-project nil)
3402 (vhdl-set-project ""))
3403 :style radio :selected (null vhdl-project)]
3404 "--")
3405 ;; add menu entries for defined projects
3406 (let ((project-alist vhdl-project-alist) menu-list name)
3407 (while project-alist
3408 (setq name (caar project-alist))
3409 (setq menu-list
3410 (cons `[,name (progn (customize-set-variable
3411 'vhdl-project ,name)
3412 (vhdl-set-project ,name))
3413 :style radio :selected (equal ,name vhdl-project)]
3414 menu-list))
3415 (setq project-alist (cdr project-alist)))
3416 (setq menu-list (nreverse menu-list))
3417 (vhdl-menu-split menu-list "Project")))
3418 ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3419 ("Auto Load Setup File"
3420 ["At Startup"
3421 (customize-set-variable 'vhdl-project-auto-load
3422 (if (memq 'startup vhdl-project-auto-load)
3423 (delq 'startup vhdl-project-auto-load)
3424 (cons 'startup vhdl-project-auto-load)))
3425 :style toggle :selected (memq 'startup vhdl-project-auto-load)])
3426 ["Sort Projects"
3427 (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3428 :style toggle :selected vhdl-project-sort]
3429 "--"
3430 ["Customize Group..." (customize-group 'vhdl-project) t])
3431 ("Compiler"
3432 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3433 ,(append
3434 '("Selected Compiler at Startup")
3435 ;; add menu entries for defined compilers
3436 (let ((comp-alist vhdl-compiler-alist) menu-list name)
3437 (while comp-alist
3438 (setq name (caar comp-alist))
3439 (setq menu-list
3440 (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3441 :style radio :selected (equal ,name vhdl-compiler)]
3442 menu-list))
3443 (setq comp-alist (cdr comp-alist)))
3444 (setq menu-list (nreverse menu-list))
3445 (vhdl-menu-split menu-list "Compler")))
3446 ["Use Local Error Regexp"
3447 (customize-set-variable 'vhdl-compile-use-local-error-regexp
3448 (not vhdl-compile-use-local-error-regexp))
3449 :style toggle :selected vhdl-compile-use-local-error-regexp]
3450 ["Makefile Generation Hook..."
3451 (customize-option 'vhdl-makefile-generation-hook) t]
3452 ["Default Library Name" (customize-option 'vhdl-default-library) t]
3453 "--"
3454 ["Customize Group..." (customize-group 'vhdl-compiler) t])
3455 ("Style"
3456 ("VHDL Standard"
3457 ["VHDL'87"
3458 (progn (customize-set-variable 'vhdl-standard
3459 (list '87 (cadr vhdl-standard)))
3460 (vhdl-activate-customizations))
3461 :style radio :selected (eq '87 (car vhdl-standard))]
3462 ["VHDL'93"
3463 (progn (customize-set-variable 'vhdl-standard
3464 (list '93 (cadr vhdl-standard)))
3465 (vhdl-activate-customizations))
3466 :style radio :selected (eq '93 (car vhdl-standard))]
3467 "--"
3468 ["VHDL-AMS"
3469 (progn (customize-set-variable
3470 'vhdl-standard (list (car vhdl-standard)
3471 (if (memq 'ams (cadr vhdl-standard))
3472 (delq 'ams (cadr vhdl-standard))
3473 (cons 'ams (cadr vhdl-standard)))))
3474 (vhdl-activate-customizations))
3475 :style toggle :selected (memq 'ams (cadr vhdl-standard))]
3476 ["Math Packages"
3477 (progn (customize-set-variable
3478 'vhdl-standard (list (car vhdl-standard)
3479 (if (memq 'math (cadr vhdl-standard))
3480 (delq 'math (cadr vhdl-standard))
3481 (cons 'math (cadr vhdl-standard)))))
3482 (vhdl-activate-customizations))
3483 :style toggle :selected (memq 'math (cadr vhdl-standard))])
3484 ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3485 ["Upper Case Keywords"
3486 (customize-set-variable 'vhdl-upper-case-keywords
3487 (not vhdl-upper-case-keywords))
3488 :style toggle :selected vhdl-upper-case-keywords]
3489 ["Upper Case Types"
3490 (customize-set-variable 'vhdl-upper-case-types
3491 (not vhdl-upper-case-types))
3492 :style toggle :selected vhdl-upper-case-types]
3493 ["Upper Case Attributes"
3494 (customize-set-variable 'vhdl-upper-case-attributes
3495 (not vhdl-upper-case-attributes))
3496 :style toggle :selected vhdl-upper-case-attributes]
3497 ["Upper Case Enumeration Values"
3498 (customize-set-variable 'vhdl-upper-case-enum-values
3499 (not vhdl-upper-case-enum-values))
3500 :style toggle :selected vhdl-upper-case-enum-values]
3501 ["Upper Case Constants"
3502 (customize-set-variable 'vhdl-upper-case-constants
3503 (not vhdl-upper-case-constants))
3504 :style toggle :selected vhdl-upper-case-constants]
3505 ("Use Direct Instantiation"
3506 ["Never"
3507 (customize-set-variable 'vhdl-use-direct-instantiation 'never)
3508 :style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3509 ["Standard"
3510 (customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3511 :style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3512 ["Always"
3513 (customize-set-variable 'vhdl-use-direct-instantiation 'always)
3514 :style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3515 "--"
3516 ["Customize Group..." (customize-group 'vhdl-style) t])
3517 ("Naming"
3518 ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3519 ["Architecture File Name..."
3520 (customize-option 'vhdl-architecture-file-name) t]
3521 ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3522 ("File Name Case"
3523 ["As Is"
3524 (customize-set-variable 'vhdl-file-name-case 'identity)
3525 :style radio :selected (eq 'identity vhdl-file-name-case)]
3526 ["Lower Case"
3527 (customize-set-variable 'vhdl-file-name-case 'downcase)
3528 :style radio :selected (eq 'downcase vhdl-file-name-case)]
3529 ["Upper Case"
3530 (customize-set-variable 'vhdl-file-name-case 'upcase)
3531 :style radio :selected (eq 'upcase vhdl-file-name-case)]
3532 ["Capitalize"
3533 (customize-set-variable 'vhdl-file-name-case 'capitalize)
3534 :style radio :selected (eq 'capitalize vhdl-file-name-case)])
3535 "--"
3536 ["Customize Group..." (customize-group 'vhdl-naming) t])
3537 ("Template"
3538 ("Electric Keywords"
3539 ["VHDL Keywords"
3540 (customize-set-variable 'vhdl-electric-keywords
3541 (if (memq 'vhdl vhdl-electric-keywords)
3542 (delq 'vhdl vhdl-electric-keywords)
3543 (cons 'vhdl vhdl-electric-keywords)))
3544 :style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3545 ["User Model Keywords"
3546 (customize-set-variable 'vhdl-electric-keywords
3547 (if (memq 'user vhdl-electric-keywords)
3548 (delq 'user vhdl-electric-keywords)
3549 (cons 'user vhdl-electric-keywords)))
3550 :style toggle :selected (memq 'user vhdl-electric-keywords)])
3551 ("Insert Optional Labels"
3552 ["None"
3553 (customize-set-variable 'vhdl-optional-labels 'none)
3554 :style radio :selected (eq 'none vhdl-optional-labels)]
3555 ["Processes Only"
3556 (customize-set-variable 'vhdl-optional-labels 'process)
3557 :style radio :selected (eq 'process vhdl-optional-labels)]
3558 ["All Constructs"
3559 (customize-set-variable 'vhdl-optional-labels 'all)
3560 :style radio :selected (eq 'all vhdl-optional-labels)])
3561 ("Insert Empty Lines"
3562 ["None"
3563 (customize-set-variable 'vhdl-insert-empty-lines 'none)
3564 :style radio :selected (eq 'none vhdl-insert-empty-lines)]
3565 ["Design Units Only"
3566 (customize-set-variable 'vhdl-insert-empty-lines 'unit)
3567 :style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3568 ["All Constructs"
3569 (customize-set-variable 'vhdl-insert-empty-lines 'all)
3570 :style radio :selected (eq 'all vhdl-insert-empty-lines)])
3571 ["Argument List Indent"
3572 (customize-set-variable 'vhdl-argument-list-indent
3573 (not vhdl-argument-list-indent))
3574 :style toggle :selected vhdl-argument-list-indent]
3575 ["Association List with Formals"
3576 (customize-set-variable 'vhdl-association-list-with-formals
3577 (not vhdl-association-list-with-formals))
3578 :style toggle :selected vhdl-association-list-with-formals]
3579 ["Conditions in Parenthesis"
3580 (customize-set-variable 'vhdl-conditions-in-parenthesis
3581 (not vhdl-conditions-in-parenthesis))
3582 :style toggle :selected vhdl-conditions-in-parenthesis]
3583 ["Zero String..." (customize-option 'vhdl-zero-string) t]
3584 ["One String..." (customize-option 'vhdl-one-string) t]
3585 ("File Header"
3586 ["Header String..." (customize-option 'vhdl-file-header) t]
3587 ["Footer String..." (customize-option 'vhdl-file-footer) t]
3588 ["Company Name..." (customize-option 'vhdl-company-name) t]
3589 ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3590 ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3591 ["Date Format..." (customize-option 'vhdl-date-format) t]
3592 ["Modify Date Prefix String..."
3593 (customize-option 'vhdl-modify-date-prefix-string) t]
3594 ["Modify Date on Saving"
3595 (progn (customize-set-variable 'vhdl-modify-date-on-saving
3596 (not vhdl-modify-date-on-saving))
3597 (vhdl-activate-customizations))
3598 :style toggle :selected vhdl-modify-date-on-saving])
3599 ("Sequential Process"
3600 ("Kind of Reset"
3601 ["None"
3602 (customize-set-variable 'vhdl-reset-kind 'none)
3603 :style radio :selected (eq 'none vhdl-reset-kind)]
3604 ["Synchronous"
3605 (customize-set-variable 'vhdl-reset-kind 'sync)
3606 :style radio :selected (eq 'sync vhdl-reset-kind)]
3607 ["Asynchronous"
3608 (customize-set-variable 'vhdl-reset-kind 'async)
3609 :style radio :selected (eq 'async vhdl-reset-kind)])
3610 ["Reset is Active High"
3611 (customize-set-variable 'vhdl-reset-active-high
3612 (not vhdl-reset-active-high))
3613 :style toggle :selected vhdl-reset-active-high]
3614 ["Use Rising Clock Edge"
3615 (customize-set-variable 'vhdl-clock-rising-edge
3616 (not vhdl-clock-rising-edge))
3617 :style toggle :selected vhdl-clock-rising-edge]
3618 ("Clock Edge Condition"
3619 ["Standard"
3620 (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3621 :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3622 ["Function \"rising_edge\""
3623 (customize-set-variable 'vhdl-clock-edge-condition 'function)
3624 :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3625 ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3626 ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3627 "--"
3628 ["Customize Group..." (customize-group 'vhdl-template) t])
3629 ("Model"
3630 ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3631 ("Port"
3632 ["Include Port Comments"
3633 (customize-set-variable 'vhdl-include-port-comments
3634 (not vhdl-include-port-comments))
3635 :style toggle :selected vhdl-include-port-comments]
3636 ["Include Direction Comments"
3637 (customize-set-variable 'vhdl-include-direction-comments
3638 (not vhdl-include-direction-comments))
3639 :style toggle :selected vhdl-include-direction-comments]
3640 ["Include Type Comments"
3641 (customize-set-variable 'vhdl-include-type-comments
3642 (not vhdl-include-type-comments))
3643 :style toggle :selected vhdl-include-type-comments]
3644 ("Include Group Comments"
3645 ["Never"
3646 (customize-set-variable 'vhdl-include-group-comments 'never)
3647 :style radio :selected (eq 'never vhdl-include-group-comments)]
3648 ["Declarations"
3649 (customize-set-variable 'vhdl-include-group-comments 'decl)
3650 :style radio :selected (eq 'decl vhdl-include-group-comments)]
3651 ["Always"
3652 (customize-set-variable 'vhdl-include-group-comments 'always)
3653 :style radio :selected (eq 'always vhdl-include-group-comments)])
3654 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3655 ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3656 ("Testbench"
3657 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3658 ["Architecture Name..."
3659 (customize-option 'vhdl-testbench-architecture-name) t]
3660 ["Configuration Name..."
3661 (customize-option 'vhdl-testbench-configuration-name) t]
3662 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3663 ["Include Header"
3664 (customize-set-variable 'vhdl-testbench-include-header
3665 (not vhdl-testbench-include-header))
3666 :style toggle :selected vhdl-testbench-include-header]
3667 ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3668 ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3669 ["Initialize Signals"
3670 (customize-set-variable 'vhdl-testbench-initialize-signals
3671 (not vhdl-testbench-initialize-signals))
3672 :style toggle :selected vhdl-testbench-initialize-signals]
3673 ["Include Library Clause"
3674 (customize-set-variable 'vhdl-testbench-include-library
3675 (not vhdl-testbench-include-library))
3676 :style toggle :selected vhdl-testbench-include-library]
3677 ["Include Configuration"
3678 (customize-set-variable 'vhdl-testbench-include-configuration
3679 (not vhdl-testbench-include-configuration))
3680 :style toggle :selected vhdl-testbench-include-configuration]
3681 ("Create Files"
3682 ["None"
3683 (customize-set-variable 'vhdl-testbench-create-files 'none)
3684 :style radio :selected (eq 'none vhdl-testbench-create-files)]
3685 ["Single"
3686 (customize-set-variable 'vhdl-testbench-create-files 'single)
3687 :style radio :selected (eq 'single vhdl-testbench-create-files)]
3688 ["Separate"
3689 (customize-set-variable 'vhdl-testbench-create-files 'separate)
3690 :style radio :selected (eq 'separate vhdl-testbench-create-files)]))
3691 "--"
3692 ["Customize Group..." (customize-group 'vhdl-port) t])
3693 ("Compose"
3694 ("Create Files"
3695 ["None"
3696 (customize-set-variable 'vhdl-compose-create-files 'none)
3697 :style radio :selected (eq 'none vhdl-compose-create-files)]
3698 ["Single"
3699 (customize-set-variable 'vhdl-compose-create-files 'single)
3700 :style radio :selected (eq 'single vhdl-compose-create-files)]
3701 ["Separate"
3702 (customize-set-variable 'vhdl-compose-create-files 'separate)
3703 :style radio :selected (eq 'separate vhdl-compose-create-files)])
3704 ["Include Header"
3705 (customize-set-variable 'vhdl-compose-include-header
3706 (not vhdl-compose-include-header))
3707 :style toggle :selected vhdl-compose-include-header]
3708 ["Architecture Name..."
3709 (customize-option 'vhdl-compose-architecture-name) t]
3710 ["Components Package Name..."
3711 (customize-option 'vhdl-components-package-name) t]
3712 ["Use Components Package"
3713 (customize-set-variable 'vhdl-use-components-package
3714 (not vhdl-use-components-package))
3715 :style toggle :selected vhdl-use-components-package]
3716 "--"
3717 ["Customize Group..." (customize-group 'vhdl-compose) t])
3718 ("Comment"
3719 ["Self Insert Comments"
3720 (customize-set-variable 'vhdl-self-insert-comments
3721 (not vhdl-self-insert-comments))
3722 :style toggle :selected vhdl-self-insert-comments]
3723 ["Prompt for Comments"
3724 (customize-set-variable 'vhdl-prompt-for-comments
3725 (not vhdl-prompt-for-comments))
3726 :style toggle :selected vhdl-prompt-for-comments]
3727 ["Inline Comment Column..."
3728 (customize-option 'vhdl-inline-comment-column) t]
3729 ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
3730 "--"
3731 ["Customize Group..." (customize-group 'vhdl-comment) t])
3732 ("Align"
3733 ["Auto Align Templates"
3734 (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
3735 :style toggle :selected vhdl-auto-align]
3736 ["Align Line Groups"
3737 (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
3738 :style toggle :selected vhdl-align-groups]
3739 ["Group Separation String..."
3740 (customize-set-variable 'vhdl-align-group-separate) t]
3741 ["Align Lines with Same Indent"
3742 (customize-set-variable 'vhdl-align-same-indent
3743 (not vhdl-align-same-indent))
3744 :style toggle :selected vhdl-align-same-indent]
3745 "--"
3746 ["Customize Group..." (customize-group 'vhdl-align) t])
3747 ("Highlight"
3748 ["Highlighting On/Off..."
3749 (customize-option
3750 (if vhdl-xemacs 'font-lock-auto-fontify 'global-font-lock-mode)) t]
3751 ["Highlight Keywords"
3752 (progn (customize-set-variable 'vhdl-highlight-keywords
3753 (not vhdl-highlight-keywords))
3754 (vhdl-fontify-buffer))
3755 :style toggle :selected vhdl-highlight-keywords]
3756 ["Highlight Names"
3757 (progn (customize-set-variable 'vhdl-highlight-names
3758 (not vhdl-highlight-names))
3759 (vhdl-fontify-buffer))
3760 :style toggle :selected vhdl-highlight-names]
3761 ["Highlight Special Words"
3762 (progn (customize-set-variable 'vhdl-highlight-special-words
3763 (not vhdl-highlight-special-words))
3764 (vhdl-fontify-buffer))
3765 :style toggle :selected vhdl-highlight-special-words]
3766 ["Highlight Forbidden Words"
3767 (progn (customize-set-variable 'vhdl-highlight-forbidden-words
3768 (not vhdl-highlight-forbidden-words))
3769 (vhdl-fontify-buffer))
3770 :style toggle :selected vhdl-highlight-forbidden-words]
3771 ["Highlight Verilog Keywords"
3772 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
3773 (not vhdl-highlight-verilog-keywords))
3774 (vhdl-fontify-buffer))
3775 :style toggle :selected vhdl-highlight-verilog-keywords]
3776 ["Highlight \"translate_off\""
3777 (progn (customize-set-variable 'vhdl-highlight-translate-off
3778 (not vhdl-highlight-translate-off))
3779 (vhdl-fontify-buffer))
3780 :style toggle :selected vhdl-highlight-translate-off]
3781 ["Case Sensitive Highlighting"
3782 (progn (customize-set-variable 'vhdl-highlight-case-sensitive
3783 (not vhdl-highlight-case-sensitive))
3784 (vhdl-fontify-buffer))
3785 :style toggle :selected vhdl-highlight-case-sensitive]
3786 ["Special Syntax Definition..."
3787 (customize-option 'vhdl-special-syntax-alist) t]
3788 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
3789 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
3790 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
3791 ["Colors..." (customize-group 'vhdl-highlight-faces) t]
3792 "--"
3793 ["Customize Group..." (customize-group 'vhdl-highlight) t])
3794 ("Speedbar"
3795 ["Auto Open at Startup"
3796 (customize-set-variable 'vhdl-speedbar-auto-open
3797 (not vhdl-speedbar-auto-open))
3798 :style toggle :selected vhdl-speedbar-auto-open]
3799 ("Default Displaying Mode"
3800 ["Files"
3801 (customize-set-variable 'vhdl-speedbar-display-mode 'files)
3802 :style radio :selected (eq 'files vhdl-speedbar-display-mode)]
3803 ["Directory Hierarchy"
3804 (customize-set-variable 'vhdl-speedbar-display-mode 'directory)
3805 :style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
3806 ["Project Hierarchy"
3807 (customize-set-variable 'vhdl-speedbar-display-mode 'project)
3808 :style radio :selected (eq 'project vhdl-speedbar-display-mode)])
3809 ["Indentation Offset..."
3810 (customize-option 'speedbar-indentation-width) t]
3811 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
3812 ["Jump to Unit when Opening"
3813 (customize-set-variable 'vhdl-speedbar-jump-to-unit
3814 (not vhdl-speedbar-jump-to-unit))
3815 :style toggle :selected vhdl-speedbar-jump-to-unit]
3816 ["Update Hierarchy on File Saving"
3817 (customize-set-variable 'vhdl-speedbar-update-on-saving
3818 (not vhdl-speedbar-update-on-saving))
3819 :style toggle :selected vhdl-speedbar-update-on-saving]
3820 ("Save in Cache File"
3821 ["Hierarchy Information"
3822 (customize-set-variable 'vhdl-speedbar-save-cache
3823 (if (memq 'hierarchy vhdl-speedbar-save-cache)
3824 (delq 'hierarchy vhdl-speedbar-save-cache)
3825 (cons 'hierarchy vhdl-speedbar-save-cache)))
3826 :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
3827 ["Displaying Status"
3828 (customize-set-variable 'vhdl-speedbar-save-cache
3829 (if (memq 'display vhdl-speedbar-save-cache)
3830 (delq 'display vhdl-speedbar-save-cache)
3831 (cons 'display vhdl-speedbar-save-cache)))
3832 :style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
3833 ["Cache File Name..."
3834 (customize-option 'vhdl-speedbar-cache-file-name) t]
3835 "--"
3836 ["Customize Group..." (customize-group 'vhdl-speedbar) t])
3837 ("Menu"
3838 ["Add Index Menu when Loading File"
3839 (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
3840 (vhdl-index-menu-init))
3841 :style toggle :selected vhdl-index-menu]
3842 ["Add Source File Menu when Loading File"
3843 (progn (customize-set-variable 'vhdl-source-file-menu
3844 (not vhdl-source-file-menu))
3845 (vhdl-add-source-files-menu))
3846 :style toggle :selected vhdl-source-file-menu]
3847 ["Add Hideshow Menu at Startup"
3848 (progn (customize-set-variable 'vhdl-hideshow-menu
3849 (not vhdl-hideshow-menu))
3850 (vhdl-activate-customizations))
3851 :style toggle :selected vhdl-hideshow-menu]
3852 ["Hide Everything Initially"
3853 (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
3854 :style toggle :selected vhdl-hide-all-init]
3855 "--"
3856 ["Customize Group..." (customize-group 'vhdl-menu) t])
3857 ("Print"
3858 ["In Two Column Format"
3859 (progn (customize-set-variable 'vhdl-print-two-column
3860 (not vhdl-print-two-column))
3861 (message "Activate new setting by saving options and restarting Emacs"))
3862 :style toggle :selected vhdl-print-two-column]
3863 ["Use Customized Faces"
3864 (progn (customize-set-variable 'vhdl-print-customize-faces
3865 (not vhdl-print-customize-faces))
3866 (message "Activate new setting by saving options and restarting Emacs"))
3867 :style toggle :selected vhdl-print-customize-faces]
3868 "--"
3869 ["Customize Group..." (customize-group 'vhdl-print) t])
3870 ("Miscellaneous"
3871 ["Use Intelligent Tab"
3872 (progn (customize-set-variable 'vhdl-intelligent-tab
3873 (not vhdl-intelligent-tab))
3874 (vhdl-activate-customizations))
3875 :style toggle :selected vhdl-intelligent-tab]
3876 ["Indent Syntax-Based"
3877 (customize-set-variable 'vhdl-indent-syntax-based
3878 (not vhdl-indent-syntax-based))
3879 :style toggle :selected vhdl-indent-syntax-based]
3880 ["Word Completion is Case Sensitive"
3881 (customize-set-variable 'vhdl-word-completion-case-sensitive
3882 (not vhdl-word-completion-case-sensitive))
3883 :style toggle :selected vhdl-word-completion-case-sensitive]
3884 ["Word Completion in Minibuffer"
3885 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
3886 (not vhdl-word-completion-in-minibuffer))
3887 (message "Activate new setting by saving options and restarting Emacs"))
3888 :style toggle :selected vhdl-word-completion-in-minibuffer]
3889 ["Underscore is Part of Word"
3890 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
3891 (not vhdl-underscore-is-part-of-word))
3892 (vhdl-activate-customizations))
3893 :style toggle :selected vhdl-underscore-is-part-of-word]
3894 "--"
3895 ["Customize Group..." (customize-group 'vhdl-misc) t])
3896 ["Related..." (customize-browse 'vhdl-related) t]
3897 "--"
3898 ["Save Options" customize-save-customized t]
3899 ["Activate Options" vhdl-activate-customizations t]
3900 ["Browse Options..." vhdl-customize t])))
3902 (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
3903 "VHDL Mode menu.")
3905 (defun vhdl-update-mode-menu ()
3906 "Update VHDL Mode menu."
3907 (interactive)
3908 (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
3909 (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
3910 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
3911 (easy-menu-define vhdl-mode-menu vhdl-mode-map
3912 "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
3914 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3915 ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
3917 (defconst vhdl-imenu-generic-expression
3919 ("Subprogram"
3920 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
3922 ("Instance"
3923 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
3925 ("Component"
3926 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
3928 ("Procedural"
3929 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
3931 ("Process"
3932 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
3934 ("Block"
3935 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
3937 ("Package"
3938 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
3940 ("Configuration"
3941 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
3943 ("Architecture"
3944 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
3946 ("Entity"
3947 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
3950 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.")
3952 (defun vhdl-index-menu-init ()
3953 "Initialize index menu."
3954 (set (make-local-variable 'imenu-case-fold-search) t)
3955 (set (make-local-variable 'imenu-generic-expression)
3956 vhdl-imenu-generic-expression)
3957 (when (and vhdl-index-menu (fboundp 'imenu))
3958 (if (or (not (boundp 'font-lock-maximum-size))
3959 (> font-lock-maximum-size (buffer-size)))
3960 (imenu-add-to-menubar "Index")
3961 (message "Scanning buffer for index...buffer too big"))))
3963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3964 ;; Source file menu (using `easy-menu.el')
3966 (defvar vhdl-sources-menu nil)
3968 (defun vhdl-directory-files (directory &optional full match)
3969 "Call `directory-files' if DIRECTORY exists, otherwise generate error
3970 message."
3971 (if (not (file-directory-p directory))
3972 (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
3973 (let ((dir (directory-files directory full match)))
3974 (setq dir (delete "." dir))
3975 (setq dir (delete ".." dir))
3976 dir)))
3978 (defun vhdl-get-source-files (&optional full directory)
3979 "Get list of VHDL source files in DIRECTORY or current directory."
3980 (let ((mode-alist auto-mode-alist)
3981 filename-regexp)
3982 ;; create regular expressions for matching file names
3983 (setq filename-regexp "\\`[^.].*\\(")
3984 (while mode-alist
3985 (when (eq (cdar mode-alist) 'vhdl-mode)
3986 (setq filename-regexp
3987 (concat filename-regexp (caar mode-alist) "\\|")))
3988 (setq mode-alist (cdr mode-alist)))
3989 (setq filename-regexp
3990 (concat (substring filename-regexp 0
3991 (string-match "\\\\|$" filename-regexp)) "\\)"))
3992 ;; find files
3993 (vhdl-directory-files
3994 (or directory default-directory) full filename-regexp)))
3996 (defun vhdl-add-source-files-menu ()
3997 "Scan directory for all VHDL source files and generate menu.
3998 The directory of the current source file is scanned."
3999 (interactive)
4000 (message "Scanning directory for source files ...")
4001 (let ((newmap (current-local-map))
4002 (file-list (vhdl-get-source-files))
4003 menu-list found)
4004 ;; Create list for menu
4005 (setq found nil)
4006 (while file-list
4007 (setq found t)
4008 (setq menu-list (cons (vector (car file-list)
4009 (list 'find-file (car file-list)) t)
4010 menu-list))
4011 (setq file-list (cdr file-list)))
4012 (setq menu-list (vhdl-menu-split menu-list "Sources"))
4013 (when found (setq menu-list (cons "--" menu-list)))
4014 (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list))
4015 (setq menu-list (cons "Sources" menu-list))
4016 ;; Create menu
4017 (easy-menu-add menu-list)
4018 (easy-menu-define vhdl-sources-menu newmap
4019 "VHDL source files menu" menu-list))
4020 (message ""))
4023 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4024 ;;; Mode definition
4025 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4026 ;; performs all buffer local initializations
4028 ;;;###autoload
4029 (defun vhdl-mode ()
4030 "Major mode for editing VHDL code.
4032 Usage:
4033 ------
4035 TEMPLATE INSERTION (electrification):
4036 After typing a VHDL keyword and entering `SPC', you are prompted for
4037 arguments while a template is generated for that VHDL construct. Typing
4038 `RET' or `C-g' at the first \(mandatory) prompt aborts the current
4039 template generation. Optional arguments are indicated by square
4040 brackets and removed if the queried string is left empty. Prompts for
4041 mandatory arguments remain in the code if the queried string is left
4042 empty. They can be queried again by `C-c C-t C-q'. Enabled
4043 electrification is indicated by `/e' in the modeline.
4045 Typing `M-SPC' after a keyword inserts a space without calling the
4046 template generator. Automatic template generation (i.e.
4047 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4048 setting option `vhdl-electric-mode' (see OPTIONS).
4050 Template generators can be invoked from the VHDL menu, by key
4051 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4052 the keyword (i.e. first word of menu entry not in parenthesis) and
4053 `SPC'. The following abbreviations can also be used: arch, attr, cond,
4054 conf, comp, cons, func, inst, pack, sig, var.
4056 Template styles can be customized in customization group
4057 `vhdl-template' \(see OPTIONS).
4060 HEADER INSERTION:
4061 A file header can be inserted by `C-c C-t C-h'. A file footer
4062 (template at the end of the file) can be inserted by `C-c C-t C-f'.
4063 See customization group `vhdl-header'.
4066 STUTTERING:
4067 Double striking of some keys inserts cumbersome VHDL syntax elements.
4068 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4069 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in
4070 the modeline. The stuttering keys and their effects are:
4072 ;; --> \" : \" [ --> ( -- --> comment
4073 ;;; --> \" := \" [[ --> [ --CR --> comment-out code
4074 .. --> \" => \" ] --> ) --- --> horizontal line
4075 ,, --> \" <= \" ]] --> ] ---- --> display comment
4076 == --> \" == \" '' --> \\\"
4079 WORD COMPLETION:
4080 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4081 word in the buffer that starts alike, inserts it and adjusts case.
4082 Re-typing `TAB' toggles through alternative word completions. This also
4083 works in the minibuffer (i.e. in template generator prompts).
4085 Typing `TAB' after `(' looks for and inserts complete parenthesized
4086 expressions (e.g. for array index ranges). All keywords as well as
4087 standard types and subprograms of VHDL have predefined abbreviations
4088 \(e.g. type \"std\" and `TAB' will toggle through all standard types
4089 beginning with \"std\").
4091 Typing `TAB' after a non-word character indents the line if at the
4092 beginning of a line (i.e. no preceding non-blank characters), and
4093 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator
4094 stop.
4097 COMMENTS:
4098 `--' puts a single comment.
4099 `---' draws a horizontal line for separating code segments.
4100 `----' inserts a display comment, i.e. two horizontal lines
4101 with a comment in between.
4102 `--CR' comments out code on that line. Re-hitting CR comments
4103 out following lines.
4104 `C-c c' comments out a region if not commented out,
4105 uncomments a region if already commented out.
4107 You are prompted for comments after object definitions (i.e. signals,
4108 variables, constants, ports) and after subprogram and process
4109 specifications if option `vhdl-prompt-for-comments' is non-nil.
4110 Comments are automatically inserted as additional labels (e.g. after
4111 begin statements) and as help comments if `vhdl-self-insert-comments' is
4112 non-nil.
4114 Inline comments (i.e. comments after a piece of code on the same line)
4115 are indented at least to `vhdl-inline-comment-column'. Comments go at
4116 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment
4117 will open a new comment line. Typing beyond `vhdl-end-comment-column'
4118 in a comment automatically opens a new comment line. `M-q' re-fills
4119 multi-line comments.
4122 INDENTATION:
4123 `TAB' indents a line if at the beginning of the line. The amount of
4124 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l'
4125 always indents the current line (is bound to `TAB' if option
4126 `vhdl-intelligent-tab' is nil).
4128 Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4129 \(`M-C-\\') or the entire buffer (menu). Argument and port lists are
4130 indented normally (nil) or relative to the opening parenthesis (non-nil)
4131 according to option `vhdl-argument-list-indent'.
4133 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4134 tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
4135 and vice versa.
4137 Syntax-based indentation can be very slow in large files. Option
4138 `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
4141 ALIGNMENT:
4142 The alignment functions align operators, keywords, and inline comments
4143 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines
4144 separated by blank lines, `C-c C-a C-i' a block of lines with same
4145 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4146 a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4147 C-a C-d' all lines within the declarative part of a design unit. `C-c
4148 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments
4149 for a group of lines, and `C-c C-a M-c' for a region.
4151 If option `vhdl-align-groups' is non-nil, groups of code lines
4152 separated by special lines (see option `vhdl-align-group-separate') are
4153 aligned individually. If option `vhdl-align-same-indent' is non-nil,
4154 blocks of lines with same indent are aligned separately. Some templates
4155 are automatically aligned after generation if option `vhdl-auto-align'
4156 is non-nil.
4158 Alignment tries to align inline comments at
4159 `vhdl-inline-comment-column' and tries inline comment not to exceed
4160 `vhdl-end-comment-column'.
4162 `C-c C-x M-w' fixes up whitespace in a region. That is, operator
4163 symbols are surrounded by one space, and multiple spaces are eliminated.
4166 | CODE FILLING:
4167 | Code filling allows to condens code (e.g. sensitivity lists or port
4168 | maps) by removing comments and newlines and re-wrapping so that all
4169 | lines are maximally filled (block filling). `C-c C-f C-f' fills a list
4170 | enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4171 | blank lines, `C-c C-f C-i' a block of lines with same indent, and
4172 | `C-c C-f M-f' an entire region.
4175 CODE BEAUTIFICATION:
4176 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4177 buffer respectively. This inludes indentation, alignment, and case
4178 fixing. Code beautification can also be run non-interactively using the
4179 command:
4181 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4184 PORT TRANSLATION:
4185 Generic and port clauses from entity or component declarations can be
4186 copied (`C-c C-p C-w') and pasted as entity and component declarations,
4187 as component instantiations and corresponding internal constants and
4188 signals, as a generic map with constants as actual generics, and as
4189 internal signal initializations (menu).
4191 To include formals in component instantiations, see option
4192 `vhdl-association-list-with-formals'. To include comments in pasting,
4193 see options `vhdl-include-...-comments'.
4195 A clause with several generic/port names on the same line can be
4196 flattened (`C-c C-p C-f') so that only one name per line exists. The
4197 | direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4198 | outputs and vice versa, which can be useful in testbenches. (This
4199 | reversion is done on the internal data structure and is only reflected
4200 | in subsequent paste operations.)
4202 Names for actual ports, instances, testbenches, and
4203 design-under-test instances can be derived from existing names according
4204 to options `vhdl-...-name'. See customization group `vhdl-port'.
4207 | SUBPROGRAM TRANSLATION:
4208 | Similar functionality exists for copying/pasting the interface of
4209 | subprograms (function/procedure). A subprogram interface can be copied
4210 | and then pasted as a subprogram declaration, body or call (uses
4211 | association list with formals).
4214 TESTBENCH GENERATION:
4215 A copied port can also be pasted as a testbench. The generated
4216 testbench includes an entity, an architecture, and an optional
4217 configuration. The architecture contains the component declaration and
4218 instantiation of the DUT as well as internal constant and signal
4219 declarations. Additional user-defined templates can be inserted. The
4220 names used for entity/architecture/configuration/DUT as well as the file
4221 structure to be generated can be customized. See customization group
4222 `vhdl-testbench'.
4225 KEY BINDINGS:
4226 Key bindings (`C-c ...') exist for most commands (see in menu).
4229 VHDL MENU:
4230 All commands can be found in the VHDL menu including their key bindings.
4233 FILE BROWSER:
4234 The speedbar allows browsing of directories and file contents. It can
4235 be accessed from the VHDL menu and is automatically opened if option
4236 `vhdl-speedbar-auto-open' is non-nil.
4238 In speedbar, open files and directories with `mouse-2' on the name and
4239 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4242 DESIGN HIERARCHY BROWSER:
4243 The speedbar can also be used for browsing the hierarchy of design units
4244 contained in the source files of the current directory or the specified
4245 projects (see option `vhdl-project-alist').
4247 The speedbar can be switched between file, directory hierarchy and
4248 project hierarchy browsing mode in the speedbar menu or by typing `f',
4249 `h' or `H' in speedbar.
4251 In speedbar, open design units with `mouse-2' on the name and browse
4252 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied
4253 from entities and components (in packages). Individual design units and
4254 complete designs can directly be compiled (\"Make\" menu entry).
4256 The hierarchy is automatically updated upon saving a modified source
4257 file when option `vhdl-speedbar-update-on-saving' is non-nil. The
4258 hierarchy is only updated for projects that have been opened once in the
4259 speedbar. The hierarchy is cached between Emacs sessions in a file (see
4260 options in group `vhdl-speedbar').
4262 Simple design consistency checks are done during scanning, such as
4263 multiple declarations of the same unit or missing primary units that are
4264 required by secondary units.
4267 | STRUCTURAL COMPOSITION:
4268 | Enables simple structural composition. `C-c C-c C-n' creates a skeleton
4269 | for a new component. Subcomponents (i.e. component declaration and
4270 | instantiation) can be automatically placed from a previously read port
4271 | \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally,
4272 | all subcomponents can be automatically connected using internal signals
4273 | and ports (`C-c C-c C-w') following these rules:
4274 | - subcomponent actual ports with same name are considered to be
4275 | connected by a signal (internal signal or port)
4276 | - signals that are only inputs to subcomponents are considered as
4277 | inputs to this component -> input port created
4278 | - signals that are only outputs from subcomponents are considered as
4279 | outputs from this component -> output port created
4280 | - signals that are inputs to AND outputs from subcomponents are
4281 | considered as internal connections -> internal signal created
4283 | Component declarations can be placed in a components package (option
4284 | `vhdl-use-components-package') which can be automatically generated for
4285 | an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct
4286 | component instantiation is also supported (option
4287 | `vhdl-use-direct-instantiation').
4289 | Purpose: With appropriate naming conventions it is possible to
4290 | create higher design levels with only a few mouse clicks or key
4291 | strokes. A new design level can be created by simply generating a new
4292 | component, placing the required subcomponents from the hierarchy
4293 | browser, and wiring everything automatically.
4295 | Note: Automatic wiring only works reliably on templates of new
4296 | components and component instantiations that were created by VHDL mode.
4298 | See the options group `vhdl-compose' for all relevant user options.
4301 SOURCE FILE COMPILATION:
4302 The syntax of the current buffer can be analyzed by calling a VHDL
4303 compiler (menu, `C-c C-k'). The compiler to be used is specified by
4304 option `vhdl-compiler'. The available compilers are listed in option
4305 `vhdl-compiler-alist' including all required compilation command,
4306 command options, compilation directory, and error message syntax
4307 information. New compilers can be added.
4309 All the source files of an entire design can be compiled by the `make'
4310 command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4313 MAKEFILE GENERATION:
4314 Makefiles can be generated automatically by an internal generation
4315 routine (`C-c M-k'). The library unit dependency information is
4316 obtained from the hierarchy browser. Makefile generation can be
4317 customized for each compiler in option `vhdl-compiler-alist'.
4319 Makefile generation can also be run non-interactively using the
4320 command:
4322 emacs -batch -l ~/.emacs -l vhdl-mode
4323 [-compiler compilername] [-project projectname]
4324 -f vhdl-generate-makefile
4326 The Makefile's default target \"all\" compiles the entire design, the
4327 target \"clean\" removes it and the target \"library\" creates the
4328 library directory if not existent. The Makefile also includes a target
4329 for each primary library unit which allows selective compilation of this
4330 unit, its secondary units and its subhierarchy (example: compilation of
4331 a design specified by a configuration). User specific parts can be
4332 inserted into a Makefile with option `vhdl-makefile-generation-hook'.
4334 Limitations:
4335 - Only library units and dependencies within the current library are
4336 considered. Makefiles for designs that span multiple libraries are
4337 not (yet) supported.
4338 - Only one-level configurations are supported (also hierarchical),
4339 but configurations that go down several levels are not.
4340 - The \"others\" keyword in configurations is not supported.
4343 PROJECTS:
4344 Projects can be defined in option `vhdl-project-alist' and a current
4345 project be selected using option `vhdl-project' (permanently) or from
4346 the menu or speedbar (temporarily). For each project, title and
4347 description strings (for the file headers), source files/directories
4348 (for the hierarchy browser and Makefile generation), library name, and
4349 compiler-dependent options, exceptions and compilation directory can be
4350 specified. Compilation settings overwrite the settings of option
4351 `vhdl-compiler-alist'.
4353 Project setups can be exported (i.e. written to a file) and imported.
4354 Imported setups are not automatically saved in `vhdl-project-alist' but
4355 can be saved afterwards in its customization buffer. When starting
4356 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4357 vhdl-mode\") in a directory with an existing project setup file, it is
4358 automatically loaded and its project activated if option
4359 `vhdl-project-auto-load' is non-nil. Names/paths of the project setup
4360 files can be specified in option `vhdl-project-file-name'. Multiple
4361 project setups can be automatically loaded from global directories.
4362 This is an alternative to specifying project setups with option
4363 `vhdl-project-alist'.
4366 SPECIAL MENUES:
4367 As an alternative to the speedbar, an index menu can be added (set
4368 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4369 (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4370 file) for browsing the file contents (is not populated if buffer is
4371 larger than `font-lock-maximum-size'). Also, a source file menu can be
4372 added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4373 current directory for VHDL source files.
4376 VHDL STANDARDS:
4377 The VHDL standards to be used are specified in option `vhdl-standard'.
4378 Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
4381 KEYWORD CASE:
4382 Lower and upper case for keywords and standardized types, attributes,
4383 and enumeration values is supported. If the option
4384 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4385 lower case and are converted into upper case automatically (not for
4386 types, attributes, and enumeration values). The case of keywords,
4387 types, attributes,and enumeration values can be fixed for an entire
4388 region (menu) or buffer (`C-c C-x C-c') according to the options
4389 `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4392 HIGHLIGHTING (fontification):
4393 Keywords and standardized types, attributes, enumeration values, and
4394 function names (controlled by option `vhdl-highlight-keywords'), as well
4395 as comments, strings, and template prompts are highlighted using
4396 different colors. Unit, subprogram, signal, variable, constant,
4397 parameter and generic/port names in declarations as well as labels are
4398 highlighted if option `vhdl-highlight-names' is non-nil.
4400 Additional reserved words or words with a forbidden syntax (e.g. words
4401 that should be avoided) can be specified in option
4402 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4403 a warning color (option `vhdl-highlight-forbidden-words'). Verilog
4404 keywords are highlighted as forbidden words if option
4405 `vhdl-highlight-verilog-keywords' is non-nil.
4407 Words with special syntax can be highlighted by specifying their
4408 syntax and color in option `vhdl-special-syntax-alist' and by setting
4409 option `vhdl-highlight-special-words' to non-nil. This allows to
4410 establish some naming conventions (e.g. to distinguish different kinds
4411 of signals or other objects by using name suffices) and to support them
4412 visually.
4414 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4415 to support case-sensitive highlighting. However, keywords are then only
4416 highlighted if written in lower case.
4418 Code between \"translate_off\" and \"translate_on\" pragmas is
4419 highlighted using a different background color if option
4420 `vhdl-highlight-translate-off' is non-nil.
4422 For documentation and customization of the used colors see
4423 customization group `vhdl-highlight-faces' (`M-x customize-group'). For
4424 highlighting of matching parenthesis, see customization group
4425 `paren-showing'. Automatic buffer highlighting is turned on/off by
4426 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4429 USER MODELS:
4430 VHDL models (templates) can be specified by the user and made accessible
4431 in the menu, through key bindings (`C-c C-m ...'), or by keyword
4432 electrification. See option `vhdl-model-alist'.
4435 HIDE/SHOW:
4436 The code of blocks, processes, subprograms, component declarations and
4437 instantiations, generic/port clauses, and configuration declarations can
4438 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4439 the code (see customization group `vhdl-menu'). XEmacs: limited
4440 functionality due to old `hideshow.el' package.
4443 CODE UPDATING:
4444 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4445 current process, `C-c C-u M-s' of all processes in the current buffer.
4446 Limitations:
4447 - Only declared local signals (ports, signals declared in
4448 architecture and blocks) are automatically inserted.
4449 - Global signals declared in packages are not automatically inserted.
4450 Insert them once manually (will be kept afterwards).
4451 - Out parameters of procedures are considered to be read.
4452 Use option `vhdl-entity-file-name' to specify the entity file name
4453 \(used to obtain the port names).
4456 CODE FIXING:
4457 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4458 \(e.g. if the closing parenthesis is on the wrong line or is missing).
4461 PRINTING:
4462 Postscript printing with different faces (an optimized set of faces is
4463 used if `vhdl-print-customize-faces' is non-nil) or colors \(if
4464 `ps-print-color-p' is non-nil) is possible using the standard Emacs
4465 postscript printing commands. Option `vhdl-print-two-column' defines
4466 appropriate default settings for nice landscape two-column printing.
4467 The paper format can be set by option `ps-paper-type'. Do not forget to
4468 switch `ps-print-color-p' to nil for printing on black-and-white
4469 printers.
4472 OPTIONS:
4473 User options allow customization of VHDL Mode. All options are
4474 accessible from the \"Options\" menu entry. Simple options (switches
4475 and choices) can directly be changed, while for complex options a
4476 customization buffer is opened. Changed options can be saved for future
4477 sessions using the \"Save Options\" menu entry.
4479 Options and their detailed descriptions can also be accessed by using
4480 the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
4481 customize-group' for groups). Some customizations only take effect
4482 after some action (read the NOTE in the option documentation).
4483 Customization can also be done globally (i.e. site-wide, read the
4484 INSTALL file).
4486 Not all options are described in this documentation, so go and see
4487 what other useful user options there are (`M-x vhdl-customize' or menu)!
4490 FILE EXTENSIONS:
4491 As default, files with extensions \".vhd\" and \".vhdl\" are
4492 automatically recognized as VHDL source files. To add an extension
4493 \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4495 \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
4498 HINTS:
4499 - To start Emacs with open VHDL hierarchy browser without having to load
4500 a VHDL file first, use the command:
4502 emacs -l vhdl-mode -f speedbar-frame-mode
4504 - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4506 - Some features only work on properly indented code.
4509 RELEASE NOTES:
4510 See also the release notes (menu) for added features in new releases.
4513 Maintenance:
4514 ------------
4516 To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
4517 Add a description of the problem and include a reproducible test case.
4519 Questions and enhancement requests can be sent to <reto@gnu.org>.
4521 The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4522 The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4523 releases. You are kindly invited to participate in beta testing. Subscribe
4524 to above mailing lists by sending an email to <reto@gnu.org>.
4526 VHDL Mode is officially distributed at
4527 http://opensource.ethz.ch/emacs/vhdl-mode.html
4528 where the latest version can be found.
4531 Known problems:
4532 ---------------
4534 - Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
4535 - XEmacs: Incorrect start-up when automatically opening speedbar.
4536 - XEmacs: Indentation in XEmacs 21.4 (and higher).
4539 The VHDL Mode Authors
4540 Reto Zimmermann and Rod Whitby
4542 Key bindings:
4543 -------------
4545 \\{vhdl-mode-map}"
4546 (interactive)
4547 (kill-all-local-variables)
4548 (setq major-mode 'vhdl-mode)
4549 (setq mode-name "VHDL")
4551 ;; set maps and tables
4552 (use-local-map vhdl-mode-map)
4553 (set-syntax-table vhdl-mode-syntax-table)
4554 (setq local-abbrev-table vhdl-mode-abbrev-table)
4556 ;; set local variables
4557 (set (make-local-variable 'paragraph-start)
4558 "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
4559 (set (make-local-variable 'paragraph-separate) paragraph-start)
4560 (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4561 (set (make-local-variable 'require-final-newline) t)
4562 (set (make-local-variable 'parse-sexp-ignore-comments) t)
4563 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
4564 (set (make-local-variable 'comment-start) "--")
4565 (set (make-local-variable 'comment-end) "")
4566 (when vhdl-emacs-21
4567 (set (make-local-variable 'comment-padding) ""))
4568 (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4569 (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4570 (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4571 (set (make-local-variable 'comment-multi-line) nil)
4572 (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
4573 (set (make-local-variable 'hippie-expand-verbose) nil)
4575 ;; setup the comment indent variable in a Emacs version portable way
4576 ;; ignore any byte compiler warnings you might get here
4577 (when (boundp 'comment-indent-function)
4578 (make-local-variable 'comment-indent-function)
4579 (setq comment-indent-function 'vhdl-comment-indent))
4581 ;; initialize font locking
4582 (set (make-local-variable 'font-lock-defaults)
4583 (list
4584 '(nil vhdl-font-lock-keywords) nil
4585 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
4586 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
4587 (unless vhdl-emacs-21
4588 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4589 (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4590 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4591 ; (set (make-local-variable 'lazy-lock-defer-time) 0.1)
4592 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4593 ; (turn-on-font-lock)
4595 ;; variables for source file compilation
4596 (when vhdl-compile-use-local-error-regexp
4597 (set (make-local-variable 'compilation-error-regexp-alist) nil)
4598 (set (make-local-variable 'compilation-file-regexp-alist) nil))
4600 ;; add index menu
4601 (vhdl-index-menu-init)
4602 ;; add source file menu
4603 (if vhdl-source-file-menu (vhdl-add-source-files-menu))
4604 ;; add VHDL menu
4605 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs
4606 (easy-menu-define vhdl-mode-menu vhdl-mode-map
4607 "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4608 ;; initialize hideshow and add menu
4609 (vhdl-hideshow-init)
4610 (run-hooks 'menu-bar-update-hook)
4612 ;; miscellaneous
4613 (vhdl-ps-print-init)
4614 (vhdl-write-file-hooks-init)
4615 (vhdl-mode-line-update)
4616 (message "VHDL Mode %s.%s" vhdl-version
4617 (if noninteractive "" " See menu for documentation and release notes."))
4619 ;; run hooks
4620 (run-hooks 'vhdl-mode-hook))
4622 (defun vhdl-activate-customizations ()
4623 "Activate all customizations on local variables."
4624 (interactive)
4625 (vhdl-mode-map-init)
4626 (use-local-map vhdl-mode-map)
4627 (set-syntax-table vhdl-mode-syntax-table)
4628 (setq comment-column vhdl-inline-comment-column)
4629 (setq end-comment-column vhdl-end-comment-column)
4630 (vhdl-write-file-hooks-init)
4631 (vhdl-update-mode-menu)
4632 (vhdl-hideshow-init)
4633 (run-hooks 'menu-bar-update-hook)
4634 (vhdl-mode-line-update))
4636 (defun vhdl-write-file-hooks-init ()
4637 "Add/remove hooks when buffer is saved."
4638 (if vhdl-modify-date-on-saving
4639 (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)
4640 (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror))
4641 (make-local-variable 'after-save-hook)
4642 (add-hook 'after-save-hook 'vhdl-add-modified-file))
4644 (defun vhdl-process-command-line-option (option)
4645 "Process command line options for VHDL Mode."
4646 (cond
4647 ;; set compiler
4648 ((equal option "-compiler")
4649 (vhdl-set-compiler (car command-line-args-left))
4650 (setq command-line-args-left (cdr command-line-args-left)))
4651 ;; set project
4652 ((equal option "-project")
4653 (vhdl-set-project (car command-line-args-left))
4654 (setq command-line-args-left (cdr command-line-args-left)))))
4656 ;; make Emacs process VHDL Mode options
4657 (setq command-switch-alist
4658 (append command-switch-alist
4659 '(("-compiler" . vhdl-process-command-line-option)
4660 ("-project" . vhdl-process-command-line-option))))
4663 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4664 ;;; Keywords and standardized words
4665 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4667 (defconst vhdl-93-keywords
4669 "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4670 "assert" "attribute"
4671 "begin" "block" "body" "buffer" "bus"
4672 "case" "component" "configuration" "constant"
4673 "disconnect" "downto"
4674 "else" "elsif" "end" "entity" "exit"
4675 "file" "for" "function"
4676 "generate" "generic" "group" "guarded"
4677 "if" "impure" "in" "inertial" "inout" "is"
4678 "label" "library" "linkage" "literal" "loop"
4679 "map" "mod"
4680 "nand" "new" "next" "nor" "not" "null"
4681 "of" "on" "open" "or" "others" "out"
4682 "package" "port" "postponed" "procedure" "process" "pure"
4683 "range" "record" "register" "reject" "rem" "report" "return"
4684 "rol" "ror"
4685 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
4686 "then" "to" "transport" "type"
4687 "unaffected" "units" "until" "use"
4688 "variable"
4689 "wait" "when" "while" "with"
4690 "xnor" "xor"
4692 "List of VHDL'93 keywords.")
4694 (defconst vhdl-ams-keywords
4696 "across" "break" "limit" "nature" "noise" "procedural" "quantity"
4697 "reference" "spectrum" "subnature" "terminal" "through"
4698 "tolerance"
4700 "List of VHDL-AMS keywords.")
4702 (defconst vhdl-verilog-keywords
4704 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
4705 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
4706 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
4707 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
4708 "endprimitive" "endspecify" "endtable" "endtask" "event"
4709 "for" "force" "forever" "fork" "function"
4710 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
4711 "macromodule" "makefile" "medium" "module"
4712 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
4713 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
4714 "pullup"
4715 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
4716 "rtranif0" "rtranif1"
4717 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
4718 "strong1" "supply" "supply0" "supply1"
4719 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
4720 "triand" "trior" "trireg"
4721 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
4723 "List of Verilog keywords as candidate for additional reserved words.")
4725 (defconst vhdl-93-types
4727 "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
4728 "real" "time" "natural" "positive" "string" "line" "text" "side"
4729 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
4730 "std_logic" "std_logic_vector"
4731 "std_ulogic" "std_ulogic_vector"
4733 "List of VHDL'93 standardized types.")
4735 (defconst vhdl-ams-types
4737 "domain_type" "real_vector"
4738 ;; from `nature_pkg' package
4739 "voltage" "current" "electrical" "position" "velocity" "force"
4740 "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational"
4741 "pressure" "flowrate" "fluid"
4743 "List of VHDL-AMS standardized types.")
4745 (defconst vhdl-math-types
4747 "complex" "complex_polar"
4749 "List of Math Packages standardized types.")
4751 (defconst vhdl-93-attributes
4753 "base" "left" "right" "high" "low" "pos" "val" "succ"
4754 "pred" "leftof" "rightof" "range" "reverse_range"
4755 "length" "delayed" "stable" "quiet" "transaction"
4756 "event" "active" "last_event" "last_active" "last_value"
4757 "driving" "driving_value" "ascending" "value" "image"
4758 "simple_name" "instance_name" "path_name"
4759 "foreign"
4761 "List of VHDL'93 standardized attributes.")
4763 (defconst vhdl-ams-attributes
4765 "across" "through"
4766 "reference" "contribution" "tolerance"
4767 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
4768 "ramp" "slew"
4770 "List of VHDL-AMS standardized attributes.")
4772 (defconst vhdl-93-enum-values
4774 "true" "false"
4775 "note" "warning" "error" "failure"
4776 "read_mode" "write_mode" "append_mode"
4777 "open_ok" "status_error" "name_error" "mode_error"
4778 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
4779 "right" "left"
4781 "List of VHDL'93 standardized enumeration values.")
4783 (defconst vhdl-ams-enum-values
4785 "quiescent_domain" "time_domain" "frequency_domain"
4786 ;; from `nature_pkg' package
4787 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
4789 "List of VHDL-AMS standardized enumeration values.")
4791 (defconst vhdl-math-constants
4793 "math_e" "math_1_over_e"
4794 "math_pi" "math_two_pi" "math_1_over_pi"
4795 "math_half_pi" "math_q_pi" "math_3_half_pi"
4796 "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e"
4797 "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi"
4798 "math_deg_to_rad" "math_rad_to_deg"
4799 "cbase_1" "cbase_j" "czero"
4801 "List of Math Packages standardized constants.")
4803 (defconst vhdl-93-functions
4805 "now" "resolved" "rising_edge" "falling_edge"
4806 "read" "readline" "write" "writeline" "endfile"
4807 "resize" "is_X" "std_match"
4808 "shift_left" "shift_right" "rotate_left" "rotate_right"
4809 "to_unsigned" "to_signed" "to_integer"
4810 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
4811 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
4812 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
4813 "shl" "shr" "ext" "sxt"
4814 "deallocate"
4816 "List of VHDL'93 standardized functions.")
4818 (defconst vhdl-ams-functions
4820 "frequency"
4822 "List of VHDL-AMS standardized functions.")
4824 (defconst vhdl-math-functions
4826 "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform"
4827 "sqrt" "cbrt" "exp" "log"
4828 "sin" "cos" "tan" "arcsin" "arccos" "arctan"
4829 "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh"
4830 "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj"
4832 "List of Math Packages standardized functions.")
4834 (defconst vhdl-93-packages
4836 "std_logic_1164" "numeric_std" "numeric_bit"
4837 "standard" "textio"
4838 "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
4839 "std_logic_misc" "std_logic_textio"
4840 "ieee" "std" "work"
4842 "List of VHDL'93 standardized packages and libraries.")
4844 (defconst vhdl-ams-packages
4846 ;; from `nature_pkg' package
4847 "nature_pkg"
4849 "List of VHDL-AMS standardized packages and libraries.")
4851 (defconst vhdl-math-packages
4853 "math_real" "math_complex"
4855 "List of Math Packages standardized packages and libraries.")
4857 (defvar vhdl-keywords nil
4858 "List of VHDL keywords.")
4860 (defvar vhdl-types nil
4861 "List of VHDL standardized types.")
4863 (defvar vhdl-attributes nil
4864 "List of VHDL standardized attributes.")
4866 (defvar vhdl-enum-values nil
4867 "List of VHDL standardized enumeration values.")
4869 (defvar vhdl-constants nil
4870 "List of VHDL standardized constants.")
4872 (defvar vhdl-functions nil
4873 "List of VHDL standardized functions.")
4875 (defvar vhdl-packages nil
4876 "List of VHDL standardized packages and libraries.")
4878 (defvar vhdl-reserved-words nil
4879 "List of additional reserved words.")
4881 (defvar vhdl-keywords-regexp nil
4882 "Regexp for VHDL keywords.")
4884 (defvar vhdl-types-regexp nil
4885 "Regexp for VHDL standardized types.")
4887 (defvar vhdl-attributes-regexp nil
4888 "Regexp for VHDL standardized attributes.")
4890 (defvar vhdl-enum-values-regexp nil
4891 "Regexp for VHDL standardized enumeration values.")
4893 (defvar vhdl-functions-regexp nil
4894 "Regexp for VHDL standardized functions.")
4896 (defvar vhdl-packages-regexp nil
4897 "Regexp for VHDL standardized packages and libraries.")
4899 (defvar vhdl-reserved-words-regexp nil
4900 "Regexp for additional reserved words.")
4902 (defvar vhdl-directive-keywords-regexp nil
4903 "Regexp for compiler directive keywords.")
4905 (defun vhdl-words-init ()
4906 "Initialize reserved words."
4907 (setq vhdl-keywords
4908 (append vhdl-93-keywords
4909 (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))
4910 (setq vhdl-types
4911 (append vhdl-93-types
4912 (when (vhdl-standard-p 'ams) vhdl-ams-types)
4913 (when (vhdl-standard-p 'math) vhdl-math-types)))
4914 (setq vhdl-attributes
4915 (append vhdl-93-attributes
4916 (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))
4917 (setq vhdl-enum-values
4918 (append vhdl-93-enum-values
4919 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))
4920 (setq vhdl-constants
4921 (append (when (vhdl-standard-p 'math) vhdl-math-constants)))
4922 (setq vhdl-functions
4923 (append vhdl-93-functions
4924 (when (vhdl-standard-p 'ams) vhdl-ams-functions)
4925 (when (vhdl-standard-p 'math) vhdl-math-functions)))
4926 (setq vhdl-packages
4927 (append vhdl-93-packages
4928 (when (vhdl-standard-p 'ams) vhdl-ams-packages)
4929 (when (vhdl-standard-p 'math) vhdl-math-packages)))
4930 (setq vhdl-reserved-words
4931 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
4932 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
4933 '("")))
4934 (setq vhdl-keywords-regexp
4935 (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>"))
4936 (setq vhdl-types-regexp
4937 (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>"))
4938 (setq vhdl-attributes-regexp
4939 (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
4940 (setq vhdl-enum-values-regexp
4941 (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
4942 (setq vhdl-functions-regexp
4943 (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
4944 (setq vhdl-packages-regexp
4945 (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>"))
4946 (setq vhdl-reserved-words-regexp
4947 (concat "\\<\\("
4948 (unless (equal vhdl-forbidden-syntax "")
4949 (concat vhdl-forbidden-syntax "\\|"))
4950 (regexp-opt vhdl-reserved-words)
4951 "\\)\\>"))
4952 (setq vhdl-directive-keywords-regexp
4953 (concat "\\<\\(" (mapconcat 'regexp-quote
4954 vhdl-directive-keywords "\\|") "\\)\\>"))
4955 (vhdl-abbrev-list-init))
4957 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4958 ;; Words to expand
4960 (defvar vhdl-abbrev-list nil
4961 "Predefined abbreviations for VHDL.")
4963 (defun vhdl-abbrev-list-init ()
4964 (setq vhdl-abbrev-list
4965 (append
4966 (list vhdl-upper-case-keywords) vhdl-keywords
4967 (list vhdl-upper-case-types) vhdl-types
4968 (list vhdl-upper-case-attributes) vhdl-attributes
4969 (list vhdl-upper-case-enum-values) vhdl-enum-values
4970 (list vhdl-upper-case-constants) vhdl-constants
4971 (list nil) vhdl-functions
4972 (list nil) vhdl-packages)))
4974 ;; initialize reserved words for VHDL Mode
4975 (vhdl-words-init)
4978 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4979 ;;; Indentation
4980 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4982 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4983 ;; Syntax analysis
4985 ;; constant regular expressions for looking at various constructs
4987 (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
4988 "Regexp describing a VHDL symbol.
4989 We cannot use just `word' syntax class since `_' cannot be in word
4990 class. Putting underscore in word class breaks forward word movement
4991 behavior that users are familiar with.")
4993 (defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is"
4994 "Regexp describing a case statement header key.")
4996 (defconst vhdl-label-key
4997 (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]")
4998 "Regexp describing a VHDL label.")
5000 ;; Macro definitions:
5002 (defmacro vhdl-point (position)
5003 "Return the value of point at certain commonly referenced POSITIONs.
5004 POSITION can be one of the following symbols:
5006 bol -- beginning of line
5007 eol -- end of line
5008 bod -- beginning of defun
5009 boi -- back to indentation
5010 eoi -- last whitespace on line
5011 ionl -- indentation of next line
5012 iopl -- indentation of previous line
5013 bonl -- beginning of next line
5014 bopl -- beginning of previous line
5016 This function does not modify point or mark."
5017 (or (and (eq 'quote (car-safe position))
5018 (null (cddr position)))
5019 (error "ERROR: Bad buffer position requested: %s" position))
5020 (setq position (nth 1 position))
5021 `(let ((here (point)))
5022 ,@(cond
5023 ((eq position 'bol) '((beginning-of-line)))
5024 ((eq position 'eol) '((end-of-line)))
5025 ((eq position 'bod) '((save-match-data
5026 (vhdl-beginning-of-defun))))
5027 ((eq position 'boi) '((back-to-indentation)))
5028 ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t")))
5029 ((eq position 'bonl) '((forward-line 1)))
5030 ((eq position 'bopl) '((forward-line -1)))
5031 ((eq position 'iopl)
5032 '((forward-line -1)
5033 (back-to-indentation)))
5034 ((eq position 'ionl)
5035 '((forward-line 1)
5036 (back-to-indentation)))
5037 (t (error "ERROR: Unknown buffer position requested: %s" position))
5039 (prog1
5040 (point)
5041 (goto-char here))
5042 ;; workaround for an Emacs18 bug -- blech! Well, at least it
5043 ;; doesn't hurt for v19
5044 ,@nil
5047 (defmacro vhdl-safe (&rest body)
5048 "Safely execute BODY, return nil if an error occurred."
5049 `(condition-case nil
5050 (progn ,@body)
5051 (error nil)))
5053 (defmacro vhdl-add-syntax (symbol &optional relpos)
5054 "A simple macro to append the syntax in SYMBOL to the syntax list.
5055 Try to increase performance by using this macro."
5056 `(setq vhdl-syntactic-context
5057 (cons (cons ,symbol ,relpos) vhdl-syntactic-context)))
5059 (defmacro vhdl-has-syntax (symbol)
5060 "A simple macro to return check the syntax list.
5061 Try to increase performance by using this macro."
5062 `(assoc ,symbol vhdl-syntactic-context))
5064 ;; Syntactic element offset manipulation:
5066 (defun vhdl-read-offset (langelem)
5067 "Read new offset value for LANGELEM from minibuffer.
5068 Return a legal value only."
5069 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
5070 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5071 (prompt "Offset: ")
5072 offset input interned)
5073 (while (not offset)
5074 (setq input (read-string prompt oldoff)
5075 offset (cond ((string-equal "+" input) '+)
5076 ((string-equal "-" input) '-)
5077 ((string-equal "++" input) '++)
5078 ((string-equal "--" input) '--)
5079 ((string-match "^-?[0-9]+$" input)
5080 (string-to-int input))
5081 ((fboundp (setq interned (intern input)))
5082 interned)
5083 ((boundp interned) interned)
5084 ;; error, but don't signal one, keep trying
5085 ;; to read an input value
5086 (t (ding)
5087 (setq prompt errmsg)
5088 nil))))
5089 offset))
5091 (defun vhdl-set-offset (symbol offset &optional add-p)
5092 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5093 SYMBOL is the syntactic element symbol to change and OFFSET is the new
5094 offset for that syntactic element. Optional ADD says to add SYMBOL to
5095 `vhdl-offsets-alist' if it doesn't already appear there."
5096 (interactive
5097 (let* ((langelem
5098 (intern (completing-read
5099 (concat "Syntactic symbol to change"
5100 (if current-prefix-arg " or add" "")
5101 ": ")
5102 (mapcar
5103 (function
5104 (lambda (langelem)
5105 (cons (format "%s" (car langelem)) nil)))
5106 vhdl-offsets-alist)
5107 nil (not current-prefix-arg)
5108 ;; initial contents tries to be the last element
5109 ;; on the syntactic analysis list for the current
5110 ;; line
5111 (let* ((syntax (vhdl-get-syntactic-context))
5112 (len (length syntax))
5113 (ic (format "%s" (car (nth (1- len) syntax)))))
5116 (offset (vhdl-read-offset langelem)))
5117 (list langelem offset current-prefix-arg)))
5118 ;; sanity check offset
5119 (or (eq offset '+)
5120 (eq offset '-)
5121 (eq offset '++)
5122 (eq offset '--)
5123 (integerp offset)
5124 (fboundp offset)
5125 (boundp offset)
5126 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s"
5127 offset))
5128 (let ((entry (assq symbol vhdl-offsets-alist)))
5129 (if entry
5130 (setcdr entry offset)
5131 (if add-p
5132 (setq vhdl-offsets-alist
5133 (cons (cons symbol offset) vhdl-offsets-alist))
5134 (error "ERROR: %s is not a valid syntactic symbol" symbol))))
5135 (vhdl-keep-region-active))
5137 (defun vhdl-set-style (style &optional local)
5138 "Set `vhdl-mode' variables to use one of several different indentation styles.
5139 STYLE is a string representing the desired style and optional LOCAL is
5140 a flag which, if non-nil, means to make the style variables being
5141 changed buffer local, instead of the default, which is to set the
5142 global variables. Interactively, the flag comes from the prefix
5143 argument. The styles are chosen from the `vhdl-style-alist' variable."
5144 (interactive (list (completing-read "Use which VHDL indentation style? "
5145 vhdl-style-alist nil t)
5146 current-prefix-arg))
5147 (let ((vars (cdr (assoc style vhdl-style-alist))))
5148 (or vars
5149 (error "ERROR: Invalid VHDL indentation style `%s'" style))
5150 ;; set all the variables
5151 (mapcar
5152 (function
5153 (lambda (varentry)
5154 (let ((var (car varentry))
5155 (val (cdr varentry)))
5156 (and local
5157 (make-local-variable var))
5158 ;; special case for vhdl-offsets-alist
5159 (if (not (eq var 'vhdl-offsets-alist))
5160 (set var val)
5161 ;; reset vhdl-offsets-alist to the default value first
5162 (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default))
5163 ;; now set the langelems that are different
5164 (mapcar
5165 (function
5166 (lambda (langentry)
5167 (let ((langelem (car langentry))
5168 (offset (cdr langentry)))
5169 (vhdl-set-offset langelem offset)
5171 val))
5173 vars))
5174 (vhdl-keep-region-active))
5176 (defun vhdl-get-offset (langelem)
5177 "Get offset from LANGELEM which is a cons cell of the form:
5178 \(SYMBOL . RELPOS). The symbol is matched against
5179 vhdl-offsets-alist and the offset found there is either returned,
5180 or added to the indentation at RELPOS. If RELPOS is nil, then
5181 the offset is simply returned."
5182 (let* ((symbol (car langelem))
5183 (relpos (cdr langelem))
5184 (match (assq symbol vhdl-offsets-alist))
5185 (offset (cdr-safe match)))
5186 ;; offset can be a number, a function, a variable, or one of the
5187 ;; symbols + or -
5188 (cond
5189 ((not match)
5190 (if vhdl-strict-syntax-p
5191 (error "ERROR: Don't know how to indent a %s" symbol)
5192 (setq offset 0
5193 relpos 0)))
5194 ((eq offset '+) (setq offset vhdl-basic-offset))
5195 ((eq offset '-) (setq offset (- vhdl-basic-offset)))
5196 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
5197 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
5198 ((and (not (numberp offset))
5199 (fboundp offset))
5200 (setq offset (funcall offset langelem)))
5201 ((not (numberp offset))
5202 (setq offset (eval offset)))
5204 (+ (if (and relpos
5205 (< relpos (vhdl-point 'bol)))
5206 (save-excursion
5207 (goto-char relpos)
5208 (current-column))
5210 offset)))
5212 ;; Syntactic support functions:
5214 (defun vhdl-in-comment-p ()
5215 "Check if point is in a comment."
5216 (eq (vhdl-in-literal) 'comment))
5218 (defun vhdl-in-string-p ()
5219 "Check if point is in a string."
5220 (eq (vhdl-in-literal) 'string))
5222 (defun vhdl-in-literal ()
5223 "Determine if point is in a VHDL literal."
5224 (save-excursion
5225 (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
5226 (cond
5227 ((nth 3 state) 'string)
5228 ((nth 4 state) 'comment)
5229 (t nil)))))
5231 (defun vhdl-forward-comment (&optional direction)
5232 "Skip all comments (including whitespace). Skip backwards if DIRECTION is
5233 negative, skip forward otherwise."
5234 (interactive "p")
5235 (if (and direction (< direction 0))
5236 ;; skip backwards
5237 (progn
5238 (skip-chars-backward " \t\n")
5239 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5240 (goto-char (match-beginning 3))
5241 (skip-chars-backward " \t\n")))
5242 ;; skip forwards
5243 (skip-chars-forward " \t\n")
5244 (while (looking-at "--.*")
5245 (goto-char (match-end 0))
5246 (skip-chars-forward " \t\n"))))
5248 ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5249 (unless (and vhdl-xemacs (string< "21.2" emacs-version))
5250 (defalias 'vhdl-forward-comment 'forward-comment))
5252 ;; This is the best we can do in Win-Emacs.
5253 (defun vhdl-win-il (&optional lim)
5254 "Determine if point is in a VHDL literal."
5255 (save-excursion
5256 (let* ((here (point))
5257 (state nil)
5258 (match nil)
5259 (lim (or lim (vhdl-point 'bod))))
5260 (goto-char lim )
5261 (while (< (point) here)
5262 (setq match
5263 (and (re-search-forward "--\\|[\"']"
5264 here 'move)
5265 (buffer-substring (match-beginning 0) (match-end 0))))
5266 (setq state
5267 (cond
5268 ;; no match
5269 ((null match) nil)
5270 ;; looking at the opening of a VHDL style comment
5271 ((string= "--" match)
5272 (if (<= here (progn (end-of-line) (point))) 'comment))
5273 ;; looking at the opening of a double quote string
5274 ((string= "\"" match)
5275 (if (not (save-restriction
5276 ;; this seems to be necessary since the
5277 ;; re-search-forward will not work without it
5278 (narrow-to-region (point) here)
5279 (re-search-forward
5280 ;; this regexp matches a double quote
5281 ;; which is preceded by an even number
5282 ;; of backslashes, including zero
5283 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
5284 'string))
5285 ;; looking at the opening of a single quote string
5286 ((string= "'" match)
5287 (if (not (save-restriction
5288 ;; see comments from above
5289 (narrow-to-region (point) here)
5290 (re-search-forward
5291 ;; this matches a single quote which is
5292 ;; preceded by zero or two backslashes.
5293 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5294 here 'move)))
5295 'string))
5296 (t nil)))
5297 ) ; end-while
5298 state)))
5300 (and (string-match "Win-Emacs" emacs-version)
5301 (fset 'vhdl-in-literal 'vhdl-win-il))
5303 ;; Skipping of "syntactic whitespace". Syntactic whitespace is
5304 ;; defined as lexical whitespace or comments. Search no farther back
5305 ;; or forward than optional LIM. If LIM is omitted, (point-min) is
5306 ;; used for backward skipping, (point-max) is used for forward
5307 ;; skipping.
5309 (defun vhdl-forward-syntactic-ws (&optional lim)
5310 "Forward skip of syntactic whitespace."
5311 (save-restriction
5312 (let* ((lim (or lim (point-max)))
5313 (here lim)
5314 (hugenum (point-max)))
5315 (narrow-to-region lim (point))
5316 (while (/= here (point))
5317 (setq here (point))
5318 (vhdl-forward-comment hugenum)))))
5320 ;; This is the best we can do in Win-Emacs.
5321 (defun vhdl-win-fsws (&optional lim)
5322 "Forward skip syntactic whitespace for Win-Emacs."
5323 (let ((lim (or lim (point-max)))
5324 stop)
5325 (while (not stop)
5326 (skip-chars-forward " \t\n\r\f" lim)
5327 (cond
5328 ;; vhdl comment
5329 ((looking-at "--") (end-of-line))
5330 ;; none of the above
5331 (t (setq stop t))))))
5333 (and (string-match "Win-Emacs" emacs-version)
5334 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
5336 (defun vhdl-backward-syntactic-ws (&optional lim)
5337 "Backward skip over syntactic whitespace."
5338 (save-restriction
5339 (let* ((lim (or lim (point-min)))
5340 (here lim)
5341 (hugenum (- (point-max))))
5342 (if (< lim (point))
5343 (progn
5344 (narrow-to-region lim (point))
5345 (while (/= here (point))
5346 (setq here (point))
5347 (vhdl-forward-comment hugenum)))))))
5349 ;; This is the best we can do in Win-Emacs.
5350 (defun vhdl-win-bsws (&optional lim)
5351 "Backward skip syntactic whitespace for Win-Emacs."
5352 (let ((lim (or lim (vhdl-point 'bod)))
5353 stop)
5354 (while (not stop)
5355 (skip-chars-backward " \t\n\r\f" lim)
5356 (cond
5357 ;; vhdl comment
5358 ((eq (vhdl-in-literal) 'comment)
5359 (skip-chars-backward "^-" lim)
5360 (skip-chars-backward "-" lim)
5361 (while (not (or (and (= (following-char) ?-)
5362 (= (char-after (1+ (point))) ?-))
5363 (<= (point) lim)))
5364 (skip-chars-backward "^-" lim)
5365 (skip-chars-backward "-" lim)))
5366 ;; none of the above
5367 (t (setq stop t))))))
5369 (and (string-match "Win-Emacs" emacs-version)
5370 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
5372 ;; Functions to help finding the correct indentation column:
5374 (defun vhdl-first-word (point)
5375 "If the keyword at POINT is at boi, then return (current-column) at
5376 that point, else nil."
5377 (save-excursion
5378 (and (goto-char point)
5379 (eq (point) (vhdl-point 'boi))
5380 (current-column))))
5382 (defun vhdl-last-word (point)
5383 "If the keyword at POINT is at eoi, then return (current-column) at
5384 that point, else nil."
5385 (save-excursion
5386 (and (goto-char point)
5387 (save-excursion (or (eq (progn (forward-sexp) (point))
5388 (vhdl-point 'eoi))
5389 (looking-at "\\s-*\\(--\\)?")))
5390 (current-column))))
5392 ;; Core syntactic evaluation functions:
5394 (defconst vhdl-libunit-re
5395 "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]")
5397 (defun vhdl-libunit-p ()
5398 (and
5399 (save-excursion
5400 (forward-sexp)
5401 (skip-chars-forward " \t\n")
5402 (not (looking-at "is\\b[^_]")))
5403 (save-excursion
5404 (backward-sexp)
5405 (and (not (looking-at "use\\b[^_]"))
5406 (progn
5407 (forward-sexp)
5408 (vhdl-forward-syntactic-ws)
5409 (/= (following-char) ?:))))
5412 (defconst vhdl-defun-re
5413 "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5415 (defun vhdl-defun-p ()
5416 (save-excursion
5417 (if (looking-at "block\\|process\\|procedural")
5418 ;; "block", "process", "procedural":
5419 (save-excursion
5420 (backward-sexp)
5421 (not (looking-at "end\\s-+\\w")))
5422 ;; "architecture", "configuration", "entity",
5423 ;; "package", "procedure", "function":
5424 t)))
5426 (defun vhdl-corresponding-defun ()
5427 "If the word at the current position corresponds to a \"defun\"
5428 keyword, then return a string that can be used to find the
5429 corresponding \"begin\" keyword, else return nil."
5430 (save-excursion
5431 (and (looking-at vhdl-defun-re)
5432 (vhdl-defun-p)
5433 (if (looking-at "block\\|process\\|procedural")
5434 ;; "block", "process". "procedural:
5435 (buffer-substring (match-beginning 0) (match-end 0))
5436 ;; "architecture", "configuration", "entity", "package",
5437 ;; "procedure", "function":
5438 "is"))))
5440 (defconst vhdl-begin-fwd-re
5441 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)"
5442 "A regular expression for searching forward that matches all known
5443 \"begin\" keywords.")
5445 (defconst vhdl-begin-bwd-re
5446 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b[^_]"
5447 "A regular expression for searching backward that matches all known
5448 \"begin\" keywords.")
5450 (defun vhdl-begin-p (&optional lim)
5451 "Return t if we are looking at a real \"begin\" keyword.
5452 Assumes that the caller will make sure that we are looking at
5453 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5454 the middle of an identifier that just happens to contain a \"begin\"
5455 keyword."
5456 (cond
5457 ;; "[architecture|case|configuration|entity|package|
5458 ;; procedure|function] ... is":
5459 ((and (looking-at "i")
5460 (save-excursion
5461 ;; Skip backward over first sexp (needed to skip over a
5462 ;; procedure interface list, and is harmless in other
5463 ;; situations). Note that we need "return" in the
5464 ;; following search list so that we don't run into
5465 ;; semicolons in the function interface list.
5466 (backward-sexp)
5467 (let (foundp)
5468 (while (and (not foundp)
5469 (re-search-backward
5470 ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
5471 lim 'move))
5472 (if (or (= (preceding-char) ?_)
5473 (vhdl-in-literal))
5474 (backward-char)
5475 (setq foundp t))))
5476 (and (/= (following-char) ?\;)
5477 (not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
5479 ;; "begin", "then":
5480 ((looking-at "be\\|t")
5482 ;; "else":
5483 ((and (looking-at "e")
5484 ;; make sure that the "else" isn't inside a
5485 ;; conditional signal assignment.
5486 (save-excursion
5487 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
5488 (or (eq (following-char) ?\;)
5489 (eq (point) lim))))
5491 ;; "block", "generate", "loop", "process", "procedural",
5492 ;; "units", "record":
5493 ((and (looking-at "bl\\|[glpur]")
5494 (save-excursion
5495 (backward-sexp)
5496 (not (looking-at "end\\s-+\\w"))))
5498 ;; "component":
5499 ((and (looking-at "c")
5500 (save-excursion
5501 (backward-sexp)
5502 (not (looking-at "end\\s-+\\w")))
5503 ;; look out for the dreaded entity class in an attribute
5504 (save-excursion
5505 (vhdl-backward-syntactic-ws lim)
5506 (/= (preceding-char) ?:)))
5508 ;; "for" (inside configuration declaration):
5509 ((and (looking-at "f")
5510 (save-excursion
5511 (backward-sexp)
5512 (not (looking-at "end\\s-+\\w")))
5513 (vhdl-has-syntax 'configuration))
5517 (defun vhdl-corresponding-mid (&optional lim)
5518 (cond
5519 ((looking-at "is\\|block\\|generate\\|process\\|procedural")
5520 "begin")
5521 ((looking-at "then")
5522 "<else>")
5524 "end")))
5526 (defun vhdl-corresponding-end (&optional lim)
5527 "If the word at the current position corresponds to a \"begin\"
5528 keyword, then return a vector containing enough information to find
5529 the corresponding \"end\" keyword, else return nil. The keyword to
5530 search forward for is aref 0. The column in which the keyword must
5531 appear is aref 1 or nil if any column is suitable.
5532 Assumes that the caller will make sure that we are not in the middle
5533 of an identifier that just happens to contain a \"begin\" keyword."
5534 (save-excursion
5535 (and (looking-at vhdl-begin-fwd-re)
5536 (/= (preceding-char) ?_)
5537 (not (vhdl-in-literal))
5538 (vhdl-begin-p lim)
5539 (cond
5540 ;; "is", "generate", "loop":
5541 ((looking-at "[igl]")
5542 (vector "end"
5543 (and (vhdl-last-word (point))
5544 (or (vhdl-first-word (point))
5545 (save-excursion
5546 (vhdl-beginning-of-statement-1 lim)
5547 (vhdl-backward-skip-label lim)
5548 (vhdl-first-word (point)))))))
5549 ;; "begin", "else", "for":
5550 ((looking-at "be\\|[ef]")
5551 (vector "end"
5552 (and (vhdl-last-word (point))
5553 (or (vhdl-first-word (point))
5554 (save-excursion
5555 (vhdl-beginning-of-statement-1 lim)
5556 (vhdl-backward-skip-label lim)
5557 (vhdl-first-word (point)))))))
5558 ;; "component", "units", "record":
5559 ((looking-at "[cur]")
5560 ;; The first end found will close the block
5561 (vector "end" nil))
5562 ;; "block", "process", "procedural":
5563 ((looking-at "bl\\|p")
5564 (vector "end"
5565 (or (vhdl-first-word (point))
5566 (save-excursion
5567 (vhdl-beginning-of-statement-1 lim)
5568 (vhdl-backward-skip-label lim)
5569 (vhdl-first-word (point))))))
5570 ;; "then":
5571 ((looking-at "t")
5572 (vector "elsif\\|else\\|end\\s-+if"
5573 (and (vhdl-last-word (point))
5574 (or (vhdl-first-word (point))
5575 (save-excursion
5576 (vhdl-beginning-of-statement-1 lim)
5577 (vhdl-backward-skip-label lim)
5578 (vhdl-first-word (point)))))))
5579 ))))
5581 (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
5583 (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]")
5585 (defun vhdl-end-p (&optional lim)
5586 "Return t if we are looking at a real \"end\" keyword.
5587 Assumes that the caller will make sure that we are looking at
5588 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
5589 the middle of an identifier that just happens to contain an \"end\"
5590 keyword."
5591 (or (not (looking-at "else"))
5592 ;; make sure that the "else" isn't inside a conditional signal
5593 ;; assignment.
5594 (save-excursion
5595 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
5596 (or (eq (following-char) ?\;)
5597 (eq (point) lim)))))
5599 (defun vhdl-corresponding-begin (&optional lim)
5600 "If the word at the current position corresponds to an \"end\"
5601 keyword, then return a vector containing enough information to find
5602 the corresponding \"begin\" keyword, else return nil. The keyword to
5603 search backward for is aref 0. The column in which the keyword must
5604 appear is aref 1 or nil if any column is suitable. The supplementary
5605 keyword to search forward for is aref 2 or nil if this is not
5606 required. If aref 3 is t, then the \"begin\" keyword may be found in
5607 the middle of a statement.
5608 Assumes that the caller will make sure that we are not in the middle
5609 of an identifier that just happens to contain an \"end\" keyword."
5610 (save-excursion
5611 (let (pos)
5612 (if (and (looking-at vhdl-end-fwd-re)
5613 (not (vhdl-in-literal))
5614 (vhdl-end-p lim))
5615 (if (looking-at "el")
5616 ;; "else", "elsif":
5617 (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil)
5618 ;; "end ...":
5619 (setq pos (point))
5620 (forward-sexp)
5621 (skip-chars-forward " \t\n")
5622 (cond
5623 ;; "end if":
5624 ((looking-at "if\\b[^_]")
5625 (vector "else\\|elsif\\|if"
5626 (vhdl-first-word pos)
5627 "else\\|then" nil))
5628 ;; "end component":
5629 ((looking-at "component\\b[^_]")
5630 (vector (buffer-substring (match-beginning 1)
5631 (match-end 1))
5632 (vhdl-first-word pos)
5633 nil nil))
5634 ;; "end units", "end record":
5635 ((looking-at "\\(units\\|record\\)\\b[^_]")
5636 (vector (buffer-substring (match-beginning 1)
5637 (match-end 1))
5638 (vhdl-first-word pos)
5639 nil t))
5640 ;; "end block", "end process", "end procedural":
5641 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
5642 (vector "begin" (vhdl-first-word pos) nil nil))
5643 ;; "end case":
5644 ((looking-at "case\\b[^_]")
5645 (vector "case" (vhdl-first-word pos) "is" nil))
5646 ;; "end generate":
5647 ((looking-at "generate\\b[^_]")
5648 (vector "generate\\|for\\|if"
5649 (vhdl-first-word pos)
5650 "generate" nil))
5651 ;; "end loop":
5652 ((looking-at "loop\\b[^_]")
5653 (vector "loop\\|while\\|for"
5654 (vhdl-first-word pos)
5655 "loop" nil))
5656 ;; "end for" (inside configuration declaration):
5657 ((looking-at "for\\b[^_]")
5658 (vector "for" (vhdl-first-word pos) nil nil))
5659 ;; "end [id]":
5661 (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function"
5662 (vhdl-first-word pos)
5663 ;; return an alist of (statement . keyword) mappings
5665 ;; "begin ... end [id]":
5666 ("begin" . nil)
5667 ;; "architecture ... is ... begin ... end [id]":
5668 ("architecture" . "is")
5669 ;; "configuration ... is ... end [id]":
5670 ("configuration" . "is")
5671 ;; "entity ... is ... end [id]":
5672 ("entity" . "is")
5673 ;; "package ... is ... end [id]":
5674 ("package" . "is")
5675 ;; "procedure ... is ... begin ... end [id]":
5676 ("procedure" . "is")
5677 ;; "function ... is ... begin ... end [id]":
5678 ("function" . "is")
5680 nil))
5681 ))) ; "end ..."
5684 (defconst vhdl-leader-re
5685 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
5687 (defun vhdl-end-of-leader ()
5688 (save-excursion
5689 (cond ((looking-at "block\\|process\\|procedural")
5690 (if (save-excursion
5691 (forward-sexp)
5692 (skip-chars-forward " \t\n")
5693 (= (following-char) ?\())
5694 (forward-sexp 2)
5695 (forward-sexp))
5696 (when (looking-at "[ \t\n]*is")
5697 (goto-char (match-end 0)))
5698 (point))
5699 ((looking-at "component")
5700 (forward-sexp 2)
5701 (when (looking-at "[ \t\n]*is")
5702 (goto-char (match-end 0)))
5703 (point))
5704 ((looking-at "for")
5705 (forward-sexp 2)
5706 (skip-chars-forward " \t\n")
5707 (while (looking-at "[,:(]")
5708 (forward-sexp)
5709 (skip-chars-forward " \t\n"))
5710 (point))
5711 (t nil)
5714 (defconst vhdl-trailer-re
5715 "\\b\\(is\\|then\\|generate\\|loop\\)\\b[^_]")
5717 (defconst vhdl-statement-fwd-re
5718 "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)"
5719 "A regular expression for searching forward that matches all known
5720 \"statement\" keywords.")
5722 (defconst vhdl-statement-bwd-re
5723 "\\b\\(if\\|for\\|while\\)\\b[^_]"
5724 "A regular expression for searching backward that matches all known
5725 \"statement\" keywords.")
5727 (defun vhdl-statement-p (&optional lim)
5728 "Return t if we are looking at a real \"statement\" keyword.
5729 Assumes that the caller will make sure that we are looking at
5730 vhdl-statement-fwd-re, and are not inside a literal, and that we are not
5731 in the middle of an identifier that just happens to contain a
5732 \"statement\" keyword."
5733 (cond
5734 ;; "for" ... "generate":
5735 ((and (looking-at "f")
5736 ;; Make sure it's the start of a parameter specification.
5737 (save-excursion
5738 (forward-sexp 2)
5739 (skip-chars-forward " \t\n")
5740 (looking-at "in\\b[^_]"))
5741 ;; Make sure it's not an "end for".
5742 (save-excursion
5743 (backward-sexp)
5744 (not (looking-at "end\\s-+\\w"))))
5746 ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
5747 ((and (looking-at "i")
5748 ;; Make sure it's not an "end if".
5749 (save-excursion
5750 (backward-sexp)
5751 (not (looking-at "end\\s-+\\w"))))
5753 ;; "while" ... "loop":
5754 ((looking-at "w")
5758 (defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>"
5759 "Regexp describing a case statement alternative key.")
5761 (defun vhdl-case-alternative-p (&optional lim)
5762 "Return t if we are looking at a real case alternative.
5763 Assumes that the caller will make sure that we are looking at
5764 vhdl-case-alternative-re, and are not inside a literal, and that
5765 we are not in the middle of an identifier that just happens to
5766 contain a \"when\" keyword."
5767 (save-excursion
5768 (let (foundp)
5769 (while (and (not foundp)
5770 (re-search-backward ";\\|<=" lim 'move))
5771 (if (or (= (preceding-char) ?_)
5772 (vhdl-in-literal))
5773 (backward-char)
5774 (setq foundp t)))
5775 (or (eq (following-char) ?\;)
5776 (eq (point) lim)))
5779 ;; Core syntactic movement functions:
5781 (defconst vhdl-b-t-b-re
5782 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
5784 (defun vhdl-backward-to-block (&optional lim)
5785 "Move backward to the previous \"begin\" or \"end\" keyword."
5786 (let (foundp)
5787 (while (and (not foundp)
5788 (re-search-backward vhdl-b-t-b-re lim 'move))
5789 (if (or (= (preceding-char) ?_)
5790 (vhdl-in-literal))
5791 (backward-char)
5792 (cond
5793 ;; "begin" keyword:
5794 ((and (looking-at vhdl-begin-fwd-re)
5795 (/= (preceding-char) ?_)
5796 (vhdl-begin-p lim))
5797 (setq foundp 'begin))
5798 ;; "end" keyword:
5799 ((and (looking-at vhdl-end-fwd-re)
5800 (/= (preceding-char) ?_)
5801 (vhdl-end-p lim))
5802 (setq foundp 'end))
5805 foundp
5808 (defun vhdl-forward-sexp (&optional count lim)
5809 "Move forward across one balanced expression (sexp).
5810 With COUNT, do it that many times."
5811 (interactive "p")
5812 (let ((count (or count 1))
5813 (case-fold-search t)
5814 end-vec target)
5815 (save-excursion
5816 (while (> count 0)
5817 ;; skip whitespace
5818 (skip-chars-forward " \t\n")
5819 ;; Check for an unbalanced "end" keyword
5820 (if (and (looking-at vhdl-end-fwd-re)
5821 (/= (preceding-char) ?_)
5822 (not (vhdl-in-literal))
5823 (vhdl-end-p lim)
5824 (not (looking-at "else")))
5825 (error
5826 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp"))
5827 ;; If the current keyword is a "begin" keyword, then find the
5828 ;; corresponding "end" keyword.
5829 (if (setq end-vec (vhdl-corresponding-end lim))
5830 (let (
5831 ;; end-re is the statement keyword to search for
5832 (end-re
5833 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
5834 ;; column is either the statement keyword target column
5835 ;; or nil
5836 (column (aref end-vec 1))
5837 (eol (vhdl-point 'eol))
5838 foundp literal placeholder)
5839 ;; Look for the statement keyword.
5840 (while (and (not foundp)
5841 (re-search-forward end-re nil t)
5842 (setq placeholder (match-end 1))
5843 (goto-char (match-beginning 0)))
5844 ;; If we are in a literal, or not in the right target
5845 ;; column and not on the same line as the begin, then
5846 ;; try again.
5847 (if (or (and column
5848 (/= (current-indentation) column)
5849 (> (point) eol))
5850 (= (preceding-char) ?_)
5851 (setq literal (vhdl-in-literal)))
5852 (if (eq literal 'comment)
5853 (end-of-line)
5854 (forward-char))
5855 ;; An "else" keyword corresponds to both the opening brace
5856 ;; of the following sexp and the closing brace of the
5857 ;; previous sexp.
5858 (if (not (looking-at "else"))
5859 (goto-char placeholder))
5860 (setq foundp t))
5862 (if (not foundp)
5863 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp"))
5865 ;; If the current keyword is not a "begin" keyword, then just
5866 ;; perform the normal forward-sexp.
5867 (forward-sexp)
5869 (setq count (1- count))
5871 (setq target (point)))
5872 (goto-char target)
5873 nil))
5875 (defun vhdl-backward-sexp (&optional count lim)
5876 "Move backward across one balanced expression (sexp).
5877 With COUNT, do it that many times. LIM bounds any required backward
5878 searches."
5879 (interactive "p")
5880 (let ((count (or count 1))
5881 (case-fold-search t)
5882 begin-vec target)
5883 (save-excursion
5884 (while (> count 0)
5885 ;; Perform the normal backward-sexp, unless we are looking at
5886 ;; "else" - an "else" keyword corresponds to both the opening brace
5887 ;; of the following sexp and the closing brace of the previous sexp.
5888 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
5889 (/= (preceding-char) ?_)
5890 (not (vhdl-in-literal)))
5892 (backward-sexp)
5893 (if (and (looking-at vhdl-begin-fwd-re)
5894 (/= (preceding-char) ?_)
5895 (not (vhdl-in-literal))
5896 (vhdl-begin-p lim))
5897 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp")))
5898 ;; If the current keyword is an "end" keyword, then find the
5899 ;; corresponding "begin" keyword.
5900 (if (and (setq begin-vec (vhdl-corresponding-begin lim))
5901 (/= (preceding-char) ?_))
5902 (let (
5903 ;; begin-re is the statement keyword to search for
5904 (begin-re
5905 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
5906 ;; column is either the statement keyword target column
5907 ;; or nil
5908 (column (aref begin-vec 1))
5909 ;; internal-p controls where the statement keyword can
5910 ;; be found.
5911 (internal-p (aref begin-vec 3))
5912 (last-backward (point)) last-forward
5913 foundp literal keyword)
5914 ;; Look for the statement keyword.
5915 (while (and (not foundp)
5916 (re-search-backward begin-re lim t)
5917 (setq keyword
5918 (buffer-substring (match-beginning 1)
5919 (match-end 1))))
5920 ;; If we are in a literal or in the wrong column,
5921 ;; then try again.
5922 (if (or (and column
5923 (and (/= (current-indentation) column)
5924 ;; possibly accept current-column as
5925 ;; well as current-indentation.
5926 (or (not internal-p)
5927 (/= (current-column) column))))
5928 (= (preceding-char) ?_)
5929 (vhdl-in-literal))
5930 (backward-char)
5931 ;; If there is a supplementary keyword, then
5932 ;; search forward for it.
5933 (if (and (setq begin-re (aref begin-vec 2))
5934 (or (not (listp begin-re))
5935 ;; If begin-re is an alist, then find the
5936 ;; element corresponding to the actual
5937 ;; keyword that we found.
5938 (progn
5939 (setq begin-re
5940 (assoc keyword begin-re))
5941 (and begin-re
5942 (setq begin-re (cdr begin-re))))))
5943 (and
5944 (setq begin-re
5945 (concat "\\b\\(" begin-re "\\)\\b[^_]"))
5946 (save-excursion
5947 (setq last-forward (point))
5948 ;; Look for the supplementary keyword
5949 ;; (bounded by the backward search start
5950 ;; point).
5951 (while (and (not foundp)
5952 (re-search-forward begin-re
5953 last-backward t)
5954 (goto-char (match-beginning 1)))
5955 ;; If we are in a literal, then try again.
5956 (if (or (= (preceding-char) ?_)
5957 (setq literal
5958 (vhdl-in-literal)))
5959 (if (eq literal 'comment)
5960 (goto-char
5961 (min (vhdl-point 'eol) last-backward))
5962 (forward-char))
5963 ;; We have found the supplementary keyword.
5964 ;; Save the position of the keyword in foundp.
5965 (setq foundp (point)))
5967 foundp)
5968 ;; If the supplementary keyword was found, then
5969 ;; move point to the supplementary keyword.
5970 (goto-char foundp))
5971 ;; If there was no supplementary keyword, then
5972 ;; point is already at the statement keyword.
5973 (setq foundp t)))
5974 ) ; end of the search for the statement keyword
5975 (if (not foundp)
5976 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp"))
5978 (setq count (1- count))
5980 (setq target (point)))
5981 (goto-char target)
5982 nil))
5984 (defun vhdl-backward-up-list (&optional count limit)
5985 "Move backward out of one level of blocks.
5986 With argument, do this that many times."
5987 (interactive "p")
5988 (let ((count (or count 1))
5989 target)
5990 (save-excursion
5991 (while (> count 0)
5992 (if (looking-at vhdl-defun-re)
5993 (error "ERROR: Unbalanced blocks"))
5994 (vhdl-backward-to-block limit)
5995 (setq count (1- count)))
5996 (setq target (point)))
5997 (goto-char target)))
5999 (defun vhdl-end-of-defun (&optional count)
6000 "Move forward to the end of a VHDL defun."
6001 (interactive)
6002 (let ((case-fold-search t))
6003 (vhdl-beginning-of-defun)
6004 (if (not (looking-at "block\\|process\\|procedural"))
6005 (re-search-forward "\\bis\\b"))
6006 (vhdl-forward-sexp)))
6008 (defun vhdl-mark-defun ()
6009 "Put mark at end of this \"defun\", point at beginning."
6010 (interactive)
6011 (let ((case-fold-search t))
6012 (push-mark)
6013 (vhdl-beginning-of-defun)
6014 (push-mark)
6015 (if (not (looking-at "block\\|process\\|procedural"))
6016 (re-search-forward "\\bis\\b"))
6017 (vhdl-forward-sexp)
6018 (exchange-point-and-mark)))
6020 (defun vhdl-beginning-of-libunit ()
6021 "Move backward to the beginning of a VHDL library unit.
6022 Returns the location of the corresponding begin keyword, unless search
6023 stops due to beginning or end of buffer.
6024 Note that if point is between the \"libunit\" keyword and the
6025 corresponding \"begin\" keyword, then that libunit will not be
6026 recognised, and the search will continue backwards. If point is
6027 at the \"begin\" keyword, then the defun will be recognised. The
6028 returned point is at the first character of the \"libunit\" keyword."
6029 (let ((last-forward (point))
6030 (last-backward
6031 ;; Just in case we are actually sitting on the "begin"
6032 ;; keyword, allow for the keyword and an extra character,
6033 ;; as this will be used when looking forward for the
6034 ;; "begin" keyword.
6035 (save-excursion (forward-word 1) (1+ (point))))
6036 foundp literal placeholder)
6037 ;; Find the "libunit" keyword.
6038 (while (and (not foundp)
6039 (re-search-backward vhdl-libunit-re nil 'move))
6040 ;; If we are in a literal, or not at a real libunit, then try again.
6041 (if (or (= (preceding-char) ?_)
6042 (vhdl-in-literal)
6043 (not (vhdl-libunit-p)))
6044 (backward-char)
6045 ;; Find the corresponding "begin" keyword.
6046 (setq last-forward (point))
6047 (while (and (not foundp)
6048 (re-search-forward "\\bis\\b[^_]" last-backward t)
6049 (setq placeholder (match-beginning 0)))
6050 (if (or (= (preceding-char) ?_)
6051 (setq literal (vhdl-in-literal)))
6052 ;; It wasn't a real keyword, so keep searching.
6053 (if (eq literal 'comment)
6054 (goto-char
6055 (min (vhdl-point 'eol) last-backward))
6056 (forward-char))
6057 ;; We have found the begin keyword, loop will exit.
6058 (setq foundp placeholder)))
6059 ;; Go back to the libunit keyword
6060 (goto-char last-forward)))
6061 foundp))
6063 (defun vhdl-beginning-of-defun (&optional count)
6064 "Move backward to the beginning of a VHDL defun.
6065 With argument, do it that many times.
6066 Returns the location of the corresponding begin keyword, unless search
6067 stops due to beginning or end of buffer."
6068 ;; Note that if point is between the "defun" keyword and the
6069 ;; corresponding "begin" keyword, then that defun will not be
6070 ;; recognised, and the search will continue backwards. If point is
6071 ;; at the "begin" keyword, then the defun will be recognised. The
6072 ;; returned point is at the first character of the "defun" keyword.
6073 (interactive "p")
6074 (let ((count (or count 1))
6075 (case-fold-search t)
6076 (last-forward (point))
6077 foundp)
6078 (while (> count 0)
6079 (setq foundp nil)
6080 (goto-char last-forward)
6081 (let ((last-backward
6082 ;; Just in case we are actually sitting on the "begin"
6083 ;; keyword, allow for the keyword and an extra character,
6084 ;; as this will be used when looking forward for the
6085 ;; "begin" keyword.
6086 (save-excursion (forward-word 1) (1+ (point))))
6087 begin-string literal)
6088 (while (and (not foundp)
6089 (re-search-backward vhdl-defun-re nil 'move))
6090 ;; If we are in a literal, then try again.
6091 (if (or (= (preceding-char) ?_)
6092 (vhdl-in-literal))
6093 (backward-char)
6094 (if (setq begin-string (vhdl-corresponding-defun))
6095 ;; This is a real defun keyword.
6096 ;; Find the corresponding "begin" keyword.
6097 ;; Look for the begin keyword.
6098 (progn
6099 ;; Save the search start point.
6100 (setq last-forward (point))
6101 (while (and (not foundp)
6102 (search-forward begin-string last-backward t))
6103 (if (or (= (preceding-char) ?_)
6104 (save-match-data
6105 (setq literal (vhdl-in-literal))))
6106 ;; It wasn't a real keyword, so keep searching.
6107 (if (eq literal 'comment)
6108 (goto-char
6109 (min (vhdl-point 'eol) last-backward))
6110 (forward-char))
6111 ;; We have found the begin keyword, loop will exit.
6112 (setq foundp (match-beginning 0)))
6114 ;; Go back to the defun keyword
6115 (goto-char last-forward)) ; end search for begin keyword
6117 ) ; end of the search for the defun keyword
6119 (setq count (1- count))
6121 (vhdl-keep-region-active)
6122 foundp))
6124 (defun vhdl-beginning-of-statement (&optional count lim)
6125 "Go to the beginning of the innermost VHDL statement.
6126 With prefix arg, go back N - 1 statements. If already at the
6127 beginning of a statement then go to the beginning of the preceding
6128 one. If within a string or comment, or next to a comment (only
6129 whitespace between), move by sentences instead of statements.
6131 When called from a program, this function takes 2 optional args: the
6132 prefix arg, and a buffer position limit which is the farthest back to
6133 search."
6134 (interactive "p")
6135 (let ((count (or count 1))
6136 (case-fold-search t)
6137 (lim (or lim (point-min)))
6138 (here (point))
6139 state)
6140 (save-excursion
6141 (goto-char lim)
6142 (setq state (parse-partial-sexp (point) here nil nil)))
6143 (if (and (interactive-p)
6144 (or (nth 3 state)
6145 (nth 4 state)
6146 (looking-at (concat "[ \t]*" comment-start-skip))))
6147 (forward-sentence (- count))
6148 (while (> count 0)
6149 (vhdl-beginning-of-statement-1 lim)
6150 (setq count (1- count))))
6151 ;; its possible we've been left up-buf of lim
6152 (goto-char (max (point) lim))
6154 (vhdl-keep-region-active))
6156 (defconst vhdl-e-o-s-re
6157 (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re))
6159 (defun vhdl-end-of-statement ()
6160 "Very simple implementation."
6161 (interactive)
6162 (re-search-forward vhdl-e-o-s-re))
6164 (defconst vhdl-b-o-s-re
6165 (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|"
6166 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
6168 (defun vhdl-beginning-of-statement-1 (&optional lim)
6169 "Move to the start of the current statement, or the previous
6170 statement if already at the beginning of one."
6171 (let ((lim (or lim (point-min)))
6172 (here (point))
6173 (pos (point))
6174 donep)
6175 ;; go backwards one balanced expression, but be careful of
6176 ;; unbalanced paren being reached
6177 (if (not (vhdl-safe (progn (backward-sexp) t)))
6178 (progn
6179 (backward-up-list 1)
6180 (forward-char)
6181 (vhdl-forward-syntactic-ws here)
6182 (setq donep t)))
6183 (while (and (not donep)
6184 (not (bobp))
6185 ;; look backwards for a statement boundary
6186 (re-search-backward vhdl-b-o-s-re lim 'move))
6187 (if (or (= (preceding-char) ?_)
6188 (vhdl-in-literal))
6189 (backward-char)
6190 (cond
6191 ;; If we are looking at an open paren, then stop after it
6192 ((eq (following-char) ?\()
6193 (forward-char)
6194 (vhdl-forward-syntactic-ws here)
6195 (setq donep t))
6196 ;; If we are looking at a close paren, then skip it
6197 ((eq (following-char) ?\))
6198 (forward-char)
6199 (setq pos (point))
6200 (backward-sexp)
6201 (if (< (point) lim)
6202 (progn (goto-char pos)
6203 (vhdl-forward-syntactic-ws here)
6204 (setq donep t))))
6205 ;; If we are looking at a semicolon, then stop
6206 ((eq (following-char) ?\;)
6207 (progn
6208 (forward-char)
6209 (vhdl-forward-syntactic-ws here)
6210 (setq donep t)))
6211 ;; If we are looking at a "begin", then stop
6212 ((and (looking-at vhdl-begin-fwd-re)
6213 (/= (preceding-char) ?_)
6214 (vhdl-begin-p nil))
6215 ;; If it's a leader "begin", then find the
6216 ;; right place
6217 (if (looking-at vhdl-leader-re)
6218 (save-excursion
6219 ;; set a default stop point at the begin
6220 (setq pos (point))
6221 ;; is the start point inside the leader area ?
6222 (goto-char (vhdl-end-of-leader))
6223 (vhdl-forward-syntactic-ws here)
6224 (if (< (point) here)
6225 ;; start point was not inside leader area
6226 ;; set stop point at word after leader
6227 (setq pos (point))))
6228 (forward-word 1)
6229 (vhdl-forward-syntactic-ws here)
6230 (setq pos (point)))
6231 (goto-char pos)
6232 (setq donep t))
6233 ;; If we are looking at a "statement", then stop
6234 ((and (looking-at vhdl-statement-fwd-re)
6235 (/= (preceding-char) ?_)
6236 (vhdl-statement-p nil))
6237 (setq donep t))
6238 ;; If we are looking at a case alternative key, then stop
6239 ((and (looking-at vhdl-case-alternative-re)
6240 (vhdl-case-alternative-p lim))
6241 (save-excursion
6242 ;; set a default stop point at the when
6243 (setq pos (point))
6244 ;; is the start point inside the case alternative key ?
6245 (looking-at vhdl-case-alternative-re)
6246 (goto-char (match-end 0))
6247 (vhdl-forward-syntactic-ws here)
6248 (if (< (point) here)
6249 ;; start point was not inside the case alternative key
6250 ;; set stop point at word after case alternative keyleader
6251 (setq pos (point))))
6252 (goto-char pos)
6253 (setq donep t))
6254 ;; Bogus find, continue
6256 (backward-char)))))
6259 ;; Defuns for calculating the current syntactic state:
6261 (defun vhdl-get-library-unit (bod placeholder)
6262 "If there is an enclosing library unit at bod, with it's \"begin\"
6263 keyword at placeholder, then return the library unit type."
6264 (let ((here (vhdl-point 'bol)))
6265 (if (save-excursion
6266 (goto-char placeholder)
6267 (vhdl-safe (vhdl-forward-sexp 1 bod))
6268 (<= here (point)))
6269 (save-excursion
6270 (goto-char bod)
6271 (cond
6272 ((looking-at "e") 'entity)
6273 ((looking-at "a") 'architecture)
6274 ((looking-at "c") 'configuration)
6275 ((looking-at "p")
6276 (save-excursion
6277 (goto-char bod)
6278 (forward-sexp)
6279 (vhdl-forward-syntactic-ws here)
6280 (if (looking-at "body\\b[^_]")
6281 'package-body 'package))))))
6284 (defun vhdl-get-block-state (&optional lim)
6285 "Finds and records all the closest opens.
6286 lim is the furthest back we need to search (it should be the
6287 previous libunit keyword)."
6288 (let ((here (point))
6289 (lim (or lim (point-min)))
6290 keyword sexp-start sexp-mid sexp-end
6291 preceding-sexp containing-sexp
6292 containing-begin containing-mid containing-paren)
6293 (save-excursion
6294 ;; Find the containing-paren, and use that as the limit
6295 (if (setq containing-paren
6296 (save-restriction
6297 (narrow-to-region lim (point))
6298 (vhdl-safe (scan-lists (point) -1 1))))
6299 (setq lim containing-paren))
6300 ;; Look backwards for "begin" and "end" keywords.
6301 (while (and (> (point) lim)
6302 (not containing-sexp))
6303 (setq keyword (vhdl-backward-to-block lim))
6304 (cond
6305 ((eq keyword 'begin)
6306 ;; Found a "begin" keyword
6307 (setq sexp-start (point))
6308 (setq sexp-mid (vhdl-corresponding-mid lim))
6309 (setq sexp-end (vhdl-safe
6310 (save-excursion
6311 (vhdl-forward-sexp 1 lim) (point))))
6312 (if (and sexp-end (<= sexp-end here))
6313 ;; we want to record this sexp, but we only want to
6314 ;; record the last-most of any of them before here
6315 (or preceding-sexp
6316 (setq preceding-sexp sexp-start))
6317 ;; we're contained in this sexp so put sexp-start on
6318 ;; front of list
6319 (setq containing-sexp sexp-start)
6320 (setq containing-mid sexp-mid)
6321 (setq containing-begin t)))
6322 ((eq keyword 'end)
6323 ;; Found an "end" keyword
6324 (forward-sexp)
6325 (setq sexp-end (point))
6326 (setq sexp-mid nil)
6327 (setq sexp-start
6328 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
6329 (progn (backward-sexp) (point))))
6330 ;; we want to record this sexp, but we only want to
6331 ;; record the last-most of any of them before here
6332 (or preceding-sexp
6333 (setq preceding-sexp sexp-start)))
6335 ;; Check if the containing-paren should be the containing-sexp
6336 (if (and containing-paren
6337 (or (null containing-sexp)
6338 (< containing-sexp containing-paren)))
6339 (setq containing-sexp containing-paren
6340 preceding-sexp nil
6341 containing-begin nil
6342 containing-mid nil))
6343 (vector containing-sexp preceding-sexp containing-begin containing-mid)
6347 (defconst vhdl-s-c-a-re
6348 (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key))
6350 (defun vhdl-skip-case-alternative (&optional lim)
6351 "Skip forward over case/when bodies, with optional maximal
6352 limit. If no next case alternative is found, nil is returned and point
6353 is not moved."
6354 (let ((lim (or lim (point-max)))
6355 (here (point))
6356 donep foundp)
6357 (while (and (< (point) lim)
6358 (not donep))
6359 (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
6360 (save-match-data
6361 (not (vhdl-in-literal)))
6362 (/= (match-beginning 0) here))
6363 (progn
6364 (goto-char (match-beginning 0))
6365 (cond
6366 ((and (looking-at "case")
6367 (re-search-forward "\\bis[^_]" lim t))
6368 (backward-sexp)
6369 (vhdl-forward-sexp))
6371 (setq donep t
6372 foundp t))))))
6373 (if (not foundp)
6374 (goto-char here))
6375 foundp))
6377 (defun vhdl-backward-skip-label (&optional lim)
6378 "Skip backward over a label, with optional maximal
6379 limit. If label is not found, nil is returned and point
6380 is not moved."
6381 (let ((lim (or lim (point-min)))
6382 placeholder)
6383 (if (save-excursion
6384 (vhdl-backward-syntactic-ws lim)
6385 (and (eq (preceding-char) ?:)
6386 (progn
6387 (backward-sexp)
6388 (setq placeholder (point))
6389 (looking-at vhdl-label-key))))
6390 (goto-char placeholder))
6393 (defun vhdl-forward-skip-label (&optional lim)
6394 "Skip forward over a label, with optional maximal
6395 limit. If label is not found, nil is returned and point
6396 is not moved."
6397 (let ((lim (or lim (point-max))))
6398 (if (looking-at vhdl-label-key)
6399 (progn
6400 (goto-char (match-end 0))
6401 (vhdl-forward-syntactic-ws lim)))
6404 (defun vhdl-get-syntactic-context ()
6405 "Guess the syntactic description of the current line of VHDL code."
6406 (save-excursion
6407 (save-restriction
6408 (beginning-of-line)
6409 (let* ((indent-point (point))
6410 (case-fold-search t)
6411 vec literal containing-sexp preceding-sexp
6412 containing-begin containing-mid containing-leader
6413 char-before-ip char-after-ip begin-after-ip end-after-ip
6414 placeholder lim library-unit
6417 ;; Reset the syntactic context
6418 (setq vhdl-syntactic-context nil)
6420 (save-excursion
6421 ;; Move to the start of the previous library unit, and
6422 ;; record the position of the "begin" keyword.
6423 (setq placeholder (vhdl-beginning-of-libunit))
6424 ;; The position of the "libunit" keyword gives us a gross
6425 ;; limit point.
6426 (setq lim (point))
6429 ;; If there is a previous library unit, and we are enclosed by
6430 ;; it, then set the syntax accordingly.
6431 (and placeholder
6432 (setq library-unit (vhdl-get-library-unit lim placeholder))
6433 (vhdl-add-syntax library-unit lim))
6435 ;; Find the surrounding state.
6436 (if (setq vec (vhdl-get-block-state lim))
6437 (progn
6438 (setq containing-sexp (aref vec 0))
6439 (setq preceding-sexp (aref vec 1))
6440 (setq containing-begin (aref vec 2))
6441 (setq containing-mid (aref vec 3))
6444 ;; set the limit on the farthest back we need to search
6445 (setq lim (if containing-sexp
6446 (save-excursion
6447 (goto-char containing-sexp)
6448 ;; set containing-leader if required
6449 (if (looking-at vhdl-leader-re)
6450 (setq containing-leader (vhdl-end-of-leader)))
6451 (vhdl-point 'bol))
6452 (point-min)))
6454 ;; cache char before and after indent point, and move point to
6455 ;; the most likely position to perform the majority of tests
6456 (goto-char indent-point)
6457 (skip-chars-forward " \t")
6458 (setq literal (vhdl-in-literal))
6459 (setq char-after-ip (following-char))
6460 (setq begin-after-ip (and
6461 (not literal)
6462 (looking-at vhdl-begin-fwd-re)
6463 (vhdl-begin-p)))
6464 (setq end-after-ip (and
6465 (not literal)
6466 (looking-at vhdl-end-fwd-re)
6467 (vhdl-end-p)))
6468 (vhdl-backward-syntactic-ws lim)
6469 (setq char-before-ip (preceding-char))
6470 (goto-char indent-point)
6471 (skip-chars-forward " \t")
6473 ;; now figure out syntactic qualities of the current line
6474 (cond
6475 ;; CASE 1: in a string or comment.
6476 ((memq literal '(string comment))
6477 (vhdl-add-syntax literal (vhdl-point 'bopl)))
6478 ;; CASE 2: Line is at top level.
6479 ((null containing-sexp)
6480 ;; Find the point to which indentation will be relative
6481 (save-excursion
6482 (if (null preceding-sexp)
6483 ;; CASE 2X.1
6484 ;; no preceding-sexp -> use the preceding statement
6485 (vhdl-beginning-of-statement-1 lim)
6486 ;; CASE 2X.2
6487 ;; if there is a preceding-sexp then indent relative to it
6488 (goto-char preceding-sexp)
6489 ;; if not at boi, then the block-opening keyword is
6490 ;; probably following a label, so we need a different
6491 ;; relpos
6492 (if (/= (point) (vhdl-point 'boi))
6493 ;; CASE 2X.3
6494 (vhdl-beginning-of-statement-1 lim)))
6495 ;; v-b-o-s could have left us at point-min
6496 (and (bobp)
6497 ;; CASE 2X.4
6498 (vhdl-forward-syntactic-ws indent-point))
6499 (setq placeholder (point)))
6500 (cond
6501 ;; CASE 2A : we are looking at a block-open
6502 (begin-after-ip
6503 (vhdl-add-syntax 'block-open placeholder))
6504 ;; CASE 2B: we are looking at a block-close
6505 (end-after-ip
6506 (vhdl-add-syntax 'block-close placeholder))
6507 ;; CASE 2C: we are looking at a top-level statement
6508 ((progn
6509 (vhdl-backward-syntactic-ws lim)
6510 (or (bobp)
6511 (= (preceding-char) ?\;)))
6512 (vhdl-add-syntax 'statement placeholder))
6513 ;; CASE 2D: we are looking at a top-level statement-cont
6515 (vhdl-beginning-of-statement-1 lim)
6516 ;; v-b-o-s could have left us at point-min
6517 (and (bobp)
6518 ;; CASE 2D.1
6519 (vhdl-forward-syntactic-ws indent-point))
6520 (vhdl-add-syntax 'statement-cont (point)))
6521 )) ; end CASE 2
6522 ;; CASE 3: line is inside parentheses. Most likely we are
6523 ;; either in a subprogram argument (interface) list, or a
6524 ;; continued expression containing parentheses.
6525 ((null containing-begin)
6526 (vhdl-backward-syntactic-ws containing-sexp)
6527 (cond
6528 ;; CASE 3A: we are looking at the arglist closing paren
6529 ((eq char-after-ip ?\))
6530 (goto-char containing-sexp)
6531 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
6532 ;; CASE 3B: we are looking at the first argument in an empty
6533 ;; argument list.
6534 ((eq char-before-ip ?\()
6535 (goto-char containing-sexp)
6536 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
6537 ;; CASE 3C: we are looking at an arglist continuation line,
6538 ;; but the preceding argument is on the same line as the
6539 ;; opening paren. This case includes multi-line
6540 ;; expression paren groupings.
6541 ((and (save-excursion
6542 (goto-char (1+ containing-sexp))
6543 (skip-chars-forward " \t")
6544 (not (eolp))
6545 (not (looking-at "--")))
6546 (save-excursion
6547 (vhdl-beginning-of-statement-1 containing-sexp)
6548 (skip-chars-backward " \t(")
6549 (<= (point) containing-sexp)))
6550 (goto-char containing-sexp)
6551 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
6552 ;; CASE 3D: we are looking at just a normal arglist
6553 ;; continuation line
6554 (t (vhdl-beginning-of-statement-1 containing-sexp)
6555 (vhdl-forward-syntactic-ws indent-point)
6556 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
6558 ;; CASE 4: A block mid open
6559 ((and begin-after-ip
6560 (looking-at containing-mid))
6561 (goto-char containing-sexp)
6562 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6563 (if (looking-at vhdl-trailer-re)
6564 ;; CASE 4.1
6565 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6566 (vhdl-backward-skip-label (vhdl-point 'boi))
6567 (vhdl-add-syntax 'block-open (point)))
6568 ;; CASE 5: block close brace
6569 (end-after-ip
6570 (goto-char containing-sexp)
6571 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6572 (if (looking-at vhdl-trailer-re)
6573 ;; CASE 5.1
6574 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6575 (vhdl-backward-skip-label (vhdl-point 'boi))
6576 (vhdl-add-syntax 'block-close (point)))
6577 ;; CASE 6: A continued statement
6578 ((and (/= char-before-ip ?\;)
6579 ;; check it's not a trailer begin keyword, or a begin
6580 ;; keyword immediately following a label.
6581 (not (and begin-after-ip
6582 (or (looking-at vhdl-trailer-re)
6583 (save-excursion
6584 (vhdl-backward-skip-label containing-sexp)))))
6585 ;; check it's not a statement keyword
6586 (not (and (looking-at vhdl-statement-fwd-re)
6587 (vhdl-statement-p)))
6588 ;; see if the b-o-s is before the indent point
6589 (> indent-point
6590 (save-excursion
6591 (vhdl-beginning-of-statement-1 containing-sexp)
6592 ;; If we ended up after a leader, then this will
6593 ;; move us forward to the start of the first
6594 ;; statement. Note that a containing sexp here is
6595 ;; always a keyword, not a paren, so this will
6596 ;; have no effect if we hit the containing-sexp.
6597 (vhdl-forward-syntactic-ws indent-point)
6598 (setq placeholder (point))))
6599 ;; check it's not a block-intro
6600 (/= placeholder containing-sexp)
6601 ;; check it's not a case block-intro
6602 (save-excursion
6603 (goto-char placeholder)
6604 (or (not (looking-at vhdl-case-alternative-re))
6605 (> (match-end 0) indent-point))))
6606 ;; Make placeholder skip a label, but only if it puts us
6607 ;; before the indent point at the start of a line.
6608 (let ((new placeholder))
6609 (if (and (> indent-point
6610 (save-excursion
6611 (goto-char placeholder)
6612 (vhdl-forward-skip-label indent-point)
6613 (setq new (point))))
6614 (save-excursion
6615 (goto-char new)
6616 (eq new (progn (back-to-indentation) (point)))))
6617 (setq placeholder new)))
6618 (vhdl-add-syntax 'statement-cont placeholder)
6619 (if begin-after-ip
6620 (vhdl-add-syntax 'block-open)))
6621 ;; Statement. But what kind?
6622 ;; CASE 7: A case alternative key
6623 ((and (looking-at vhdl-case-alternative-re)
6624 (vhdl-case-alternative-p containing-sexp))
6625 ;; for a case alternative key, we set relpos to the first
6626 ;; non-whitespace char on the line containing the "case"
6627 ;; keyword.
6628 (goto-char containing-sexp)
6629 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6630 (if (looking-at vhdl-trailer-re)
6631 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6632 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
6633 ;; CASE 8: statement catchall
6635 ;; we know its a statement, but we need to find out if it is
6636 ;; the first statement in a block
6637 (if containing-leader
6638 (goto-char containing-leader)
6639 (goto-char containing-sexp)
6640 ;; Note that a containing sexp here is always a keyword,
6641 ;; not a paren, so skip over the keyword.
6642 (forward-sexp))
6643 ;; move to the start of the first statement
6644 (vhdl-forward-syntactic-ws indent-point)
6645 (setq placeholder (point))
6646 ;; we want to ignore case alternatives keys when skipping forward
6647 (let (incase-p)
6648 (while (looking-at vhdl-case-alternative-re)
6649 (setq incase-p (point))
6650 ;; we also want to skip over the body of the
6651 ;; case/when statement if that doesn't put us at
6652 ;; after the indent-point
6653 (while (vhdl-skip-case-alternative indent-point))
6654 ;; set up the match end
6655 (looking-at vhdl-case-alternative-re)
6656 (goto-char (match-end 0))
6657 ;; move to the start of the first case alternative statement
6658 (vhdl-forward-syntactic-ws indent-point)
6659 (setq placeholder (point)))
6660 (cond
6661 ;; CASE 8A: we saw a case/when statement so we must be
6662 ;; in a switch statement. find out if we are at the
6663 ;; statement just after a case alternative key
6664 ((and incase-p
6665 (= (point) indent-point))
6666 ;; relpos is the "when" keyword
6667 (vhdl-add-syntax 'statement-case-intro incase-p))
6668 ;; CASE 8B: any old statement
6669 ((< (point) indent-point)
6670 ;; relpos is the first statement of the block
6671 (vhdl-add-syntax 'statement placeholder)
6672 (if begin-after-ip
6673 (vhdl-add-syntax 'block-open)))
6674 ;; CASE 8C: first statement in a block
6676 (goto-char containing-sexp)
6677 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
6678 (if (looking-at vhdl-trailer-re)
6679 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
6680 (vhdl-backward-skip-label (vhdl-point 'boi))
6681 (vhdl-add-syntax 'statement-block-intro (point))
6682 (if begin-after-ip
6683 (vhdl-add-syntax 'block-open)))
6687 ;; now we need to look at any modifiers
6688 (goto-char indent-point)
6689 (skip-chars-forward " \t")
6690 (if (looking-at "--")
6691 (vhdl-add-syntax 'comment))
6692 ;; return the syntax
6693 vhdl-syntactic-context))))
6695 ;; Standard indentation line-ups:
6697 (defun vhdl-lineup-arglist (langelem)
6698 "Lineup the current arglist line with the arglist appearing just
6699 after the containing paren which starts the arglist."
6700 (save-excursion
6701 (let* ((containing-sexp
6702 (save-excursion
6703 ;; arglist-cont-nonempty gives relpos ==
6704 ;; to boi of containing-sexp paren. This
6705 ;; is good when offset is +, but bad
6706 ;; when it is vhdl-lineup-arglist, so we
6707 ;; have to special case a kludge here.
6708 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
6709 (progn
6710 (beginning-of-line)
6711 (backward-up-list 1)
6712 (skip-chars-forward " \t" (vhdl-point 'eol)))
6713 (goto-char (cdr langelem)))
6714 (point)))
6715 (cs-curcol (save-excursion
6716 (goto-char (cdr langelem))
6717 (current-column))))
6718 (if (save-excursion
6719 (beginning-of-line)
6720 (looking-at "[ \t]*)"))
6721 (progn (goto-char (match-end 0))
6722 (backward-sexp)
6723 (forward-char)
6724 (vhdl-forward-syntactic-ws)
6725 (- (current-column) cs-curcol))
6726 (goto-char containing-sexp)
6727 (or (eolp)
6728 (let ((eol (vhdl-point 'eol))
6729 (here (progn
6730 (forward-char)
6731 (skip-chars-forward " \t")
6732 (point))))
6733 (vhdl-forward-syntactic-ws)
6734 (if (< (point) eol)
6735 (goto-char here))))
6736 (- (current-column) cs-curcol)
6737 ))))
6739 (defun vhdl-lineup-arglist-intro (langelem)
6740 "Lineup an arglist-intro line to just after the open paren."
6741 (save-excursion
6742 (let ((cs-curcol (save-excursion
6743 (goto-char (cdr langelem))
6744 (current-column)))
6745 (ce-curcol (save-excursion
6746 (beginning-of-line)
6747 (backward-up-list 1)
6748 (skip-chars-forward " \t" (vhdl-point 'eol))
6749 (current-column))))
6750 (- ce-curcol cs-curcol -1))))
6752 (defun vhdl-lineup-comment (langelem)
6753 "Support old behavior for comment indentation. We look at
6754 vhdl-comment-only-line-offset to decide how to indent comment
6755 only-lines."
6756 (save-excursion
6757 (back-to-indentation)
6758 ;; at or to the right of comment-column
6759 (if (>= (current-column) comment-column)
6760 (vhdl-comment-indent)
6761 ;; otherwise, indent as specified by vhdl-comment-only-line-offset
6762 (if (not (bolp))
6763 (or (car-safe vhdl-comment-only-line-offset)
6764 vhdl-comment-only-line-offset)
6765 (or (cdr-safe vhdl-comment-only-line-offset)
6766 (car-safe vhdl-comment-only-line-offset)
6767 -1000 ;jam it against the left side
6768 )))))
6770 (defun vhdl-lineup-statement-cont (langelem)
6771 "Line up statement-cont after the assignment operator."
6772 (save-excursion
6773 (let* ((relpos (cdr langelem))
6774 (assignp (save-excursion
6775 (goto-char (vhdl-point 'boi))
6776 (and (re-search-forward "\\(<\\|:\\)="
6777 (vhdl-point 'eol) t)
6778 (- (point) (vhdl-point 'boi)))))
6779 (curcol (progn
6780 (goto-char relpos)
6781 (current-column)))
6782 foundp)
6783 (while (and (not foundp)
6784 (< (point) (vhdl-point 'eol)))
6785 (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
6786 (if (vhdl-in-literal)
6787 (forward-char)
6788 (if (= (preceding-char) ?\()
6789 ;; skip over any parenthesized expressions
6790 (goto-char (min (vhdl-point 'eol)
6791 (scan-lists (point) 1 1)))
6792 ;; found an assignment operator (not at eol)
6793 (setq foundp (not (looking-at "\\s-*$"))))))
6794 (if (not foundp)
6795 ;; there's no assignment operator on the line
6796 vhdl-basic-offset
6797 ;; calculate indentation column after assign and ws, unless
6798 ;; our line contains an assignment operator
6799 (if (not assignp)
6800 (progn
6801 (forward-char)
6802 (skip-chars-forward " \t")
6803 (setq assignp 0)))
6804 (- (current-column) assignp curcol))
6807 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6808 ;; Progress reporting
6810 (defvar vhdl-progress-info nil
6811 "Array variable for progress information: 0 begin, 1 end, 2 time.")
6813 (defun vhdl-update-progress-info (string pos)
6814 "Update progress information."
6815 (when (and vhdl-progress-info (not noninteractive)
6816 (< vhdl-progress-interval
6817 (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
6818 (message (concat string "... (%2d%s)")
6819 (/ (* 100 (- pos (aref vhdl-progress-info 0)))
6820 (- (aref vhdl-progress-info 1)
6821 (aref vhdl-progress-info 0))) "%")
6822 (aset vhdl-progress-info 2 (nth 1 (current-time)))))
6824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6825 ;; Indentation commands
6827 (defun vhdl-electric-tab (&optional prefix-arg)
6828 "If preceeding character is part of a word or a paren then hippie-expand,
6829 else if right of non whitespace on line then insert tab,
6830 else if last command was a tab or return then dedent one step or if a comment
6831 toggle between normal indent and inline comment indent,
6832 else indent `correctly'."
6833 (interactive "*P")
6834 (vhdl-prepare-search-2
6835 (cond
6836 ;; expand word
6837 ((= (char-syntax (preceding-char)) ?w)
6838 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
6839 (case-replace nil)
6840 (hippie-expand-only-buffers
6841 (or (and (boundp 'hippie-expand-only-buffers)
6842 hippie-expand-only-buffers)
6843 '(vhdl-mode))))
6844 (vhdl-expand-abbrev prefix-arg)))
6845 ;; expand parenthesis
6846 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
6847 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
6848 (case-replace nil))
6849 (vhdl-expand-paren prefix-arg)))
6850 ;; insert tab
6851 ((> (current-column) (current-indentation))
6852 (insert-tab))
6853 ;; toggle comment indent
6854 ((and (looking-at "--")
6855 (or (eq last-command 'vhdl-electric-tab)
6856 (eq last-command 'vhdl-electric-return)))
6857 (cond ((= (current-indentation) 0) ; no indent
6858 (indent-to 1)
6859 (indent-according-to-mode))
6860 ((< (current-indentation) comment-column) ; normal indent
6861 (indent-to comment-column)
6862 (indent-according-to-mode))
6863 (t ; inline comment indent
6864 (kill-line -0))))
6865 ;; dedent
6866 ((and (>= (current-indentation) vhdl-basic-offset)
6867 (or (eq last-command 'vhdl-electric-tab)
6868 (eq last-command 'vhdl-electric-return)))
6869 (backward-delete-char-untabify vhdl-basic-offset nil))
6870 ;; indent line
6871 (t (indent-according-to-mode)))
6872 (setq this-command 'vhdl-electric-tab)))
6874 (defun vhdl-electric-return ()
6875 "newline-and-indent or indent-new-comment-line if in comment and preceding
6876 character is a space."
6877 (interactive)
6878 (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
6879 (indent-new-comment-line)
6880 (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
6881 (vhdl-fix-case-word -1))
6882 (newline-and-indent)))
6884 (defun vhdl-indent-line ()
6885 "Indent the current line as VHDL code. Returns the amount of
6886 indentation change."
6887 (interactive)
6888 (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
6889 (pos (- (point-max) (point)))
6890 (indent
6891 (if syntax
6892 ;; indent syntax-based
6893 (if (and (eq (caar syntax) 'comment)
6894 (>= (vhdl-get-offset (car syntax)) comment-column))
6895 ;; special case: comments at or right of comment-column
6896 (vhdl-get-offset (car syntax))
6897 (apply '+ (mapcar 'vhdl-get-offset syntax)))
6898 ;; indent like previous nonblank line
6899 (save-excursion (beginning-of-line)
6900 (re-search-backward "^[^\n]" nil t)
6901 (current-indentation))))
6902 (shift-amt (- indent (current-indentation))))
6903 (and vhdl-echo-syntactic-information-p
6904 (message "syntax: %s, indent= %d" syntax indent))
6905 (unless (zerop shift-amt)
6906 (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
6907 (beginning-of-line)
6908 (indent-to indent))
6909 (if (< (point) (vhdl-point 'boi))
6910 (back-to-indentation)
6911 ;; If initial point was within line's indentation, position after
6912 ;; the indentation. Else stay at same point in text.
6913 (when (> (- (point-max) pos) (point))
6914 (goto-char (- (point-max) pos))))
6915 (run-hooks 'vhdl-special-indent-hook)
6916 (vhdl-update-progress-info "Indenting" (vhdl-current-line))
6917 shift-amt))
6919 (defun vhdl-indent-region (beg end column)
6920 "Indent region as VHDL code.
6921 Adds progress reporting to `indent-region'."
6922 (interactive "r\nP")
6923 (when vhdl-progress-interval
6924 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
6925 (count-lines (point-min) end) 0)))
6926 (indent-region beg end column)
6927 (when vhdl-progress-interval (message "Indenting...done"))
6928 (setq vhdl-progress-info nil))
6930 (defun vhdl-indent-buffer ()
6931 "Indent whole buffer as VHDL code.
6932 Calls `indent-region' for whole buffer and adds progress reporting."
6933 (interactive)
6934 (vhdl-indent-region (point-min) (point-max) nil))
6936 (defun vhdl-indent-group ()
6937 "Indent group of lines between empty lines."
6938 (interactive)
6939 (let ((beg (save-excursion
6940 (if (re-search-backward vhdl-align-group-separate nil t)
6941 (point-marker)
6942 (point-min-marker))))
6943 (end (save-excursion
6944 (if (re-search-forward vhdl-align-group-separate nil t)
6945 (point-marker)
6946 (point-max-marker)))))
6947 (vhdl-indent-region beg end nil)))
6949 (defun vhdl-indent-sexp (&optional endpos)
6950 "Indent each line of the list starting just after point.
6951 If optional arg ENDPOS is given, indent each line, stopping when
6952 ENDPOS is encountered."
6953 (interactive)
6954 (save-excursion
6955 (let ((beg (point))
6956 (end (progn (vhdl-forward-sexp nil endpos) (point))))
6957 (indent-region beg end nil))))
6959 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6960 ;; Miscellaneous commands
6962 (defun vhdl-show-syntactic-information ()
6963 "Show syntactic information for current line."
6964 (interactive)
6965 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
6966 (vhdl-keep-region-active))
6968 ;; Verification and regression functions:
6970 (defun vhdl-regress-line (&optional arg)
6971 "Check syntactic information for current line."
6972 (interactive "P")
6973 (let ((expected (save-excursion
6974 (end-of-line)
6975 (when (search-backward " -- ((" (vhdl-point 'bol) t)
6976 (forward-char 4)
6977 (read (current-buffer)))))
6978 (actual (vhdl-get-syntactic-context))
6979 (expurgated))
6980 ;; remove the library unit symbols
6981 (mapcar
6982 (function
6983 (lambda (elt)
6984 (if (memq (car elt) '(entity configuration package
6985 package-body architecture))
6987 (setq expurgated (append expurgated (list elt))))))
6988 actual)
6989 (if (and (not arg) expected (listp expected))
6990 (if (not (equal expected expurgated))
6991 (error "ERROR: Should be: %s, is: %s" expected expurgated))
6992 (save-excursion
6993 (beginning-of-line)
6994 (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
6995 (end-of-line)
6996 (if (search-backward " -- ((" (vhdl-point 'bol) t)
6997 (kill-line))
6998 (insert " -- ")
6999 (insert (format "%s" expurgated))))))
7000 (vhdl-keep-region-active))
7003 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7004 ;;; Alignment, whitespace fixup, beautifying
7005 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7007 (defconst vhdl-align-alist
7009 ;; after some keywords
7010 (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]"
7011 "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2)
7012 ;; before ':'
7013 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7014 ;; after direction specifications
7015 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7016 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7017 ;; before "==", ":=", "=>", and "<="
7018 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur
7019 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7020 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur
7021 ;; before some keywords
7022 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7023 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7024 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7025 ;; before "=>" since "when/else ... =>" can occur
7026 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7028 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7029 It is searched in order. If REGEXP is found anywhere in the first
7030 line of a region to be aligned, ALIGN-PATTERN will be used for that
7031 region. ALIGN-PATTERN must include the whitespace to be expanded or
7032 contracted. It may also provide regexps for the text surrounding the
7033 whitespace. SUBEXP specifies which sub-expression of
7034 ALIGN-PATTERN matches the white space to be expanded/contracted.")
7036 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7037 ;; Align code
7039 (defvar vhdl-align-try-all-clauses t
7040 "If REGEXP is not found on the first line of the region that clause
7041 is ignored. If this variable is non-nil, then the clause is tried anyway.")
7043 (defun vhdl-do-group (function &optional spacing)
7044 "Apply FUNCTION on group of lines between empty lines."
7045 (let
7046 ;; search for group beginning
7047 ((beg (save-excursion
7048 (if (re-search-backward vhdl-align-group-separate nil t)
7049 (progn (beginning-of-line 2) (back-to-indentation) (point))
7050 (point-min))))
7051 ;; search for group end
7052 (end (save-excursion
7053 (if (re-search-forward vhdl-align-group-separate nil t)
7054 (progn (beginning-of-line) (point))
7055 (point-max)))))
7056 ;; run FUNCTION
7057 (funcall function beg end spacing)))
7059 (defun vhdl-do-list (function &optional spacing)
7060 "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7061 parentheses."
7062 (let (beg end)
7063 (save-excursion
7064 ;; search for beginning of balanced group of parentheses
7065 (setq beg (vhdl-re-search-backward "[()]" nil t))
7066 (while (looking-at ")")
7067 (forward-char) (backward-sexp)
7068 (setq beg (vhdl-re-search-backward "[()]" nil t)))
7069 ;; search for end of balanced group of parentheses
7070 (when beg
7071 (forward-list)
7072 (setq end (point))
7073 (goto-char (1+ beg))
7074 (skip-chars-forward " \t\n")
7075 (setq beg (point))))
7076 ;; run FUNCTION
7077 (if beg
7078 (funcall function beg end spacing)
7079 (error "ERROR: Not within a list enclosed by a pair of parentheses"))))
7081 (defun vhdl-do-same-indent (function &optional spacing)
7082 "Apply FUNCTION to block of lines with same indent."
7083 (let ((indent (current-indentation))
7084 beg end)
7085 ;; search for first line with same indent
7086 (save-excursion
7087 (while (and (not (bobp))
7088 (or (looking-at "^\\s-*\\(--.*\\)?$")
7089 (= (current-indentation) indent)))
7090 (unless (looking-at "^\\s-*$")
7091 (back-to-indentation) (setq beg (point)))
7092 (beginning-of-line -0)))
7093 ;; search for last line with same indent
7094 (save-excursion
7095 (while (and (not (eobp))
7096 (or (looking-at "^\\s-*\\(--.*\\)?$")
7097 (= (current-indentation) indent)))
7098 (if (looking-at "^\\s-*$")
7099 (beginning-of-line 2)
7100 (beginning-of-line 2)
7101 (setq end (point)))))
7102 ;; run FUNCTION
7103 (funcall function beg end spacing)))
7105 (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
7106 "Attempt to align a range of lines based on the content of the
7107 lines. The definition of `alignment-list' determines the matching
7108 order and the manner in which the lines are aligned. If ALIGNMENT-LIST
7109 is not specified `vhdl-align-alist' is used. If INDENT is non-nil,
7110 indentation is done before aligning."
7111 (interactive "r\np")
7112 (setq alignment-list (or alignment-list vhdl-align-alist))
7113 (setq spacing (or spacing 1))
7114 (save-excursion
7115 (let (bol indent)
7116 (goto-char end)
7117 (setq end (point-marker))
7118 (goto-char begin)
7119 (setq bol (setq begin (progn (beginning-of-line) (point))))
7120 ; (untabify bol end)
7121 (when indent
7122 (indent-region bol end nil))))
7123 (let ((copy (copy-alist alignment-list)))
7124 (vhdl-prepare-search-2
7125 (while copy
7126 (save-excursion
7127 (goto-char begin)
7128 (let (element
7129 (eol (save-excursion (progn (end-of-line) (point)))))
7130 (setq element (nth 0 copy))
7131 (when (and (or (and (listp (car element))
7132 (memq major-mode (car element)))
7133 (eq major-mode (car element)))
7134 (or vhdl-align-try-all-clauses
7135 (re-search-forward (car (cdr element)) eol t)))
7136 (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7137 (car (cdr (cdr (cdr element)))) spacing))
7138 (setq copy (cdr copy))))))))
7140 (defun vhdl-align-region-2 (begin end match &optional substr spacing)
7141 "Align a range of lines from BEGIN to END. The regular expression
7142 MATCH must match exactly one fields: the whitespace to be
7143 contracted/expanded. The alignment column will equal the
7144 rightmost column of the widest whitespace block. SPACING is
7145 the amount of extra spaces to add to the calculated maximum required.
7146 SPACING defaults to 1 so that at least one space is inserted after
7147 the token in MATCH."
7148 (setq spacing (or spacing 1))
7149 (setq substr (or substr 1))
7150 (save-excursion
7151 (let (distance (max 0) (lines 0) bol eol width)
7152 ;; Determine the greatest whitespace distance to the alignment
7153 ;; character
7154 (goto-char begin)
7155 (setq eol (progn (end-of-line) (point))
7156 bol (setq begin (progn (beginning-of-line) (point))))
7157 (while (< bol end)
7158 (save-excursion
7159 (when (and (re-search-forward match eol t)
7160 (not (vhdl-in-literal)))
7161 (setq distance (- (match-beginning substr) bol))
7162 (when (> distance max)
7163 (setq max distance))))
7164 (forward-line)
7165 (setq bol (point)
7166 eol (save-excursion (end-of-line) (point)))
7167 (setq lines (1+ lines)))
7168 ;; Now insert enough maxs to push each assignment operator to
7169 ;; the same column. We need to use 'lines' as a counter, since
7170 ;; the location of the mark may change
7171 (goto-char (setq bol begin))
7172 (setq eol (save-excursion (end-of-line) (point)))
7173 (while (> lines 0)
7174 (when (and (re-search-forward match eol t)
7175 (not (vhdl-in-literal)))
7176 (setq width (- (match-end substr) (match-beginning substr)))
7177 (setq distance (- (match-beginning substr) bol))
7178 (goto-char (match-beginning substr))
7179 (delete-char width)
7180 (insert-char ? (+ (- max distance) spacing)))
7181 (beginning-of-line)
7182 (forward-line)
7183 (setq bol (point)
7184 eol (save-excursion (end-of-line) (point)))
7185 (setq lines (1- lines))))))
7187 (defun vhdl-align-region-groups (beg end &optional spacing
7188 no-message no-comments)
7189 "Align region, treat groups of lines separately."
7190 (interactive "r\nP")
7191 (save-excursion
7192 (let (orig pos)
7193 (goto-char beg)
7194 (beginning-of-line)
7195 (setq orig (point-marker))
7196 (setq beg (point))
7197 (goto-char end)
7198 (setq end (point-marker))
7199 (untabify beg end)
7200 (unless no-message
7201 (when vhdl-progress-interval
7202 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7203 (count-lines (point-min) end) 0))))
7204 (vhdl-fixup-whitespace-region beg end t)
7205 (goto-char beg)
7206 (if (not vhdl-align-groups)
7207 ;; align entire region
7208 (progn (vhdl-align-region-1 beg end spacing)
7209 (unless no-comments
7210 (vhdl-align-inline-comment-region-1 beg end)))
7211 ;; align groups
7212 (while (and (< beg end)
7213 (re-search-forward vhdl-align-group-separate end t))
7214 (setq pos (point-marker))
7215 (vhdl-align-region-1 beg pos spacing)
7216 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7217 (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7218 (setq beg (1+ pos))
7219 (goto-char beg))
7220 ;; align last group
7221 (when (< beg end)
7222 (vhdl-align-region-1 beg end spacing)
7223 (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7224 (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7225 (when vhdl-indent-tabs-mode
7226 (tabify orig end))
7227 (unless no-message
7228 (when vhdl-progress-interval (message "Aligning...done"))
7229 (setq vhdl-progress-info nil)))))
7231 (defun vhdl-align-region (beg end &optional spacing)
7232 "Align region, treat blocks with same indent and argument lists separately."
7233 (interactive "r\nP")
7234 (if (not vhdl-align-same-indent)
7235 ;; align entire region
7236 (vhdl-align-region-groups beg end spacing)
7237 ;; align blocks with same indent and argument lists
7238 (save-excursion
7239 (let ((cur-beg beg)
7240 indent cur-end)
7241 (when vhdl-progress-interval
7242 (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7243 (count-lines (point-min) end) 0)))
7244 (goto-char end)
7245 (setq end (point-marker))
7246 (goto-char cur-beg)
7247 (while (< (point) end)
7248 ;; is argument list opening?
7249 (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7250 (point) (vhdl-point 'eol)))))
7251 ;; determine region for argument list
7252 (progn (goto-char cur-beg)
7253 (forward-sexp)
7254 (setq cur-end (point))
7255 (beginning-of-line 2))
7256 ;; determine region with same indent
7257 (setq indent (current-indentation))
7258 (setq cur-beg (point))
7259 (setq cur-end (vhdl-point 'bonl))
7260 (beginning-of-line 2)
7261 (while (and (< (point) end)
7262 (or (looking-at "^\\s-*\\(--.*\\)?$")
7263 (= (current-indentation) indent))
7264 (<= (save-excursion
7265 (nth 0 (parse-partial-sexp
7266 (point) (vhdl-point 'eol)))) 0))
7267 (unless (looking-at "^\\s-*$")
7268 (setq cur-end (vhdl-point 'bonl)))
7269 (beginning-of-line 2)))
7270 ;; align region
7271 (vhdl-align-region-groups cur-beg cur-end spacing t t))
7272 (vhdl-align-inline-comment-region beg end spacing noninteractive)
7273 (when vhdl-progress-interval (message "Aligning...done"))
7274 (setq vhdl-progress-info nil)))))
7276 (defun vhdl-align-group (&optional spacing)
7277 "Align group of lines between empty lines."
7278 (interactive)
7279 (vhdl-do-group 'vhdl-align-region spacing))
7281 (defun vhdl-align-list (&optional spacing)
7282 "Align the lines of a list surrounded by a balanced group of parentheses."
7283 (interactive)
7284 (vhdl-do-list 'vhdl-align-region-groups spacing))
7286 (defun vhdl-align-same-indent (&optional spacing)
7287 "Align block of lines with same indent."
7288 (interactive)
7289 (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7291 (defun vhdl-align-declarations (&optional spacing)
7292 "Align the lines within the declarative part of a design unit."
7293 (interactive)
7294 (let (beg end)
7295 (vhdl-prepare-search-2
7296 (save-excursion
7297 ;; search for declarative part
7298 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
7299 (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7300 (setq beg (point))
7301 (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7302 (setq end (point)))))
7303 (if beg
7304 (vhdl-align-region-groups beg end spacing)
7305 (error "ERROR: Not within the declarative part of a design unit"))))
7307 (defun vhdl-align-buffer ()
7308 "Align buffer."
7309 (interactive)
7310 (vhdl-align-region (point-min) (point-max)))
7312 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7313 ;; Align inline comments
7315 (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7316 "Align inline comments in region."
7317 (save-excursion
7318 (let ((start-max comment-column)
7319 (length-max 0)
7320 comment-list start-list tmp-list start length
7321 cur-start prev-start no-code)
7322 (setq spacing (or spacing 2))
7323 (vhdl-prepare-search-2
7324 (goto-char beg)
7325 ;; search for comment start positions and lengths
7326 (while (< (point) end)
7327 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7328 (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$")
7329 (not (save-excursion (goto-char (match-beginning 2))
7330 (vhdl-in-literal))))
7331 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7332 (setq length (- (match-end 2) (match-beginning 2)))
7333 (setq start-max (max start start-max))
7334 (setq length-max (max length length-max))
7335 (setq comment-list (cons (cons start length) comment-list)))
7336 (beginning-of-line 2))
7337 (setq comment-list
7338 (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
7339 ;; reduce start positions
7340 (setq start-list (list (caar comment-list)))
7341 (setq comment-list (cdr comment-list))
7342 (while comment-list
7343 (unless (or (= (caar comment-list) (car start-list))
7344 (<= (+ (car start-list) (cdar comment-list))
7345 end-comment-column))
7346 (setq start-list (cons (caar comment-list) start-list)))
7347 (setq comment-list (cdr comment-list)))
7348 ;; align lines as nicely as possible
7349 (goto-char beg)
7350 (while (< (point) end)
7351 (setq cur-start nil)
7352 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7353 (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7354 (not (save-excursion
7355 (goto-char (match-beginning 3))
7356 (vhdl-in-literal))))
7357 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7358 (>= (- (match-end 2) (match-beginning 2))
7359 comment-column))))
7360 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7361 (setq length (- (match-end 3) (match-beginning 3)))
7362 (setq no-code (= (match-beginning 1) (match-end 1)))
7363 ;; insert minimum whitespace
7364 (goto-char (match-end 2))
7365 (delete-region (match-beginning 2) (match-end 2))
7366 (insert-char ?\ spacing)
7367 (setq tmp-list start-list)
7368 ;; insert additional whitespace to align
7369 (setq cur-start
7370 (cond
7371 ;; align comment-only line to inline comment of previous line
7372 ((and no-code prev-start
7373 (<= length (- end-comment-column prev-start)))
7374 prev-start)
7375 ;; align all comments at `start-max' if this is possible
7376 ((<= (+ start-max length-max) end-comment-column)
7377 start-max)
7378 ;; align at `comment-column' if possible
7379 ((and (<= start comment-column)
7380 (<= length (- end-comment-column comment-column)))
7381 comment-column)
7382 ;; align at left-most possible start position otherwise
7384 (while (and tmp-list (< (car tmp-list) start))
7385 (setq tmp-list (cdr tmp-list)))
7386 (car tmp-list))))
7387 (indent-to cur-start))
7388 (setq prev-start cur-start)
7389 (beginning-of-line 2))))))
7391 (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7392 "Align inline comments within a region. Groups of code lines separated by
7393 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7394 (interactive "r\nP")
7395 (save-excursion
7396 (let (orig pos)
7397 (goto-char beg)
7398 (beginning-of-line)
7399 (setq orig (point-marker))
7400 (setq beg (point))
7401 (goto-char end)
7402 (setq end (point-marker))
7403 (untabify beg end)
7404 (unless no-message (message "Aligning inline comments..."))
7405 (goto-char beg)
7406 (if (not vhdl-align-groups)
7407 ;; align entire region
7408 (vhdl-align-inline-comment-region-1 beg end spacing)
7409 ;; align groups
7410 (while (and (< beg end)
7411 (re-search-forward vhdl-align-group-separate end t))
7412 (setq pos (point-marker))
7413 (vhdl-align-inline-comment-region-1 beg pos spacing)
7414 (setq beg (1+ pos))
7415 (goto-char beg))
7416 ;; align last group
7417 (when (< beg end)
7418 (vhdl-align-inline-comment-region-1 beg end spacing)))
7419 (when vhdl-indent-tabs-mode
7420 (tabify orig end))
7421 (unless no-message (message "Aligning inline comments...done")))))
7423 (defun vhdl-align-inline-comment-group (&optional spacing)
7424 "Align inline comments within a group of lines between empty lines."
7425 (interactive)
7426 (save-excursion
7427 (let ((start (point))
7428 beg end)
7429 (setq end (if (re-search-forward vhdl-align-group-separate nil t)
7430 (point-marker) (point-max)))
7431 (goto-char start)
7432 (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
7433 (point) (point-min)))
7434 (untabify beg end)
7435 (message "Aligning inline comments...")
7436 (vhdl-align-inline-comment-region-1 beg end)
7437 (when vhdl-indent-tabs-mode
7438 (tabify beg end))
7439 (message "Aligning inline comments...done"))))
7441 (defun vhdl-align-inline-comment-buffer ()
7442 "Align inline comments within buffer. Groups of code lines separated by
7443 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7444 (interactive)
7445 (vhdl-align-inline-comment-region (point-min) (point-max)))
7447 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7448 ;; Fixup whitespace
7450 (defun vhdl-fixup-whitespace-region (beg end &optional no-message)
7451 "Fixup whitespace in region. Surround operator symbols by one space,
7452 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7453 end of line, do nothing in comments and strings."
7454 (interactive "r")
7455 (unless no-message (message "Fixing up whitespace..."))
7456 (save-excursion
7457 (goto-char end)
7458 (setq end (point-marker))
7459 ;; have no space before and one space after `,' and ';'
7460 (goto-char beg)
7461 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
7462 (if (match-string 1)
7463 (goto-char (match-end 1))
7464 (replace-match "\\3 " nil nil nil 3)))
7465 ;; have no space after `('
7466 (goto-char beg)
7467 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\((\\)\\s-+" end t)
7468 (if (match-string 1)
7469 (goto-char (match-end 1))
7470 (replace-match "\\2")))
7471 ;; have no space before `)'
7472 (goto-char beg)
7473 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
7474 (if (match-string 1)
7475 (goto-char (match-end 1))
7476 (replace-match "\\2")))
7477 ;; surround operator symbols by one space
7478 (goto-char beg)
7479 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t)
7480 (if (match-string 1)
7481 (goto-char (match-end 1))
7482 (replace-match "\\3 \\4 \\5")
7483 (goto-char (match-end 4))))
7484 ;; eliminate multiple spaces and spaces at end of line
7485 (goto-char beg)
7486 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
7487 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
7488 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
7489 (progn (replace-match "" nil nil) t))
7490 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
7491 (progn (replace-match ";" nil nil) t))
7492 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
7493 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
7494 (progn (replace-match " " nil nil) t))
7495 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
7496 (progn (replace-match " " nil nil) t))
7497 (re-search-forward "[^ \t-]+" end t))))
7498 (unless no-message (message "Fixing up whitespace...done")))
7500 (defun vhdl-fixup-whitespace-buffer ()
7501 "Fixup whitespace in buffer. Surround operator symbols by one space,
7502 eliminate multiple spaces (except at beginning of line), eliminate spaces at
7503 end of line, do nothing in comments."
7504 (interactive)
7505 (vhdl-fixup-whitespace-region (point-min) (point-max)))
7507 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7508 ;; Beautify
7510 (defun vhdl-beautify-region (beg end)
7511 "Beautify region by applying indentation, whitespace fixup, alignment, and
7512 case fixing to a region. Calls functions `vhdl-indent-buffer',
7513 `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
7514 `vhdl-fix-case-buffer'."
7515 (interactive "r")
7516 (setq end (save-excursion (goto-char end) (point-marker)))
7517 (vhdl-indent-region beg end nil)
7518 (let ((vhdl-align-groups t))
7519 (vhdl-align-region beg end))
7520 (vhdl-fix-case-region beg end))
7522 (defun vhdl-beautify-buffer ()
7523 "Beautify buffer by applying indentation, whitespace fixup, alignment, and
7524 case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire
7525 buffer."
7526 (interactive)
7527 (vhdl-beautify-region (point-min) (point-max))
7528 (when noninteractive (save-buffer)))
7530 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7531 ;; Code filling
7533 (defun vhdl-fill-region (beg end &optional arg)
7534 "Fill lines for a region of code."
7535 (interactive "r")
7536 (save-excursion
7537 (goto-char beg)
7538 (let ((margin (if (interactive-p) (current-indentation) (current-column))))
7539 (goto-char end)
7540 (setq end (point-marker))
7541 ;; remove inline comments, newlines and whitespace
7542 (vhdl-comment-kill-region beg end)
7543 (vhdl-comment-kill-inline-region beg end)
7544 (subst-char-in-region beg (1- end) ?\n ?\ )
7545 (vhdl-fixup-whitespace-region beg end)
7546 ;; wrap and end-comment-column
7547 (goto-char beg)
7548 (while (re-search-forward "\\s-" end t)
7549 (when(> (current-column) vhdl-end-comment-column)
7550 (backward-char)
7551 (when (re-search-backward "\\s-" beg t)
7552 (replace-match "\n")
7553 (indent-to margin)))))))
7555 (defun vhdl-fill-group ()
7556 "Fill group of lines between empty lines."
7557 (interactive)
7558 (vhdl-do-group 'vhdl-fill-region))
7560 (defun vhdl-fill-list ()
7561 "Fill the lines of a list surrounded by a balanced group of parentheses."
7562 (interactive)
7563 (vhdl-do-list 'vhdl-fill-region))
7565 (defun vhdl-fill-same-indent ()
7566 "Fill the lines of block of lines with same indent."
7567 (interactive)
7568 (vhdl-do-same-indent 'vhdl-fill-region))
7571 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7572 ;;; Code updating/fixing
7573 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7575 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7576 ;; Sensitivity list update
7578 ;; Strategy:
7579 ;; - no sensitivity list is generated for processes with wait statements
7580 ;; - otherwise, do the following:
7581 ;; 1. scan for all local signals (ports, signals declared in arch./blocks)
7582 ;; 2. scan for all signals already in the sensitivity list (in order to catch
7583 ;; manually entered global signals)
7584 ;; 3. signals from 1. and 2. form the list of visible signals
7585 ;; 4. search for if/elsif conditions containing an event (sequential code)
7586 ;; 5. scan for strings that are within syntactical regions where signals are
7587 ;; read but not within sequential code, and that correspond to visible
7588 ;; signals
7589 ;; 6. replace sensitivity list by list of signals from 5.
7591 (defun vhdl-update-sensitivity-list-process ()
7592 "Update sensitivity list of current process."
7593 (interactive)
7594 (save-excursion
7595 (vhdl-prepare-search-2
7596 (end-of-line)
7597 ;; look whether in process
7598 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
7599 (equal (upcase (match-string 2)) "PROCESS")
7600 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
7601 (error "ERROR: Not within a process")
7602 (message "Updating sensitivity list...")
7603 (vhdl-update-sensitivity-list)
7604 (message "Updating sensitivity list...done")))))
7606 (defun vhdl-update-sensitivity-list-buffer ()
7607 "Update sensitivity list of all processes in current buffer."
7608 (interactive)
7609 (save-excursion
7610 (vhdl-prepare-search-2
7611 (goto-char (point-min))
7612 (message "Updating sensitivity lists...")
7613 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t)
7614 (goto-char (match-beginning 0))
7615 (condition-case nil (vhdl-update-sensitivity-list) (error)))
7616 (message "Updating sensitivity lists...done"))))
7618 (defun vhdl-update-sensitivity-list ()
7619 "Update sensitivity list."
7620 (let ((proc-beg (point))
7621 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
7622 (proc-mid (re-search-backward "^\\s-*begin\\>" nil t))
7623 seq-region-list)
7624 (cond
7625 ;; search for wait statement (no sensitivity list allowed)
7626 ((progn (goto-char proc-mid)
7627 (vhdl-re-search-forward "\\<wait\\>" proc-end t))
7628 (error "ERROR: Process with wait statement, sensitivity list not generated"))
7629 ;; combinational process (update sensitivity list)
7631 (let
7632 ;; scan for visible signals
7633 ((visible-list (vhdl-get-visible-signals))
7634 ;; define syntactic regions where signals are read
7635 (scan-regions-list
7636 '(;; right-hand side of signal/variable assignment
7637 ;; (special case: "<=" is relational operator in a condition)
7638 ((re-search-forward "[<:]=" proc-end t)
7639 (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
7640 ;; if condition
7641 ((re-search-forward "^\\s-*if\\>" proc-end t)
7642 (re-search-forward "\\<then\\>" proc-end t))
7643 ;; elsif condition
7644 ((re-search-forward "\\<elsif\\>" proc-end t)
7645 (re-search-forward "\\<then\\>" proc-end t))
7646 ;; while loop condition
7647 ((re-search-forward "^\\s-*while\\>" proc-end t)
7648 (re-search-forward "\\<loop\\>" proc-end t))
7649 ;; exit/next condition
7650 ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
7651 (re-search-forward ";" proc-end t))
7652 ;; assert condition
7653 ((re-search-forward "\\<assert\\>" proc-end t)
7654 (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
7655 ;; case expression
7656 ((re-search-forward "^\\s-*case\\>" proc-end t)
7657 (re-search-forward "\\<is\\>" proc-end t))
7658 ;; parameter list of procedure call
7659 ((re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
7660 (progn (backward-char) (forward-sexp) (point)))))
7661 name read-list sens-list signal-list
7662 sens-beg sens-end beg end margin)
7663 ;; scan for signals in old sensitivity list
7664 (goto-char proc-beg)
7665 (re-search-forward "\\<process\\>" proc-mid t)
7666 (if (not (looking-at "[ \t\n]*("))
7667 (setq sens-beg (point))
7668 (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t))
7669 (goto-char (match-end 1))
7670 (forward-sexp)
7671 (setq sens-end (1- (point)))
7672 (goto-char sens-beg)
7673 (while (and (re-search-forward "\\(\\w+\\)" sens-end t)
7674 (setq sens-list
7675 (cons (downcase (match-string 0)) sens-list))
7676 (re-search-forward "\\s-*,\\s-*" sens-end t))))
7677 (setq signal-list (append visible-list sens-list))
7678 ;; search for sequential parts
7679 (goto-char proc-mid)
7680 (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
7681 (setq end (re-search-forward "\\<then\\>" proc-end t))
7682 (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
7683 (goto-char end)
7684 (backward-word 1)
7685 (vhdl-forward-sexp)
7686 (setq seq-region-list (cons (cons end (point)) seq-region-list))
7687 (beginning-of-line)))
7688 ;; scan for signals read in process
7689 (while scan-regions-list
7690 (goto-char proc-mid)
7691 (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
7692 (setq end (eval (nth 1 (car scan-regions-list)))))
7693 (goto-char beg)
7694 (unless (or (vhdl-in-literal)
7695 (and seq-region-list
7696 (let ((tmp-list seq-region-list))
7697 (while (and tmp-list
7698 (< (point) (caar tmp-list)))
7699 (setq tmp-list (cdr tmp-list)))
7700 (and tmp-list (< (point) (cdar tmp-list))))))
7701 (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>" end t)
7702 (setq name (match-string 1))
7703 (when (member (downcase name) signal-list)
7704 (add-to-list 'read-list name)))))
7705 (setq scan-regions-list (cdr scan-regions-list)))
7706 ;; update sensitivity list
7707 (goto-char sens-beg)
7708 (if sens-end
7709 (delete-region sens-beg sens-end)
7710 (when read-list
7711 (insert " ()") (backward-char)))
7712 (setq read-list (sort read-list 'string<))
7713 (when read-list
7714 (setq margin (current-column))
7715 (insert (car read-list))
7716 (setq read-list (cdr read-list))
7717 (while read-list
7718 (insert ",")
7719 (if (<= (+ (current-column) (length (car read-list)) 2)
7720 end-comment-column)
7721 (insert " ")
7722 (insert "\n") (indent-to margin))
7723 (insert (car read-list))
7724 (setq read-list (cdr read-list)))))))))
7726 (defun vhdl-get-visible-signals ()
7727 "Get all signals visible in the current block."
7728 (save-excursion
7729 (let (beg end signal-list entity-name file-name)
7730 ;; search for signals declared in surrounding block declarative parts
7731 (save-excursion
7732 (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
7733 (match-string 2))
7734 (goto-char (match-end 2))
7735 (vhdl-backward-sexp)
7736 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
7737 beg)
7738 (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
7739 ;; scan for all declared signal names
7740 (goto-char beg)
7741 (while (re-search-forward "^\\s-*signal\\>" end t)
7742 (while (and (not (looking-at "[ \t\n]*:"))
7743 (re-search-forward "[ \t\n,]+\\(\\w+\\)" end t))
7744 (setq signal-list
7745 (cons (downcase (match-string 1)) signal-list))))
7746 (goto-char beg)))
7747 ;; search for signals declared in architecture declarative part
7748 (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
7749 (not (equal "END" (upcase (match-string 1))))
7750 (setq entity-name (match-string 2))
7751 (setq end (re-search-forward "^begin\\>" nil t))))
7752 (error "ERROR: No architecture declarative part found")
7753 ;; scan for all declared signal names
7754 (goto-char beg)
7755 (while (re-search-forward "^\\s-*signal\\>" end t)
7756 (while (and (not (looking-at "[ \t\n]*:"))
7757 (re-search-forward "[ \t\n,]+\\(\\w+\\)" end t))
7758 (setq signal-list
7759 (cons (downcase (match-string 1)) signal-list)))))
7760 ;; search for signals declared in entity port clause
7761 (goto-char (point-min))
7762 (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
7763 (setq file-name
7764 (concat (vhdl-replace-string vhdl-entity-file-name entity-name)
7765 "." (file-name-extension (buffer-file-name)))))
7766 (vhdl-visit-file
7767 file-name t
7768 (vhdl-prepare-search-2
7769 (goto-char (point-min))
7770 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
7771 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name)
7772 (when (setq beg (re-search-forward
7773 "^\\s-*port[ \t\n]*("
7774 (save-excursion
7775 (re-search-forward "^end\\>" nil t)) t))
7776 (setq end (save-excursion
7777 (backward-char) (forward-sexp) (point)))
7778 (vhdl-forward-syntactic-ws)
7779 (while (< (point) end)
7780 (while (and (not (looking-at "[ \t\n]*:"))
7781 (re-search-forward "[ \t\n,]*\\(\\w+\\)" end t))
7782 (setq signal-list
7783 (cons (downcase (match-string 1)) signal-list)))
7784 (re-search-forward ";" end 1)
7785 (vhdl-forward-syntactic-ws))))))
7786 signal-list)))
7788 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7789 ;; Generic/port clause fixing
7791 (defun vhdl-fix-clause ()
7792 "Fix closing parenthesis within generic/port clause."
7793 (interactive)
7794 (save-excursion
7795 (vhdl-prepare-search-2
7796 (let ((pos (point))
7797 beg end)
7798 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t))
7799 (error "ERROR: Not within a generic/port clause")
7800 ;; search for end of clause
7801 (goto-char (match-end 0))
7802 (setq beg (1- (point)))
7803 (vhdl-forward-syntactic-ws)
7804 (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;")
7805 (goto-char (1- (match-end 0)))
7806 (setq end (point-marker))
7807 (forward-char)
7808 (vhdl-forward-syntactic-ws))
7809 (goto-char end)
7810 (when (> pos (save-excursion (end-of-line) (point)))
7811 (error "ERROR: Not within a generic/port clause"))
7812 ;; delete closing parenthesis on separate line (not supported style)
7813 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
7814 (vhdl-line-kill)
7815 (vhdl-backward-syntactic-ws)
7816 (setq end (point-marker))
7817 (insert ";"))
7818 ;; delete superfluous parentheses
7819 (while (progn (goto-char beg)
7820 (condition-case () (forward-sexp)
7821 (error (goto-char (point-max))))
7822 (< (point) end))
7823 (delete-backward-char 1))
7824 ;; add closing parenthesis
7825 (when (> (point) end)
7826 (goto-char end)
7827 (insert ")")))))))
7829 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7830 ;; Miscellaneous
7832 (defun vhdl-remove-trailing-spaces ()
7833 "Remove trailing spaces in the whole buffer."
7834 (interactive)
7835 (save-match-data
7836 (save-excursion
7837 (goto-char (point-min))
7838 (while (re-search-forward "[ \t]+$" (point-max) t)
7839 (unless (vhdl-in-literal)
7840 (replace-match "" nil nil))))))
7843 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7844 ;;; Electrification
7845 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7847 (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
7848 "Syntax of prompt inserted by template generators.")
7850 (defvar vhdl-template-invoked-by-hook nil
7851 "Indicates whether a template has been invoked by a hook or by key or menu.
7852 Used for undoing after template abortion.")
7854 ;; correct different behavior of function `unread-command-events' in XEmacs
7855 (defun vhdl-character-to-event (arg))
7856 (defalias 'vhdl-character-to-event
7857 (if vhdl-xemacs 'character-to-event 'identity))
7859 (defun vhdl-work-library ()
7860 "Return the working library name of the current project or \"work\" if no
7861 project is defined."
7862 (vhdl-resolve-env-variable
7863 (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
7865 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7866 ;; Enabling/disabling
7868 (defun vhdl-mode-line-update ()
7869 "Update the modeline string for VHDL major mode."
7870 (setq mode-name (concat "VHDL"
7871 (and (or vhdl-electric-mode vhdl-stutter-mode) "/")
7872 (and vhdl-electric-mode "e")
7873 (and vhdl-stutter-mode "s")))
7874 (force-mode-line-update t))
7876 (defun vhdl-electric-mode (arg)
7877 "Toggle VHDL electric mode.
7878 Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
7879 (interactive "P")
7880 (setq vhdl-electric-mode
7881 (cond ((or (not arg) (zerop arg)) (not vhdl-electric-mode))
7882 ((> arg 0) t) (t nil)))
7883 (vhdl-mode-line-update))
7885 (defun vhdl-stutter-mode (arg)
7886 "Toggle VHDL stuttering mode.
7887 Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
7888 (interactive "P")
7889 (setq vhdl-stutter-mode
7890 (cond ((or (not arg) (zerop arg)) (not vhdl-stutter-mode))
7891 ((> arg 0) t) (t nil)))
7892 (vhdl-mode-line-update))
7894 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7895 ;; Stuttering
7897 (defun vhdl-electric-dash (count)
7898 "-- starts a comment, --- draws a horizontal line,
7899 ---- starts a display comment"
7900 (interactive "p")
7901 (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
7902 (cond
7903 ((and abbrev-start-location (= abbrev-start-location (point)))
7904 (setq abbrev-start-location nil)
7905 (goto-char last-abbrev-location)
7906 (beginning-of-line nil)
7907 (vhdl-comment-display))
7908 ((/= (preceding-char) ?-) ; standard dash (minus)
7909 (self-insert-command count))
7910 (t (self-insert-command count)
7911 (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment")
7912 (let ((next-input (read-char)))
7913 (if (= next-input ?-) ; triple dash
7914 (progn
7915 (vhdl-comment-display-line)
7916 (message
7917 "Enter '-' for display comment, else continue coding")
7918 (let ((next-input (read-char)))
7919 (if (= next-input ?-) ; four dashes
7920 (vhdl-comment-display t)
7921 (setq unread-command-events ; pushback the char
7922 (list (vhdl-character-to-event next-input))))))
7923 (setq unread-command-events ; pushback the char
7924 (list (vhdl-character-to-event next-input)))
7925 (vhdl-comment-insert)))))
7926 (self-insert-command count)))
7928 (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
7929 (interactive "p")
7930 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7931 (if (= (preceding-char) ?\()
7932 (progn (delete-char -1) (insert-char ?\[ 1))
7933 (insert-char ?\( 1))
7934 (self-insert-command count)))
7936 (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
7937 (interactive "p")
7938 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7939 (progn
7940 (if (= (preceding-char) ?\))
7941 (progn (delete-char -1) (insert-char ?\] 1))
7942 (insert-char ?\) 1))
7943 (blink-matching-open))
7944 (self-insert-command count)))
7946 (defun vhdl-electric-quote (count) "'' --> \""
7947 (interactive "p")
7948 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7949 (if (= (preceding-char) last-input-char)
7950 (progn (delete-backward-char 1) (insert-char ?\" 1))
7951 (insert-char ?\' 1))
7952 (self-insert-command count)))
7954 (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
7955 (interactive "p")
7956 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7957 (cond ((= (preceding-char) last-input-char)
7958 (progn (delete-char -1)
7959 (unless (eq (preceding-char) ? ) (insert " "))
7960 (insert ": ")
7961 (setq this-command 'vhdl-electric-colon)))
7962 ((and
7963 (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? ))
7964 (progn (delete-char -1) (insert "= ")))
7965 (t (insert-char ?\; 1)))
7966 (self-insert-command count)))
7968 (defun vhdl-electric-comma (count) "',,' --> ' <= '"
7969 (interactive "p")
7970 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7971 (cond ((= (preceding-char) last-input-char)
7972 (progn (delete-char -1)
7973 (unless (eq (preceding-char) ? ) (insert " "))
7974 (insert "<= ")))
7975 (t (insert-char ?\, 1)))
7976 (self-insert-command count)))
7978 (defun vhdl-electric-period (count) "'..' --> ' => '"
7979 (interactive "p")
7980 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7981 (cond ((= (preceding-char) last-input-char)
7982 (progn (delete-char -1)
7983 (unless (eq (preceding-char) ? ) (insert " "))
7984 (insert "=> ")))
7985 (t (insert-char ?\. 1)))
7986 (self-insert-command count)))
7988 (defun vhdl-electric-equal (count) "'==' --> ' == '"
7989 (interactive "p")
7990 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7991 (cond ((= (preceding-char) last-input-char)
7992 (progn (delete-char -1)
7993 (unless (eq (preceding-char) ? ) (insert " "))
7994 (insert "== ")))
7995 (t (insert-char ?\= 1)))
7996 (self-insert-command count)))
7998 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7999 ;; VHDL templates
8001 (defun vhdl-template-paired-parens ()
8002 "Insert a pair of round parentheses, placing point between them."
8003 (interactive)
8004 (insert "()")
8005 (backward-char))
8007 (defun vhdl-template-alias ()
8008 "Insert alias declaration."
8009 (interactive)
8010 (let ((start (point)))
8011 (vhdl-insert-keyword "ALIAS ")
8012 (when (vhdl-template-field "name" nil t start (point))
8013 (insert " : ")
8014 (unless (vhdl-template-field
8015 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8016 nil t)
8017 (delete-backward-char 3))
8018 (vhdl-insert-keyword " IS ")
8019 (vhdl-template-field "name" ";")
8020 (vhdl-comment-insert-inline))))
8022 (defun vhdl-template-architecture ()
8023 "Insert architecture."
8024 (interactive)
8025 (let ((margin (current-indentation))
8026 (start (point))
8027 arch-name)
8028 (vhdl-insert-keyword "ARCHITECTURE ")
8029 (when (setq arch-name
8030 (vhdl-template-field "name" nil t start (point)))
8031 (vhdl-insert-keyword " OF ")
8032 (if (save-excursion
8033 (vhdl-prepare-search-1
8034 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8035 (insert (match-string 1))
8036 (vhdl-template-field "entity name"))
8037 (vhdl-insert-keyword " IS\n")
8038 (vhdl-template-begin-end
8039 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8040 (memq vhdl-insert-empty-lines '(unit all))))))
8042 (defun vhdl-template-array (kind &optional secondary)
8043 "Insert array type definition."
8044 (interactive)
8045 (let ((start (point)))
8046 (vhdl-insert-keyword "ARRAY (")
8047 (when (or (vhdl-template-field "range" nil (not secondary) start (point))
8048 secondary)
8049 (vhdl-insert-keyword ") OF ")
8050 (vhdl-template-field (if (eq kind 'type) "type" "nature"))
8051 (vhdl-insert-keyword ";"))))
8053 (defun vhdl-template-assert ()
8054 "Insert an assertion statement."
8055 (interactive)
8056 (let ((start (point)))
8057 (vhdl-insert-keyword "ASSERT ")
8058 (when vhdl-conditions-in-parenthesis (insert "("))
8059 (when (vhdl-template-field "condition (negated)" nil t start (point))
8060 (when vhdl-conditions-in-parenthesis (insert ")"))
8061 (setq start (point))
8062 (vhdl-insert-keyword " REPORT ")
8063 (unless (vhdl-template-field "string expression" nil nil nil nil t)
8064 (delete-region start (point)))
8065 (setq start (point))
8066 (vhdl-insert-keyword " SEVERITY ")
8067 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
8068 (delete-region start (point)))
8069 (insert ";"))))
8071 (defun vhdl-template-attribute ()
8072 "Insert an attribute declaration or specification."
8073 (interactive)
8074 (if (eq (vhdl-decision-query
8075 "attribute" "(d)eclaration or (s)pecification?" t) ?s)
8076 (vhdl-template-attribute-spec)
8077 (vhdl-template-attribute-decl)))
8079 (defun vhdl-template-attribute-decl ()
8080 "Insert an attribute declaration."
8081 (interactive)
8082 (let ((start (point)))
8083 (vhdl-insert-keyword "ATTRIBUTE ")
8084 (when (vhdl-template-field "name" " : " t start (point))
8085 (vhdl-template-field "type" ";")
8086 (vhdl-comment-insert-inline))))
8088 (defun vhdl-template-attribute-spec ()
8089 "Insert an attribute specification."
8090 (interactive)
8091 (let ((start (point)))
8092 (vhdl-insert-keyword "ATTRIBUTE ")
8093 (when (vhdl-template-field "name" nil t start (point))
8094 (vhdl-insert-keyword " OF ")
8095 (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8096 (vhdl-template-field "entity class")
8097 (vhdl-insert-keyword " IS ")
8098 (vhdl-template-field "expression" ";"))))
8100 (defun vhdl-template-block ()
8101 "Insert a block."
8102 (interactive)
8103 (let ((margin (current-indentation))
8104 (start (point))
8105 label)
8106 (vhdl-insert-keyword ": BLOCK ")
8107 (goto-char start)
8108 (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
8109 (forward-word 1)
8110 (forward-char 1)
8111 (insert "(")
8112 (if (vhdl-template-field "[guard expression]" nil t)
8113 (insert ")")
8114 (delete-char -2))
8115 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8116 (insert "\n")
8117 (vhdl-template-begin-end "BLOCK" label margin)
8118 (vhdl-comment-block))))
8120 (defun vhdl-template-block-configuration ()
8121 "Insert a block configuration statement."
8122 (interactive)
8123 (let ((margin (current-indentation))
8124 (start (point)))
8125 (vhdl-insert-keyword "FOR ")
8126 (when (vhdl-template-field "block name" nil t start (point))
8127 (vhdl-insert-keyword "\n\n")
8128 (indent-to margin)
8129 (vhdl-insert-keyword "END FOR;")
8130 (end-of-line 0)
8131 (indent-to (+ margin vhdl-basic-offset)))))
8133 (defun vhdl-template-break ()
8134 "Insert a break statement."
8135 (interactive)
8136 (let (position)
8137 (vhdl-insert-keyword "BREAK")
8138 (setq position (point))
8139 (insert " ")
8140 (while (or
8141 (progn (vhdl-insert-keyword "FOR ")
8142 (if (vhdl-template-field "[quantity name]" " USE " t)
8143 (progn (vhdl-template-field "quantity name" " => ") t)
8144 (kill-word -1) nil))
8145 (vhdl-template-field "[quantity name]" " => " t))
8146 (vhdl-template-field "expression")
8147 (setq position (point))
8148 (insert ", "))
8149 (delete-region position (point))
8150 (unless (vhdl-sequential-statement-p)
8151 (vhdl-insert-keyword " ON ")
8152 (if (vhdl-template-field "[sensitivity list]" nil t)
8153 (setq position (point))
8154 (delete-region position (point))))
8155 (vhdl-insert-keyword " WHEN ")
8156 (when vhdl-conditions-in-parenthesis (insert "("))
8157 (if (vhdl-template-field "[condition]" nil t)
8158 (when vhdl-conditions-in-parenthesis (insert ")"))
8159 (delete-region position (point)))
8160 (insert ";")))
8162 (defun vhdl-template-case (&optional kind)
8163 "Insert a case statement."
8164 (interactive)
8165 (let ((margin (current-indentation))
8166 (start (point))
8167 label)
8168 (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use)))
8169 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8170 (vhdl-insert-keyword "CASE ")
8171 (vhdl-insert-keyword ": CASE ")
8172 (goto-char start)
8173 (setq label (vhdl-template-field "[label]" nil t))
8174 (unless label (delete-char 2))
8175 (forward-word 1)
8176 (forward-char 1))
8177 (when (vhdl-template-field "expression" nil t start (point))
8178 (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
8179 (indent-to margin)
8180 (vhdl-insert-keyword "END CASE")
8181 (when label (insert " " label))
8182 (insert ";")
8183 (forward-line -1)
8184 (indent-to (+ margin vhdl-basic-offset))
8185 (vhdl-insert-keyword "WHEN ")
8186 (let ((position (point)))
8187 (insert " => ;\n")
8188 (indent-to (+ margin vhdl-basic-offset))
8189 (vhdl-insert-keyword "WHEN OTHERS => null;")
8190 (goto-char position)))))
8192 (defun vhdl-template-case-is ()
8193 "Insert a sequential case statement."
8194 (interactive)
8195 (vhdl-template-case 'is))
8197 (defun vhdl-template-case-use ()
8198 "Insert a simultaneous case statement."
8199 (interactive)
8200 (vhdl-template-case 'use))
8202 (defun vhdl-template-component ()
8203 "Insert a component declaration."
8204 (interactive)
8205 (vhdl-template-component-decl))
8207 (defun vhdl-template-component-conf ()
8208 "Insert a component configuration (uses `vhdl-template-configuration-spec'
8209 since these are almost equivalent)."
8210 (interactive)
8211 (let ((margin (current-indentation))
8212 (result (vhdl-template-configuration-spec t)))
8213 (when result
8214 (insert "\n")
8215 (indent-to margin)
8216 (vhdl-insert-keyword "END FOR;")
8217 (when (eq result 'no-use)
8218 (end-of-line -0)))))
8220 (defun vhdl-template-component-decl ()
8221 "Insert a component declaration."
8222 (interactive)
8223 (let ((margin (current-indentation))
8224 (start (point))
8225 name end-column)
8226 (vhdl-insert-keyword "COMPONENT ")
8227 (when (setq name (vhdl-template-field "name" nil t start (point)))
8228 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8229 (insert "\n\n")
8230 (indent-to margin)
8231 (vhdl-insert-keyword "END COMPONENT")
8232 (unless (vhdl-standard-p '87) (insert " " name))
8233 (insert ";")
8234 (setq end-column (current-column))
8235 (end-of-line -0)
8236 (indent-to (+ margin vhdl-basic-offset))
8237 (vhdl-template-generic-list t t)
8238 (insert "\n")
8239 (indent-to (+ margin vhdl-basic-offset))
8240 (vhdl-template-port-list t)
8241 (beginning-of-line 2)
8242 (forward-char end-column))))
8244 (defun vhdl-template-component-inst ()
8245 "Insert a component instantiation statement."
8246 (interactive)
8247 (let ((margin (current-indentation))
8248 (start (point))
8249 unit position)
8250 (when (vhdl-template-field "instance label" nil t start (point))
8251 (insert ": ")
8252 (if (not (vhdl-use-direct-instantiation))
8253 (vhdl-template-field "component name")
8254 ;; direct instantiation
8255 (setq unit (vhdl-template-field
8256 "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
8257 (setq unit (upcase (or unit "")))
8258 (cond ((equal unit "ENTITY")
8259 (vhdl-template-field "library name" "." nil nil nil nil
8260 (vhdl-work-library))
8261 (vhdl-template-field "entity name" "(")
8262 (if (vhdl-template-field "[architecture name]" nil t)
8263 (insert ")")
8264 (delete-char -1)))
8265 ((equal unit "CONFIGURATION")
8266 (vhdl-template-field "library name" "." nil nil nil nil
8267 (vhdl-work-library))
8268 (vhdl-template-field "configuration name"))
8269 (t (vhdl-template-field "component name"))))
8270 (insert "\n")
8271 (indent-to (+ margin vhdl-basic-offset))
8272 (setq position (point))
8273 (vhdl-insert-keyword "GENERIC ")
8274 (when (vhdl-template-map position t t)
8275 (insert "\n")
8276 (indent-to (+ margin vhdl-basic-offset)))
8277 (setq position (point))
8278 (vhdl-insert-keyword "PORT ")
8279 (unless (vhdl-template-map position t t)
8280 (kill-line -0)
8281 (delete-char -1))
8282 (insert ";"))))
8284 (defun vhdl-template-conditional-signal-asst ()
8285 "Insert a conditional signal assignment."
8286 (interactive)
8287 (when (vhdl-template-field "target signal")
8288 (insert " <= ")
8289 ; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") ""))
8290 ; (insert " "))
8291 (let ((margin (current-column))
8292 (start (point))
8293 position)
8294 (vhdl-template-field "waveform")
8295 (setq position (point))
8296 (vhdl-insert-keyword " WHEN ")
8297 (when vhdl-conditions-in-parenthesis (insert "("))
8298 (while (and (vhdl-template-field "[condition]" nil t)
8299 (progn
8300 (when vhdl-conditions-in-parenthesis (insert ")"))
8301 (setq position (point))
8302 (vhdl-insert-keyword " ELSE")
8303 (insert "\n")
8304 (indent-to margin)
8305 (vhdl-template-field "[waveform]" nil t)))
8306 (setq position (point))
8307 (vhdl-insert-keyword " WHEN ")
8308 (when vhdl-conditions-in-parenthesis (insert "(")))
8309 (delete-region position (point))
8310 (insert ";")
8311 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
8313 (defun vhdl-template-configuration ()
8314 "Insert a configuration specification if within an architecture,
8315 a block or component configuration if within a configuration declaration,
8316 a configuration declaration if not within a design unit."
8317 (interactive)
8318 (vhdl-prepare-search-1
8319 (cond
8320 ((and (save-excursion ; architecture body
8321 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
8322 (equal "ARCHITECTURE" (upcase (match-string 1))))
8323 (vhdl-template-configuration-spec))
8324 ((and (save-excursion ; configuration declaration
8325 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8326 (equal "CONFIGURATION" (upcase (match-string 1))))
8327 (if (eq (vhdl-decision-query
8328 "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
8329 (vhdl-template-component-conf)
8330 (vhdl-template-block-configuration)))
8331 (t (vhdl-template-configuration-decl))))) ; otherwise
8333 (defun vhdl-template-configuration-spec (&optional optional-use)
8334 "Insert a configuration specification."
8335 (interactive)
8336 (let ((margin (current-indentation))
8337 (start (point))
8338 aspect position)
8339 (vhdl-insert-keyword "FOR ")
8340 (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
8341 t start (point))
8342 (vhdl-template-field "component name" "\n")
8343 (indent-to (+ margin vhdl-basic-offset))
8344 (setq start (point))
8345 (vhdl-insert-keyword "USE ")
8346 (if (and optional-use
8347 (not (setq aspect (vhdl-template-field
8348 "[ENTITY | CONFIGURATION | OPEN]" " " t))))
8349 (progn (delete-region start (point)) 'no-use)
8350 (unless optional-use
8351 (setq aspect (vhdl-template-field
8352 "ENTITY | CONFIGURATION | OPEN" " ")))
8353 (setq aspect (upcase (or aspect "")))
8354 (cond ((equal aspect "ENTITY")
8355 (vhdl-template-field "library name" "." nil nil nil nil
8356 (vhdl-work-library))
8357 (vhdl-template-field "entity name" "(")
8358 (if (vhdl-template-field "[architecture name]" nil t)
8359 (insert ")")
8360 (delete-char -1))
8361 (insert "\n")
8362 (indent-to (+ margin (* 2 vhdl-basic-offset)))
8363 (setq position (point))
8364 (vhdl-insert-keyword "GENERIC ")
8365 (when (vhdl-template-map position t t)
8366 (insert "\n")
8367 (indent-to (+ margin (* 2 vhdl-basic-offset))))
8368 (setq position (point))
8369 (vhdl-insert-keyword "PORT ")
8370 (unless (vhdl-template-map position t t)
8371 (kill-line -0)
8372 (delete-char -1))
8373 (insert ";")
8375 ((equal aspect "CONFIGURATION")
8376 (vhdl-template-field "library name" "." nil nil nil nil
8377 (vhdl-work-library))
8378 (vhdl-template-field "configuration name" ";"))
8379 (t (delete-backward-char 1) (insert ";") t))))))
8382 (defun vhdl-template-configuration-decl ()
8383 "Insert a configuration declaration."
8384 (interactive)
8385 (let ((margin (current-indentation))
8386 (start (point))
8387 entity-exists string name position)
8388 (vhdl-insert-keyword "CONFIGURATION ")
8389 (when (setq name (vhdl-template-field "name" nil t start (point)))
8390 (vhdl-insert-keyword " OF ")
8391 (save-excursion
8392 (vhdl-prepare-search-1
8393 (setq entity-exists (vhdl-re-search-backward
8394 "\\<entity \\(\\w*\\) is\\>" nil t))
8395 (setq string (match-string 1))))
8396 (if (and entity-exists (not (equal string "")))
8397 (insert string)
8398 (vhdl-template-field "entity name"))
8399 (vhdl-insert-keyword " IS\n")
8400 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8401 (indent-to (+ margin vhdl-basic-offset))
8402 (setq position (point))
8403 (insert "\n")
8404 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8405 (indent-to margin)
8406 (vhdl-insert-keyword "END ")
8407 (unless (vhdl-standard-p '87)
8408 (vhdl-insert-keyword "CONFIGURATION "))
8409 (insert name ";")
8410 (goto-char position))))
8412 (defun vhdl-template-constant ()
8413 "Insert a constant declaration."
8414 (interactive)
8415 (let ((start (point))
8416 (in-arglist (vhdl-in-argument-list-p)))
8417 (vhdl-insert-keyword "CONSTANT ")
8418 (when (vhdl-template-field "name" nil t start (point))
8419 (insert " : ")
8420 (when in-arglist (vhdl-insert-keyword "IN "))
8421 (vhdl-template-field "type")
8422 (if in-arglist
8423 (progn (insert ";")
8424 (vhdl-comment-insert-inline))
8425 (let ((position (point)))
8426 (insert " := ")
8427 (unless (vhdl-template-field "[initialization]" nil t)
8428 (delete-region position (point)))
8429 (insert ";")
8430 (vhdl-comment-insert-inline))))))
8432 (defun vhdl-template-default ()
8433 "Insert nothing."
8434 (interactive)
8435 (insert " ")
8436 (unexpand-abbrev)
8437 (backward-word 1)
8438 (vhdl-case-word 1)
8439 (forward-char 1))
8441 (defun vhdl-template-default-indent ()
8442 "Insert nothing and indent."
8443 (interactive)
8444 (insert " ")
8445 (unexpand-abbrev)
8446 (backward-word 1)
8447 (vhdl-case-word 1)
8448 (forward-char 1)
8449 (indent-according-to-mode))
8451 (defun vhdl-template-disconnect ()
8452 "Insert a disconnect statement."
8453 (interactive)
8454 (let ((start (point)))
8455 (vhdl-insert-keyword "DISCONNECT ")
8456 (when (vhdl-template-field "signal names | OTHERS | ALL"
8457 " : " t start (point))
8458 (vhdl-template-field "type")
8459 (vhdl-insert-keyword " AFTER ")
8460 (vhdl-template-field "time expression" ";"))))
8462 (defun vhdl-template-else ()
8463 "Insert an else statement."
8464 (interactive)
8465 (let (margin)
8466 (vhdl-prepare-search-1
8467 (vhdl-insert-keyword "ELSE")
8468 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
8469 (equal "WHEN" (upcase (match-string 1))))
8470 (insert " ")
8471 (indent-according-to-mode)
8472 (setq margin (current-indentation))
8473 (insert "\n")
8474 (indent-to (+ margin vhdl-basic-offset))))))
8476 (defun vhdl-template-elsif ()
8477 "Insert an elsif statement."
8478 (interactive)
8479 (let ((start (point))
8480 margin)
8481 (vhdl-insert-keyword "ELSIF ")
8482 (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
8483 (when vhdl-conditions-in-parenthesis (insert "("))
8484 (when (vhdl-template-field "condition" nil t start (point))
8485 (when vhdl-conditions-in-parenthesis (insert ")"))
8486 (indent-according-to-mode)
8487 (setq margin (current-indentation))
8488 (vhdl-insert-keyword
8489 (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
8490 (indent-to (+ margin vhdl-basic-offset))))))
8492 (defun vhdl-template-entity ()
8493 "Insert an entity."
8494 (interactive)
8495 (let ((margin (current-indentation))
8496 (start (point))
8497 name end-column)
8498 (vhdl-insert-keyword "ENTITY ")
8499 (when (setq name (vhdl-template-field "name" nil t start (point)))
8500 (vhdl-insert-keyword " IS\n\n")
8501 (indent-to margin)
8502 (vhdl-insert-keyword "END ")
8503 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
8504 (insert name ";")
8505 (setq end-column (current-column))
8506 (end-of-line -0)
8507 (indent-to (+ margin vhdl-basic-offset))
8508 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8509 (indent-to (+ margin vhdl-basic-offset))
8510 (when (vhdl-template-generic-list t)
8511 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
8512 (insert "\n")
8513 (indent-to (+ margin vhdl-basic-offset))
8514 (when (vhdl-template-port-list t)
8515 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
8516 (beginning-of-line 2)
8517 (forward-char end-column))))
8519 (defun vhdl-template-exit ()
8520 "Insert an exit statement."
8521 (interactive)
8522 (let ((start (point)))
8523 (vhdl-insert-keyword "EXIT ")
8524 (if (vhdl-template-field "[loop label]" nil t start (point))
8525 (let ((position (point)))
8526 (vhdl-insert-keyword " WHEN ")
8527 (when vhdl-conditions-in-parenthesis (insert "("))
8528 (if (vhdl-template-field "[condition]" nil t)
8529 (when vhdl-conditions-in-parenthesis (insert ")"))
8530 (delete-region position (point))))
8531 (delete-char -1))
8532 (insert ";")))
8534 (defun vhdl-template-file ()
8535 "Insert a file declaration."
8536 (interactive)
8537 (let ((start (point)))
8538 (vhdl-insert-keyword "FILE ")
8539 (when (vhdl-template-field "name" nil t start (point))
8540 (insert " : ")
8541 (vhdl-template-field "type")
8542 (unless (vhdl-standard-p '87)
8543 (vhdl-insert-keyword " OPEN ")
8544 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
8545 nil t)
8546 (delete-backward-char 6)))
8547 (vhdl-insert-keyword " IS ")
8548 (when (vhdl-standard-p '87)
8549 (vhdl-template-field "[IN | OUT]" " " t))
8550 (vhdl-template-field "filename-string" nil nil nil nil t)
8551 (insert ";")
8552 (vhdl-comment-insert-inline))))
8554 (defun vhdl-template-for ()
8555 "Insert a block or component configuration if within a configuration
8556 declaration, a configuration specification if within an architecture
8557 declarative part (and not within a subprogram), a for-loop if within a
8558 sequential statement part (subprogram or process), and a for-generate
8559 otherwise."
8560 (interactive)
8561 (vhdl-prepare-search-1
8562 (cond
8563 ((vhdl-sequential-statement-p) ; sequential statement
8564 (vhdl-template-for-loop))
8565 ((and (save-excursion ; configuration declaration
8566 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8567 (equal "CONFIGURATION" (upcase (match-string 1))))
8568 (if (eq (vhdl-decision-query
8569 "for" "(b)lock or (c)omponent configuration?" t) ?c)
8570 (vhdl-template-component-conf)
8571 (vhdl-template-block-configuration)))
8572 ((and (save-excursion
8573 (re-search-backward ; architecture declarative part
8574 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
8575 (equal "ARCHITECTURE" (upcase (match-string 1))))
8576 (vhdl-template-configuration-spec))
8577 (t (vhdl-template-for-generate))))) ; concurrent statement
8579 (defun vhdl-template-for-generate ()
8580 "Insert a for-generate."
8581 (interactive)
8582 (let ((margin (current-indentation))
8583 (start (point))
8584 label position)
8585 (vhdl-insert-keyword ": FOR ")
8586 (setq position (point-marker))
8587 (goto-char start)
8588 (when (setq label (vhdl-template-field "label" nil t start position))
8589 (goto-char position)
8590 (vhdl-template-field "loop variable")
8591 (vhdl-insert-keyword " IN ")
8592 (vhdl-template-field "range")
8593 (vhdl-template-generate-body margin label))))
8595 (defun vhdl-template-for-loop ()
8596 "Insert a for loop."
8597 (interactive)
8598 (let ((margin (current-indentation))
8599 (start (point))
8600 label index)
8601 (if (not (eq vhdl-optional-labels 'all))
8602 (vhdl-insert-keyword "FOR ")
8603 (vhdl-insert-keyword ": FOR ")
8604 (goto-char start)
8605 (setq label (vhdl-template-field "[label]" nil t))
8606 (unless label (delete-char 2))
8607 (forward-word 1)
8608 (forward-char 1))
8609 (when (setq index (vhdl-template-field "loop variable"
8610 nil t start (point)))
8611 (vhdl-insert-keyword " IN ")
8612 (vhdl-template-field "range")
8613 (vhdl-insert-keyword " LOOP\n\n")
8614 (indent-to margin)
8615 (vhdl-insert-keyword "END LOOP")
8616 (if label
8617 (insert " " label ";")
8618 (insert ";")
8619 (when vhdl-self-insert-comments (insert " -- " index)))
8620 (forward-line -1)
8621 (indent-to (+ margin vhdl-basic-offset)))))
8623 (defun vhdl-template-function (&optional kind)
8624 "Insert a function declaration or body."
8625 (interactive)
8626 (let ((margin (current-indentation))
8627 (start (point))
8628 name)
8629 (vhdl-insert-keyword "FUNCTION ")
8630 (when (setq name (vhdl-template-field "name" nil t start (point)))
8631 (vhdl-template-argument-list t)
8632 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
8633 (end-of-line)
8634 (insert "\n")
8635 (indent-to (+ margin vhdl-basic-offset))
8636 (vhdl-insert-keyword "RETURN ")
8637 (vhdl-template-field "type")
8638 (if (if kind (eq kind 'body)
8639 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
8640 (progn (vhdl-insert-keyword " IS\n")
8641 (vhdl-template-begin-end
8642 (unless (vhdl-standard-p '87) "FUNCTION") name margin)
8643 (vhdl-comment-block))
8644 (insert ";")))))
8646 (defun vhdl-template-function-decl ()
8647 "Insert a function declaration."
8648 (interactive)
8649 (vhdl-template-function 'decl))
8651 (defun vhdl-template-function-body ()
8652 "Insert a function declaration."
8653 (interactive)
8654 (vhdl-template-function 'body))
8656 (defun vhdl-template-generate ()
8657 "Insert a generation scheme."
8658 (interactive)
8659 (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i)
8660 (vhdl-template-if-generate)
8661 (vhdl-template-for-generate)))
8663 (defun vhdl-template-generic ()
8664 "Insert generic declaration, or generic map in instantiation statements."
8665 (interactive)
8666 (let ((start (point)))
8667 (vhdl-prepare-search-1
8668 (cond
8669 ((and (save-excursion ; entity declaration
8670 (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
8671 (equal "ENTITY" (upcase (match-string 1))))
8672 (vhdl-template-generic-list nil))
8673 ((or (save-excursion
8674 (or (beginning-of-line)
8675 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
8676 (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
8677 (vhdl-insert-keyword "GENERIC ")
8678 (vhdl-template-map start))
8679 (t (vhdl-template-generic-list nil t))))))
8681 (defun vhdl-template-group ()
8682 "Insert group or group template declaration."
8683 (interactive)
8684 (let ((start (point)))
8685 (if (eq (vhdl-decision-query
8686 "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
8687 (vhdl-template-group-template)
8688 (vhdl-template-group-decl))))
8690 (defun vhdl-template-group-decl ()
8691 "Insert group declaration."
8692 (interactive)
8693 (let ((start (point)))
8694 (vhdl-insert-keyword "GROUP ")
8695 (when (vhdl-template-field "name" " : " t start (point))
8696 (vhdl-template-field "template name" " (")
8697 (vhdl-template-field "constituent list" ");")
8698 (vhdl-comment-insert-inline))))
8700 (defun vhdl-template-group-template ()
8701 "Insert group template declaration."
8702 (interactive)
8703 (let ((start (point)))
8704 (vhdl-insert-keyword "GROUP ")
8705 (when (vhdl-template-field "template name" nil t start (point))
8706 (vhdl-insert-keyword " IS (")
8707 (vhdl-template-field "entity class list" ");")
8708 (vhdl-comment-insert-inline))))
8710 (defun vhdl-template-if ()
8711 "Insert a sequential if statement or an if-generate statement."
8712 (interactive)
8713 (if (vhdl-sequential-statement-p)
8714 (vhdl-template-if-then)
8715 (if (and (vhdl-standard-p 'ams)
8716 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u))
8717 (vhdl-template-if-use)
8718 (vhdl-template-if-generate))))
8720 (defun vhdl-template-if-generate ()
8721 "Insert an if-generate."
8722 (interactive)
8723 (let ((margin (current-indentation))
8724 (start (point))
8725 label position)
8726 (vhdl-insert-keyword ": IF ")
8727 (setq position (point-marker))
8728 (goto-char start)
8729 (when (setq label (vhdl-template-field "label" nil t start position))
8730 (goto-char position)
8731 (when vhdl-conditions-in-parenthesis (insert "("))
8732 (vhdl-template-field "condition")
8733 (when vhdl-conditions-in-parenthesis (insert ")"))
8734 (vhdl-template-generate-body margin label))))
8736 (defun vhdl-template-if-then-use (kind)
8737 "Insert a sequential if statement."
8738 (interactive)
8739 (let ((margin (current-indentation))
8740 (start (point))
8741 label)
8742 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8743 (vhdl-insert-keyword "IF ")
8744 (vhdl-insert-keyword ": IF ")
8745 (goto-char start)
8746 (setq label (vhdl-template-field "[label]" nil t))
8747 (unless label (delete-char 2))
8748 (forward-word 1)
8749 (forward-char 1))
8750 (when vhdl-conditions-in-parenthesis (insert "("))
8751 (when (vhdl-template-field "condition" nil t start (point))
8752 (when vhdl-conditions-in-parenthesis (insert ")"))
8753 (vhdl-insert-keyword
8754 (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
8755 (indent-to margin)
8756 (vhdl-insert-keyword "END IF")
8757 (when label (insert " " label))
8758 (insert ";")
8759 (forward-line -1)
8760 (indent-to (+ margin vhdl-basic-offset)))))
8762 (defun vhdl-template-if-then ()
8763 "Insert a sequential if statement."
8764 (interactive)
8765 (vhdl-template-if-then-use 'then))
8767 (defun vhdl-template-if-use ()
8768 "Insert a simultaneous if statement."
8769 (interactive)
8770 (vhdl-template-if-then-use 'use))
8772 (defun vhdl-template-instance ()
8773 "Insert a component instantiation statement."
8774 (interactive)
8775 (vhdl-template-component-inst))
8777 (defun vhdl-template-library ()
8778 "Insert a library specification."
8779 (interactive)
8780 (let ((margin (current-indentation))
8781 (start (point))
8782 name end-pos)
8783 (vhdl-insert-keyword "LIBRARY ")
8784 (when (setq name (vhdl-template-field "names" nil t start (point)))
8785 (insert ";")
8786 (unless (string-match "," name)
8787 (setq end-pos (point))
8788 (insert "\n")
8789 (indent-to margin)
8790 (vhdl-insert-keyword "USE ")
8791 (insert name)
8792 (vhdl-insert-keyword "..ALL;")
8793 (backward-char 5)
8794 (if (vhdl-template-field "package name")
8795 (forward-char 5)
8796 (delete-region end-pos (+ (point) 5)))))))
8798 (defun vhdl-template-limit ()
8799 "Insert a limit."
8800 (interactive)
8801 (let ((start (point)))
8802 (vhdl-insert-keyword "LIMIT ")
8803 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
8804 t start (point))
8805 (vhdl-template-field "type")
8806 (vhdl-insert-keyword " WITH ")
8807 (vhdl-template-field "real expression" ";"))))
8809 (defun vhdl-template-loop ()
8810 "Insert a loop."
8811 (interactive)
8812 (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t)))
8813 (cond ((eq char ?w)
8814 (vhdl-template-while-loop))
8815 ((eq char ?f)
8816 (vhdl-template-for-loop))
8817 (t (vhdl-template-bare-loop)))))
8819 (defun vhdl-template-bare-loop ()
8820 "Insert a loop."
8821 (interactive)
8822 (let ((margin (current-indentation))
8823 (start (point))
8824 label)
8825 (if (not (eq vhdl-optional-labels 'all))
8826 (vhdl-insert-keyword "LOOP ")
8827 (vhdl-insert-keyword ": LOOP ")
8828 (goto-char start)
8829 (setq label (vhdl-template-field "[label]" nil t))
8830 (unless label (delete-char 2))
8831 (forward-word 1)
8832 (delete-char 1))
8833 (insert "\n\n")
8834 (indent-to margin)
8835 (vhdl-insert-keyword "END LOOP")
8836 (insert (if label (concat " " label ";") ";"))
8837 (forward-line -1)
8838 (indent-to (+ margin vhdl-basic-offset))))
8840 (defun vhdl-template-map (&optional start optional secondary)
8841 "Insert a map specification with association list."
8842 (interactive)
8843 (let ((start (or start (point)))
8844 margin end-pos)
8845 (vhdl-insert-keyword "MAP (")
8846 (if (not vhdl-association-list-with-formals)
8847 (if (vhdl-template-field
8848 (concat (and optional "[") "association list" (and optional "]"))
8849 ")" (or (not secondary) optional)
8850 (and (not secondary) start) (point))
8852 (if (and optional secondary) (delete-region start (point)))
8853 nil)
8854 (if vhdl-argument-list-indent
8855 (setq margin (current-column))
8856 (setq margin (+ (current-indentation) vhdl-basic-offset))
8857 (insert "\n")
8858 (indent-to margin))
8859 (if (vhdl-template-field
8860 (concat (and optional "[") "formal" (and optional "]"))
8861 " => " (or (not secondary) optional)
8862 (and (not secondary) start) (point))
8863 (progn
8864 (vhdl-template-field "actual" ",")
8865 (setq end-pos (point))
8866 (insert "\n")
8867 (indent-to margin)
8868 (while (vhdl-template-field "[formal]" " => " t)
8869 (vhdl-template-field "actual" ",")
8870 (setq end-pos (point))
8871 (insert "\n")
8872 (indent-to margin))
8873 (delete-region end-pos (point))
8874 (delete-backward-char 1)
8875 (insert ")")
8876 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
8878 (when (and optional secondary) (delete-region start (point)))
8879 nil))))
8881 (defun vhdl-template-modify (&optional noerror)
8882 "Actualize modification date."
8883 (interactive)
8884 (vhdl-prepare-search-2
8885 (save-excursion
8886 (goto-char (point-min))
8887 (if (re-search-forward vhdl-modify-date-prefix-string nil t)
8888 (progn (delete-region (point) (progn (end-of-line) (point)))
8889 (vhdl-template-insert-date))
8890 (unless noerror
8891 (error (concat "ERROR: Modification date prefix string \""
8892 vhdl-modify-date-prefix-string "\" not found")))))))
8894 (defun vhdl-template-modify-noerror ()
8895 "Call `vhdl-template-modify' with NOERROR non-nil."
8896 (vhdl-template-modify t))
8898 (defun vhdl-template-nature ()
8899 "Insert a nature declaration."
8900 (interactive)
8901 (let ((start (point))
8902 name mid-pos end-pos)
8903 (vhdl-insert-keyword "NATURE ")
8904 (when (setq name (vhdl-template-field "name" nil t start (point)))
8905 (vhdl-insert-keyword " IS ")
8906 (let ((definition
8907 (upcase
8908 (or (vhdl-template-field
8909 "across type | ARRAY | RECORD")
8910 ""))))
8911 (cond ((equal definition "")
8912 (insert ";"))
8913 ((equal definition "ARRAY")
8914 (kill-word -1)
8915 (vhdl-template-array 'nature t))
8916 ((equal definition "RECORD")
8917 (setq mid-pos (point-marker))
8918 (kill-word -1)
8919 (vhdl-template-record 'nature name t))
8921 (vhdl-insert-keyword " ACROSS ")
8922 (vhdl-template-field "through type")
8923 (vhdl-insert-keyword " THROUGH ")
8924 (vhdl-template-field "reference name")
8925 (vhdl-insert-keyword " REFERENCE;")))
8926 (when mid-pos
8927 (setq end-pos (point-marker))
8928 (goto-char mid-pos)
8929 (end-of-line))
8930 (vhdl-comment-insert-inline)
8931 (when end-pos (goto-char end-pos))))))
8933 (defun vhdl-template-next ()
8934 "Insert a next statement."
8935 (interactive)
8936 (let ((start (point)))
8937 (vhdl-insert-keyword "NEXT ")
8938 (if (vhdl-template-field "[loop label]" nil t start (point))
8939 (let ((position (point)))
8940 (vhdl-insert-keyword " WHEN ")
8941 (when vhdl-conditions-in-parenthesis (insert "("))
8942 (if (vhdl-template-field "[condition]" nil t)
8943 (when vhdl-conditions-in-parenthesis (insert ")"))
8944 (delete-region position (point))))
8945 (delete-char -1))
8946 (insert ";")))
8948 (defun vhdl-template-others ()
8949 "Insert an others aggregate."
8950 (interactive)
8951 (let ((start (point)))
8952 (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
8953 (progn (unless vhdl-template-invoked-by-hook (insert "("))
8954 (vhdl-insert-keyword "OTHERS => '")
8955 (when (vhdl-template-field "value" nil t start (point))
8956 (insert "')")))
8957 (vhdl-insert-keyword "OTHERS "))))
8959 (defun vhdl-template-package (&optional kind)
8960 "Insert a package specification or body."
8961 (interactive)
8962 (let ((margin (current-indentation))
8963 (start (point))
8964 name body position)
8965 (vhdl-insert-keyword "PACKAGE ")
8966 (setq body (if kind (eq kind 'body)
8967 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
8968 (when body
8969 (vhdl-insert-keyword "BODY ")
8970 (when (save-excursion
8971 (vhdl-prepare-search-1
8972 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
8973 (insert (setq name (match-string 1)))))
8974 (when (or name
8975 (setq name (vhdl-template-field "name" nil t start (point))))
8976 (vhdl-insert-keyword " IS\n")
8977 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8978 (indent-to (+ margin vhdl-basic-offset))
8979 (setq position (point))
8980 (insert "\n")
8981 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8982 (indent-to margin)
8983 (vhdl-insert-keyword "END ")
8984 (unless (vhdl-standard-p '87)
8985 (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY "))))
8986 (insert (or name "") ";")
8987 (goto-char position))))
8989 (defun vhdl-template-package-decl ()
8990 "Insert a package specification."
8991 (interactive)
8992 (vhdl-template-package 'decl))
8994 (defun vhdl-template-package-body ()
8995 "Insert a package body."
8996 (interactive)
8997 (vhdl-template-package 'body))
8999 (defun vhdl-template-port ()
9000 "Insert a port declaration, or port map in instantiation statements."
9001 (interactive)
9002 (let ((start (point)))
9003 (vhdl-prepare-search-1
9004 (cond
9005 ((and (save-excursion ; entity declaration
9006 (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9007 (equal "ENTITY" (upcase (match-string 1))))
9008 (vhdl-template-port-list nil))
9009 ((or (save-excursion
9010 (or (beginning-of-line)
9011 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9012 (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9013 (vhdl-insert-keyword "PORT ")
9014 (vhdl-template-map start))
9015 (t (vhdl-template-port-list nil))))))
9017 (defun vhdl-template-procedural ()
9018 "Insert a procedural."
9019 (interactive)
9020 (let ((margin (current-indentation))
9021 (start (point))
9022 (case-fold-search t)
9023 label)
9024 (vhdl-insert-keyword "PROCEDURAL ")
9025 (when (memq vhdl-optional-labels '(process all))
9026 (goto-char start)
9027 (insert ": ")
9028 (goto-char start)
9029 (setq label (vhdl-template-field "[label]" nil t))
9030 (unless label (delete-char 2))
9031 (forward-word 1)
9032 (forward-char 1))
9033 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9034 (insert "\n")
9035 (vhdl-template-begin-end "PROCEDURAL" label margin)
9036 (vhdl-comment-block)))
9038 (defun vhdl-template-procedure (&optional kind)
9039 "Insert a procedure declaration or body."
9040 (interactive)
9041 (let ((margin (current-indentation))
9042 (start (point))
9043 name)
9044 (vhdl-insert-keyword "PROCEDURE ")
9045 (when (setq name (vhdl-template-field "name" nil t start (point)))
9046 (vhdl-template-argument-list)
9047 (if (if kind (eq kind 'body)
9048 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9049 (progn (vhdl-insert-keyword " IS")
9050 (when vhdl-auto-align
9051 (vhdl-align-region-groups start (point) 1))
9052 (end-of-line) (insert "\n")
9053 (vhdl-template-begin-end
9054 (unless (vhdl-standard-p '87) "PROCEDURE")
9055 name margin)
9056 (vhdl-comment-block))
9057 (insert ";")
9058 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9059 (end-of-line)))))
9061 (defun vhdl-template-procedure-decl ()
9062 "Insert a procedure declaration."
9063 (interactive)
9064 (vhdl-template-procedure 'decl))
9066 (defun vhdl-template-procedure-body ()
9067 "Insert a procedure body."
9068 (interactive)
9069 (vhdl-template-procedure 'body))
9071 (defun vhdl-template-process (&optional kind)
9072 "Insert a process."
9073 (interactive)
9074 (let ((margin (current-indentation))
9075 (start (point))
9076 label seq input-signals clock reset final-pos)
9077 (setq seq (if kind (eq kind 'seq)
9078 (eq (vhdl-decision-query
9079 "process" "(c)ombinational or (s)equential?" t) ?s)))
9080 (vhdl-insert-keyword "PROCESS ")
9081 (when (memq vhdl-optional-labels '(process all))
9082 (goto-char start)
9083 (insert ": ")
9084 (goto-char start)
9085 (setq label (vhdl-template-field "[label]" nil t))
9086 (unless label (delete-char 2))
9087 (forward-word 1)
9088 (forward-char 1))
9089 (insert "(")
9090 (if (not seq)
9091 (unless (setq input-signals
9092 (vhdl-template-field "[sensitivity list]" ")" t))
9093 (setq input-signals "")
9094 (delete-char -2))
9095 (setq clock (or (and (not (equal "" vhdl-clock-name))
9096 (progn (insert vhdl-clock-name) vhdl-clock-name))
9097 (vhdl-template-field "clock name") "<clock>"))
9098 (when (eq vhdl-reset-kind 'async)
9099 (insert ", ")
9100 (setq reset (or (and (not (equal "" vhdl-reset-name))
9101 (progn (insert vhdl-reset-name) vhdl-reset-name))
9102 (vhdl-template-field "reset name") "<reset>")))
9103 (insert ")"))
9104 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9105 (insert "\n")
9106 (vhdl-template-begin-end "PROCESS" label margin)
9107 (when seq (setq reset (vhdl-template-seq-process clock reset)))
9108 (when vhdl-prompt-for-comments
9109 (setq final-pos (point-marker))
9110 (vhdl-prepare-search-2
9111 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9112 (vhdl-re-search-backward "\\<process\\>" nil t))
9113 (end-of-line -0)
9114 (if (bobp)
9115 (progn (insert "\n") (forward-line -1))
9116 (insert "\n"))
9117 (indent-to margin)
9118 (insert "-- purpose: ")
9119 (if (not (vhdl-template-field "[description]" nil t))
9120 (vhdl-line-kill-entire)
9121 (insert "\n")
9122 (indent-to margin)
9123 (insert "-- type : ")
9124 (insert (if seq "sequential" "combinational") "\n")
9125 (indent-to margin)
9126 (insert "-- inputs : ")
9127 (if (not seq)
9128 (insert input-signals)
9129 (insert clock ", ")
9130 (when reset (insert reset ", "))
9131 (unless (vhdl-template-field "[signal names]" nil t)
9132 (delete-char -2)))
9133 (insert "\n")
9134 (indent-to margin)
9135 (insert "-- outputs: ")
9136 (vhdl-template-field "[signal names]" nil t))))
9137 (goto-char final-pos))))
9139 (defun vhdl-template-process-comb ()
9140 "Insert a combinational process."
9141 (interactive)
9142 (vhdl-template-process 'comb))
9144 (defun vhdl-template-process-seq ()
9145 "Insert a sequential process."
9146 (interactive)
9147 (vhdl-template-process 'seq))
9149 (defun vhdl-template-quantity ()
9150 "Insert a quantity declaration."
9151 (interactive)
9152 (if (vhdl-in-argument-list-p)
9153 (let ((start (point)))
9154 (vhdl-insert-keyword "QUANTITY ")
9155 (when (vhdl-template-field "names" nil t start (point))
9156 (insert " : ")
9157 (vhdl-template-field "[IN | OUT]" " " t)
9158 (vhdl-template-field "type")
9159 (insert ";")
9160 (vhdl-comment-insert-inline)))
9161 (let ((char (vhdl-decision-query
9162 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
9163 (cond ((eq char ?f) (vhdl-template-quantity-free))
9164 ((eq char ?b) (vhdl-template-quantity-branch))
9165 ((eq char ?s) (vhdl-template-quantity-source))
9166 (t (vhdl-template-undo (point) (point)))))))
9168 (defun vhdl-template-quantity-free ()
9169 "Insert a free quantity declaration."
9170 (interactive)
9171 (vhdl-insert-keyword "QUANTITY ")
9172 (vhdl-template-field "names")
9173 (insert " : ")
9174 (vhdl-template-field "type")
9175 (let ((position (point)))
9176 (insert " := ")
9177 (unless (vhdl-template-field "[initialization]" nil t)
9178 (delete-region position (point)))
9179 (insert ";")
9180 (vhdl-comment-insert-inline)))
9182 (defun vhdl-template-quantity-branch ()
9183 "Insert a branch quantity declaration."
9184 (interactive)
9185 (let (position)
9186 (vhdl-insert-keyword "QUANTITY ")
9187 (when (vhdl-template-field "[across names]" " " t)
9188 (vhdl-insert-keyword "ACROSS "))
9189 (when (vhdl-template-field "[through names]" " " t)
9190 (vhdl-insert-keyword "THROUGH "))
9191 (vhdl-template-field "plus terminal name")
9192 (setq position (point))
9193 (vhdl-insert-keyword " TO ")
9194 (unless (vhdl-template-field "[minus terminal name]" nil t)
9195 (delete-region position (point)))
9196 (insert ";")
9197 (vhdl-comment-insert-inline)))
9199 (defun vhdl-template-quantity-source ()
9200 "Insert a source quantity declaration."
9201 (interactive)
9202 (vhdl-insert-keyword "QUANTITY ")
9203 (vhdl-template-field "names")
9204 (insert " : ")
9205 (vhdl-template-field "type" " ")
9206 (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n)
9207 (progn (vhdl-insert-keyword "NOISE ")
9208 (vhdl-template-field "power expression"))
9209 (vhdl-insert-keyword "SPECTRUM ")
9210 (vhdl-template-field "magnitude expression" ", ")
9211 (vhdl-template-field "phase expression"))
9212 (insert ";")
9213 (vhdl-comment-insert-inline))
9215 (defun vhdl-template-record (kind &optional name secondary)
9216 "Insert a record type declaration."
9217 (interactive)
9218 (let ((margin (current-column))
9219 (start (point))
9220 (first t))
9221 (vhdl-insert-keyword "RECORD\n")
9222 (indent-to (+ margin vhdl-basic-offset))
9223 (when (or (vhdl-template-field "element names"
9224 nil (not secondary) start (point))
9225 secondary)
9226 (while (or first (vhdl-template-field "[element names]" nil t))
9227 (insert " : ")
9228 (vhdl-template-field (if (eq kind 'type) "type" "nature") ";")
9229 (vhdl-comment-insert-inline)
9230 (insert "\n")
9231 (indent-to (+ margin vhdl-basic-offset))
9232 (setq first nil))
9233 (kill-line -0)
9234 (indent-to margin)
9235 (vhdl-insert-keyword "END RECORD")
9236 (unless (vhdl-standard-p '87) (and name (insert " " name)))
9237 (insert ";")
9238 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9240 (defun vhdl-template-report ()
9241 "Insert a report statement."
9242 (interactive)
9243 (let ((start (point)))
9244 (vhdl-insert-keyword "REPORT ")
9245 (if (equal "\"\"" (vhdl-template-field
9246 "string expression" nil t start (point) t))
9247 (delete-backward-char 2)
9248 (setq start (point))
9249 (vhdl-insert-keyword " SEVERITY ")
9250 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
9251 (delete-region start (point)))
9252 (insert ";"))))
9254 (defun vhdl-template-return ()
9255 "Insert a return statement."
9256 (interactive)
9257 (let ((start (point)))
9258 (vhdl-insert-keyword "RETURN ")
9259 (unless (vhdl-template-field "[expression]" nil t start (point))
9260 (delete-char -1))
9261 (insert ";")))
9263 (defun vhdl-template-selected-signal-asst ()
9264 "Insert a selected signal assignment."
9265 (interactive)
9266 (let ((margin (current-indentation))
9267 (start (point))
9268 (choices t))
9269 (let ((position (point)))
9270 (vhdl-insert-keyword " SELECT ")
9271 (goto-char position))
9272 (vhdl-insert-keyword "WITH ")
9273 (when (vhdl-template-field "selector expression"
9274 nil t start (+ (point) 7))
9275 (forward-word 1)
9276 (delete-char 1)
9277 (insert "\n")
9278 (indent-to (+ margin vhdl-basic-offset))
9279 (vhdl-template-field "target signal" " <= ")
9280 ; (vhdl-template-field "[GUARDED] [TRANSPORT]")
9281 (insert "\n")
9282 (indent-to (+ margin vhdl-basic-offset))
9283 (vhdl-template-field "waveform")
9284 (vhdl-insert-keyword " WHEN ")
9285 (vhdl-template-field "choices" ",")
9286 (insert "\n")
9287 (indent-to (+ margin vhdl-basic-offset))
9288 (while (and choices (vhdl-template-field "[waveform]" nil t))
9289 (vhdl-insert-keyword " WHEN ")
9290 (if (setq choices (vhdl-template-field "[choices]" "," t))
9291 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
9292 (vhdl-insert-keyword "OTHERS")))
9293 (when choices
9294 (fixup-whitespace)
9295 (delete-char -2))
9296 (insert ";")
9297 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9299 (defun vhdl-template-signal ()
9300 "Insert a signal declaration."
9301 (interactive)
9302 (let ((start (point))
9303 (in-arglist (vhdl-in-argument-list-p)))
9304 (vhdl-insert-keyword "SIGNAL ")
9305 (when (vhdl-template-field "names" nil t start (point))
9306 (insert " : ")
9307 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
9308 (vhdl-template-field "type")
9309 (if in-arglist
9310 (progn (insert ";")
9311 (vhdl-comment-insert-inline))
9312 (let ((position (point)))
9313 (insert " := ")
9314 (unless (vhdl-template-field "[initialization]" nil t)
9315 (delete-region position (point)))
9316 (insert ";")
9317 (vhdl-comment-insert-inline))))))
9319 (defun vhdl-template-subnature ()
9320 "Insert a subnature declaration."
9321 (interactive)
9322 (let ((start (point))
9323 position)
9324 (vhdl-insert-keyword "SUBNATURE ")
9325 (when (vhdl-template-field "name" nil t start (point))
9326 (vhdl-insert-keyword " IS ")
9327 (vhdl-template-field "nature" " (")
9328 (if (vhdl-template-field "[index range]" nil t)
9329 (insert ")")
9330 (delete-char -2))
9331 (setq position (point))
9332 (vhdl-insert-keyword " TOLERANCE ")
9333 (if (equal "\"\"" (vhdl-template-field "[string expression]"
9334 nil t nil nil t))
9335 (delete-region position (point))
9336 (vhdl-insert-keyword " ACROSS ")
9337 (vhdl-template-field "string expression" nil nil nil nil t)
9338 (vhdl-insert-keyword " THROUGH"))
9339 (insert ";")
9340 (vhdl-comment-insert-inline))))
9342 (defun vhdl-template-subprogram-body ()
9343 "Insert a subprogram body."
9344 (interactive)
9345 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
9346 (vhdl-template-function-body)
9347 (vhdl-template-procedure-body)))
9349 (defun vhdl-template-subprogram-decl ()
9350 "Insert a subprogram declaration."
9351 (interactive)
9352 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
9353 (vhdl-template-function-decl)
9354 (vhdl-template-procedure-decl)))
9356 (defun vhdl-template-subtype ()
9357 "Insert a subtype declaration."
9358 (interactive)
9359 (let ((start (point)))
9360 (vhdl-insert-keyword "SUBTYPE ")
9361 (when (vhdl-template-field "name" nil t start (point))
9362 (vhdl-insert-keyword " IS ")
9363 (vhdl-template-field "type" " ")
9364 (unless
9365 (vhdl-template-field "[RANGE value range | ( index range )]" nil t)
9366 (delete-char -1))
9367 (insert ";")
9368 (vhdl-comment-insert-inline))))
9370 (defun vhdl-template-terminal ()
9371 "Insert a terminal declaration."
9372 (interactive)
9373 (let ((start (point)))
9374 (vhdl-insert-keyword "TERMINAL ")
9375 (when (vhdl-template-field "names" nil t start (point))
9376 (insert " : ")
9377 (vhdl-template-field "nature")
9378 (insert ";")
9379 (vhdl-comment-insert-inline))))
9381 (defun vhdl-template-type ()
9382 "Insert a type declaration."
9383 (interactive)
9384 (let ((start (point))
9385 name mid-pos end-pos)
9386 (vhdl-insert-keyword "TYPE ")
9387 (when (setq name (vhdl-template-field "name" nil t start (point)))
9388 (vhdl-insert-keyword " IS ")
9389 (let ((definition
9390 (upcase
9391 (or (vhdl-template-field
9392 "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)
9393 ""))))
9394 (cond ((equal definition "")
9395 (delete-backward-char 4)
9396 (insert ";"))
9397 ((equal definition "ARRAY")
9398 (kill-word -1)
9399 (vhdl-template-array 'type t))
9400 ((equal definition "RECORD")
9401 (setq mid-pos (point-marker))
9402 (kill-word -1)
9403 (vhdl-template-record 'type name t))
9404 ((equal definition "ACCESS")
9405 (insert " ")
9406 (vhdl-template-field "type" ";"))
9407 ((equal definition "FILE")
9408 (vhdl-insert-keyword " OF ")
9409 (vhdl-template-field "type" ";"))
9410 (t (insert ";")))
9411 (when mid-pos
9412 (setq end-pos (point-marker))
9413 (goto-char mid-pos)
9414 (end-of-line))
9415 (vhdl-comment-insert-inline)
9416 (when end-pos (goto-char end-pos))))))
9418 (defun vhdl-template-use ()
9419 "Insert a use clause."
9420 (interactive)
9421 (let ((start (point)))
9422 (vhdl-prepare-search-1
9423 (vhdl-insert-keyword "USE ")
9424 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
9425 (vhdl-insert-keyword "..ALL;")
9426 (backward-char 6)
9427 (when (vhdl-template-field "library name" nil t start (+ (point) 6))
9428 (forward-char 1)
9429 (vhdl-template-field "package name")
9430 (forward-char 5))))))
9432 (defun vhdl-template-variable ()
9433 "Insert a variable declaration."
9434 (interactive)
9435 (let ((start (point))
9436 (in-arglist (vhdl-in-argument-list-p)))
9437 (vhdl-prepare-search-2
9438 (if (or (save-excursion
9439 (and (vhdl-re-search-backward
9440 "\\<function\\|procedure\\|process\\|procedural\\|end\\>"
9441 nil t)
9442 (not (progn (backward-word 1) (looking-at "\\<end\\>")))))
9443 (save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
9444 (vhdl-insert-keyword "VARIABLE ")
9445 (vhdl-insert-keyword "SHARED VARIABLE ")))
9446 (when (vhdl-template-field "names" nil t start (point))
9447 (insert " : ")
9448 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
9449 (vhdl-template-field "type")
9450 (if in-arglist
9451 (progn (insert ";")
9452 (vhdl-comment-insert-inline))
9453 (let ((position (point)))
9454 (insert " := ")
9455 (unless (vhdl-template-field "[initialization]" nil t)
9456 (delete-region position (point)))
9457 (insert ";")
9458 (vhdl-comment-insert-inline))))))
9460 (defun vhdl-template-wait ()
9461 "Insert a wait statement."
9462 (interactive)
9463 (vhdl-insert-keyword "WAIT ")
9464 (unless (vhdl-template-field
9465 "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
9466 nil t)
9467 (delete-char -1))
9468 (insert ";"))
9470 (defun vhdl-template-when ()
9471 "Indent correctly if within a case statement."
9472 (interactive)
9473 (let ((position (point))
9474 margin)
9475 (vhdl-prepare-search-2
9476 (if (and (= (current-column) (current-indentation))
9477 (vhdl-re-search-forward "\\<end\\>" nil t)
9478 (looking-at "\\s-*\\<case\\>"))
9479 (progn
9480 (setq margin (current-indentation))
9481 (goto-char position)
9482 (delete-horizontal-space)
9483 (indent-to (+ margin vhdl-basic-offset)))
9484 (goto-char position)))
9485 (vhdl-insert-keyword "WHEN ")))
9487 (defun vhdl-template-while-loop ()
9488 "Insert a while loop."
9489 (interactive)
9490 (let* ((margin (current-indentation))
9491 (start (point))
9492 label)
9493 (if (not (eq vhdl-optional-labels 'all))
9494 (vhdl-insert-keyword "WHILE ")
9495 (vhdl-insert-keyword ": WHILE ")
9496 (goto-char start)
9497 (setq label (vhdl-template-field "[label]" nil t))
9498 (unless label (delete-char 2))
9499 (forward-word 1)
9500 (forward-char 1))
9501 (when vhdl-conditions-in-parenthesis (insert "("))
9502 (when (vhdl-template-field "condition" nil t start (point))
9503 (when vhdl-conditions-in-parenthesis (insert ")"))
9504 (vhdl-insert-keyword " LOOP\n\n")
9505 (indent-to margin)
9506 (vhdl-insert-keyword "END LOOP")
9507 (insert (if label (concat " " label ";") ";"))
9508 (forward-line -1)
9509 (indent-to (+ margin vhdl-basic-offset)))))
9511 (defun vhdl-template-with ()
9512 "Insert a with statement (i.e. selected signal assignment)."
9513 (interactive)
9514 (vhdl-prepare-search-1
9515 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
9516 (equal ";" (match-string 1)))
9517 (vhdl-template-selected-signal-asst)
9518 (vhdl-insert-keyword "WITH "))))
9520 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9521 ;; Special templates
9523 (defun vhdl-template-clocked-wait ()
9524 "Insert a wait statement for rising/falling clock edge."
9525 (interactive)
9526 (let ((start (point))
9527 clock)
9528 (vhdl-insert-keyword "WAIT UNTIL ")
9529 (when (setq clock
9530 (or (and (not (equal "" vhdl-clock-name))
9531 (progn (insert vhdl-clock-name) vhdl-clock-name))
9532 (vhdl-template-field "clock name" nil t start (point))))
9533 (insert "'event")
9534 (vhdl-insert-keyword " AND ")
9535 (insert clock)
9536 (insert
9537 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";")
9538 (vhdl-comment-insert-inline
9539 (concat (if vhdl-clock-rising-edge "rising" "falling")
9540 " clock edge")))))
9542 (defun vhdl-template-seq-process (clock reset)
9543 "Insert a template for the body of a sequential process."
9544 (let ((margin (current-indentation))
9545 position)
9546 (vhdl-insert-keyword "IF ")
9547 (when (eq vhdl-reset-kind 'async)
9548 (insert reset " = "
9549 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
9550 (vhdl-insert-keyword " THEN")
9551 (vhdl-comment-insert-inline
9552 (concat "asynchronous reset (active "
9553 (if vhdl-reset-active-high "high" "low") ")"))
9554 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9555 (setq position (point))
9556 (insert "\n") (indent-to margin)
9557 (vhdl-insert-keyword "ELSIF "))
9558 (if (eq vhdl-clock-edge-condition 'function)
9559 (insert (if vhdl-clock-rising-edge "rising" "falling")
9560 "_edge(" clock ")")
9561 (insert clock "'event")
9562 (vhdl-insert-keyword " AND ")
9563 (insert clock " = "
9564 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
9565 (vhdl-insert-keyword " THEN")
9566 (vhdl-comment-insert-inline
9567 (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
9568 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9569 (when (eq vhdl-reset-kind 'sync)
9570 (vhdl-insert-keyword "IF ")
9571 (setq reset (or (and (not (equal "" vhdl-reset-name))
9572 (progn (insert vhdl-reset-name) vhdl-reset-name))
9573 (vhdl-template-field "reset name") "<reset>"))
9574 (insert " = "
9575 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
9576 (vhdl-insert-keyword " THEN")
9577 (vhdl-comment-insert-inline
9578 (concat "synchronous reset (active "
9579 (if vhdl-reset-active-high "high" "low") ")"))
9580 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
9581 (setq position (point))
9582 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9583 (vhdl-insert-keyword "ELSE")
9584 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
9585 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
9586 (vhdl-insert-keyword "END IF;"))
9587 (when (eq vhdl-reset-kind 'none)
9588 (setq position (point)))
9589 (insert "\n") (indent-to margin)
9590 (vhdl-insert-keyword "END IF;")
9591 (goto-char position)
9592 reset))
9594 (defun vhdl-template-standard-package (library package)
9595 "Insert specification of a standard package. Include a library
9596 specification, if not already there."
9597 (let ((margin (current-indentation)))
9598 (unless (equal library "std")
9599 (unless (or (save-excursion
9600 (vhdl-prepare-search-1
9601 (and (not (bobp))
9602 (re-search-backward
9603 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
9604 library "\\|end\\)\\>") nil t)
9605 (match-string 2))))
9606 (equal (downcase library) "work"))
9607 (vhdl-insert-keyword "LIBRARY ")
9608 (insert library ";\n")
9609 (indent-to margin))
9610 (vhdl-insert-keyword "USE ")
9611 (insert library "." package)
9612 (vhdl-insert-keyword ".ALL;"))))
9614 (defun vhdl-template-package-math-complex ()
9615 "Insert specification of `math_complex' package."
9616 (interactive)
9617 (vhdl-template-standard-package "ieee" "math_complex"))
9619 (defun vhdl-template-package-math-real ()
9620 "Insert specification of `math_real' package."
9621 (interactive)
9622 (vhdl-template-standard-package "ieee" "math_real"))
9624 (defun vhdl-template-package-numeric-bit ()
9625 "Insert specification of `numeric_bit' package."
9626 (interactive)
9627 (vhdl-template-standard-package "ieee" "numeric_bit"))
9629 (defun vhdl-template-package-numeric-std ()
9630 "Insert specification of `numeric_std' package."
9631 (interactive)
9632 (vhdl-template-standard-package "ieee" "numeric_std"))
9634 (defun vhdl-template-package-std-logic-1164 ()
9635 "Insert specification of `std_logic_1164' package."
9636 (interactive)
9637 (vhdl-template-standard-package "ieee" "std_logic_1164"))
9639 (defun vhdl-template-package-std-logic-arith ()
9640 "Insert specification of `std_logic_arith' package."
9641 (interactive)
9642 (vhdl-template-standard-package "ieee" "std_logic_arith"))
9644 (defun vhdl-template-package-std-logic-misc ()
9645 "Insert specification of `std_logic_misc' package."
9646 (interactive)
9647 (vhdl-template-standard-package "ieee" "std_logic_misc"))
9649 (defun vhdl-template-package-std-logic-signed ()
9650 "Insert specification of `std_logic_signed' package."
9651 (interactive)
9652 (vhdl-template-standard-package "ieee" "std_logic_signed"))
9654 (defun vhdl-template-package-std-logic-textio ()
9655 "Insert specification of `std_logic_textio' package."
9656 (interactive)
9657 (vhdl-template-standard-package "ieee" "std_logic_textio"))
9659 (defun vhdl-template-package-std-logic-unsigned ()
9660 "Insert specification of `std_logic_unsigned' package."
9661 (interactive)
9662 (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
9664 (defun vhdl-template-package-textio ()
9665 "Insert specification of `textio' package."
9666 (interactive)
9667 (vhdl-template-standard-package "std" "textio"))
9669 (defun vhdl-template-directive (directive)
9670 "Insert directive."
9671 (unless (= (current-indentation) (current-column))
9672 (delete-horizontal-space)
9673 (insert " "))
9674 (insert "-- pragma " directive))
9676 (defun vhdl-template-directive-translate-on ()
9677 "Insert directive 'translate_on'."
9678 (interactive)
9679 (vhdl-template-directive "translate_on"))
9681 (defun vhdl-template-directive-translate-off ()
9682 "Insert directive 'translate_off'."
9683 (interactive)
9684 (vhdl-template-directive "translate_off"))
9686 (defun vhdl-template-directive-synthesis-on ()
9687 "Insert directive 'synthesis_on'."
9688 (interactive)
9689 (vhdl-template-directive "synthesis_on"))
9691 (defun vhdl-template-directive-synthesis-off ()
9692 "Insert directive 'synthesis_off'."
9693 (interactive)
9694 (vhdl-template-directive "synthesis_off"))
9696 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9697 ;; Header and footer templates
9699 (defun vhdl-template-header (&optional file-title)
9700 "Insert a VHDL file header."
9701 (interactive)
9702 (unless (equal vhdl-file-header "")
9703 (let (pos)
9704 (save-excursion
9705 (goto-char (point-min))
9706 (vhdl-insert-string-or-file vhdl-file-header)
9707 (setq pos (point-marker)))
9708 (vhdl-template-replace-header-keywords
9709 (point-min-marker) pos file-title))))
9711 (defun vhdl-template-footer ()
9712 "Insert a VHDL file footer."
9713 (interactive)
9714 (unless (equal vhdl-file-footer "")
9715 (let (pos)
9716 (save-excursion
9717 (goto-char (point-max))
9718 (setq pos (point-marker))
9719 (vhdl-insert-string-or-file vhdl-file-footer)
9720 (unless (= (preceding-char) ?\n)
9721 (insert "\n")))
9722 (vhdl-template-replace-header-keywords pos (point-max-marker)))))
9724 (defun vhdl-template-replace-header-keywords (beg end &optional file-title
9725 is-model)
9726 "Replace keywords in header and footer."
9727 (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
9728 (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
9729 pos)
9730 (vhdl-prepare-search-2
9731 (save-excursion
9732 (goto-char beg)
9733 (while (search-forward "<projectdesc>" end t)
9734 (replace-match project-desc t t))
9735 (goto-char beg)
9736 (while (search-forward "<filename>" end t)
9737 (replace-match (buffer-name) t t))
9738 (goto-char beg)
9739 (while (search-forward "<copyright>" end t)
9740 (replace-match vhdl-copyright-string t t))
9741 (goto-char beg)
9742 (while (search-forward "<author>" end t)
9743 (replace-match "" t t)
9744 (insert (user-full-name))
9745 (when user-mail-address (insert " <" user-mail-address ">")))
9746 (goto-char beg)
9747 (while (search-forward "<login>" end t)
9748 (replace-match (user-login-name) t t))
9749 (goto-char beg)
9750 (while (search-forward "<project>" end t)
9751 (replace-match project-title t t))
9752 (goto-char beg)
9753 (while (search-forward "<company>" end t)
9754 (replace-match vhdl-company-name t t))
9755 (goto-char beg)
9756 (while (search-forward "<platform>" end t)
9757 (replace-match vhdl-platform-spec t t))
9758 (goto-char beg)
9759 (while (search-forward "<standard>" end t)
9760 (replace-match
9761 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
9762 ((vhdl-standard-p '93) "'93"))
9763 (when (vhdl-standard-p 'ams) ", VHDL-AMS")
9764 (when (vhdl-standard-p 'math) ", Math Packages")) t t))
9765 (goto-char beg)
9766 ;; Replace <RCS> with $, so that RCS for the source is
9767 ;; not over-enthusiastic with replacements
9768 (while (search-forward "<RCS>" end t)
9769 (replace-match "$" nil t))
9770 (goto-char beg)
9771 (while (search-forward "<date>" end t)
9772 (replace-match "" t t)
9773 (vhdl-template-insert-date))
9774 (goto-char beg)
9775 (while (search-forward "<year>" end t)
9776 (replace-match (format-time-string "%Y" nil) t t))
9777 (goto-char beg)
9778 (when file-title
9779 (while (search-forward "<title string>" end t)
9780 (replace-match file-title t t))
9781 (goto-char beg))
9782 (let (string)
9783 (while
9784 (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
9785 (setq string (read-string (concat (match-string 1) ": ")))
9786 (replace-match string t t)))
9787 (goto-char beg)
9788 (when (and (not is-model) (search-forward "<cursor>" end t))
9789 (replace-match "" t t)
9790 (setq pos (point))))
9791 (when pos (goto-char pos))
9792 (unless is-model
9793 (when (or (not project-title) (equal project-title ""))
9794 (message "You can specify a project title in user option `vhdl-project-alist'"))
9795 (when (or (not project-desc) (equal project-desc ""))
9796 (message "You can specify a project description in user option `vhdl-project-alist'"))
9797 (when (equal vhdl-platform-spec "")
9798 (message "You can specify a platform in user option `vhdl-platform-spec'"))
9799 (when (equal vhdl-company-name "")
9800 (message "You can specify a company name in user option `vhdl-company-name'"))))))
9802 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9803 ;; Comment templates and functions
9805 (defun vhdl-comment-indent ()
9806 "Indent comments."
9807 (let* ((position (point))
9808 (col
9809 (progn
9810 (forward-line -1)
9811 (if (re-search-forward "--" position t)
9812 (- (current-column) 2) ; existing comment at bol stays there
9813 (goto-char position)
9814 (skip-chars-backward " \t")
9815 (max comment-column ; else indent to comment column
9816 (1+ (current-column))))))) ; except leave at least one space
9817 (goto-char position)
9818 col))
9820 (defun vhdl-comment-insert ()
9821 "Start a comment at the end of the line.
9822 If on line with code, indent at least `comment-column'.
9823 If starting after end-comment-column, start a new line."
9824 (interactive)
9825 (when (> (current-column) end-comment-column) (newline-and-indent))
9826 (if (or (looking-at "\\s-*$") ; end of line
9827 (and (not unread-command-events) ; called with key binding or menu
9828 (not (end-of-line))))
9829 (let (margin)
9830 (while (= (preceding-char) ?-) (delete-char -1))
9831 (setq margin (current-column))
9832 (delete-horizontal-space)
9833 (if (bolp)
9834 (progn (indent-to margin) (insert "--"))
9835 (insert " ")
9836 (indent-to comment-column)
9837 (insert "--"))
9838 (if (not unread-command-events) (insert " ")))
9839 ;; else code following current point implies commenting out code
9840 (let (next-input code)
9841 (while (= (preceding-char) ?-) (delete-char -2))
9842 (while (= (setq next-input (read-char)) 13) ; CR
9843 (insert "--") ; or have a space after it?
9844 (forward-char -2)
9845 (forward-line 1)
9846 (message "Enter CR if commenting out a line of code.")
9847 (setq code t))
9848 (unless code
9849 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
9850 (setq unread-command-events
9851 (list (vhdl-character-to-event next-input)))))) ; pushback the char
9853 (defun vhdl-comment-display (&optional line-exists)
9854 "Add 2 comment lines at the current indent, making a display comment."
9855 (interactive)
9856 (let ((margin (current-indentation)))
9857 (unless line-exists (vhdl-comment-display-line))
9858 (insert "\n") (indent-to margin)
9859 (insert "\n") (indent-to margin)
9860 (vhdl-comment-display-line)
9861 (end-of-line -0)
9862 (insert "-- ")))
9864 (defun vhdl-comment-display-line ()
9865 "Displays one line of dashes."
9866 (interactive)
9867 (while (= (preceding-char) ?-) (delete-char -2))
9868 (let* ((col (current-column))
9869 (len (- end-comment-column col)))
9870 (insert-char ?- len)))
9872 (defun vhdl-comment-append-inline ()
9873 "Append empty inline comment to current line."
9874 (interactive)
9875 (end-of-line)
9876 (delete-horizontal-space)
9877 (insert " ")
9878 (indent-to comment-column)
9879 (insert "-- "))
9881 (defun vhdl-comment-insert-inline (&optional string always-insert)
9882 "Insert inline comment."
9883 (when (or (and string (or vhdl-self-insert-comments always-insert))
9884 (and (not string) vhdl-prompt-for-comments))
9885 (let ((position (point)))
9886 (insert " ")
9887 (indent-to comment-column)
9888 (insert "-- ")
9889 (if (not (or (and string (progn (insert string) t))
9890 (vhdl-template-field "[comment]" nil t)))
9891 (delete-region position (point))
9892 (while (= (preceding-char) ? ) (delete-backward-char 1))
9893 ; (when (> (current-column) end-comment-column)
9894 ; (setq position (point-marker))
9895 ; (re-search-backward "-- ")
9896 ; (insert "\n")
9897 ; (indent-to comment-column)
9898 ; (goto-char position))
9899 ))))
9901 (defun vhdl-comment-block ()
9902 "Insert comment for code block."
9903 (when vhdl-prompt-for-comments
9904 (let ((final-pos (point-marker)))
9905 (vhdl-prepare-search-2
9906 (when (and (re-search-backward "^\\s-*begin\\>" nil t)
9907 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
9908 (let (margin)
9909 (back-to-indentation)
9910 (setq margin (current-column))
9911 (end-of-line -0)
9912 (if (bobp)
9913 (progn (insert "\n") (forward-line -1))
9914 (insert "\n"))
9915 (indent-to margin)
9916 (insert "-- purpose: ")
9917 (unless (vhdl-template-field "[description]" nil t)
9918 (vhdl-line-kill-entire)))))
9919 (goto-char final-pos))))
9921 (defun vhdl-comment-uncomment-region (beg end &optional arg)
9922 "Comment out region if not commented out, uncomment otherwise."
9923 (interactive "r\nP")
9924 (save-excursion
9925 (goto-char (1- end))
9926 (end-of-line)
9927 (setq end (point-marker))
9928 (goto-char beg)
9929 (beginning-of-line)
9930 (setq beg (point))
9931 (if (looking-at comment-start)
9932 (comment-region beg end '(4))
9933 (comment-region beg end))))
9935 (defun vhdl-comment-uncomment-line (&optional arg)
9936 "Comment out line if not commented out, uncomment otherwise."
9937 (interactive "p")
9938 (save-excursion
9939 (beginning-of-line)
9940 (let ((position (point)))
9941 (forward-line (or arg 1))
9942 (vhdl-comment-uncomment-region position (point)))))
9944 (defun vhdl-comment-kill-region (beg end)
9945 "Kill comments in region."
9946 (interactive "r")
9947 (save-excursion
9948 (goto-char end)
9949 (setq end (point-marker))
9950 (goto-char beg)
9951 (beginning-of-line)
9952 (while (< (point) end)
9953 (if (looking-at "^\\(\\s-*--.*\n\\)")
9954 (progn (delete-region (match-beginning 1) (match-end 1)))
9955 (beginning-of-line 2)))))
9957 (defun vhdl-comment-kill-inline-region (beg end)
9958 "Kill inline comments in region."
9959 (interactive "r")
9960 (save-excursion
9961 (goto-char end)
9962 (setq end (point-marker))
9963 (goto-char beg)
9964 (beginning-of-line)
9965 (while (< (point) end)
9966 (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$")
9967 (delete-region (match-beginning 1) (match-end 1)))
9968 (beginning-of-line 2))))
9970 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9971 ;; Subtemplates
9973 (defun vhdl-template-begin-end (construct name margin &optional empty-lines)
9974 "Insert a begin ... end pair with optional name after the end.
9975 Point is left between them."
9976 (let (position)
9977 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
9978 (indent-to margin)
9979 (vhdl-insert-keyword "BEGIN")
9980 (when (and (or construct name) vhdl-self-insert-comments)
9981 (insert " --")
9982 (when construct (insert " ") (vhdl-insert-keyword construct))
9983 (when name (insert " " name)))
9984 (insert "\n")
9985 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
9986 (indent-to (+ margin vhdl-basic-offset))
9987 (setq position (point))
9988 (insert "\n")
9989 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
9990 (indent-to margin)
9991 (vhdl-insert-keyword "END")
9992 (when construct (insert " ") (vhdl-insert-keyword construct))
9993 (insert (if name (concat " " name) "") ";")
9994 (goto-char position)))
9996 (defun vhdl-template-argument-list (&optional is-function)
9997 "Read from user a procedure or function argument list."
9998 (insert " (")
9999 (let ((margin (current-column))
10000 (start (point))
10001 (end-pos (point))
10002 not-empty interface semicolon-pos)
10003 (unless vhdl-argument-list-indent
10004 (setq margin (+ (current-indentation) vhdl-basic-offset))
10005 (insert "\n")
10006 (indent-to margin))
10007 (setq interface (vhdl-template-field
10008 (concat "[CONSTANT | SIGNAL"
10009 (unless is-function " | VARIABLE") "]") " " t))
10010 (while (vhdl-template-field "[names]" nil t)
10011 (setq not-empty t)
10012 (insert " : ")
10013 (unless is-function
10014 (if (and interface (equal (upcase interface) "CONSTANT"))
10015 (vhdl-insert-keyword "IN ")
10016 (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
10017 (vhdl-template-field "type")
10018 (setq semicolon-pos (point))
10019 (insert ";")
10020 (vhdl-comment-insert-inline)
10021 (setq end-pos (point))
10022 (insert "\n")
10023 (indent-to margin)
10024 (setq interface (vhdl-template-field
10025 (concat "[CONSTANT | SIGNAL"
10026 (unless is-function " | VARIABLE") "]") " " t)))
10027 (delete-region end-pos (point))
10028 (when semicolon-pos (goto-char semicolon-pos))
10029 (if not-empty
10030 (progn (delete-char 1) (insert ")"))
10031 (delete-backward-char 2))))
10033 (defun vhdl-template-generic-list (optional &optional no-value)
10034 "Read from user a generic spec argument list."
10035 (let (margin
10036 (start (point)))
10037 (vhdl-insert-keyword "GENERIC (")
10038 (setq margin (current-column))
10039 (unless vhdl-argument-list-indent
10040 (let ((position (point)))
10041 (back-to-indentation)
10042 (setq margin (+ (current-column) vhdl-basic-offset))
10043 (goto-char position)
10044 (insert "\n")
10045 (indent-to margin)))
10046 (let ((vhdl-generics (vhdl-template-field
10047 (concat (and optional "[") "name"
10048 (and no-value "s") (and optional "]"))
10049 nil optional)))
10050 (if (not vhdl-generics)
10051 (if optional
10052 (progn (vhdl-line-kill-entire) (end-of-line -0)
10053 (unless vhdl-argument-list-indent
10054 (vhdl-line-kill-entire) (end-of-line -0)))
10055 (vhdl-template-undo start (point))
10056 nil )
10057 (insert " : ")
10058 (let (semicolon-pos end-pos)
10059 (while vhdl-generics
10060 (vhdl-template-field "type")
10061 (if no-value
10062 (progn (setq semicolon-pos (point))
10063 (insert ";"))
10064 (insert " := ")
10065 (unless (vhdl-template-field "[value]" nil t)
10066 (delete-char -4))
10067 (setq semicolon-pos (point))
10068 (insert ";"))
10069 (vhdl-comment-insert-inline)
10070 (setq end-pos (point))
10071 (insert "\n")
10072 (indent-to margin)
10073 (setq vhdl-generics (vhdl-template-field
10074 (concat "[name" (and no-value "s") "]")
10075 " : " t)))
10076 (delete-region end-pos (point))
10077 (goto-char semicolon-pos)
10078 (insert ")")
10079 (end-of-line)
10080 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10081 t)))))
10083 (defun vhdl-template-port-list (optional)
10084 "Read from user a port spec argument list."
10085 (let ((start (point))
10086 margin vhdl-ports object)
10087 (vhdl-insert-keyword "PORT (")
10088 (setq margin (current-column))
10089 (unless vhdl-argument-list-indent
10090 (let ((position (point)))
10091 (back-to-indentation)
10092 (setq margin (+ (current-column) vhdl-basic-offset))
10093 (goto-char position)
10094 (insert "\n")
10095 (indent-to margin)))
10096 (when (vhdl-standard-p 'ams)
10097 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10098 " " t)))
10099 (setq vhdl-ports (vhdl-template-field
10100 (concat (and optional "[") "names" (and optional "]"))
10101 nil optional))
10102 (if (not vhdl-ports)
10103 (if optional
10104 (progn (vhdl-line-kill-entire) (end-of-line -0)
10105 (unless vhdl-argument-list-indent
10106 (vhdl-line-kill-entire) (end-of-line -0)))
10107 (vhdl-template-undo start (point))
10108 nil)
10109 (insert " : ")
10110 (let (semicolon-pos end-pos)
10111 (while vhdl-ports
10112 (cond ((or (null object) (equal "SIGNAL" (upcase object)))
10113 (vhdl-template-field "IN | OUT | INOUT" " "))
10114 ((equal "QUANTITY" (upcase object))
10115 (vhdl-template-field "[IN | OUT]" " " t)))
10116 (vhdl-template-field
10117 (if (and object (equal "TERMINAL" (upcase object)))
10118 "nature" "type"))
10119 (setq semicolon-pos (point))
10120 (insert ";")
10121 (vhdl-comment-insert-inline)
10122 (setq end-pos (point))
10123 (insert "\n")
10124 (indent-to margin)
10125 (when (vhdl-standard-p 'ams)
10126 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
10127 " " t)))
10128 (setq vhdl-ports (vhdl-template-field "[names]" " : " t)))
10129 (delete-region end-pos (point))
10130 (goto-char semicolon-pos)
10131 (insert ")")
10132 (end-of-line)
10133 (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
10134 t))))
10136 (defun vhdl-template-generate-body (margin label)
10137 "Insert body for generate template."
10138 (vhdl-insert-keyword " GENERATE")
10139 ; (if (not (vhdl-standard-p '87))
10140 ; (vhdl-template-begin-end "GENERATE" label margin)
10141 (insert "\n\n")
10142 (indent-to margin)
10143 (vhdl-insert-keyword "END GENERATE ")
10144 (insert label ";")
10145 (end-of-line 0)
10146 (indent-to (+ margin vhdl-basic-offset)))
10148 (defun vhdl-template-insert-date ()
10149 "Insert date in appropriate format."
10150 (interactive)
10151 (insert
10152 (cond
10153 ;; 'american, 'european, 'scientific kept for backward compatibility
10154 ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
10155 ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
10156 ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
10157 (t (format-time-string vhdl-date-format nil)))))
10159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10160 ;; Help functions
10162 (defun vhdl-electric-space (count)
10163 "Expand abbreviations and self-insert space(s), do indent-new-comment-line
10164 if in comment and past end-comment-column."
10165 (interactive "p")
10166 (cond ((vhdl-in-comment-p)
10167 (self-insert-command count)
10168 (cond ((>= (current-column) (+ 2 end-comment-column))
10169 (backward-char 1)
10170 (skip-chars-backward "^ \t\n")
10171 (indent-new-comment-line)
10172 (skip-chars-forward "^ \t\n")
10173 (forward-char 1))
10174 ((>= (current-column) end-comment-column)
10175 (indent-new-comment-line))
10176 (t nil)))
10177 ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
10178 (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
10179 (vhdl-prepare-search-1
10180 (or (expand-abbrev) (vhdl-fix-case-word -1)))
10181 (self-insert-command count))
10182 (t (self-insert-command count))))
10184 (defun vhdl-template-field (prompt &optional follow-string optional
10185 begin end is-string default)
10186 "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
10187 If OPTIONAL is nil, the prompt is left if an empty string is inserted. If
10188 an empty string is inserted, return nil and call `vhdl-template-undo' for
10189 the region between BEGIN and END. IS-STRING indicates whether a string
10190 with double-quotes is to be inserted. DEFAULT specifies a default string."
10191 (let ((position (point))
10192 string)
10193 (insert "<" prompt ">")
10194 (setq string
10195 (condition-case ()
10196 (read-from-minibuffer (concat prompt ": ")
10197 (or (and is-string '("\"\"" . 2)) default)
10198 vhdl-minibuffer-local-map)
10199 (quit (if (and optional begin end)
10200 (progn (beep) "")
10201 (keyboard-quit)))))
10202 (when (or (not (equal string "")) optional)
10203 (delete-region position (point)))
10204 (when (and (equal string "") optional begin end)
10205 (vhdl-template-undo begin end)
10206 (message "Template aborted"))
10207 (unless (equal string "")
10208 (insert string)
10209 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
10210 vhdl-keywords-regexp)
10211 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
10212 vhdl-types-regexp)
10213 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
10214 (concat "'" vhdl-attributes-regexp))
10215 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
10216 vhdl-enum-values-regexp))
10217 (when (or (not (equal string "")) (not optional))
10218 (insert (or follow-string "")))
10219 (if (equal string "") nil string)))
10221 (defun vhdl-decision-query (string prompt &optional optional)
10222 "Query a decision from the user."
10223 (let ((start (point)))
10224 (when string (vhdl-insert-keyword (concat string " ")))
10225 (message prompt)
10226 (let ((char (read-char)))
10227 (delete-region start (point))
10228 (if (and optional (eq char ?\r))
10229 (progn (insert " ")
10230 (unexpand-abbrev)
10231 (throw 'abort "ERROR: Template aborted"))
10232 char))))
10234 (defun vhdl-insert-keyword (keyword)
10235 "Insert KEYWORD and adjust case."
10236 (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))))
10238 (defun vhdl-case-keyword (keyword)
10239 "Adjust case of KEYWORD."
10240 (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
10242 (defun vhdl-case-word (num)
10243 "Adjust case or following NUM words."
10244 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
10246 (defun vhdl-minibuffer-tab (&optional prefix-arg)
10247 "If preceeding character is part of a word or a paren then hippie-expand,
10248 else insert tab (used for word completion in VHDL minibuffer)."
10249 (interactive "P")
10250 (cond
10251 ;; expand word
10252 ((= (char-syntax (preceding-char)) ?w)
10253 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10254 (case-replace nil)
10255 (hippie-expand-only-buffers
10256 (or (and (boundp 'hippie-expand-only-buffers)
10257 hippie-expand-only-buffers)
10258 '(vhdl-mode))))
10259 (vhdl-expand-abbrev prefix-arg)))
10260 ;; expand parenthesis
10261 ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
10262 (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10263 (case-replace nil))
10264 (vhdl-expand-paren prefix-arg)))
10265 ;; insert tab
10266 (t (insert-tab))))
10268 (defun vhdl-template-search-prompt ()
10269 "Search for left out template prompts and query again."
10270 (interactive)
10271 (vhdl-prepare-search-2
10272 (when (or (re-search-forward
10273 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
10274 (re-search-backward
10275 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
10276 (let ((string (match-string 1)))
10277 (replace-match "")
10278 (vhdl-template-field string)))))
10280 (defun vhdl-template-undo (begin end)
10281 "Undo aborted template by deleting region and unexpanding the keyword."
10282 (cond (vhdl-template-invoked-by-hook
10283 (goto-char end)
10284 (insert " ")
10285 (delete-region begin end)
10286 (unexpand-abbrev))
10287 (t (delete-region begin end))))
10289 (defun vhdl-insert-string-or-file (string)
10290 "Insert STRING or file contents if STRING is an existing file name."
10291 (unless (equal string "")
10292 (let ((file-name
10293 (progn (string-match "^\\([^\n]+\\)" string)
10294 (vhdl-resolve-env-variable (match-string 1 string)))))
10295 (if (file-exists-p file-name)
10296 (forward-char (cadr (insert-file-contents file-name)))
10297 (insert string)))))
10299 (defun vhdl-beginning-of-block ()
10300 "Move cursor to the beginning of the enclosing block."
10301 (let (pos)
10302 (save-excursion
10303 (beginning-of-line)
10304 ;; search backward for block beginning or end
10305 (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10306 ;; not consider subprogram declarations
10307 (or (and (match-string 5)
10308 (save-match-data
10309 (save-excursion
10310 (goto-char (match-end 5))
10311 (forward-word 1) (forward-sexp)
10312 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10313 (match-string 1)))
10314 ;; not consider configuration specifications
10315 (and (match-string 6)
10316 (save-match-data
10317 (save-excursion
10318 (vhdl-end-of-block)
10319 (beginning-of-line)
10320 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10321 (match-string 2))
10322 ;; skip subblock if block end found
10323 (vhdl-beginning-of-block)))
10324 (when pos (goto-char pos))))
10326 (defun vhdl-end-of-block ()
10327 "Move cursor to the end of the enclosing block."
10328 (let (pos)
10329 (save-excursion
10330 (end-of-line)
10331 ;; search forward for block beginning or end
10332 (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10333 ;; not consider subprogram declarations
10334 (or (and (match-string 5)
10335 (save-match-data
10336 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10337 (match-string 1)))
10338 ;; not consider configuration specifications
10339 (and (match-string 6)
10340 (save-match-data
10341 (save-excursion
10342 (vhdl-end-of-block)
10343 (beginning-of-line)
10344 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10345 (not (match-string 2)))
10346 ;; skip subblock if block beginning found
10347 (vhdl-end-of-block)))
10348 (when pos (goto-char pos))))
10350 (defun vhdl-sequential-statement-p ()
10351 "Check if point is within sequential statement part."
10352 (let ((start (point)))
10353 (save-excursion
10354 (vhdl-prepare-search-2
10355 ;; is sequential statement if ...
10356 (and (re-search-backward "^\\s-*begin\\>" nil t)
10357 ;; ... point is between "begin" and "end" of ...
10358 (progn (vhdl-end-of-block)
10359 (< start (point)))
10360 ;; ... a sequential block
10361 (progn (vhdl-beginning-of-block)
10362 (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
10364 (defun vhdl-in-argument-list-p ()
10365 "Check if within an argument list."
10366 (save-excursion
10367 (vhdl-prepare-search-2
10368 (or (string-match "arglist"
10369 (format "%s" (caar (vhdl-get-syntactic-context))))
10370 (progn (beginning-of-line)
10371 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
10373 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10374 ;; Abbrev hooks
10376 (defun vhdl-hooked-abbrev (func)
10377 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
10378 but not if inside a comment or quote)."
10379 (if (or (vhdl-in-literal)
10380 (save-excursion
10381 (forward-word -1)
10382 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
10383 (progn
10384 (insert " ")
10385 (unexpand-abbrev)
10386 (delete-char -1))
10387 (if (not vhdl-electric-mode)
10388 (progn
10389 (insert " ")
10390 (unexpand-abbrev)
10391 (backward-word 1)
10392 (vhdl-case-word 1)
10393 (delete-char 1))
10394 (let ((invoke-char last-command-char)
10395 (abbrev-mode -1)
10396 (vhdl-template-invoked-by-hook t))
10397 (let ((caught (catch 'abort
10398 (funcall func))))
10399 (when (stringp caught) (message caught)))
10400 (when (= invoke-char ?-) (setq abbrev-start-location (point)))
10401 ;; delete CR which is still in event queue
10402 (if vhdl-xemacs
10403 (enqueue-eval-event 'delete-char -1)
10404 (setq unread-command-events ; push back a delete char
10405 (list (vhdl-character-to-event ?\177))))))))
10407 (defun vhdl-template-alias-hook ()
10408 (vhdl-hooked-abbrev 'vhdl-template-alias))
10409 (defun vhdl-template-architecture-hook ()
10410 (vhdl-hooked-abbrev 'vhdl-template-architecture))
10411 (defun vhdl-template-assert-hook ()
10412 (vhdl-hooked-abbrev 'vhdl-template-assert))
10413 (defun vhdl-template-attribute-hook ()
10414 (vhdl-hooked-abbrev 'vhdl-template-attribute))
10415 (defun vhdl-template-block-hook ()
10416 (vhdl-hooked-abbrev 'vhdl-template-block))
10417 (defun vhdl-template-break-hook ()
10418 (vhdl-hooked-abbrev 'vhdl-template-break))
10419 (defun vhdl-template-case-hook ()
10420 (vhdl-hooked-abbrev 'vhdl-template-case))
10421 (defun vhdl-template-component-hook ()
10422 (vhdl-hooked-abbrev 'vhdl-template-component))
10423 (defun vhdl-template-instance-hook ()
10424 (vhdl-hooked-abbrev 'vhdl-template-instance))
10425 (defun vhdl-template-conditional-signal-asst-hook ()
10426 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
10427 (defun vhdl-template-configuration-hook ()
10428 (vhdl-hooked-abbrev 'vhdl-template-configuration))
10429 (defun vhdl-template-constant-hook ()
10430 (vhdl-hooked-abbrev 'vhdl-template-constant))
10431 (defun vhdl-template-disconnect-hook ()
10432 (vhdl-hooked-abbrev 'vhdl-template-disconnect))
10433 (defun vhdl-template-display-comment-hook ()
10434 (vhdl-hooked-abbrev 'vhdl-comment-display))
10435 (defun vhdl-template-else-hook ()
10436 (vhdl-hooked-abbrev 'vhdl-template-else))
10437 (defun vhdl-template-elsif-hook ()
10438 (vhdl-hooked-abbrev 'vhdl-template-elsif))
10439 (defun vhdl-template-entity-hook ()
10440 (vhdl-hooked-abbrev 'vhdl-template-entity))
10441 (defun vhdl-template-exit-hook ()
10442 (vhdl-hooked-abbrev 'vhdl-template-exit))
10443 (defun vhdl-template-file-hook ()
10444 (vhdl-hooked-abbrev 'vhdl-template-file))
10445 (defun vhdl-template-for-hook ()
10446 (vhdl-hooked-abbrev 'vhdl-template-for))
10447 (defun vhdl-template-function-hook ()
10448 (vhdl-hooked-abbrev 'vhdl-template-function))
10449 (defun vhdl-template-generic-hook ()
10450 (vhdl-hooked-abbrev 'vhdl-template-generic))
10451 (defun vhdl-template-group-hook ()
10452 (vhdl-hooked-abbrev 'vhdl-template-group))
10453 (defun vhdl-template-library-hook ()
10454 (vhdl-hooked-abbrev 'vhdl-template-library))
10455 (defun vhdl-template-limit-hook ()
10456 (vhdl-hooked-abbrev 'vhdl-template-limit))
10457 (defun vhdl-template-if-hook ()
10458 (vhdl-hooked-abbrev 'vhdl-template-if))
10459 (defun vhdl-template-bare-loop-hook ()
10460 (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
10461 (defun vhdl-template-map-hook ()
10462 (vhdl-hooked-abbrev 'vhdl-template-map))
10463 (defun vhdl-template-nature-hook ()
10464 (vhdl-hooked-abbrev 'vhdl-template-nature))
10465 (defun vhdl-template-next-hook ()
10466 (vhdl-hooked-abbrev 'vhdl-template-next))
10467 (defun vhdl-template-others-hook ()
10468 (vhdl-hooked-abbrev 'vhdl-template-others))
10469 (defun vhdl-template-package-hook ()
10470 (vhdl-hooked-abbrev 'vhdl-template-package))
10471 (defun vhdl-template-port-hook ()
10472 (vhdl-hooked-abbrev 'vhdl-template-port))
10473 (defun vhdl-template-procedural-hook ()
10474 (vhdl-hooked-abbrev 'vhdl-template-procedural))
10475 (defun vhdl-template-procedure-hook ()
10476 (vhdl-hooked-abbrev 'vhdl-template-procedure))
10477 (defun vhdl-template-process-hook ()
10478 (vhdl-hooked-abbrev 'vhdl-template-process))
10479 (defun vhdl-template-quantity-hook ()
10480 (vhdl-hooked-abbrev 'vhdl-template-quantity))
10481 (defun vhdl-template-report-hook ()
10482 (vhdl-hooked-abbrev 'vhdl-template-report))
10483 (defun vhdl-template-return-hook ()
10484 (vhdl-hooked-abbrev 'vhdl-template-return))
10485 (defun vhdl-template-selected-signal-asst-hook ()
10486 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
10487 (defun vhdl-template-signal-hook ()
10488 (vhdl-hooked-abbrev 'vhdl-template-signal))
10489 (defun vhdl-template-subnature-hook ()
10490 (vhdl-hooked-abbrev 'vhdl-template-subnature))
10491 (defun vhdl-template-subtype-hook ()
10492 (vhdl-hooked-abbrev 'vhdl-template-subtype))
10493 (defun vhdl-template-terminal-hook ()
10494 (vhdl-hooked-abbrev 'vhdl-template-terminal))
10495 (defun vhdl-template-type-hook ()
10496 (vhdl-hooked-abbrev 'vhdl-template-type))
10497 (defun vhdl-template-use-hook ()
10498 (vhdl-hooked-abbrev 'vhdl-template-use))
10499 (defun vhdl-template-variable-hook ()
10500 (vhdl-hooked-abbrev 'vhdl-template-variable))
10501 (defun vhdl-template-wait-hook ()
10502 (vhdl-hooked-abbrev 'vhdl-template-wait))
10503 (defun vhdl-template-when-hook ()
10504 (vhdl-hooked-abbrev 'vhdl-template-when))
10505 (defun vhdl-template-while-loop-hook ()
10506 (vhdl-hooked-abbrev 'vhdl-template-while-loop))
10507 (defun vhdl-template-with-hook ()
10508 (vhdl-hooked-abbrev 'vhdl-template-with))
10509 (defun vhdl-template-and-hook ()
10510 (vhdl-hooked-abbrev 'vhdl-template-and))
10511 (defun vhdl-template-or-hook ()
10512 (vhdl-hooked-abbrev 'vhdl-template-or))
10513 (defun vhdl-template-nand-hook ()
10514 (vhdl-hooked-abbrev 'vhdl-template-nand))
10515 (defun vhdl-template-nor-hook ()
10516 (vhdl-hooked-abbrev 'vhdl-template-nor))
10517 (defun vhdl-template-xor-hook ()
10518 (vhdl-hooked-abbrev 'vhdl-template-xor))
10519 (defun vhdl-template-xnor-hook ()
10520 (vhdl-hooked-abbrev 'vhdl-template-xnor))
10521 (defun vhdl-template-not-hook ()
10522 (vhdl-hooked-abbrev 'vhdl-template-not))
10524 (defun vhdl-template-default-hook ()
10525 (vhdl-hooked-abbrev 'vhdl-template-default))
10526 (defun vhdl-template-default-indent-hook ()
10527 (vhdl-hooked-abbrev 'vhdl-template-default-indent))
10529 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10530 ;; Template insertion from completion list
10532 (defun vhdl-template-insert-construct (name)
10533 "Insert the built-in construct template with NAME."
10534 (interactive
10535 (list (let ((completion-ignore-case t))
10536 (completing-read "Construct name: "
10537 vhdl-template-construct-alist nil t))))
10538 (vhdl-template-insert-fun
10539 (cadr (assoc name vhdl-template-construct-alist))))
10541 (defun vhdl-template-insert-package (name)
10542 "Insert the built-in package template with NAME."
10543 (interactive
10544 (list (let ((completion-ignore-case t))
10545 (completing-read "Package name: "
10546 vhdl-template-package-alist nil t))))
10547 (vhdl-template-insert-fun
10548 (cadr (assoc name vhdl-template-package-alist))))
10550 (defun vhdl-template-insert-directive (name)
10551 "Insert the built-in directive template with NAME."
10552 (interactive
10553 (list (let ((completion-ignore-case t))
10554 (completing-read "Directive name: "
10555 vhdl-template-directive-alist nil t))))
10556 (vhdl-template-insert-fun
10557 (cadr (assoc name vhdl-template-directive-alist))))
10559 (defun vhdl-template-insert-fun (fun)
10560 "Call FUN to insert a built-in template."
10561 (let ((caught (catch 'abort (when fun (funcall fun)))))
10562 (when (stringp caught) (message caught))))
10565 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10566 ;;; Models
10567 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10569 (defun vhdl-model-insert (model-name)
10570 "Insert the user model with name MODEL-NAME."
10571 (interactive
10572 (let ((completion-ignore-case t))
10573 (list (completing-read "Model name: " vhdl-model-alist))))
10574 (indent-according-to-mode)
10575 (let ((start (point-marker))
10576 (margin (current-indentation))
10577 model position prompt string end)
10578 (vhdl-prepare-search-2
10579 (when (setq model (assoc model-name vhdl-model-alist))
10580 ;; insert model
10581 (beginning-of-line)
10582 (delete-horizontal-space)
10583 (goto-char start)
10584 (vhdl-insert-string-or-file (nth 1 model))
10585 (setq end (point-marker))
10586 ;; indent code
10587 (goto-char start)
10588 (beginning-of-line)
10589 (while (< (point) end)
10590 (unless (looking-at "^$")
10591 (insert-char ? margin))
10592 (beginning-of-line 2))
10593 (goto-char start)
10594 ;; insert clock
10595 (unless (equal "" vhdl-clock-name)
10596 (while (re-search-forward "<clock>" end t)
10597 (replace-match vhdl-clock-name)))
10598 (goto-char start)
10599 ;; insert reset
10600 (unless (equal "" vhdl-reset-name)
10601 (while (re-search-forward "<reset>" end t)
10602 (replace-match vhdl-reset-name)))
10603 ;; replace header prompts
10604 (vhdl-template-replace-header-keywords start end nil t)
10605 (goto-char start)
10606 ;; query other prompts
10607 (while (re-search-forward
10608 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
10609 (unless (equal "cursor" (match-string 1))
10610 (setq position (match-beginning 1))
10611 (setq prompt (match-string 1))
10612 (replace-match "")
10613 (setq string (vhdl-template-field prompt nil t))
10614 ;; replace occurrences of same prompt
10615 (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
10616 (replace-match (or string "")))
10617 (goto-char position)))
10618 (goto-char start)
10619 ;; goto final position
10620 (if (re-search-forward "<cursor>" end t)
10621 (replace-match "")
10622 (goto-char end))))))
10624 (defun vhdl-model-defun ()
10625 "Define help and hook functions for user models."
10626 (let ((model-alist vhdl-model-alist)
10627 model-name model-keyword)
10628 (while model-alist
10629 ;; define functions for user models that can be invoked from menu and key
10630 ;; bindings and which themselves call `vhdl-model-insert' with the model
10631 ;; name as argument
10632 (setq model-name (nth 0 (car model-alist)))
10633 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
10634 ,(concat "Insert model for \"" model-name "\".")
10635 (interactive)
10636 (vhdl-model-insert ,model-name)))
10637 ;; define hooks for user models that are invoked from keyword abbrevs
10638 (setq model-keyword (nth 3 (car model-alist)))
10639 (unless (equal model-keyword "")
10640 (eval `(defun
10641 ,(vhdl-function-name
10642 "vhdl-model" model-name "hook") ()
10643 (vhdl-hooked-abbrev
10644 ',(vhdl-function-name "vhdl-model" model-name)))))
10645 (setq model-alist (cdr model-alist)))))
10647 (vhdl-model-defun)
10650 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10651 ;;; Port translation
10652 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10654 (defvar vhdl-port-list nil
10655 "Variable to hold last port map parsed.")
10656 ;; structure: (parenthesised expression means list of such entries)
10657 ;; (ent-name
10658 ;; ((generic-names) generic-type generic-init generic-comment group-comment)
10659 ;; ((port-names) port-object port-direct port-type port-comment group-comment)
10660 ;; (lib-name pack-key))
10662 (defun vhdl-parse-string (string &optional optional)
10663 "Check that the text following point matches the regexp in STRING."
10664 (if (looking-at string)
10665 (goto-char (match-end 0))
10666 (unless optional
10667 (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\""
10668 (vhdl-current-line) string)))
10669 nil))
10671 (defun vhdl-replace-string (regexp-cons string)
10672 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
10673 (vhdl-prepare-search-1
10674 (if (string-match (car regexp-cons) string)
10675 (funcall vhdl-file-name-case
10676 (replace-match (cdr regexp-cons) t nil string))
10677 string)))
10679 (defun vhdl-parse-group-comment ()
10680 "Parse comment and empty lines between groups of lines."
10681 (let ((start (point))
10682 string)
10683 (vhdl-forward-comment (point-max))
10684 (setq string (buffer-substring-no-properties start (point)))
10685 ;; strip off leading blanks and first newline
10686 (while (string-match "^\\(\\s-+\\)" string)
10687 (setq string (concat (substring string 0 (match-beginning 1))
10688 (substring string (match-end 1)))))
10689 (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
10690 (substring string 1)
10691 string)))
10693 (defun vhdl-paste-group-comment (string indent)
10694 "Paste comment and empty lines from STRING between groups of lines
10695 with INDENT."
10696 (let ((pos (point-marker)))
10697 (when (> indent 0)
10698 (while (string-match "^\\(--\\)" string)
10699 (setq string (concat (substring string 0 (match-beginning 1))
10700 (make-string indent ? )
10701 (substring string (match-beginning 1))))))
10702 (beginning-of-line)
10703 (insert string)
10704 (goto-char pos)))
10706 (defvar vhdl-port-flattened nil
10707 "Indicates whether a port has been flattened.")
10709 (defun vhdl-port-flatten (&optional as-alist)
10710 "Flatten port list so that only one generic/port exists per line."
10711 (interactive)
10712 (if (not vhdl-port-list)
10713 (error "ERROR: No port has been read")
10714 (message "Flattening port...")
10715 (let ((new-vhdl-port-list (list (car vhdl-port-list)))
10716 (old-vhdl-port-list (cdr vhdl-port-list))
10717 old-port-list new-port-list old-port new-port names)
10718 ;; traverse port list and flatten entries
10719 (while (cdr old-vhdl-port-list)
10720 (setq old-port-list (car old-vhdl-port-list))
10721 (setq new-port-list nil)
10722 (while old-port-list
10723 (setq old-port (car old-port-list))
10724 (setq names (car old-port))
10725 (while names
10726 (setq new-port (cons (if as-alist (car names) (list (car names)))
10727 (cdr old-port)))
10728 (setq new-port-list (append new-port-list (list new-port)))
10729 (setq names (cdr names)))
10730 (setq old-port-list (cdr old-port-list)))
10731 (setq old-vhdl-port-list (cdr old-vhdl-port-list))
10732 (setq new-vhdl-port-list (append new-vhdl-port-list
10733 (list new-port-list))))
10734 (setq vhdl-port-list
10735 (append new-vhdl-port-list (list old-vhdl-port-list))
10736 vhdl-port-flattened t)
10737 (message "Flattening port...done"))))
10739 (defvar vhdl-port-reversed-direction nil
10740 "Indicates whether port directions are reversed.")
10742 (defun vhdl-port-reverse-direction ()
10743 "Reverse direction for all ports (useful in testbenches)."
10744 (interactive)
10745 (if (not vhdl-port-list)
10746 (error "ERROR: No port has been read")
10747 (message "Reversing port directions...")
10748 (let ((port-list (nth 2 vhdl-port-list))
10749 port-dir-car port-dir)
10750 ;; traverse port list and reverse directions
10751 (while port-list
10752 (setq port-dir-car (cddr (car port-list))
10753 port-dir (car port-dir-car))
10754 (setcar port-dir-car
10755 (cond ((equal port-dir "in") "out")
10756 ((equal port-dir "out") "in")
10757 (t port-dir)))
10758 (setq port-list (cdr port-list)))
10759 (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
10760 (message "Reversing port directions...done"))))
10762 (defun vhdl-port-copy ()
10763 "Get generic and port information from an entity or component declaration."
10764 (interactive)
10765 (save-excursion
10766 (let (parse-error end-of-list
10767 decl-type name generic-list port-list context-clause
10768 object names direct type init comment group-comment)
10769 (vhdl-prepare-search-2
10770 (setq
10771 parse-error
10772 (catch 'parse
10773 ;; check if within entity or component declaration
10774 (end-of-line)
10775 (when (or (not (re-search-backward
10776 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
10777 (equal "END" (upcase (match-string 1))))
10778 (throw 'parse "ERROR: Not within an entity or component declaration"))
10779 (setq decl-type (downcase (match-string-no-properties 1)))
10780 (forward-word 1)
10781 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
10782 (setq name (match-string-no-properties 1))
10783 (message "Reading port of %s \"%s\"..." decl-type name)
10784 (vhdl-forward-syntactic-ws)
10785 ;; parse generic clause
10786 (when (vhdl-parse-string "generic[ \t\n]*(" t)
10787 ;; parse group comment and spacing
10788 (setq group-comment (vhdl-parse-group-comment))
10789 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
10790 (while (not end-of-list)
10791 ;; parse names
10792 (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")
10793 (setq names (list (match-string-no-properties 1)))
10794 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
10795 (setq names
10796 (append names (list (match-string-no-properties 1)))))
10797 ;; parse type
10798 (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
10799 (setq type (match-string-no-properties 1))
10800 (setq comment nil)
10801 (while (looking-at "(")
10802 (setq type
10803 (concat type
10804 (buffer-substring-no-properties
10805 (point) (progn (forward-sexp) (point)))
10806 (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
10807 (match-string-no-properties 1)))))
10808 ;; special case: closing parenthesis is on separate line
10809 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
10810 (setq comment (substring type (match-beginning 2)))
10811 (setq type (substring type 0 (match-beginning 1))))
10812 ;; strip of trailing group-comment
10813 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
10814 (setq type (substring type 0 (match-end 1)))
10815 ;; parse initialization expression
10816 (setq init nil)
10817 (when (vhdl-parse-string ":=[ \t\n]*" t)
10818 (vhdl-parse-string "\\([^();\n]*\\)")
10819 (setq init (match-string-no-properties 1))
10820 (while (looking-at "(")
10821 (setq init
10822 (concat init
10823 (buffer-substring-no-properties
10824 (point) (progn (forward-sexp) (point)))
10825 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
10826 (match-string-no-properties 1))))))
10827 ;; special case: closing parenthesis is on separate line
10828 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
10829 (setq comment (substring init (match-beginning 2)))
10830 (setq init (substring init 0 (match-beginning 1)))
10831 (vhdl-forward-syntactic-ws))
10832 (skip-chars-forward " \t")
10833 ;; parse inline comment, special case: as above, no initial.
10834 (unless comment
10835 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10836 (match-string-no-properties 1))))
10837 (vhdl-forward-syntactic-ws)
10838 (setq end-of-list (vhdl-parse-string ")" t))
10839 (vhdl-parse-string "\\s-*;\\s-*")
10840 ;; parse inline comment
10841 (unless comment
10842 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10843 (match-string-no-properties 1))))
10844 ;; save everything in list
10845 (setq generic-list (append generic-list
10846 (list (list names type init
10847 comment group-comment))))
10848 ;; parse group comment and spacing
10849 (setq group-comment (vhdl-parse-group-comment))))
10850 ;; parse port clause
10851 (when (vhdl-parse-string "port[ \t\n]*(" t)
10852 ;; parse group comment and spacing
10853 (setq group-comment (vhdl-parse-group-comment))
10854 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
10855 (while (not end-of-list)
10856 ;; parse object
10857 (setq object
10858 (and (vhdl-parse-string "\\(signal\\|quantity\\|terminal\\)[ \t\n]*" t)
10859 (match-string-no-properties 1)))
10860 ;; parse names (accept extended identifiers)
10861 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
10862 (setq names (list (match-string-no-properties 1)))
10863 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
10864 (setq names (append names (list (match-string-no-properties 1)))))
10865 ;; parse direction
10866 (vhdl-parse-string ":[ \t\n]*")
10867 (setq direct
10868 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
10869 (match-string-no-properties 1)))
10870 ;; parse type
10871 (vhdl-parse-string "\\([^();\n]+\\)")
10872 (setq type (match-string-no-properties 1))
10873 (setq comment nil)
10874 (while (looking-at "(")
10875 (setq type (concat type
10876 (buffer-substring-no-properties
10877 (point) (progn (forward-sexp) (point)))
10878 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
10879 (match-string-no-properties 1)))))
10880 ;; special case: closing parenthesis is on separate line
10881 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
10882 (setq comment (substring type (match-beginning 2)))
10883 (setq type (substring type 0 (match-beginning 1))))
10884 ;; strip of trailing group-comment
10885 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
10886 (setq type (substring type 0 (match-end 1)))
10887 (vhdl-forward-syntactic-ws)
10888 (setq end-of-list (vhdl-parse-string ")" t))
10889 (vhdl-parse-string "\\s-*;\\s-*")
10890 ;; parse inline comment
10891 (unless comment
10892 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10893 (match-string-no-properties 1))))
10894 ;; save everything in list
10895 (setq port-list (append port-list
10896 (list (list names object direct type
10897 comment group-comment))))
10898 ;; parse group comment and spacing
10899 (setq group-comment (vhdl-parse-group-comment))))
10900 ; (vhdl-parse-string "end\\>")
10901 ;; parse context clause
10902 (setq context-clause (vhdl-scan-context-clause))
10903 ; ;; add surrounding package to context clause
10904 ; (when (and (equal decl-type "component")
10905 ; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
10906 ; (setq context-clause
10907 ; (append context-clause
10908 ; (list (cons (vhdl-work-library)
10909 ; (match-string-no-properties 1))))))
10910 (message "Reading port of %s \"%s\"...done" decl-type name)
10911 nil)))
10912 ;; finish parsing
10913 (if parse-error
10914 (error parse-error)
10915 (setq vhdl-port-list (list name generic-list port-list context-clause)
10916 vhdl-port-reversed-direction nil
10917 vhdl-port-flattened nil)))))
10919 (defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
10920 "Paste a context clause."
10921 (let ((margin (current-indentation))
10922 (clause-list (nth 3 vhdl-port-list))
10923 clause)
10924 (while clause-list
10925 (setq clause (car clause-list))
10926 (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
10927 (downcase exclude-pack-name)))
10928 (save-excursion
10929 (re-search-backward
10930 (concat "^\\s-*use\\s-+" (car clause)
10931 "\." (cdr clause) "\\>") nil t)))
10932 (vhdl-template-standard-package (car clause) (cdr clause))
10933 (insert "\n"))
10934 (setq clause-list (cdr clause-list)))))
10936 (defun vhdl-port-paste-generic (&optional no-init)
10937 "Paste a generic clause."
10938 (let ((margin (current-indentation))
10939 (generic-list (nth 1 vhdl-port-list))
10940 list-margin start names generic)
10941 ;; paste generic clause
10942 (when generic-list
10943 (setq start (point))
10944 (vhdl-insert-keyword "GENERIC (")
10945 (unless vhdl-argument-list-indent
10946 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10947 (setq list-margin (current-column))
10948 (while generic-list
10949 (setq generic (car generic-list))
10950 ;; paste group comment and spacing
10951 (when (memq vhdl-include-group-comments '(decl always))
10952 (vhdl-paste-group-comment (nth 4 generic) list-margin))
10953 ;; paste names
10954 (setq names (nth 0 generic))
10955 (while names
10956 (insert (car names))
10957 (setq names (cdr names))
10958 (when names (insert ", ")))
10959 ;; paste type
10960 (insert " : " (nth 1 generic))
10961 ;; paste initialization
10962 (when (and (not no-init) (nth 2 generic))
10963 (insert " := " (nth 2 generic)))
10964 (unless (cdr generic-list) (insert ")"))
10965 (insert ";")
10966 ;; paste comment
10967 (when (and vhdl-include-port-comments (nth 3 generic))
10968 (vhdl-comment-insert-inline (nth 3 generic) t))
10969 (setq generic-list (cdr generic-list))
10970 (when generic-list (insert "\n") (indent-to list-margin)))
10971 ;; align generic clause
10972 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
10974 (defun vhdl-port-paste-port ()
10975 "Paste a port clause."
10976 (let ((margin (current-indentation))
10977 (port-list (nth 2 vhdl-port-list))
10978 list-margin start names port)
10979 ;; paste port clause
10980 (when port-list
10981 (setq start (point))
10982 (vhdl-insert-keyword "PORT (")
10983 (unless vhdl-argument-list-indent
10984 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10985 (setq list-margin (current-column))
10986 (while port-list
10987 (setq port (car port-list))
10988 ;; paste group comment and spacing
10989 (when (memq vhdl-include-group-comments '(decl always))
10990 (vhdl-paste-group-comment (nth 5 port) list-margin))
10991 ;; paste object
10992 (when (nth 1 port) (insert (nth 1 port) " "))
10993 ;; paste names
10994 (setq names (nth 0 port))
10995 (while names
10996 (insert (car names))
10997 (setq names (cdr names))
10998 (when names (insert ", ")))
10999 ;; paste direction
11000 (insert " : ")
11001 (when (nth 2 port) (insert (nth 2 port) " "))
11002 ;; paste type
11003 (insert (nth 3 port))
11004 (unless (cdr port-list) (insert ")"))
11005 (insert ";")
11006 ;; paste comment
11007 (when (and vhdl-include-port-comments (nth 4 port))
11008 (vhdl-comment-insert-inline (nth 4 port) t))
11009 (setq port-list (cdr port-list))
11010 (when port-list (insert "\n") (indent-to list-margin)))
11011 ;; align port clause
11012 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11014 (defun vhdl-port-paste-declaration (kind &optional no-indent)
11015 "Paste as an entity or component declaration."
11016 (unless no-indent (indent-according-to-mode))
11017 (let ((margin (current-indentation))
11018 (name (nth 0 vhdl-port-list)))
11019 (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11020 (insert name)
11021 (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11022 (vhdl-insert-keyword " IS"))
11023 ;; paste generic and port clause
11024 (when (nth 1 vhdl-port-list)
11025 (insert "\n")
11026 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11027 (insert "\n"))
11028 (indent-to (+ margin vhdl-basic-offset))
11029 (vhdl-port-paste-generic (eq kind 'component)))
11030 (when (nth 2 vhdl-port-list)
11031 (insert "\n")
11032 (when (and (memq vhdl-insert-empty-lines '(unit all))
11033 (eq kind 'entity))
11034 (insert "\n"))
11035 (indent-to (+ margin vhdl-basic-offset)))
11036 (vhdl-port-paste-port)
11037 (insert "\n")
11038 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11039 (insert "\n"))
11040 (indent-to margin)
11041 (vhdl-insert-keyword "END")
11042 (if (eq kind 'entity)
11043 (progn
11044 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11045 (insert " " name))
11046 (vhdl-insert-keyword " COMPONENT")
11047 (unless (vhdl-standard-p '87) (insert " " name)))
11048 (insert ";")))
11050 (defun vhdl-port-paste-entity (&optional no-indent)
11051 "Paste as an entity declaration."
11052 (interactive)
11053 (if (not vhdl-port-list)
11054 (error "ERROR: No port read")
11055 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11056 (vhdl-port-paste-declaration 'entity no-indent)
11057 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11059 (defun vhdl-port-paste-component (&optional no-indent)
11060 "Paste as a component declaration."
11061 (interactive)
11062 (if (not vhdl-port-list)
11063 (error "ERROR: No port read")
11064 (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
11065 (vhdl-port-paste-declaration 'component no-indent)
11066 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
11068 (defun vhdl-port-paste-generic-map (&optional secondary no-constants)
11069 "Paste as a generic map."
11070 (interactive)
11071 (unless secondary (indent-according-to-mode))
11072 (let ((margin (current-indentation))
11073 list-margin start generic
11074 (generic-list (nth 1 vhdl-port-list)))
11075 (when generic-list
11076 (setq start (point))
11077 (vhdl-insert-keyword "GENERIC MAP (")
11078 (if (not vhdl-association-list-with-formals)
11079 ;; paste list of actual generics
11080 (while generic-list
11081 (insert (if no-constants
11082 (car (nth 0 (car generic-list)))
11083 (or (nth 2 (car generic-list)) " ")))
11084 (setq generic-list (cdr generic-list))
11085 (insert (if generic-list ", " ")")))
11086 (unless vhdl-argument-list-indent
11087 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11088 (setq list-margin (current-column))
11089 (while generic-list
11090 (setq generic (car generic-list))
11091 ;; paste group comment and spacing
11092 (when (eq vhdl-include-group-comments 'always)
11093 (vhdl-paste-group-comment (nth 4 generic) list-margin))
11094 ;; paste formal and actual generic
11095 (insert (car (nth 0 generic)) " => "
11096 (if no-constants
11097 (car (nth 0 generic))
11098 (or (nth 2 generic) "")))
11099 (setq generic-list (cdr generic-list))
11100 (insert (if generic-list "," ")"))
11101 ;; paste comment
11102 (when (or vhdl-include-type-comments
11103 (and vhdl-include-port-comments (nth 3 generic)))
11104 (vhdl-comment-insert-inline
11105 (concat
11106 (when vhdl-include-type-comments
11107 (concat "[" (nth 1 generic) "] "))
11108 (when vhdl-include-port-comments (nth 3 generic))) t))
11109 (when generic-list (insert "\n") (indent-to list-margin)))
11110 ;; align generic map
11111 (when vhdl-auto-align
11112 (vhdl-align-region-groups start (point) 1 t))))))
11114 (defun vhdl-port-paste-port-map ()
11115 "Paste as a port map."
11116 (let ((margin (current-indentation))
11117 list-margin start port
11118 (port-list (nth 2 vhdl-port-list)))
11119 (when port-list
11120 (setq start (point))
11121 (vhdl-insert-keyword "PORT MAP (")
11122 (if (not vhdl-association-list-with-formals)
11123 ;; paste list of actual ports
11124 (while port-list
11125 (insert (vhdl-replace-string vhdl-actual-port-name
11126 (car (nth 0 (car port-list)))))
11127 (setq port-list (cdr port-list))
11128 (insert (if port-list ", " ");")))
11129 (unless vhdl-argument-list-indent
11130 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11131 (setq list-margin (current-column))
11132 (while port-list
11133 (setq port (car port-list))
11134 ;; paste group comment and spacing
11135 (when (eq vhdl-include-group-comments 'always)
11136 (vhdl-paste-group-comment (nth 5 port) list-margin))
11137 ;; paste formal and actual port
11138 (insert (car (nth 0 port)) " => ")
11139 (insert (vhdl-replace-string vhdl-actual-port-name
11140 (car (nth 0 port))))
11141 (setq port-list (cdr port-list))
11142 (insert (if port-list "," ");"))
11143 ;; paste comment
11144 (when (or vhdl-include-direction-comments
11145 vhdl-include-type-comments
11146 (and vhdl-include-port-comments (nth 4 port)))
11147 (vhdl-comment-insert-inline
11148 (concat
11149 (cond ((and vhdl-include-direction-comments
11150 vhdl-include-type-comments)
11151 (concat "[" (format "%-4s" (concat (nth 2 port) " "))
11152 (nth 3 port) "] "))
11153 ((and vhdl-include-direction-comments (nth 2 port))
11154 (format "%-6s" (concat "[" (nth 2 port) "] ")))
11155 (vhdl-include-direction-comments " ")
11156 (vhdl-include-type-comments
11157 (concat "[" (nth 3 port) "] ")))
11158 (when vhdl-include-port-comments (nth 4 port))) t))
11159 (when port-list (insert "\n") (indent-to list-margin)))
11160 ;; align port clause
11161 (when vhdl-auto-align
11162 (vhdl-align-region-groups start (point) 1))))))
11164 (defun vhdl-port-paste-instance (&optional name no-indent title)
11165 "Paste as an instantiation."
11166 (interactive)
11167 (if (not vhdl-port-list)
11168 (error "ERROR: No port read")
11169 (let ((orig-vhdl-port-list vhdl-port-list))
11170 ;; flatten local copy of port list (must be flat for port mapping)
11171 (vhdl-port-flatten)
11172 (unless no-indent (indent-according-to-mode))
11173 (let ((margin (current-indentation)))
11174 ;; paste instantiation
11175 (cond (name
11176 (insert name))
11177 ((equal (cdr vhdl-instance-name) "")
11178 (setq name (vhdl-template-field "instance name")))
11179 ((string-match "\%d" (cdr vhdl-instance-name))
11180 (let ((n 1))
11181 (while (save-excursion
11182 (setq name (format (vhdl-replace-string
11183 vhdl-instance-name
11184 (nth 0 vhdl-port-list)) n))
11185 (goto-char (point-min))
11186 (vhdl-re-search-forward name nil t))
11187 (setq n (1+ n)))
11188 (insert name)))
11189 (t (insert (vhdl-replace-string vhdl-instance-name
11190 (nth 0 vhdl-port-list)))))
11191 (message "Pasting port as instantiation \"%s\"..." name)
11192 (insert ": ")
11193 (when title
11194 (save-excursion
11195 (beginning-of-line)
11196 (indent-to vhdl-basic-offset)
11197 (insert "-- instance \"" name "\"\n")))
11198 (if (not (vhdl-use-direct-instantiation))
11199 (insert (nth 0 vhdl-port-list))
11200 (vhdl-insert-keyword "ENTITY ")
11201 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
11202 (when (nth 1 vhdl-port-list)
11203 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11204 (vhdl-port-paste-generic-map t t))
11205 (when (nth 2 vhdl-port-list)
11206 (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11207 (vhdl-port-paste-port-map))
11208 (message "Pasting port as instantiation \"%s\"...done" name))
11209 (setq vhdl-port-list orig-vhdl-port-list))))
11211 (defun vhdl-port-paste-constants (&optional no-indent)
11212 "Paste generics as constants."
11213 (interactive)
11214 (if (not vhdl-port-list)
11215 (error "ERROR: No port read")
11216 (let ((orig-vhdl-port-list vhdl-port-list))
11217 (message "Pasting port as constants...")
11218 ;; flatten local copy of port list (must be flat for constant initial.)
11219 (vhdl-port-flatten)
11220 (unless no-indent (indent-according-to-mode))
11221 (let ((margin (current-indentation))
11222 start generic name
11223 (generic-list (nth 1 vhdl-port-list)))
11224 (when generic-list
11225 (setq start (point))
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) margin))
11231 (vhdl-insert-keyword "CONSTANT ")
11232 ;; paste generic constants
11233 (setq name (nth 0 generic))
11234 (when name
11235 (insert (car name))
11236 ;; paste type
11237 (insert " : " (nth 1 generic))
11238 ;; paste initialization
11239 (when (nth 2 generic)
11240 (insert " := " (nth 2 generic)))
11241 (insert ";")
11242 ;; paste comment
11243 (when (and vhdl-include-port-comments (nth 3 generic))
11244 (vhdl-comment-insert-inline (nth 3 generic) t))
11245 (setq generic-list (cdr generic-list))
11246 (when generic-list (insert "\n") (indent-to margin))))
11247 ;; align signal list
11248 (when vhdl-auto-align
11249 (vhdl-align-region-groups start (point) 1))))
11250 (message "Pasting port as constants...done")
11251 (setq vhdl-port-list orig-vhdl-port-list))))
11253 (defun vhdl-port-paste-signals (&optional initialize no-indent)
11254 "Paste ports as internal signals."
11255 (interactive)
11256 (if (not vhdl-port-list)
11257 (error "ERROR: No port read")
11258 (message "Pasting port as signals...")
11259 (unless no-indent (indent-according-to-mode))
11260 (let ((margin (current-indentation))
11261 start port names
11262 (port-list (nth 2 vhdl-port-list)))
11263 (when port-list
11264 (setq start (point))
11265 (while port-list
11266 (setq port (car port-list))
11267 ;; paste group comment and spacing
11268 (when (memq vhdl-include-group-comments '(decl always))
11269 (vhdl-paste-group-comment (nth 5 port) margin))
11270 ;; paste object
11271 (if (nth 1 port)
11272 (insert (nth 1 port) " ")
11273 (vhdl-insert-keyword "SIGNAL "))
11274 ;; paste actual port signals
11275 (setq names (nth 0 port))
11276 (while names
11277 (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
11278 (setq names (cdr names))
11279 (when names (insert ", ")))
11280 ;; paste type
11281 (insert " : " (nth 3 port))
11282 ;; paste initialization (inputs only)
11283 (when (and initialize (equal "IN" (upcase (nth 2 port))))
11284 (insert " := " (if (string-match "(.+)" (nth 3 port))
11285 "(others => '0')" "'0'")))
11286 (insert ";")
11287 ;; paste comment
11288 (when (or vhdl-include-direction-comments
11289 (and vhdl-include-port-comments (nth 4 port)))
11290 (vhdl-comment-insert-inline
11291 (concat
11292 (cond ((and vhdl-include-direction-comments (nth 2 port))
11293 (format "%-6s" (concat "[" (nth 2 port) "] ")))
11294 (vhdl-include-direction-comments " "))
11295 (when vhdl-include-port-comments (nth 4 port))) t))
11296 (setq port-list (cdr port-list))
11297 (when port-list (insert "\n") (indent-to margin)))
11298 ;; align signal list
11299 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11300 (message "Pasting port as signals...done")))
11302 (defun vhdl-port-paste-initializations (&optional no-indent)
11303 "Paste ports as signal initializations."
11304 (interactive)
11305 (if (not vhdl-port-list)
11306 (error "ERROR: No port read")
11307 (let ((orig-vhdl-port-list vhdl-port-list))
11308 (message "Pasting port as initializations...")
11309 ;; flatten local copy of port list (must be flat for signal initial.)
11310 (vhdl-port-flatten)
11311 (unless no-indent (indent-according-to-mode))
11312 (let ((margin (current-indentation))
11313 start port name
11314 (port-list (nth 2 vhdl-port-list)))
11315 (when port-list
11316 (setq start (point))
11317 (while port-list
11318 (setq port (car port-list))
11319 ;; paste actual port signal (inputs only)
11320 (when (equal "IN" (upcase (nth 2 port)))
11321 (setq name (car (nth 0 port)))
11322 (insert (vhdl-replace-string vhdl-actual-port-name name))
11323 ;; paste initialization
11324 (insert " <= " (if (string-match "(.+)" (nth 3 port))
11325 "(others => '0')" "'0'") ";"))
11326 (setq port-list (cdr port-list))
11327 (when (and port-list
11328 (equal "IN" (upcase (nth 2 (car port-list)))))
11329 (insert "\n") (indent-to margin)))
11330 ;; align signal list
11331 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11332 (message "Pasting port as initializations...done")
11333 (setq vhdl-port-list orig-vhdl-port-list))))
11335 (defun vhdl-port-paste-testbench ()
11336 "Paste as a bare-bones testbench."
11337 (interactive)
11338 (if (not vhdl-port-list)
11339 (error "ERROR: No port read")
11340 (let ((case-fold-search t)
11341 (ent-name (vhdl-replace-string vhdl-testbench-entity-name
11342 (nth 0 vhdl-port-list)))
11343 (source-buffer (current-buffer))
11344 arch-name config-name ent-file-name arch-file-name
11345 ent-buffer arch-buffer position)
11346 ;; open entity file
11347 (unless (eq vhdl-testbench-create-files 'none)
11348 (setq ent-file-name
11349 (concat ent-name "." (file-name-extension (buffer-file-name))))
11350 (if (file-exists-p ent-file-name)
11351 (if (y-or-n-p
11352 (concat "File \"" ent-file-name "\" exists; overwrite? "))
11353 (progn (find-file ent-file-name)
11354 (erase-buffer)
11355 (set-buffer-modified-p nil))
11356 (if (eq vhdl-testbench-create-files 'separate)
11357 (setq ent-file-name nil)
11358 (error "ERROR: Pasting port as testbench...aborted")))
11359 (find-file ent-file-name)))
11360 (unless (and (eq vhdl-testbench-create-files 'separate)
11361 (null ent-file-name))
11362 ;; paste entity header
11363 (if vhdl-testbench-include-header
11364 (progn (vhdl-template-header
11365 (concat "Testbench for design \""
11366 (nth 0 vhdl-port-list) "\""))
11367 (goto-char (point-max)))
11368 (vhdl-comment-display-line) (insert "\n\n"))
11369 ;; paste std_logic_1164 package
11370 (when vhdl-testbench-include-library
11371 (vhdl-template-package-std-logic-1164)
11372 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
11373 ;; paste entity declaration
11374 (vhdl-insert-keyword "ENTITY ")
11375 (insert ent-name)
11376 (vhdl-insert-keyword " IS")
11377 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
11378 (insert "\n")
11379 (vhdl-insert-keyword "END ")
11380 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
11381 (insert ent-name ";")
11382 (insert "\n\n")
11383 (vhdl-comment-display-line) (insert "\n"))
11384 ;; get architecture name
11385 (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
11386 (read-from-minibuffer "architecture name: "
11387 nil vhdl-minibuffer-local-map)
11388 (vhdl-replace-string vhdl-testbench-architecture-name
11389 (nth 0 vhdl-port-list))))
11390 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
11391 ;; open architecture file
11392 (if (not (eq vhdl-testbench-create-files 'separate))
11393 (insert "\n")
11394 (setq ent-buffer (current-buffer))
11395 (setq arch-file-name
11396 (concat ent-name "_" arch-name "."
11397 (file-name-extension (buffer-file-name))))
11398 (when (and (file-exists-p arch-file-name)
11399 (not (y-or-n-p (concat "File \"" arch-file-name
11400 "\" exists; overwrite? "))))
11401 (error "ERROR: Pasting port as testbench...aborted"))
11402 (find-file arch-file-name)
11403 (erase-buffer)
11404 (set-buffer-modified-p nil)
11405 ;; paste architecture header
11406 (if vhdl-testbench-include-header
11407 (progn (vhdl-template-header
11408 (concat "Testbench architecture for design \""
11409 (nth 0 vhdl-port-list) "\""))
11410 (goto-char (point-max)))
11411 (vhdl-comment-display-line) (insert "\n\n")))
11412 ;; paste architecture body
11413 (vhdl-insert-keyword "ARCHITECTURE ")
11414 (insert arch-name)
11415 (vhdl-insert-keyword " OF ")
11416 (insert ent-name)
11417 (vhdl-insert-keyword " IS")
11418 (insert "\n\n") (indent-to vhdl-basic-offset)
11419 ;; paste component declaration
11420 (unless (vhdl-use-direct-instantiation)
11421 (vhdl-port-paste-component t)
11422 (insert "\n\n") (indent-to vhdl-basic-offset))
11423 ;; paste constants
11424 (when (nth 1 vhdl-port-list)
11425 (insert "-- component generics\n") (indent-to vhdl-basic-offset)
11426 (vhdl-port-paste-constants t)
11427 (insert "\n\n") (indent-to vhdl-basic-offset))
11428 ;; paste internal signals
11429 (insert "-- component ports\n") (indent-to vhdl-basic-offset)
11430 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
11431 (insert "\n")
11432 ;; paste custom declarations
11433 (unless (equal "" vhdl-testbench-declarations)
11434 (insert "\n")
11435 (vhdl-insert-string-or-file vhdl-testbench-declarations))
11436 (setq position (point))
11437 (insert "\n\n")
11438 (vhdl-comment-display-line) (insert "\n")
11439 (when vhdl-testbench-include-configuration
11440 (setq config-name (vhdl-replace-string
11441 vhdl-testbench-configuration-name
11442 (concat ent-name " " arch-name)))
11443 (insert "\n")
11444 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
11445 (vhdl-insert-keyword " OF ") (insert ent-name)
11446 (vhdl-insert-keyword " IS\n")
11447 (indent-to vhdl-basic-offset)
11448 (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
11449 (indent-to vhdl-basic-offset)
11450 (vhdl-insert-keyword "END FOR;\n")
11451 (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
11452 (vhdl-comment-display-line) (insert "\n"))
11453 (goto-char position)
11454 (vhdl-template-begin-end
11455 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
11456 ;; paste instantiation
11457 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
11458 (vhdl-port-paste-instance
11459 (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
11460 (insert "\n")
11461 ;; paste custom statements
11462 (unless (equal "" vhdl-testbench-statements)
11463 (insert "\n")
11464 (vhdl-insert-string-or-file vhdl-testbench-statements))
11465 (insert "\n")
11466 (indent-to vhdl-basic-offset)
11467 (unless (eq vhdl-testbench-create-files 'none)
11468 (setq arch-buffer (current-buffer))
11469 (when ent-buffer (set-buffer ent-buffer) (save-buffer))
11470 (set-buffer arch-buffer) (save-buffer))
11471 (message
11472 (concat (format "Pasting port as testbench \"%s(%s)\"...done"
11473 ent-name arch-name)
11474 (and ent-file-name
11475 (format "\n File created: \"%s\"" ent-file-name))
11476 (and arch-file-name
11477 (format "\n File created: \"%s\"" arch-file-name)))))))
11480 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11481 ;;; Subprogram interface translation
11482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11484 (defvar vhdl-subprog-list nil
11485 "Variable to hold last subprogram interface parsed.")
11486 ;; structure: (parenthesised expression means list of such entries)
11487 ;; (subprog-name kind
11488 ;; ((names) object direct type init comment group-comment)
11489 ;; return-type return-comment group-comment)
11491 (defvar vhdl-subprog-flattened nil
11492 "Indicates whether an subprogram interface has been flattened.")
11494 (defun vhdl-subprog-flatten ()
11495 "Flatten interface list so that only one parameter exists per line."
11496 (interactive)
11497 (if (not vhdl-subprog-list)
11498 (error "ERROR: No subprogram interface has been read")
11499 (message "Flattening subprogram interface...")
11500 (let ((old-subprog-list (nth 2 vhdl-subprog-list))
11501 new-subprog-list old-subprog new-subprog names)
11502 ;; traverse parameter list and flatten entries
11503 (while old-subprog-list
11504 (setq old-subprog (car old-subprog-list))
11505 (setq names (car old-subprog))
11506 (while names
11507 (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
11508 (setq new-subprog-list (append new-subprog-list (list new-subprog)))
11509 (setq names (cdr names)))
11510 (setq old-subprog-list (cdr old-subprog-list)))
11511 (setq vhdl-subprog-list
11512 (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
11513 new-subprog-list (nth 3 vhdl-subprog-list)
11514 (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
11515 vhdl-subprog-flattened t)
11516 (message "Flattening subprogram interface...done"))))
11518 (defun vhdl-subprog-copy ()
11519 "Get interface information from a subprogram specification."
11520 (interactive)
11521 (save-excursion
11522 (let (parse-error pos end-of-list
11523 name kind param-list object names direct type init
11524 comment group-comment
11525 return-type return-comment return-group-comment)
11526 (vhdl-prepare-search-2
11527 (setq
11528 parse-error
11529 (catch 'parse
11530 ;; check if within function declaration
11531 (setq pos (point))
11532 (end-of-line)
11533 (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
11534 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
11535 (goto-char (match-end 0))
11536 (save-excursion (backward-char)
11537 (forward-sexp)
11538 (<= pos (point))))
11539 (throw 'parse "ERROR: Not within a subprogram specification"))
11540 (setq name (match-string-no-properties 5))
11541 (setq kind (if (match-string 2) 'procedure 'function))
11542 (setq end-of-list (not (match-string 7)))
11543 (message "Reading interface of subprogram \"%s\"..." name)
11544 ;; parse parameter list
11545 (setq group-comment (vhdl-parse-group-comment))
11546 (setq end-of-list (or end-of-list
11547 (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
11548 (while (not end-of-list)
11549 ;; parse object
11550 (setq object
11551 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
11552 (match-string-no-properties 1)))
11553 ;; parse names (accept extended identifiers)
11554 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
11555 (setq names (list (match-string-no-properties 1)))
11556 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
11557 (setq names (append names (list (match-string-no-properties 1)))))
11558 ;; parse direction
11559 (vhdl-parse-string ":[ \t\n]*")
11560 (setq direct
11561 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
11562 (match-string-no-properties 1)))
11563 ;; parse type
11564 (vhdl-parse-string "\\([^():;\n]+\\)")
11565 (setq type (match-string-no-properties 1))
11566 (setq comment nil)
11567 (while (looking-at "(")
11568 (setq type
11569 (concat type
11570 (buffer-substring-no-properties
11571 (point) (progn (forward-sexp) (point)))
11572 (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11573 (match-string-no-properties 1)))))
11574 ;; special case: closing parenthesis is on separate line
11575 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11576 (setq comment (substring type (match-beginning 2)))
11577 (setq type (substring type 0 (match-beginning 1))))
11578 ;; strip off trailing group-comment
11579 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11580 (setq type (substring type 0 (match-end 1)))
11581 ;; parse initialization expression
11582 (setq init nil)
11583 (when (vhdl-parse-string ":=[ \t\n]*" t)
11584 (vhdl-parse-string "\\([^();\n]*\\)")
11585 (setq init (match-string-no-properties 1))
11586 (while (looking-at "(")
11587 (setq init
11588 (concat init
11589 (buffer-substring-no-properties
11590 (point) (progn (forward-sexp) (point)))
11591 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11592 (match-string-no-properties 1))))))
11593 ;; special case: closing parenthesis is on separate line
11594 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11595 (setq comment (substring init (match-beginning 2)))
11596 (setq init (substring init 0 (match-beginning 1)))
11597 (vhdl-forward-syntactic-ws))
11598 (skip-chars-forward " \t")
11599 ;; parse inline comment, special case: as above, no initial.
11600 (unless comment
11601 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11602 (match-string-no-properties 1))))
11603 (vhdl-forward-syntactic-ws)
11604 (setq end-of-list (vhdl-parse-string ")\\s-*" t))
11605 ;; parse inline comment
11606 (unless comment
11607 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11608 (match-string-no-properties 1))))
11609 (setq return-group-comment (vhdl-parse-group-comment))
11610 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
11611 ;; parse return type
11612 (when (match-string 3)
11613 (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
11614 (setq return-type (match-string-no-properties 1))
11615 (when (and return-type
11616 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
11617 (setq return-comment (substring return-type (match-beginning 2)))
11618 (setq return-type (substring return-type 0 (match-beginning 1))))
11619 ;; strip of trailing group-comment
11620 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
11621 (setq return-type (substring return-type 0 (match-end 1)))
11622 ;; parse return comment
11623 (unless return-comment
11624 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11625 (match-string-no-properties 1)))))
11626 ;; parse inline comment
11627 (unless comment
11628 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11629 (match-string-no-properties 1))))
11630 ;; save everything in list
11631 (setq param-list (append param-list
11632 (list (list names object direct type init
11633 comment group-comment))))
11634 ;; parse group comment and spacing
11635 (setq group-comment (vhdl-parse-group-comment)))
11636 (message "Reading interface of subprogram \"%s\"...done" name)
11637 nil)))
11638 ;; finish parsing
11639 (if parse-error
11640 (error parse-error)
11641 (setq vhdl-subprog-list
11642 (list name kind param-list return-type return-comment
11643 return-group-comment)
11644 vhdl-subprog-flattened nil)))))
11646 (defun vhdl-subprog-paste-specification (kind)
11647 "Paste as a subprogram specification."
11648 (indent-according-to-mode)
11649 (let ((margin (current-column))
11650 (param-list (nth 2 vhdl-subprog-list))
11651 list-margin start names param)
11652 ;; paste keyword and name
11653 (vhdl-insert-keyword
11654 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
11655 (insert (nth 0 vhdl-subprog-list))
11656 (if (not param-list)
11657 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11658 (setq start (point))
11659 ;; paste parameter list
11660 (insert " (")
11661 (unless vhdl-argument-list-indent
11662 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11663 (setq list-margin (current-column))
11664 (while param-list
11665 (setq param (car param-list))
11666 ;; paste group comment and spacing
11667 (when (memq vhdl-include-group-comments (list kind 'always))
11668 (vhdl-paste-group-comment (nth 6 param) list-margin))
11669 ;; paste object
11670 (when (nth 1 param) (insert (nth 1 param) " "))
11671 ;; paste names
11672 (setq names (nth 0 param))
11673 (while names
11674 (insert (car names))
11675 (setq names (cdr names))
11676 (when names (insert ", ")))
11677 ;; paste direction
11678 (insert " : ")
11679 (when (nth 2 param) (insert (nth 2 param) " "))
11680 ;; paste type
11681 (insert (nth 3 param))
11682 ;; paste initialization
11683 (when (nth 4 param) (insert " := " (nth 4 param)))
11684 ;; terminate line
11685 (if (cdr param-list)
11686 (insert ";")
11687 (insert ")")
11688 (when (null (nth 3 vhdl-subprog-list))
11689 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
11690 ;; paste comment
11691 (when (and vhdl-include-port-comments (nth 5 param))
11692 (vhdl-comment-insert-inline (nth 5 param) t))
11693 (setq param-list (cdr param-list))
11694 (when param-list (insert "\n") (indent-to list-margin)))
11695 (when (nth 3 vhdl-subprog-list)
11696 (insert "\n") (indent-to list-margin)
11697 ;; paste group comment and spacing
11698 (when (memq vhdl-include-group-comments (list kind 'always))
11699 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
11700 ;; paste return type
11701 (insert "return " (nth 3 vhdl-subprog-list))
11702 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11703 (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
11704 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
11705 ;; align parameter list
11706 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
11707 ;; paste body
11708 (when (eq kind 'body)
11709 (insert "\n")
11710 (vhdl-template-begin-end
11711 (unless (vhdl-standard-p '87)
11712 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
11713 (nth 0 vhdl-subprog-list) margin))))
11715 (defun vhdl-subprog-paste-declaration ()
11716 "Paste as a subprogram declaration."
11717 (interactive)
11718 (if (not vhdl-subprog-list)
11719 (error "ERROR: No subprogram interface read")
11720 (message "Pasting interface as subprogram declaration \"%s\"..."
11721 (car vhdl-subprog-list))
11722 ;; paste specification
11723 (vhdl-subprog-paste-specification 'decl)
11724 (message "Pasting interface as subprogram declaration \"%s\"...done"
11725 (car vhdl-subprog-list))))
11727 (defun vhdl-subprog-paste-body ()
11728 "Paste as a subprogram body."
11729 (interactive)
11730 (if (not vhdl-subprog-list)
11731 (error "ERROR: No subprogram interface read")
11732 (message "Pasting interface as subprogram body \"%s\"..."
11733 (car vhdl-subprog-list))
11734 ;; paste specification and body
11735 (vhdl-subprog-paste-specification 'body)
11736 (message "Pasting interface as subprogram body \"%s\"...done"
11737 (car vhdl-subprog-list))))
11739 (defun vhdl-subprog-paste-call ()
11740 "Paste as a subprogram call."
11741 (interactive)
11742 (if (not vhdl-subprog-list)
11743 (error "ERROR: No subprogram interface read")
11744 (let ((orig-vhdl-subprog-list vhdl-subprog-list)
11745 param-list margin list-margin param start)
11746 ;; flatten local copy of interface list (must be flat for parameter mapping)
11747 (vhdl-subprog-flatten)
11748 (setq param-list (nth 2 vhdl-subprog-list))
11749 (indent-according-to-mode)
11750 (setq margin (current-indentation))
11751 (message "Pasting interface as subprogram call \"%s\"..."
11752 (car vhdl-subprog-list))
11753 ;; paste name
11754 (insert (nth 0 vhdl-subprog-list))
11755 (if (not param-list)
11756 (insert ";")
11757 (setq start (point))
11758 ;; paste parameter list
11759 (insert " (")
11760 (unless vhdl-argument-list-indent
11761 (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11762 (setq list-margin (current-column))
11763 (while param-list
11764 (setq param (car param-list))
11765 ;; paste group comment and spacing
11766 (when (eq vhdl-include-group-comments 'always)
11767 (vhdl-paste-group-comment (nth 6 param) list-margin))
11768 ;; paste formal port
11769 (insert (car (nth 0 param)) " => ")
11770 (setq param-list (cdr param-list))
11771 (insert (if param-list "," ");"))
11772 ;; paste comment
11773 (when (and vhdl-include-port-comments (nth 5 param))
11774 (vhdl-comment-insert-inline (nth 5 param)))
11775 (when param-list (insert "\n") (indent-to list-margin)))
11776 ;; align parameter list
11777 (when vhdl-auto-align
11778 (vhdl-align-region-groups start (point) 1)))
11779 (message "Pasting interface as subprogram call \"%s\"...done"
11780 (car vhdl-subprog-list))
11781 (setq vhdl-subprog-list orig-vhdl-subprog-list))))
11784 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11785 ;;; Miscellaneous
11786 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11788 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11789 ;; Hippie expand customization
11791 (defvar vhdl-expand-upper-case nil)
11793 (defun vhdl-try-expand-abbrev (old)
11794 "Try expanding abbreviations from `vhdl-abbrev-list'."
11795 (unless old
11796 (he-init-string (he-dabbrev-beg) (point))
11797 (setq he-expand-list
11798 (let ((abbrev-list vhdl-abbrev-list)
11799 (sel-abbrev-list '()))
11800 (while abbrev-list
11801 (when (or (not (stringp (car abbrev-list)))
11802 (string-match
11803 (concat "^" he-search-string) (car abbrev-list)))
11804 (setq sel-abbrev-list
11805 (cons (car abbrev-list) sel-abbrev-list)))
11806 (setq abbrev-list (cdr abbrev-list)))
11807 (nreverse sel-abbrev-list))))
11808 (while (and he-expand-list
11809 (or (not (stringp (car he-expand-list)))
11810 (he-string-member (car he-expand-list) he-tried-table t)))
11811 ; (equal (car he-expand-list) he-search-string)))
11812 (unless (stringp (car he-expand-list))
11813 (setq vhdl-expand-upper-case (car he-expand-list)))
11814 (setq he-expand-list (cdr he-expand-list)))
11815 (if (null he-expand-list)
11816 (progn (when old (he-reset-string))
11817 nil)
11818 (he-substitute-string
11819 (if vhdl-expand-upper-case
11820 (upcase (car he-expand-list))
11821 (car he-expand-list))
11823 (setq he-expand-list (cdr he-expand-list))
11826 (defun vhdl-he-list-beg ()
11827 "Also looks at the word before `(' in order to better match parenthesized
11828 expressions (e.g. for index ranges of types and signals)."
11829 (save-excursion
11830 (condition-case ()
11831 (progn (backward-up-list 1)
11832 (skip-syntax-backward "w_")) ; crashes in `viper-mode'
11833 (error ()))
11834 (point)))
11836 ;; override `he-list-beg' from `hippie-exp'
11837 (unless (and (boundp 'viper-mode) viper-mode)
11838 (defalias 'he-list-beg 'vhdl-he-list-beg))
11840 ;; function for expanding abbrevs and dabbrevs
11841 (defun vhdl-expand-abbrev (arg))
11842 (fset 'vhdl-expand-abbrev (make-hippie-expand-function
11843 '(try-expand-dabbrev
11844 try-expand-dabbrev-all-buffers
11845 vhdl-try-expand-abbrev)))
11847 ;; function for expanding parenthesis
11848 (defun vhdl-expand-paren (arg))
11849 (fset 'vhdl-expand-paren (make-hippie-expand-function
11850 '(try-expand-list
11851 try-expand-list-all-buffers)))
11853 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11854 ;; Case fixing
11856 (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
11857 "Convert all words matching word-regexp in region to lower or upper case,
11858 depending on parameter upper-case."
11859 (let ((case-replace nil)
11860 (last-update 0))
11861 (vhdl-prepare-search-2
11862 (save-excursion
11863 (goto-char end)
11864 (setq end (point-marker))
11865 (goto-char beg)
11866 (while (re-search-forward word-regexp end t)
11867 (or (vhdl-in-literal)
11868 (if upper-case
11869 (upcase-word -1)
11870 (downcase-word -1)))
11871 (when (and count vhdl-progress-interval (not noninteractive)
11872 (< vhdl-progress-interval
11873 (- (nth 1 (current-time)) last-update)))
11874 (message "Fixing case... (%2d%s)"
11875 (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))
11876 "%")
11877 (setq last-update (nth 1 (current-time)))))
11878 (goto-char end)))))
11880 (defun vhdl-fix-case-region (beg end &optional arg)
11881 "Convert all VHDL words in region to lower or upper case, depending on
11882 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
11883 (interactive "r\nP")
11884 (vhdl-fix-case-region-1
11885 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
11886 (vhdl-fix-case-region-1
11887 beg end vhdl-upper-case-types vhdl-types-regexp 1)
11888 (vhdl-fix-case-region-1
11889 beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
11890 (vhdl-fix-case-region-1
11891 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
11892 (when vhdl-progress-interval (message "Fixing case...done")))
11894 (defun vhdl-fix-case-buffer ()
11895 "Convert all VHDL words in buffer to lower or upper case, depending on
11896 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
11897 (interactive)
11898 (vhdl-fix-case-region (point-min) (point-max)))
11900 (defun vhdl-fix-case-word (&optional arg)
11901 "Convert word after cursor to upper case if necessary."
11902 (interactive "p")
11903 (save-excursion
11904 (when arg (backward-word 1))
11905 (vhdl-prepare-search-1
11906 (when (and vhdl-upper-case-keywords
11907 (looking-at vhdl-keywords-regexp))
11908 (upcase-word 1))
11909 (when (and vhdl-upper-case-types
11910 (looking-at vhdl-types-regexp))
11911 (upcase-word 1))
11912 (when (and vhdl-upper-case-attributes
11913 (looking-at vhdl-attributes-regexp))
11914 (upcase-word 1))
11915 (when (and vhdl-upper-case-enum-values
11916 (looking-at vhdl-enum-values-regexp))
11917 (upcase-word 1)))))
11919 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11920 ;; Line handling functions
11922 (defun vhdl-current-line ()
11923 "Return the line number of the line containing point."
11924 (save-restriction
11925 (widen)
11926 (save-excursion
11927 (beginning-of-line)
11928 (1+ (count-lines 1 (point))))))
11930 (defun vhdl-line-kill-entire (&optional arg)
11931 "Delete entire line."
11932 (interactive "p")
11933 (beginning-of-line)
11934 (kill-line (or arg 1)))
11936 (defun vhdl-line-kill (&optional arg)
11937 "Kill current line."
11938 (interactive "p")
11939 (vhdl-line-kill-entire arg))
11941 (defun vhdl-line-copy (&optional arg)
11942 "Copy current line."
11943 (interactive "p")
11944 (save-excursion
11945 (beginning-of-line)
11946 (let ((position (point)))
11947 (forward-line (or arg 1))
11948 (copy-region-as-kill position (point)))))
11950 (defun vhdl-line-yank ()
11951 "Yank entire line."
11952 (interactive)
11953 (beginning-of-line)
11954 (yank))
11956 (defun vhdl-line-expand (&optional prefix-arg)
11957 "Hippie-expand current line."
11958 (interactive "P")
11959 (let ((case-fold-search t) (case-replace nil)
11960 (hippie-expand-try-functions-list
11961 '(try-expand-line try-expand-line-all-buffers)))
11962 (hippie-expand prefix-arg)))
11964 (defun vhdl-line-transpose-next (&optional arg)
11965 "Interchange this line with next line."
11966 (interactive "p")
11967 (forward-line 1)
11968 (transpose-lines (or arg 1))
11969 (forward-line -1))
11971 (defun vhdl-line-transpose-previous (&optional arg)
11972 "Interchange this line with previous line."
11973 (interactive "p")
11974 (forward-line 1)
11975 (transpose-lines (- 0 (or arg 0)))
11976 (forward-line -1))
11978 (defun vhdl-line-open ()
11979 "Open a new line and indent."
11980 (interactive)
11981 (end-of-line -0)
11982 (newline-and-indent))
11984 (defun vhdl-delete-indentation ()
11985 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that
11986 it works within comments too."
11987 (interactive)
11988 (let ((fill-prefix "-- "))
11989 (delete-indentation)))
11991 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11992 ;; Move functions
11994 (defun vhdl-forward-same-indent ()
11995 "Move forward to next line with same indent."
11996 (interactive)
11997 (let ((pos (point))
11998 (indent (current-indentation)))
11999 (beginning-of-line 2)
12000 (while (and (not (eobp))
12001 (or (looking-at "^\\s-*\\(--.*\\)?$")
12002 (> (current-indentation) indent)))
12003 (beginning-of-line 2))
12004 (if (= (current-indentation) indent)
12005 (back-to-indentation)
12006 (message "No following line with same indent found in this block")
12007 (goto-char pos)
12008 nil)))
12010 (defun vhdl-backward-same-indent ()
12011 "Move backward to previous line with same indent."
12012 (interactive)
12013 (let ((pos (point))
12014 (indent (current-indentation)))
12015 (beginning-of-line -0)
12016 (while (and (not (bobp))
12017 (or (looking-at "^\\s-*\\(--.*\\)?$")
12018 (> (current-indentation) indent)))
12019 (beginning-of-line -0))
12020 (if (= (current-indentation) indent)
12021 (back-to-indentation)
12022 (message "No preceding line with same indent found in this block")
12023 (goto-char pos)
12024 nil)))
12026 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12027 ;; Statistics
12029 (defun vhdl-statistics-buffer ()
12030 "Get some file statistics."
12031 (interactive)
12032 (let ((no-stats 0)
12033 (no-code-lines 0)
12034 (no-lines (count-lines (point-min) (point-max))))
12035 (save-excursion
12036 ;; count statements
12037 (goto-char (point-min))
12038 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12039 (if (match-string 1)
12040 (goto-char (match-end 1))
12041 (setq no-stats (1+ no-stats))))
12042 ;; count code lines
12043 (goto-char (point-min))
12044 (while (not (eobp))
12045 (unless (looking-at "^\\s-*\\(--.*\\)?$")
12046 (setq no-code-lines (1+ no-code-lines)))
12047 (beginning-of-line 2)))
12048 ;; print results
12049 (message "\n\
12050 File statistics: \"%s\"\n\
12051 ---------------------\n\
12052 # statements : %5d\n\
12053 # code lines : %5d\n\
12054 # total lines : %5d\n\ "
12055 (buffer-file-name) no-stats no-code-lines no-lines)
12056 (unless vhdl-emacs-21 (vhdl-show-messages))))
12058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12059 ;; Help functions
12061 (defun vhdl-re-search-forward (regexp &optional bound noerror count)
12062 "Like `re-search-forward', but does not match within literals."
12063 (let (pos)
12064 (save-excursion
12065 (while (and (setq pos (re-search-forward regexp bound noerror count))
12066 (vhdl-in-literal))))
12067 (when pos (goto-char pos))
12068 pos))
12070 (defun vhdl-re-search-backward (regexp &optional bound noerror count)
12071 "Like `re-search-backward', but does not match within literals."
12072 (let (pos)
12073 (save-excursion
12074 (while (and (setq pos (re-search-backward regexp bound noerror count))
12075 (vhdl-in-literal))))
12076 (when pos (goto-char pos))
12077 pos))
12080 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12081 ;;; Project
12082 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12084 (defun vhdl-set-project (name)
12085 "Set current project to NAME."
12086 (interactive
12087 (list (let ((completion-ignore-case t))
12088 (completing-read "Project name: " vhdl-project-alist nil t))))
12089 (cond ((equal name "")
12090 (setq vhdl-project nil)
12091 (message "Current VHDL project: None"))
12092 ((assoc name vhdl-project-alist)
12093 (setq vhdl-project name)
12094 (message "Current VHDL project: \"%s\"" name))
12096 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
12097 (vhdl-speedbar-update-current-project))
12099 (defun vhdl-toggle-project (name token indent)
12100 "Set current project to NAME or unset if NAME is current project."
12101 (vhdl-set-project (if (equal name vhdl-project) "" name)))
12103 (defun vhdl-export-project (file-name)
12104 "Write project setup for current project."
12105 (interactive
12106 (let ((name (vhdl-resolve-env-variable
12107 (vhdl-replace-string
12108 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12109 (concat (subst-char-in-string
12110 ? ?_ (or (vhdl-project-p)
12111 (error "ERROR: No current project")))
12112 " " (user-login-name))))))
12113 (list (read-file-name
12114 "Write project file: "
12115 (when (file-name-absolute-p name) "") nil nil name))))
12116 (setq file-name (abbreviate-file-name file-name))
12117 (let ((orig-buffer (current-buffer)))
12118 (unless (file-exists-p (file-name-directory file-name))
12119 (make-directory (file-name-directory file-name) t))
12120 (if (not (file-writable-p file-name))
12121 (error "ERROR: File not writable: \"%s\"" file-name)
12122 (set-buffer (find-file-noselect file-name t t))
12123 (erase-buffer)
12124 (insert ";; -*- Emacs-Lisp -*-\n\n"
12125 ";;; " (file-name-nondirectory file-name)
12126 " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
12127 ";; Project : " vhdl-project "\n"
12128 ";; Saved : " (format-time-string "%Y-%m-%d %T ")
12129 (user-login-name) "\n\n\n"
12130 ";; project name\n"
12131 "(setq vhdl-project \"" vhdl-project "\")\n\n"
12132 ";; project setup\n"
12133 "(aput 'vhdl-project-alist vhdl-project\n'")
12134 (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
12135 (insert ")\n")
12136 (save-buffer)
12137 (kill-buffer (current-buffer))
12138 (set-buffer orig-buffer))))
12140 (defun vhdl-import-project (file-name &optional auto not-make-current)
12141 "Read project setup and set current project."
12142 (interactive
12143 (let ((name (vhdl-resolve-env-variable
12144 (vhdl-replace-string
12145 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12146 (concat "" " " (user-login-name))))))
12147 (list (read-file-name
12148 "Read project file: " (when (file-name-absolute-p name) "") nil t
12149 (file-name-directory name)))))
12150 (when (file-exists-p file-name)
12151 (condition-case ()
12152 (let ((current-project vhdl-project))
12153 (load-file file-name)
12154 (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
12155 (adelete 'vhdl-project-alist vhdl-project)
12156 (error))
12157 (when not-make-current
12158 (setq vhdl-project current-project))
12159 (vhdl-update-mode-menu)
12160 (vhdl-speedbar-refresh)
12161 (unless not-make-current
12162 (message "Current VHDL project: \"%s\"%s"
12163 vhdl-project (if auto " (auto-loaded)" ""))))
12164 (error (vhdl-warning
12165 (format "ERROR: Invalid project setup file: \"%s\"" file-name))))))
12167 (defun vhdl-duplicate-project ()
12168 "Duplicate setup of current project."
12169 (interactive)
12170 (let ((new-name (read-from-minibuffer "New project name: "))
12171 (project-entry (aget vhdl-project-alist vhdl-project t)))
12172 (setq vhdl-project-alist
12173 (append vhdl-project-alist
12174 (list (cons new-name project-entry))))
12175 (vhdl-update-mode-menu)))
12177 (defun vhdl-auto-load-project ()
12178 "Automatically load project setup at startup."
12179 (let ((file-name-list vhdl-project-file-name)
12180 file-list list-length)
12181 (while file-name-list
12182 (setq file-list
12183 (append file-list
12184 (file-expand-wildcards
12185 (vhdl-resolve-env-variable
12186 (vhdl-replace-string
12187 (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
12188 (concat "\*" " " (user-login-name)))))))
12189 (setq list-length (or list-length (length file-list)))
12190 (setq file-name-list (cdr file-name-list)))
12191 (while file-list
12192 (vhdl-import-project (expand-file-name (car file-list)) t
12193 (not (> list-length 0)))
12194 (setq list-length (1- list-length))
12195 (setq file-list (cdr file-list)))))
12197 ;; automatically load project setup when idle after startup
12198 (when (memq 'startup vhdl-project-auto-load)
12199 (if noninteractive
12200 (vhdl-auto-load-project)
12201 (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project)))
12204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12205 ;;; Hideshow
12206 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12207 ;; (using `hideshow.el')
12209 (defconst vhdl-hs-start-regexp
12210 (concat
12211 "\\(^\\)\\s-*\\("
12212 ;; generic/port clause
12213 "\\(generic\\|port\\)[ \t\n]*(\\|"
12214 ;; component
12215 "component\\>\\|"
12216 ;; component instantiation
12217 "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*"
12218 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12219 "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*"
12220 "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|"
12221 ;; subprogram
12222 "\\(function\\|procedure\\)\\>\\|"
12223 ;; process, block
12224 "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|"
12225 ;; configuration declaration
12226 "configuration\\>"
12227 "\\)")
12228 "Regexp to match start of construct to hide.")
12230 (defun vhdl-hs-forward-sexp-func (count)
12231 "Find end of construct to hide (for hideshow). Only searches forward."
12232 (let ((pos (point)))
12233 (vhdl-prepare-search-2
12234 (beginning-of-line)
12235 (cond
12236 ;; generic/port clause
12237 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(")
12238 (goto-char (match-end 0))
12239 (backward-char)
12240 (forward-sexp))
12241 ;; component declaration
12242 ((looking-at "^\\s-*component\\>")
12243 (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
12244 ;; component instantiation
12245 ((looking-at
12246 (concat
12247 "^\\s-*\\w+\\s-*:[ \t\n]*"
12248 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12249 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*"
12250 "\\(generic\\|port\\)\\s-+map[ \t\n]*("))
12251 (goto-char (match-end 0))
12252 (backward-char)
12253 (forward-sexp)
12254 (setq pos (point))
12255 (vhdl-forward-syntactic-ws)
12256 (when (looking-at "port\\s-+map[ \t\n]*(")
12257 (goto-char (match-end 0))
12258 (backward-char)
12259 (forward-sexp)
12260 (setq pos (point)))
12261 (goto-char pos))
12262 ;; subprogram declaration/body
12263 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
12264 (goto-char (match-end 0))
12265 (vhdl-forward-syntactic-ws)
12266 (when (looking-at "(")
12267 (forward-sexp))
12268 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
12269 (vhdl-in-literal)))
12270 ;; subprogram body
12271 (when (match-string 2)
12272 (re-search-forward "^\\s-*\\<begin\\>" nil t)
12273 (backward-word 1)
12274 (vhdl-forward-sexp)))
12275 ;; block (recursive)
12276 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
12277 (goto-char (match-end 0))
12278 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
12279 (match-beginning 2))
12280 (vhdl-hs-forward-sexp-func count)))
12281 ;; process
12282 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
12283 (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
12284 ;; configuration declaration
12285 ((looking-at "^\\s-*configuration\\>")
12286 (forward-word 4)
12287 (vhdl-forward-sexp))
12288 (t (goto-char pos))))))
12290 (defun vhdl-hideshow-init ()
12291 "Initialize `hideshow'."
12292 (when vhdl-hideshow-menu
12293 (vhdl-hs-minor-mode 1)))
12295 (defun vhdl-hs-minor-mode (&optional arg)
12296 "Toggle hideshow minor mode and update menu bar."
12297 (interactive "P")
12298 (require 'hideshow)
12299 ;; check for hideshow version 5.x
12300 (if (not (boundp 'hs-block-start-mdata-select))
12301 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
12302 ;; initialize hideshow
12303 (unless (assoc 'vhdl-mode hs-special-modes-alist)
12304 (setq hs-special-modes-alist
12305 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
12306 'vhdl-hs-forward-sexp-func nil)
12307 hs-special-modes-alist)))
12308 (make-local-variable 'hs-minor-mode-hook)
12309 (if vhdl-hide-all-init
12310 (add-hook 'hs-minor-mode-hook 'hs-hide-all)
12311 (remove-hook 'hs-minor-mode-hook 'hs-hide-all))
12312 (hs-minor-mode arg)
12313 (vhdl-mode-line-update))) ; hack to update menu bar
12316 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12317 ;;; Font locking
12318 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12319 ;; (using `font-lock.el')
12321 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12322 ;; Help functions
12324 (defun vhdl-within-translate-off ()
12325 "Return point if within translate-off region, else nil."
12326 (and (save-excursion
12327 (re-search-backward
12328 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t))
12329 (equal "off" (match-string 1))
12330 (point)))
12332 (defun vhdl-start-translate-off (limit)
12333 "Return point before translate-off pragma if before LIMIT, else nil."
12334 (when (re-search-forward
12335 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t)
12336 (match-beginning 0)))
12338 (defun vhdl-end-translate-off (limit)
12339 "Return point after translate-on pragma if before LIMIT, else nil."
12340 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t))
12342 (defun vhdl-match-translate-off (limit)
12343 "Match a translate-off block, setting match-data and returning t, else nil."
12344 (when (< (point) limit)
12345 (let ((start (or (vhdl-within-translate-off)
12346 (vhdl-start-translate-off limit)))
12347 (case-fold-search t))
12348 (when start
12349 (let ((end (or (vhdl-end-translate-off limit) limit)))
12350 (set-match-data (list start end))
12351 (goto-char end))))))
12353 (defun vhdl-font-lock-match-item (limit)
12354 "Match, and move over, any declaration item after point. Adapted from
12355 `font-lock-match-c-style-declaration-item-and-skip-to-next'."
12356 (condition-case nil
12357 (save-restriction
12358 (narrow-to-region (point-min) limit)
12359 ;; match item
12360 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
12361 (save-match-data
12362 (goto-char (match-end 1))
12363 ;; move to next item
12364 (if (looking-at "\\(\\s-*,\\)")
12365 (goto-char (match-end 1))
12366 (end-of-line) t))))
12367 (error t)))
12369 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12370 ;; Syntax definitions
12372 (defconst vhdl-font-lock-syntactic-keywords
12373 '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
12374 "Mark single quotes as having string quote syntax in 'c' instances.")
12376 (defvar vhdl-font-lock-keywords nil
12377 "Regular expressions to highlight in VHDL Mode.")
12379 (defvar vhdl-font-lock-keywords-0
12380 ;; set in `vhdl-font-lock-init' because dependent on user options
12381 "For consideration as a value of `vhdl-font-lock-keywords'.
12382 This does highlighting of template prompts and directives (pragmas).")
12384 (defvar vhdl-font-lock-keywords-1 nil
12385 ;; set in `vhdl-font-lock-init' because dependent on user options
12386 "For consideration as a value of `vhdl-font-lock-keywords'.
12387 This does highlighting of keywords and standard identifiers.")
12389 (defconst vhdl-font-lock-keywords-2
12390 (list
12391 ;; highlight names of units, subprograms, and components when declared
12392 (list
12393 (concat
12394 "^\\s-*\\("
12395 "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
12396 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
12397 "\\)\\s-+\\(\\w+\\)")
12398 5 'font-lock-function-name-face)
12400 ;; highlight entity names of architectures and configurations
12401 (list
12402 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
12403 2 'font-lock-function-name-face)
12405 ;; highlight labels of common constructs
12406 (list
12407 (concat
12408 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\("
12409 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
12410 "postponed\\|process\\|"
12411 (when (vhdl-standard-p 'ams) "procedural\\|")
12412 "with\\|while"
12413 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\)*\\s-*<=\\)")
12414 1 'font-lock-function-name-face)
12416 ;; highlight label and component name of component instantiations
12417 (list
12418 (concat
12419 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)"
12420 "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)")
12421 '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
12423 ;; highlight label and instantiated unit of component instantiations
12424 (list
12425 (concat
12426 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*"
12427 "\\(component\\|configuration\\|entity\\)\\s-+"
12428 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
12429 '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
12430 '(5 font-lock-function-name-face nil t)
12431 '(7 font-lock-function-name-face nil t))
12433 ;; highlight names and labels at end of constructs
12434 (list
12435 (concat
12436 "^\\s-*end\\s-+\\(\\("
12437 "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
12438 "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
12439 "procedure\\|\\(postponed\\s-+\\)?process\\|"
12440 (when (vhdl-standard-p 'ams) "procedural\\|")
12441 "units"
12442 "\\)\\s-+\\)?\\(\\w*\\)")
12443 5 'font-lock-function-name-face)
12445 ;; highlight labels in exit and next statements
12446 (list
12447 (concat
12448 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
12449 3 'font-lock-function-name-face)
12451 ;; highlight entity name in attribute specifications
12452 (list
12453 (concat
12454 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
12455 1 'font-lock-function-name-face)
12457 ;; highlight labels in block and component specifications
12458 (list
12459 (concat
12460 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
12461 "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)")
12462 '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
12464 ;; highlight names in library clauses
12465 (list "^\\s-*library\\>"
12466 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
12468 ;; highlight names in use clauses
12469 (list
12470 (concat
12471 "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
12472 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
12473 '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
12474 '(7 font-lock-function-name-face nil t))
12476 ;; highlight attribute name in attribute declarations/specifications
12477 (list
12478 (concat
12479 "^\\s-*attribute\\s-+\\(\\w+\\)")
12480 1 'vhdl-font-lock-attribute-face)
12482 ;; highlight type/nature name in (sub)type/(sub)nature declarations
12483 (list
12484 (concat
12485 "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)")
12486 3 'font-lock-type-face)
12488 ;; highlight signal/variable/constant declaration names
12489 (list "\\(:[^=]\\)"
12490 '(vhdl-font-lock-match-item
12491 (progn (goto-char (match-beginning 1))
12492 (skip-syntax-backward " ")
12493 (skip-syntax-backward "w_")
12494 (skip-syntax-backward " ")
12495 (while (= (preceding-char) ?,)
12496 (backward-char 1)
12497 (skip-syntax-backward " ")
12498 (skip-syntax-backward "w_")
12499 (skip-syntax-backward " ")))
12500 ; (skip-chars-backward "^-(\n\";")
12501 (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12503 ;; highlight formal parameters in component instantiations and subprogram
12504 ;; calls
12505 (list "\\(=>\\)"
12506 '(vhdl-font-lock-match-item
12507 (progn (goto-char (match-beginning 1))
12508 (skip-syntax-backward " ")
12509 (while (= (preceding-char) ?\)) (backward-sexp))
12510 (skip-syntax-backward "w_")
12511 (skip-syntax-backward " ")
12512 (when (memq (preceding-char) '(?n ?N))
12513 (goto-char (point-max))))
12514 (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12516 ;; highlight alias/group/quantity declaration names and for-loop/-generate
12517 ;; variables
12518 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
12519 '(vhdl-font-lock-match-item
12520 (progn (goto-char (match-end 1)) (match-beginning 2))
12521 nil (1 font-lock-variable-name-face)))
12523 "For consideration as a value of `vhdl-font-lock-keywords'.
12524 This does context sensitive highlighting of names and labels.")
12526 (defvar vhdl-font-lock-keywords-3 nil
12527 ;; set in `vhdl-font-lock-init' because dependent on user options
12528 "For consideration as a value of `vhdl-font-lock-keywords'.
12529 This does highlighting of words with special syntax.")
12531 (defvar vhdl-font-lock-keywords-4 nil
12532 ;; set in `vhdl-font-lock-init' because dependent on user options
12533 "For consideration as a value of `vhdl-font-lock-keywords'.
12534 This does highlighting of additional reserved words.")
12536 (defconst vhdl-font-lock-keywords-5
12537 ;; background highlight translate-off regions
12538 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append)))
12539 "For consideration as a value of `vhdl-font-lock-keywords'.
12540 This does background highlighting of translate-off regions.")
12542 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12543 ;; Font and color definitions
12545 (defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face
12546 "Face name to use for prompts.")
12548 (defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face
12549 "Face name to use for standardized attributes.")
12551 (defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face
12552 "Face name to use for standardized enumeration values.")
12554 (defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face
12555 "Face name to use for standardized functions and packages.")
12557 (defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face
12558 "Face name to use for directives.")
12560 (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face
12561 "Face name to use for additional reserved words.")
12563 (defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face
12564 "Face name to use for translate-off regions.")
12566 ;; face names to use for words with special syntax.
12567 (let ((syntax-alist vhdl-special-syntax-alist)
12568 name)
12569 (while syntax-alist
12570 (setq name (vhdl-function-name
12571 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
12572 (eval `(defvar ,name ',name
12573 ,(concat "Face name to use for "
12574 (nth 0 (car syntax-alist)) ".")))
12575 (setq syntax-alist (cdr syntax-alist))))
12577 (defgroup vhdl-highlight-faces nil
12578 "Faces for highlighting."
12579 :group 'vhdl-highlight)
12581 ;; add faces used from `font-lock'
12582 (custom-add-to-group
12583 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face)
12584 (custom-add-to-group
12585 'vhdl-highlight-faces 'font-lock-string-face 'custom-face)
12586 (custom-add-to-group
12587 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face)
12588 (custom-add-to-group
12589 'vhdl-highlight-faces 'font-lock-type-face 'custom-face)
12590 (custom-add-to-group
12591 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face)
12592 (custom-add-to-group
12593 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
12595 (defface vhdl-font-lock-prompt-face
12596 '((((class color) (background light)) (:foreground "Red" :bold t))
12597 (((class color) (background dark)) (:foreground "Pink" :bold t))
12598 (t (:inverse-video t)))
12599 "Font lock mode face used to highlight prompts."
12600 :group 'vhdl-highlight-faces
12601 :group 'font-lock-highlighting-faces)
12603 (defface vhdl-font-lock-attribute-face
12604 '((((class color) (background light)) (:foreground "Orchid"))
12605 (((class color) (background dark)) (:foreground "LightSteelBlue"))
12606 (t (:italic t :bold t)))
12607 "Font lock mode face used to highlight standardized attributes."
12608 :group 'vhdl-highlight-faces
12609 :group 'font-lock-highlighting-faces)
12611 (defface vhdl-font-lock-enumvalue-face
12612 '((((class color) (background light)) (:foreground "SaddleBrown"))
12613 (((class color) (background dark)) (:foreground "BurlyWood"))
12614 (t (:italic t :bold t)))
12615 "Font lock mode face used to highlight standardized enumeration values."
12616 :group 'vhdl-highlight-faces
12617 :group 'font-lock-highlighting-faces)
12619 (defface vhdl-font-lock-function-face
12620 '((((class color) (background light)) (:foreground "Cyan4"))
12621 (((class color) (background dark)) (:foreground "Orchid1"))
12622 (t (:italic t :bold t)))
12623 "Font lock mode face used to highlight standardized functions and packages."
12624 :group 'vhdl-highlight-faces
12625 :group 'font-lock-highlighting-faces)
12627 (defface vhdl-font-lock-directive-face
12628 '((((class color) (background light)) (:foreground "CadetBlue"))
12629 (((class color) (background dark)) (:foreground "Aquamarine"))
12630 (t (:italic t :bold t)))
12631 "Font lock mode face used to highlight directives."
12632 :group 'vhdl-highlight-faces
12633 :group 'font-lock-highlighting-faces)
12635 (defface vhdl-font-lock-reserved-words-face
12636 '((((class color) (background light)) (:foreground "Orange" :bold t))
12637 (((class color) (background dark)) (:foreground "Yellow" :bold t))
12638 (t ()))
12639 "Font lock mode face used to highlight additional reserved words."
12640 :group 'vhdl-highlight-faces
12641 :group 'font-lock-highlighting-faces)
12643 (defface vhdl-font-lock-translate-off-face
12644 '((((class color) (background light)) (:background "LightGray"))
12645 (((class color) (background dark)) (:background "DimGray"))
12646 (t ()))
12647 "Font lock mode face used to background highlight translate-off regions."
12648 :group 'vhdl-highlight-faces
12649 :group 'font-lock-highlighting-faces)
12651 ;; font lock mode faces used to highlight words with special syntax.
12652 (let ((syntax-alist vhdl-special-syntax-alist))
12653 (while syntax-alist
12654 (eval `(defface ,(vhdl-function-name
12655 "vhdl-font-lock" (caar syntax-alist) "face")
12656 '((((class color) (background light))
12657 (:foreground ,(nth 2 (car syntax-alist))))
12658 (((class color) (background dark))
12659 (:foreground ,(nth 3 (car syntax-alist))))
12660 (t ()))
12661 ,(concat "Font lock mode face used to highlight "
12662 (nth 0 (car syntax-alist)) ".")
12663 :group 'vhdl-highlight-faces
12664 :group 'font-lock-highlighting-faces))
12665 (setq syntax-alist (cdr syntax-alist))))
12667 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12668 ;; Font lock initialization
12670 (defun vhdl-font-lock-init ()
12671 "Initialize fontification."
12672 ;; highlight template prompts and directives
12673 (setq vhdl-font-lock-keywords-0
12674 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
12675 vhdl-template-prompt-syntax ">\\)")
12676 2 'vhdl-font-lock-prompt-face t)
12677 (list (concat "--\\s-*"
12678 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
12679 2 'vhdl-font-lock-directive-face t)))
12680 ;; highlight keywords and standardized types, attributes, enumeration
12681 ;; values, and subprograms
12682 (setq vhdl-font-lock-keywords-1
12683 (list
12684 (list (concat "'" vhdl-attributes-regexp)
12685 1 'vhdl-font-lock-attribute-face)
12686 (list vhdl-types-regexp 1 'font-lock-type-face)
12687 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face)
12688 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face)
12689 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
12690 (list vhdl-keywords-regexp 1 'font-lock-keyword-face)))
12691 ;; highlight words with special syntax.
12692 (setq vhdl-font-lock-keywords-3
12693 (let ((syntax-alist vhdl-special-syntax-alist)
12694 keywords)
12695 (while syntax-alist
12696 (setq keywords
12697 (cons
12698 (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>")
12699 (vhdl-function-name
12700 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
12701 keywords))
12702 (setq syntax-alist (cdr syntax-alist)))
12703 keywords))
12704 ;; highlight additional reserved words
12705 (setq vhdl-font-lock-keywords-4
12706 (list (list vhdl-reserved-words-regexp 1
12707 'vhdl-font-lock-reserved-words-face)))
12708 ;; highlight everything together
12709 (setq vhdl-font-lock-keywords
12710 (append
12711 vhdl-font-lock-keywords-0
12712 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1)
12713 (when (or vhdl-highlight-forbidden-words
12714 vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4)
12715 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3)
12716 (when vhdl-highlight-names vhdl-font-lock-keywords-2)
12717 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5))))
12719 ;; initialize fontification for VHDL Mode
12720 (vhdl-font-lock-init)
12722 (defun vhdl-fontify-buffer ()
12723 "Re-initialize fontification and fontify buffer."
12724 (interactive)
12725 (setq font-lock-defaults
12726 (list
12727 'vhdl-font-lock-keywords nil
12728 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
12729 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
12730 (when (fboundp 'font-lock-unset-defaults)
12731 (font-lock-unset-defaults)) ; not implemented in XEmacs
12732 (font-lock-set-defaults)
12733 (font-lock-mode nil)
12734 (font-lock-mode t))
12736 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12737 ;; Initialization for postscript printing
12739 (defun vhdl-ps-print-settings ()
12740 "Initialize custom face and page settings for postscript printing."
12741 ;; define custom face settings
12742 (unless (or (not vhdl-print-customize-faces)
12743 ps-print-color-p)
12744 (set (make-local-variable 'ps-bold-faces)
12745 '(font-lock-keyword-face
12746 font-lock-type-face
12747 vhdl-font-lock-attribute-face
12748 vhdl-font-lock-enumvalue-face
12749 vhdl-font-lock-directive-face))
12750 (set (make-local-variable 'ps-italic-faces)
12751 '(font-lock-comment-face
12752 font-lock-function-name-face
12753 font-lock-type-face
12754 vhdl-font-lock-attribute-face
12755 vhdl-font-lock-enumvalue-face
12756 vhdl-font-lock-directive-face))
12757 (set (make-local-variable 'ps-underlined-faces)
12758 '(font-lock-string-face))
12759 (setq ps-always-build-face-reference t))
12760 ;; define page settings, so that a line containing 79 characters (default)
12761 ;; fits into one column
12762 (when vhdl-print-two-column
12763 (set (make-local-variable 'ps-landscape-mode) t)
12764 (set (make-local-variable 'ps-number-of-columns) 2)
12765 (set (make-local-variable 'ps-font-size) 7.0)
12766 (set (make-local-variable 'ps-header-title-font-size) 10.0)
12767 (set (make-local-variable 'ps-header-font-size) 9.0)
12768 (set (make-local-variable 'ps-header-offset) 12.0)
12769 (when (eq ps-paper-type 'letter)
12770 (set (make-local-variable 'ps-inter-column) 40.0)
12771 (set (make-local-variable 'ps-left-margin) 40.0)
12772 (set (make-local-variable 'ps-right-margin) 40.0))))
12774 (defun vhdl-ps-print-init ()
12775 "Initialize postscript printing."
12776 (if vhdl-xemacs
12777 (when (boundp 'ps-print-color-p)
12778 (vhdl-ps-print-settings))
12779 (make-local-variable 'ps-print-hook)
12780 (add-hook 'ps-print-hook 'vhdl-ps-print-settings)))
12783 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12784 ;;; Hierarchy browser (using `speedbar.el')
12785 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12786 ;; Allows displaying the hierarchy of all VHDL design units contained in a
12787 ;; directory by using the speedbar.
12789 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12790 ;; Variables
12792 (defvar vhdl-entity-alist nil
12793 "Cache with entities and corresponding architectures for each
12794 project/directory.")
12795 ;; structure: (parenthesised expression means list of such entries)
12796 ;; (cache-key
12797 ;; (ent-key ent-name ent-file ent-line
12798 ;; (arch-key arch-name arch-file arch-line
12799 ;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
12800 ;; inst-arch-key inst-conf-key inst-lib-key)
12801 ;; (lib-name pack-key))
12802 ;; (lib-name pack-key))
12804 (defvar vhdl-config-alist nil
12805 "Cache with configurations for each project/directory.")
12806 ;; structure: (parenthesised expression means list of such entries)
12807 ;; (cache-key
12808 ;; (conf-key conf-name conf-file conf-line ent-key arch-key
12809 ;; (inst-key inst-comp-name inst-ent-key inst-arch-key
12810 ;; inst-conf-key inst-lib-key)
12811 ;; (lib-name pack-key)))
12813 (defvar vhdl-package-alist nil
12814 "Cache with packages for each project/directory.")
12815 ;; structure: (parenthesised expression means list of such entries)
12816 ;; (cache-key
12817 ;; (pack-key pack-name pack-file pack-line
12818 ;; (comp-key comp-name comp-file comp-line)
12819 ;; (func-key func-name func-file func-line)
12820 ;; (lib-name pack-key)
12821 ;; pack-body-file pack-body-line
12822 ;; (func-key func-name func-body-file func-body-line)
12823 ;; (lib-name pack-key)))
12825 (defvar vhdl-ent-inst-alist nil
12826 "Cache with instantiated entities for each project/directory.")
12827 ;; structure: (parenthesised expression means list of such entries)
12828 ;; (cache-key (inst-ent-key))
12830 (defvar vhdl-file-alist nil
12831 "Cache with design units in each file for each project/directory.")
12832 ;; structure: (parenthesised expression means list of such entries)
12833 ;; (cache-key
12834 ;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
12835 ;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
12837 (defvar vhdl-directory-alist nil
12838 "Cache with source directories for each project.")
12839 ;; structure: (parenthesised expression means list of such entries)
12840 ;; (cache-key (directory))
12842 (defvar vhdl-speedbar-shown-unit-alist nil
12843 "Alist of design units simultaneously open in the current speedbar for each
12844 directory and project.")
12846 (defvar vhdl-speedbar-shown-project-list nil
12847 "List of projects simultaneously open in the current speedbar.")
12849 (defvar vhdl-updated-project-list nil
12850 "List of projects and directories with updated files.")
12852 (defvar vhdl-modified-file-list nil
12853 "List of modified files to be rescanned for hierarchy updating.")
12855 (defvar vhdl-speedbar-hierarchy-depth 0
12856 "Depth of instantiation hierarchy to display.")
12858 (defvar vhdl-speedbar-show-projects nil
12859 "Non-nil means project hierarchy is displayed in speedbar, directory
12860 hierarchy otherwise.")
12862 (defun vhdl-get-end-of-unit ()
12863 "Return position of end of current unit."
12864 (let ((pos (point)))
12865 (save-excursion
12866 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
12867 (save-excursion
12868 (goto-char (match-beginning 0))
12869 (vhdl-backward-syntactic-ws)
12870 (and (/= (preceding-char) ?\;) (not (bobp))))))
12871 (re-search-backward "^[ \t]*end\\>" pos 1)
12872 (point))))
12874 (defun vhdl-match-string-downcase (num &optional string)
12875 "Like `match-string-no-properties' with down-casing."
12876 (let ((match (match-string-no-properties num string)))
12877 (and match (downcase match))))
12880 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12881 ;; Scan functions
12883 (defun vhdl-scan-context-clause ()
12884 "Scan the context clause that preceeds a design unit."
12885 (let (lib-alist)
12886 (save-excursion
12887 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
12888 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
12889 (equal "USE" (upcase (match-string 1))))
12890 (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
12891 (setq lib-alist (cons (cons (match-string-no-properties 1)
12892 (vhdl-match-string-downcase 2))
12893 lib-alist))))))
12894 lib-alist))
12896 (defun vhdl-scan-directory-contents (name &optional project update num-string
12897 non-final)
12898 "Scan contents of VHDL files in directory or file pattern DIR-NAME."
12899 (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
12900 ; (unless (file-directory-p (match-string 1 name))
12901 ; (message "No such directory: \"%s\"" (match-string 1 name)))
12902 (let* ((dir-name (match-string 1 name))
12903 (file-pattern (match-string 2 name))
12904 (is-directory (= 0 (length file-pattern)))
12905 (file-list
12906 (if update
12907 (list name)
12908 (if is-directory
12909 (vhdl-get-source-files t dir-name)
12910 (vhdl-directory-files
12911 dir-name t (wildcard-to-regexp file-pattern)))))
12912 (key (or project dir-name))
12913 (file-exclude-regexp
12914 (or (nth 3 (aget vhdl-project-alist project)) ""))
12915 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
12916 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
12917 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
12918 ent-alist conf-alist pack-alist ent-inst-list file-alist
12919 tmp-list tmp-entry no-files files-exist big-files)
12920 (when (or project update)
12921 (setq ent-alist (aget vhdl-entity-alist key t)
12922 conf-alist (aget vhdl-config-alist key t)
12923 pack-alist (aget vhdl-package-alist key t)
12924 ent-inst-list (car (aget vhdl-ent-inst-alist key t))
12925 file-alist (aget vhdl-file-alist key t)))
12926 (when (and (not is-directory) (null file-list))
12927 (message "No such file: \"%s\"" name))
12928 (setq files-exist file-list)
12929 (when file-list
12930 (setq no-files (length file-list))
12931 (message "Scanning %s %s\"%s\"..."
12932 (if is-directory "directory" "files") (or num-string "") name)
12933 ;; exclude files
12934 (unless (equal file-exclude-regexp "")
12935 (let ((case-fold-search nil)
12936 file-tmp-list)
12937 (while file-list
12938 (unless (string-match file-exclude-regexp (car file-list))
12939 (setq file-tmp-list (cons (car file-list) file-tmp-list)))
12940 (setq file-list (cdr file-list)))
12941 (setq file-list (nreverse file-tmp-list))))
12942 ;; do for all files
12943 (while file-list
12944 (unless noninteractive
12945 (message "Scanning %s %s\"%s\"... (%2d%s)"
12946 (if is-directory "directory" "files")
12947 (or num-string "") name
12948 (/ (* 100 (- no-files (length file-list))) no-files) "%"))
12949 (let ((file-name (abbreviate-file-name (car file-list)))
12950 ent-list arch-list arch-ent-list conf-list
12951 pack-list pack-body-list inst-list inst-ent-list)
12952 ;; scan file
12953 (vhdl-visit-file
12954 file-name nil
12955 (vhdl-prepare-search-2
12956 (save-excursion
12957 ;; scan for design units
12958 (if (and limit-design-file-size
12959 (< limit-design-file-size (buffer-size)))
12960 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name)
12961 (setq big-files t))
12962 ;; scan for entities
12963 (goto-char (point-min))
12964 (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
12965 (let* ((ent-name (match-string-no-properties 1))
12966 (ent-key (downcase ent-name))
12967 (ent-entry (aget ent-alist ent-key t))
12968 (arch-alist (nth 3 ent-entry))
12969 (lib-alist (vhdl-scan-context-clause)))
12970 (if (nth 1 ent-entry)
12971 (vhdl-warning-when-idle
12972 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
12973 ent-name (nth 1 ent-entry) (nth 2 ent-entry)
12974 file-name (vhdl-current-line))
12975 (setq ent-list (cons ent-key ent-list))
12976 (aput 'ent-alist ent-key
12977 (list ent-name file-name (vhdl-current-line)
12978 arch-alist lib-alist)))))
12979 ;; scan for architectures
12980 (goto-char (point-min))
12981 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
12982 (let* ((arch-name (match-string-no-properties 1))
12983 (arch-key (downcase arch-name))
12984 (ent-name (match-string-no-properties 2))
12985 (ent-key (downcase ent-name))
12986 (ent-entry (aget ent-alist ent-key t))
12987 (arch-alist (nth 3 ent-entry))
12988 (arch-entry (aget arch-alist arch-key t))
12989 (lib-arch-alist (vhdl-scan-context-clause)))
12990 (if arch-entry
12991 (vhdl-warning-when-idle
12992 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
12993 arch-name ent-name (nth 1 arch-entry)
12994 (nth 2 arch-entry) file-name (vhdl-current-line))
12995 (setq arch-list (cons arch-key arch-list)
12996 arch-ent-list (cons ent-key arch-ent-list))
12997 (aput 'arch-alist arch-key
12998 (list arch-name file-name (vhdl-current-line) nil
12999 lib-arch-alist))
13000 (aput 'ent-alist ent-key
13001 (list (or (nth 0 ent-entry) ent-name)
13002 (nth 1 ent-entry) (nth 2 ent-entry)
13003 (vhdl-sort-alist arch-alist)
13004 (nth 4 ent-entry))))))
13005 ;; scan for configurations
13006 (goto-char (point-min))
13007 (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13008 (let* ((conf-name (match-string-no-properties 1))
13009 (conf-key (downcase conf-name))
13010 (conf-entry (aget conf-alist conf-key t))
13011 (ent-name (match-string-no-properties 2))
13012 (ent-key (downcase ent-name))
13013 (lib-alist (vhdl-scan-context-clause))
13014 (conf-line (vhdl-current-line))
13015 (end-of-unit (vhdl-get-end-of-unit))
13016 arch-key comp-conf-list inst-key-list
13017 inst-comp-key inst-ent-key inst-arch-key
13018 inst-conf-key inst-lib-key)
13019 (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)")
13020 (setq arch-key (vhdl-match-string-downcase 1)))
13021 (if conf-entry
13022 (vhdl-warning-when-idle
13023 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13024 conf-name ent-name (nth 1 conf-entry)
13025 (nth 2 conf-entry) file-name conf-line)
13026 (setq conf-list (cons conf-key conf-list))
13027 ;; scan for subconfigurations and subentities
13028 (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)
13029 (setq inst-comp-key (vhdl-match-string-downcase 3)
13030 inst-key-list (split-string
13031 (vhdl-match-string-downcase 1)
13032 "[ \t\n]*,[ \t\n]*"))
13033 (vhdl-forward-syntactic-ws)
13034 (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?")
13035 (setq
13036 inst-lib-key (vhdl-match-string-downcase 3)
13037 inst-ent-key (and (match-string 2)
13038 (vhdl-match-string-downcase 4))
13039 inst-arch-key (and (match-string 2)
13040 (vhdl-match-string-downcase 6))
13041 inst-conf-key (and (not (match-string 2))
13042 (vhdl-match-string-downcase 4)))
13043 (while inst-key-list
13044 (setq comp-conf-list
13045 (cons (list (car inst-key-list)
13046 inst-comp-key inst-ent-key
13047 inst-arch-key inst-conf-key
13048 inst-lib-key)
13049 comp-conf-list))
13050 (setq inst-key-list (cdr inst-key-list)))))
13051 (aput 'conf-alist conf-key
13052 (list conf-name file-name conf-line ent-key
13053 arch-key comp-conf-list lib-alist)))))
13054 ;; scan for packages
13055 (goto-char (point-min))
13056 (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t)
13057 (let* ((pack-name (match-string-no-properties 2))
13058 (pack-key (downcase pack-name))
13059 (is-body (match-string-no-properties 1))
13060 (pack-entry (aget pack-alist pack-key t))
13061 (pack-line (vhdl-current-line))
13062 (end-of-unit (vhdl-get-end-of-unit))
13063 comp-name func-name comp-alist func-alist lib-alist)
13064 (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13065 (vhdl-warning-when-idle
13066 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)"
13067 (if is-body " body" "") pack-name
13068 (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13069 (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
13070 file-name (vhdl-current-line))
13071 ;; scan for context clauses
13072 (setq lib-alist (vhdl-scan-context-clause))
13073 ;; scan for component and subprogram declarations/bodies
13074 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
13075 (if (equal (upcase (match-string 1)) "COMPONENT")
13076 (setq comp-name (match-string-no-properties 2)
13077 comp-alist
13078 (cons (list (downcase comp-name) comp-name
13079 file-name (vhdl-current-line))
13080 comp-alist))
13081 (setq func-name (match-string-no-properties 2)
13082 func-alist
13083 (cons (list (downcase func-name) func-name
13084 file-name (vhdl-current-line))
13085 func-alist))))
13086 (setq func-alist (nreverse func-alist))
13087 (setq comp-alist (nreverse comp-alist))
13088 (if is-body
13089 (setq pack-body-list (cons pack-key pack-body-list))
13090 (setq pack-list (cons pack-key pack-list)))
13091 (aput
13092 'pack-alist pack-key
13093 (if is-body
13094 (list (or (nth 0 pack-entry) pack-name)
13095 (nth 1 pack-entry) (nth 2 pack-entry)
13096 (nth 3 pack-entry) (nth 4 pack-entry)
13097 (nth 5 pack-entry)
13098 file-name pack-line func-alist lib-alist)
13099 (list pack-name file-name pack-line
13100 comp-alist func-alist lib-alist
13101 (nth 6 pack-entry) (nth 7 pack-entry)
13102 (nth 8 pack-entry) (nth 9 pack-entry))))))))
13103 ;; scan for hierarchy
13104 (if (and limit-hier-file-size
13105 (< limit-hier-file-size (buffer-size)))
13106 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name)
13107 (setq big-files t))
13108 ;; scan for architectures
13109 (goto-char (point-min))
13110 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13111 (let* ((ent-name (match-string-no-properties 2))
13112 (ent-key (downcase ent-name))
13113 (arch-name (match-string-no-properties 1))
13114 (arch-key (downcase arch-name))
13115 (ent-entry (aget ent-alist ent-key t))
13116 (arch-alist (nth 3 ent-entry))
13117 (arch-entry (aget arch-alist arch-key t))
13118 (beg-of-unit (point))
13119 (end-of-unit (vhdl-get-end-of-unit))
13120 (inst-no 0)
13121 inst-alist)
13122 ;; scan for contained instantiations
13123 (while (and (re-search-forward
13124 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
13125 "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|"
13126 "component[ \t\n]+\\(\\w+\\)\\|"
13127 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\)") end-of-unit t)
13128 (or (not limit-hier-inst-no)
13129 (<= (setq inst-no (1+ inst-no))
13130 limit-hier-inst-no)))
13131 (let* ((inst-name (match-string-no-properties 1))
13132 (inst-key (downcase inst-name))
13133 (inst-comp-name
13134 (or (match-string-no-properties 3)
13135 (match-string-no-properties 6)))
13136 (inst-ent-key
13137 (or (and (match-string 8)
13138 (vhdl-match-string-downcase 11))
13139 (and inst-comp-name
13140 (downcase inst-comp-name))))
13141 (inst-arch-key (vhdl-match-string-downcase 13))
13142 (inst-conf-key
13143 (and (not (match-string 8))
13144 (vhdl-match-string-downcase 11)))
13145 (inst-lib-key (vhdl-match-string-downcase 10)))
13146 (goto-char (match-end 1))
13147 (setq inst-list (cons inst-key inst-list)
13148 inst-ent-list (cons inst-ent-key inst-ent-list))
13149 (setq inst-alist
13150 (append
13151 inst-alist
13152 (list (list inst-key inst-name file-name
13153 (vhdl-current-line) inst-comp-name
13154 inst-ent-key inst-arch-key
13155 inst-conf-key inst-lib-key))))))
13156 ;; scan for contained configuration specifications
13157 (goto-char beg-of-unit)
13158 (while (re-search-forward
13159 (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*"
13160 "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t)
13161 (let* ((inst-comp-name (match-string-no-properties 3))
13162 (inst-ent-key
13163 (and (match-string 6)
13164 (vhdl-match-string-downcase 9)))
13165 (inst-arch-key (vhdl-match-string-downcase 11))
13166 (inst-conf-key
13167 (and (not (match-string 6))
13168 (vhdl-match-string-downcase 9)))
13169 (inst-lib-key (vhdl-match-string-downcase 8))
13170 (inst-key-list
13171 (split-string (vhdl-match-string-downcase 1)
13172 "[ \t\n]*,[ \t\n]*"))
13173 (tmp-inst-alist inst-alist)
13174 inst-entry)
13175 (while tmp-inst-alist
13176 (when (and (or (equal "all" (car inst-key-list))
13177 (member (nth 0 (car tmp-inst-alist))
13178 inst-key-list))
13179 (equal
13180 (downcase
13181 (or (nth 4 (car tmp-inst-alist)) ""))
13182 (downcase inst-comp-name)))
13183 (setq inst-entry (car tmp-inst-alist))
13184 (setq inst-ent-list
13185 (cons (or inst-ent-key (nth 5 inst-entry))
13186 (vhdl-delete
13187 (nth 5 inst-entry) inst-ent-list)))
13188 (setq inst-entry
13189 (list (nth 0 inst-entry) (nth 1 inst-entry)
13190 (nth 2 inst-entry) (nth 3 inst-entry)
13191 (nth 4 inst-entry)
13192 (or inst-ent-key (nth 5 inst-entry))
13193 (or inst-arch-key (nth 6 inst-entry))
13194 inst-conf-key inst-lib-key))
13195 (setcar tmp-inst-alist inst-entry))
13196 (setq tmp-inst-alist (cdr tmp-inst-alist)))))
13197 ;; save in cache
13198 (aput 'arch-alist arch-key
13199 (list (nth 0 arch-entry) (nth 1 arch-entry)
13200 (nth 2 arch-entry) inst-alist
13201 (nth 4 arch-entry)))
13202 (aput 'ent-alist ent-key
13203 (list (nth 0 ent-entry) (nth 1 ent-entry)
13204 (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
13205 (nth 4 ent-entry)))
13206 (when (and limit-hier-inst-no
13207 (> inst-no limit-hier-inst-no))
13208 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name)
13209 (setq big-files t))
13210 (goto-char end-of-unit))))
13211 ;; remember design units for this file
13212 (aput 'file-alist file-name
13213 (list ent-list arch-list arch-ent-list conf-list
13214 pack-list pack-body-list inst-list inst-ent-list))
13215 (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
13216 (setq file-list (cdr file-list))))
13217 (when (or (and (not project) files-exist)
13218 (and project (not non-final)))
13219 ;; consistency checks:
13220 ;; check whether each architecture has a corresponding entity
13221 (setq tmp-list ent-alist)
13222 (while tmp-list
13223 (when (null (nth 2 (car tmp-list)))
13224 (setq tmp-entry (car (nth 4 (car tmp-list))))
13225 (vhdl-warning-when-idle
13226 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
13227 (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
13228 (nth 3 tmp-entry)))
13229 (setq tmp-list (cdr tmp-list)))
13230 ;; check whether configuration has a corresponding entity/architecture
13231 (setq tmp-list conf-alist)
13232 (while tmp-list
13233 (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
13234 (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
13235 (setq tmp-entry (car tmp-list))
13236 (vhdl-warning-when-idle
13237 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)"
13238 (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
13239 (nth 2 tmp-entry) (nth 3 tmp-entry)))
13240 (setq tmp-entry (car tmp-list))
13241 (vhdl-warning-when-idle
13242 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)"
13243 (nth 1 tmp-entry) (nth 4 tmp-entry)
13244 (nth 2 tmp-entry) (nth 3 tmp-entry)))
13245 (setq tmp-list (cdr tmp-list)))
13246 ;; check whether each package body has a package declaration
13247 (setq tmp-list pack-alist)
13248 (while tmp-list
13249 (when (null (nth 2 (car tmp-list)))
13250 (setq tmp-entry (car tmp-list))
13251 (vhdl-warning-when-idle
13252 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)"
13253 (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
13254 (setq tmp-list (cdr tmp-list)))
13255 ;; sort lists
13256 (setq ent-alist (vhdl-sort-alist ent-alist))
13257 (setq conf-alist (vhdl-sort-alist conf-alist))
13258 (setq pack-alist (vhdl-sort-alist pack-alist))
13259 ;; remember updated directory/project
13260 (add-to-list 'vhdl-updated-project-list (or project dir-name)))
13261 ;; clear directory alists
13262 (unless project
13263 (adelete 'vhdl-entity-alist key)
13264 (adelete 'vhdl-config-alist key)
13265 (adelete 'vhdl-package-alist key)
13266 (adelete 'vhdl-ent-inst-alist key)
13267 (adelete 'vhdl-file-alist key))
13268 ;; put directory contents into cache
13269 (aput 'vhdl-entity-alist key ent-alist)
13270 (aput 'vhdl-config-alist key conf-alist)
13271 (aput 'vhdl-package-alist key pack-alist)
13272 (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
13273 (aput 'vhdl-file-alist key file-alist)
13274 ;; final messages
13275 (message "Scanning %s %s\"%s\"...done"
13276 (if is-directory "directory" "files") (or num-string "") name)
13277 (unless project (message "Scanning directory...done"))
13278 (when big-files
13279 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'"))
13280 ;; save cache when scanned non-interactively
13281 (when (or (not project) (not non-final))
13282 (when (and noninteractive vhdl-speedbar-save-cache)
13283 (vhdl-save-cache key)))
13286 (defun vhdl-scan-project-contents (project)
13287 "Scan the contents of all VHDL files found in the directories and files
13288 of PROJECT."
13289 (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
13290 (default-dir (vhdl-resolve-env-variable
13291 (nth 1 (aget vhdl-project-alist project))))
13292 (file-exclude-regexp
13293 (or (nth 3 (aget vhdl-project-alist project)) ""))
13294 dir-list-tmp dir dir-name num-dir act-dir recursive)
13295 ;; clear project alists
13296 (adelete 'vhdl-entity-alist project)
13297 (adelete 'vhdl-config-alist project)
13298 (adelete 'vhdl-package-alist project)
13299 (adelete 'vhdl-ent-inst-alist project)
13300 (adelete 'vhdl-file-alist project)
13301 ;; expand directory names by default-directory
13302 (message "Collecting source files...")
13303 (while dir-list
13304 (setq dir (vhdl-resolve-env-variable (car dir-list)))
13305 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
13306 (setq recursive (match-string 1 dir)
13307 dir-name (match-string 3 dir))
13308 (setq dir-list-tmp
13309 (cons (concat recursive
13310 (if (file-name-absolute-p dir-name) "" default-dir)
13311 dir-name)
13312 dir-list-tmp))
13313 (setq dir-list (cdr dir-list)))
13314 ;; resolve path wildcards
13315 (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
13316 ;; expand directories
13317 (while dir-list-tmp
13318 (setq dir (car dir-list-tmp))
13319 ;; get subdirectories
13320 (if (string-match "-r \\(.*[/\\]\\)" dir)
13321 (setq dir-list (append dir-list (vhdl-get-subdirs
13322 (match-string 1 dir))))
13323 (setq dir-list (append dir-list (list dir))))
13324 (setq dir-list-tmp (cdr dir-list-tmp)))
13325 ;; exclude files
13326 (unless (equal file-exclude-regexp "")
13327 (let ((case-fold-search nil))
13328 (while dir-list
13329 (unless (string-match file-exclude-regexp (car dir-list))
13330 (setq dir-list-tmp (cons (car dir-list) dir-list-tmp)))
13331 (setq dir-list (cdr dir-list)))
13332 (setq dir-list (nreverse dir-list-tmp))))
13333 (message "Collecting source files...done")
13334 ;; scan for design units for each directory in DIR-LIST
13335 (setq dir-list-tmp nil
13336 num-dir (length dir-list)
13337 act-dir 1)
13338 (while dir-list
13339 (setq dir-name (abbreviate-file-name
13340 (expand-file-name (car dir-list))))
13341 (vhdl-scan-directory-contents dir-name project nil
13342 (format "(%s/%s) " act-dir num-dir)
13343 (cdr dir-list))
13344 (add-to-list 'dir-list-tmp (file-name-directory dir-name))
13345 (setq dir-list (cdr dir-list)
13346 act-dir (1+ act-dir)))
13347 (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
13348 (message "Scanning project \"%s\"...done" project)))
13350 (defun vhdl-update-file-contents (file-name)
13351 "Update hierarchy information by contents of current buffer."
13352 (setq file-name (abbreviate-file-name file-name))
13353 (let* ((dir-name (file-name-directory file-name))
13354 (directory-alist vhdl-directory-alist)
13355 updated)
13356 (while directory-alist
13357 (when (member dir-name (nth 1 (car directory-alist)))
13358 (let* ((vhdl-project (nth 0 (car directory-alist)))
13359 (project (vhdl-project-p))
13360 (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
13361 (conf-alist (aget vhdl-config-alist (or project dir-name) t))
13362 (pack-alist (aget vhdl-package-alist (or project dir-name) t))
13363 (ent-inst-list (car (aget vhdl-ent-inst-alist
13364 (or project dir-name) t)))
13365 (file-alist (aget vhdl-file-alist (or project dir-name) t))
13366 (file-entry (aget file-alist file-name t))
13367 (ent-list (nth 0 file-entry))
13368 (arch-list (nth 1 file-entry))
13369 (arch-ent-list (nth 2 file-entry))
13370 (conf-list (nth 3 file-entry))
13371 (pack-list (nth 4 file-entry))
13372 (pack-body-list (nth 5 file-entry))
13373 (inst-ent-list (nth 7 file-entry))
13374 (cache-key (or project dir-name))
13375 arch-alist key ent-key entry)
13376 ;; delete design units previously contained in this file:
13377 ;; entities
13378 (while ent-list
13379 (setq key (car ent-list)
13380 entry (aget ent-alist key t))
13381 (when (equal file-name (nth 1 entry))
13382 (if (nth 3 entry)
13383 (aput 'ent-alist key
13384 (list (nth 0 entry) nil nil (nth 3 entry) nil))
13385 (adelete 'ent-alist key)))
13386 (setq ent-list (cdr ent-list)))
13387 ;; architectures
13388 (while arch-list
13389 (setq key (car arch-list)
13390 ent-key (car arch-ent-list)
13391 entry (aget ent-alist ent-key t)
13392 arch-alist (nth 3 entry))
13393 (when (equal file-name (nth 1 (aget arch-alist key t)))
13394 (adelete 'arch-alist key)
13395 (if (or (nth 1 entry) arch-alist)
13396 (aput 'ent-alist ent-key
13397 (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13398 arch-alist (nth 4 entry)))
13399 (adelete 'ent-alist ent-key)))
13400 (setq arch-list (cdr arch-list)
13401 arch-ent-list (cdr arch-ent-list)))
13402 ;; configurations
13403 (while conf-list
13404 (setq key (car conf-list))
13405 (when (equal file-name (nth 1 (aget conf-alist key t)))
13406 (adelete 'conf-alist key))
13407 (setq conf-list (cdr conf-list)))
13408 ;; package declarations
13409 (while pack-list
13410 (setq key (car pack-list)
13411 entry (aget pack-alist key t))
13412 (when (equal file-name (nth 1 entry))
13413 (if (nth 6 entry)
13414 (aput 'pack-alist key
13415 (list (nth 0 entry) nil nil nil nil nil
13416 (nth 6 entry) (nth 7 entry) (nth 8 entry)
13417 (nth 9 entry)))
13418 (adelete 'pack-alist key)))
13419 (setq pack-list (cdr pack-list)))
13420 ;; package bodies
13421 (while pack-body-list
13422 (setq key (car pack-body-list)
13423 entry (aget pack-alist key t))
13424 (when (equal file-name (nth 6 entry))
13425 (if (nth 1 entry)
13426 (aput 'pack-alist key
13427 (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13428 (nth 3 entry) (nth 4 entry) (nth 5 entry)
13429 nil nil nil nil))
13430 (adelete 'pack-alist key)))
13431 (setq pack-body-list (cdr pack-body-list)))
13432 ;; instantiated entities
13433 (while inst-ent-list
13434 (setq ent-inst-list
13435 (vhdl-delete (car inst-ent-list) ent-inst-list))
13436 (setq inst-ent-list (cdr inst-ent-list)))
13437 ;; update caches
13438 (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
13439 (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
13440 (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
13441 (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
13442 ;; scan file
13443 (vhdl-scan-directory-contents file-name project t)
13444 (when (or (and vhdl-speedbar-show-projects project)
13445 (and (not vhdl-speedbar-show-projects) (not project)))
13446 (vhdl-speedbar-refresh project))
13447 (setq updated t)))
13448 (setq directory-alist (cdr directory-alist)))
13449 updated))
13451 (defun vhdl-update-hierarchy ()
13452 "Update directory and hierarchy information in speedbar."
13453 (let ((file-list (reverse vhdl-modified-file-list))
13454 updated)
13455 (when (and vhdl-speedbar-update-on-saving file-list)
13456 (while file-list
13457 (setq updated
13458 (or (vhdl-update-file-contents (car file-list))
13459 updated))
13460 (setq file-list (cdr file-list)))
13461 (setq vhdl-modified-file-list nil)
13462 (when updated (message "Updating hierarchy...done")))))
13464 ;; structure (parenthesised expression means list of such entries)
13465 ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
13466 ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
13467 ;; comp-lib-name level)
13468 (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
13469 conf-inst-alist level indent
13470 &optional include-top ent-hier)
13471 "Get instantiation hierarchy beginning in architecture ARCH-KEY of
13472 entity ENT-KEY."
13473 (let* ((ent-entry (aget ent-alist ent-key t))
13474 (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
13475 (cdar (last (nth 3 ent-entry)))))
13476 (inst-alist (nth 3 arch-entry))
13477 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
13478 hier-list subcomp-list tmp-list inst-key inst-comp-name
13479 inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
13480 (when (= level 0) (message "Extract design hierarchy..."))
13481 (when include-top
13482 (setq level (1+ level)))
13483 (when (member ent-key ent-hier)
13484 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
13485 ;; check configured architecture (already checked during scanning)
13486 ; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
13487 ; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
13488 ;; process all instances
13489 (while inst-alist
13490 (setq inst-entry (car inst-alist)
13491 inst-key (nth 0 inst-entry)
13492 inst-comp-name (nth 4 inst-entry)
13493 inst-conf-key (nth 7 inst-entry))
13494 ;; search entry in configuration's instantiations list
13495 (setq tmp-list conf-inst-alist)
13496 (while (and tmp-list
13497 (not (and (member (nth 0 (car tmp-list))
13498 (list "all" inst-key))
13499 (equal (nth 1 (car tmp-list))
13500 (downcase (or inst-comp-name ""))))))
13501 (setq tmp-list (cdr tmp-list)))
13502 (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
13503 (setq inst-conf-entry (aget conf-alist inst-conf-key t))
13504 (when (and inst-conf-key (not inst-conf-entry))
13505 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
13506 ;; determine entity
13507 (setq inst-ent-key
13508 (or (nth 2 (car tmp-list)) ; from configuration
13509 (nth 3 inst-conf-entry) ; from subconfiguration
13510 (nth 3 (aget conf-alist (nth 7 inst-entry) t))
13511 ; from configuration spec.
13512 (nth 5 inst-entry))) ; from direct instantiation
13513 (setq inst-ent-entry (aget ent-alist inst-ent-key t))
13514 ;; determine architecture
13515 (setq inst-arch-key
13516 (or (nth 3 (car tmp-list)) ; from configuration
13517 (nth 4 inst-conf-entry) ; from subconfiguration
13518 (nth 6 inst-entry) ; from direct instantiation
13519 (nth 4 (aget conf-alist (nth 7 inst-entry)))
13520 ; from configuration spec.
13521 (caar (nth 3 inst-ent-entry)))) ; random (simplified MRA)
13522 (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
13523 ;; set library
13524 (setq inst-lib-key
13525 (or (nth 5 (car tmp-list)) ; from configuration
13526 (nth 8 inst-entry))) ; from direct instantiation
13527 ;; gather information for this instance
13528 (setq comp-entry
13529 (list (nth 1 inst-entry)
13530 (cons (nth 2 inst-entry) (nth 3 inst-entry))
13531 (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
13532 (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
13533 (or (nth 0 inst-arch-entry) inst-arch-key)
13534 (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
13535 (or (nth 0 inst-conf-entry) inst-conf-key)
13536 (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
13537 inst-lib-key level))
13538 ;; get subcomponent hierarchy
13539 (setq subcomp-list (vhdl-get-hierarchy
13540 ent-alist conf-alist
13541 inst-ent-key inst-arch-key inst-conf-key
13542 (nth 5 inst-conf-entry)
13543 (1+ level) indent nil (cons ent-key ent-hier)))
13544 ;; add to list
13545 (setq hier-list (append hier-list (list comp-entry) subcomp-list))
13546 (setq inst-alist (cdr inst-alist)))
13547 (when include-top
13548 (setq hier-list
13549 (cons (list nil nil (nth 0 ent-entry)
13550 (cons (nth 1 ent-entry) (nth 2 ent-entry))
13551 (nth 0 arch-entry)
13552 (cons (nth 1 arch-entry) (nth 2 arch-entry))
13553 nil nil
13554 nil (1- level))
13555 hier-list)))
13556 (when (or (= level 0) (and include-top (= level 1))) (message ""))
13557 hier-list))
13559 (defun vhdl-get-instantiations (ent-key indent)
13560 "Get all instantiations of entity ENT-KEY."
13561 (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
13562 arch-alist inst-alist ent-inst-list
13563 ent-entry arch-entry inst-entry)
13564 (while ent-alist
13565 (setq ent-entry (car ent-alist))
13566 (setq arch-alist (nth 4 ent-entry))
13567 (while arch-alist
13568 (setq arch-entry (car arch-alist))
13569 (setq inst-alist (nth 4 arch-entry))
13570 (while inst-alist
13571 (setq inst-entry (car inst-alist))
13572 (when (equal ent-key (nth 5 inst-entry))
13573 (setq ent-inst-list
13574 (cons (list (nth 1 inst-entry)
13575 (cons (nth 2 inst-entry) (nth 3 inst-entry))
13576 (nth 1 ent-entry)
13577 (cons (nth 2 ent-entry) (nth 3 ent-entry))
13578 (nth 1 arch-entry)
13579 (cons (nth 2 arch-entry) (nth 3 arch-entry)))
13580 ent-inst-list)))
13581 (setq inst-alist (cdr inst-alist)))
13582 (setq arch-alist (cdr arch-alist)))
13583 (setq ent-alist (cdr ent-alist)))
13584 (nreverse ent-inst-list)))
13586 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13587 ;; Caching in file
13589 (defun vhdl-save-caches ()
13590 "Save all updated hierarchy caches to file."
13591 (interactive)
13592 (condition-case nil
13593 (when vhdl-speedbar-save-cache
13594 ;; update hierarchy
13595 (vhdl-update-hierarchy)
13596 (let ((project-list vhdl-updated-project-list))
13597 (message "Saving hierarchy caches...")
13598 ;; write updated project caches
13599 (while project-list
13600 (vhdl-save-cache (car project-list))
13601 (setq project-list (cdr project-list)))
13602 (message "Saving hierarchy caches...done")))
13603 (error (progn (vhdl-warning "ERROR: An error occured while saving the hierarchy caches")
13604 (sit-for 2)))))
13606 (defun vhdl-save-cache (key)
13607 "Save current hierarchy cache to file."
13608 (let* ((orig-buffer (current-buffer))
13609 (vhdl-project key)
13610 (project (vhdl-project-p))
13611 (default-directory key)
13612 (directory (abbreviate-file-name (vhdl-default-directory)))
13613 (file-name (vhdl-resolve-env-variable
13614 (vhdl-replace-string
13615 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
13616 (concat
13617 (subst-char-in-string ? ?_ (or project "dir"))
13618 " " (user-login-name)))))
13619 (file-dir-name (expand-file-name file-name directory))
13620 (cache-key (or project directory))
13621 (key (if project "project" "directory")))
13622 (unless (file-exists-p (file-name-directory file-dir-name))
13623 (make-directory (file-name-directory file-dir-name) t))
13624 (if (not (file-writable-p file-dir-name))
13625 (progn (vhdl-warning (format "File not writable: \"%s\""
13626 (abbreviate-file-name file-dir-name)))
13627 (sit-for 2))
13628 (message "Saving cache: \"%s\"" file-dir-name)
13629 (set-buffer (find-file-noselect file-dir-name t t))
13630 (erase-buffer)
13631 (insert ";; -*- Emacs-Lisp -*-\n\n"
13632 ";;; " (file-name-nondirectory file-name)
13633 " - design hierarchy cache file for Emacs VHDL Mode "
13634 vhdl-version "\n")
13635 (insert "\n;; " (if project "Project " "Directory") " : ")
13636 (if project (insert project) (prin1 directory (current-buffer)))
13637 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ")
13638 (user-login-name) "\n\n"
13639 "\n;; version number\n"
13640 "(setq vhdl-cache-version \"" vhdl-version "\")\n"
13641 "\n;; " (if project "project" "directory") " name"
13642 "\n(setq " key " ")
13643 (prin1 (or project directory) (current-buffer))
13644 (insert ")\n")
13645 (when (member 'hierarchy vhdl-speedbar-save-cache)
13646 (insert "\n;; entity and architecture cache\n"
13647 "(aput 'vhdl-entity-alist " key " '")
13648 (print (aget vhdl-entity-alist cache-key t) (current-buffer))
13649 (insert ")\n\n;; configuration cache\n"
13650 "(aput 'vhdl-config-alist " key " '")
13651 (print (aget vhdl-config-alist cache-key t) (current-buffer))
13652 (insert ")\n\n;; package cache\n"
13653 "(aput 'vhdl-package-alist " key " '")
13654 (print (aget vhdl-package-alist cache-key t) (current-buffer))
13655 (insert ")\n\n;; instantiated entities cache\n"
13656 "(aput 'vhdl-ent-inst-alist " key " '")
13657 (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
13658 (insert ")\n\n;; design units per file cache\n"
13659 "(aput 'vhdl-file-alist " key " '")
13660 (print (aget vhdl-file-alist cache-key t) (current-buffer))
13661 (when project
13662 (insert ")\n\n;; source directories in project cache\n"
13663 "(aput 'vhdl-directory-alist " key " '")
13664 (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
13665 (insert ")\n"))
13666 (when (member 'display vhdl-speedbar-save-cache)
13667 (insert "\n;; shown design units cache\n"
13668 "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
13669 (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
13670 (current-buffer))
13671 (insert ")\n"))
13672 (setq vhdl-updated-project-list
13673 (delete cache-key vhdl-updated-project-list))
13674 (save-buffer)
13675 (kill-buffer (current-buffer))
13676 (set-buffer orig-buffer))))
13678 (defun vhdl-load-cache (key)
13679 "Load hierarchy cache information from file."
13680 (let* ((vhdl-project key)
13681 (default-directory key)
13682 (directory (vhdl-default-directory))
13683 (file-name (vhdl-resolve-env-variable
13684 (vhdl-replace-string
13685 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
13686 (concat
13687 (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir"))
13688 " " (user-login-name)))))
13689 (file-dir-name (expand-file-name file-name directory))
13690 vhdl-cache-version)
13691 (unless (memq 'vhdl-save-caches kill-emacs-hook)
13692 (add-hook 'kill-emacs-hook 'vhdl-save-caches))
13693 (when (file-exists-p file-dir-name)
13694 (condition-case ()
13695 (progn (load-file file-dir-name)
13696 (string< (mapconcat
13697 (lambda (a) (format "%3d" (string-to-int a)))
13698 (split-string "3.31.14" "\\.") "")
13699 (mapconcat
13700 (lambda (a) (format "%3d" (string-to-int a)))
13701 (split-string vhdl-cache-version "\\.") "")))
13702 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name))
13703 nil))))))
13705 (defun vhdl-require-hierarchy-info ()
13706 "Make sure that hierarchy information is available. Load cache or scan files
13707 if required."
13708 (if (vhdl-project-p)
13709 (unless (or (assoc vhdl-project vhdl-file-alist)
13710 (vhdl-load-cache vhdl-project))
13711 (vhdl-scan-project-contents vhdl-project))
13712 (let ((directory (abbreviate-file-name default-directory)))
13713 (unless (or (assoc directory vhdl-file-alist)
13714 (vhdl-load-cache directory))
13715 (vhdl-scan-directory-contents directory)))))
13717 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13718 ;; Add hierarchy browser functionality to speedbar
13720 (defvar vhdl-speedbar-key-map nil
13721 "Keymap used when in the VHDL hierarchy browser mode.")
13723 (defvar vhdl-speedbar-menu-items nil
13724 "Additional menu-items to add to speedbar frame.")
13726 (defun vhdl-speedbar-initialize ()
13727 "Initialize speedbar."
13728 ;; general settings
13729 ; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil)
13730 ;; VHDL file extensions (extracted from `auto-mode-alist')
13731 (let ((mode-alist auto-mode-alist))
13732 (while mode-alist
13733 (when (eq (cdar mode-alist) 'vhdl-mode)
13734 (speedbar-add-supported-extension (caar mode-alist)))
13735 (setq mode-alist (cdr mode-alist))))
13736 ;; hierarchy browser settings
13737 (when (boundp 'speedbar-mode-functions-list)
13738 ;; special functions
13739 (speedbar-add-mode-functions-list
13740 '("vhdl directory"
13741 (speedbar-item-info . vhdl-speedbar-item-info)
13742 (speedbar-line-path . speedbar-files-line-path)))
13743 (speedbar-add-mode-functions-list
13744 '("vhdl project"
13745 (speedbar-item-info . vhdl-speedbar-item-info)
13746 (speedbar-line-path . vhdl-speedbar-line-project)))
13747 ;; keymap
13748 (unless vhdl-speedbar-key-map
13749 (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap))
13750 (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line)
13751 (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line)
13752 (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line)
13753 (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line)
13754 (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level)
13755 (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all)
13756 (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy)
13757 (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component)
13758 (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design)
13759 (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy)
13760 (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches)
13761 (let ((key 0))
13762 (while (<= key 9)
13763 (define-key vhdl-speedbar-key-map (int-to-string key)
13764 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
13765 (setq key (1+ key)))))
13766 (define-key speedbar-key-map "h"
13767 (lambda () (interactive)
13768 (speedbar-change-initial-expansion-list "vhdl directory")))
13769 (define-key speedbar-key-map "H"
13770 (lambda () (interactive)
13771 (speedbar-change-initial-expansion-list "vhdl project")))
13772 ;; menu
13773 (unless vhdl-speedbar-menu-items
13774 (setq
13775 vhdl-speedbar-menu-items
13776 `(["Edit" speedbar-edit-line t]
13777 ["Expand" speedbar-expand-line
13778 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
13779 ["Contract" vhdl-speedbar-contract-level t]
13780 ["Expand All" vhdl-speedbar-expand-all t]
13781 ["Contract All" vhdl-speedbar-contract-all t]
13782 ,(let ((key 0) (menu-list '("Hierarchy Depth")))
13783 (while (<= key 9)
13784 (setq menu-list
13785 (cons `[,(if (= key 0) "All" (int-to-string key))
13786 (vhdl-speedbar-set-depth ,key)
13787 :style radio
13788 :selected (= vhdl-speedbar-hierarchy-depth ,key)
13789 :keys ,(int-to-string key)]
13790 menu-list))
13791 (setq key (1+ key)))
13792 (nreverse menu-list))
13793 "--"
13794 ["Copy Port/Subprogram" vhdl-speedbar-port-copy
13795 (or (vhdl-speedbar-check-unit 'entity)
13796 (vhdl-speedbar-check-unit 'subprogram))]
13797 ["Place Component" vhdl-speedbar-place-component
13798 (vhdl-speedbar-check-unit 'entity)]
13799 ["Make" vhdl-speedbar-make-design
13800 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
13801 ["Generate Makefile" vhdl-speedbar-generate-makefile
13802 (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
13803 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
13804 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
13805 ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)]
13806 ["Rescan Project" vhdl-speedbar-rescan-hierarchy
13807 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
13808 ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects]
13809 ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
13810 ;; hook-ups
13811 (speedbar-add-expansion-list
13812 '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map
13813 vhdl-speedbar-display-directory))
13814 (speedbar-add-expansion-list
13815 '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map
13816 vhdl-speedbar-display-projects))
13817 (setq speedbar-stealthy-function-list
13818 (append
13819 '(("vhdl directory" vhdl-speedbar-update-current-unit)
13820 ("vhdl project" vhdl-speedbar-update-current-project
13821 vhdl-speedbar-update-current-unit)
13822 ; ("files" (lambda () (setq speedbar-ignored-path-regexp
13823 ; (speedbar-extension-list-to-regex
13824 ; speedbar-ignored-path-expressions))))
13826 speedbar-stealthy-function-list))
13827 (when (eq vhdl-speedbar-display-mode 'directory)
13828 (setq speedbar-initial-expansion-list-name "vhdl directory"))
13829 (when (eq vhdl-speedbar-display-mode 'project)
13830 (setq speedbar-initial-expansion-list-name "vhdl project"))
13831 (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
13833 (defun vhdl-speedbar (&optional arg)
13834 "Open/close speedbar."
13835 (interactive)
13836 (if (not (fboundp 'speedbar))
13837 (error "WARNING: Speedbar is not available or not installed")
13838 (condition-case ()
13839 (speedbar-frame-mode arg)
13840 (error (error "WARNING: An error occurred while opening speedbar")))))
13842 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13843 ;; Display functions
13845 (defvar vhdl-speedbar-last-selected-project nil
13846 "Name of last selected project.")
13848 ;; macros must be defined in the file they are used (copied from `speedbar.el')
13849 (defmacro speedbar-with-writable (&rest forms)
13850 "Allow the buffer to be writable and evaluate FORMS."
13851 (list 'let '((inhibit-read-only t))
13852 (cons 'progn forms)))
13853 (put 'speedbar-with-writable 'lisp-indent-function 0)
13855 (defun vhdl-speedbar-display-directory (directory depth &optional rescan)
13856 "Display directory and hierarchy information in speedbar."
13857 (setq vhdl-speedbar-show-projects nil)
13858 (setq speedbar-ignored-path-regexp
13859 (speedbar-extension-list-to-regex speedbar-ignored-path-expressions))
13860 (setq directory (abbreviate-file-name (file-name-as-directory directory)))
13861 (setq speedbar-last-selected-file nil)
13862 (speedbar-with-writable
13863 (condition-case nil
13864 (progn
13865 ;; insert directory path
13866 (speedbar-directory-buttons directory depth)
13867 ;; insert subdirectories
13868 (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
13869 ;; scan and insert hierarchy of current directory
13870 (vhdl-speedbar-insert-dir-hierarchy directory depth
13871 speedbar-power-click)
13872 ;; expand subdirectories
13873 (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
13874 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))))
13876 (defun vhdl-speedbar-display-projects (project depth &optional rescan)
13877 "Display projects and hierarchy information in speedbar."
13878 (setq vhdl-speedbar-show-projects t)
13879 (setq speedbar-ignored-path-regexp ".")
13880 (setq speedbar-last-selected-file nil)
13881 (setq vhdl-speedbar-last-selected-project nil)
13882 (speedbar-with-writable
13883 (condition-case nil
13884 ;; insert projects
13885 (vhdl-speedbar-insert-projects)
13886 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))
13887 (setq speedbar-full-text-cache nil)) ; prevent caching
13889 (defun vhdl-speedbar-insert-projects ()
13890 "Insert all projects in speedbar."
13891 (vhdl-speedbar-make-title-line "Projects:")
13892 (let ((project-alist (if vhdl-project-sort
13893 (vhdl-sort-alist (copy-alist vhdl-project-alist))
13894 vhdl-project-alist))
13895 (vhdl-speedbar-update-current-unit nil))
13896 ;; insert projects
13897 (while project-alist
13898 (speedbar-make-tag-line
13899 'angle ?+ 'vhdl-speedbar-expand-project
13900 (caar project-alist) (caar project-alist)
13901 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
13902 (setq project-alist (cdr project-alist)))
13903 (setq project-alist vhdl-project-alist)
13904 ;; expand projects
13905 (while project-alist
13906 (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
13907 (goto-char (point-min))
13908 (when (re-search-forward
13909 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
13910 (goto-char (match-end 1))
13911 (speedbar-do-function-pointer)))
13912 (setq project-alist (cdr project-alist))))
13913 ; (vhdl-speedbar-update-current-project)
13914 ; (vhdl-speedbar-update-current-unit nil t)
13917 (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
13918 "Insert hierarchy of project. Rescan directories if RESCAN is non-nil,
13919 otherwise use cached data."
13920 (when (or rescan (and (not (assoc project vhdl-file-alist))
13921 (not (vhdl-load-cache project))))
13922 (vhdl-scan-project-contents project))
13923 ;; insert design hierarchy
13924 (vhdl-speedbar-insert-hierarchy
13925 (aget vhdl-entity-alist project t)
13926 (aget vhdl-config-alist project t)
13927 (aget vhdl-package-alist project t)
13928 (car (aget vhdl-ent-inst-alist project t)) indent)
13929 (insert (int-to-string indent) ":\n")
13930 (put-text-property (- (point) 3) (1- (point)) 'invisible t)
13931 (put-text-property (1- (point)) (point) 'invisible nil)
13932 ;; expand design units
13933 (vhdl-speedbar-expand-units project))
13935 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
13936 "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil,
13937 otherwise use cached data."
13938 (when (or rescan (and (not (assoc directory vhdl-file-alist))
13939 (not (vhdl-load-cache directory))))
13940 (vhdl-scan-directory-contents directory))
13941 ;; insert design hierarchy
13942 (vhdl-speedbar-insert-hierarchy
13943 (aget vhdl-entity-alist directory t)
13944 (aget vhdl-config-alist directory t)
13945 (aget vhdl-package-alist directory t)
13946 (car (aget vhdl-ent-inst-alist directory t)) depth)
13947 ;; expand design units
13948 (vhdl-speedbar-expand-units directory)
13949 (aput 'vhdl-directory-alist directory (list (list directory))))
13951 (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
13952 ent-inst-list depth)
13953 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
13954 (if (not (or ent-alist conf-alist pack-alist))
13955 (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
13956 (let (ent-entry conf-entry pack-entry)
13957 ;; insert entities
13958 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
13959 (while ent-alist
13960 (setq ent-entry (car ent-alist))
13961 (speedbar-make-tag-line
13962 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
13963 (nth 1 ent-entry) 'vhdl-speedbar-find-file
13964 (cons (nth 2 ent-entry) (nth 3 ent-entry))
13965 'vhdl-speedbar-entity-face depth)
13966 (unless (nth 2 ent-entry)
13967 (end-of-line 0) (insert "!") (forward-char 1))
13968 (unless (member (nth 0 ent-entry) ent-inst-list)
13969 (end-of-line 0) (insert " (top)") (forward-char 1))
13970 (setq ent-alist (cdr ent-alist)))
13971 ;; insert configurations
13972 (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
13973 (while conf-alist
13974 (setq conf-entry (car conf-alist))
13975 (speedbar-make-tag-line
13976 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
13977 (nth 1 conf-entry) 'vhdl-speedbar-find-file
13978 (cons (nth 2 conf-entry) (nth 3 conf-entry))
13979 'vhdl-speedbar-configuration-face depth)
13980 (setq conf-alist (cdr conf-alist)))
13981 ;; insert packages
13982 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
13983 (while pack-alist
13984 (setq pack-entry (car pack-alist))
13985 (vhdl-speedbar-make-pack-line
13986 (nth 0 pack-entry) (nth 1 pack-entry)
13987 (cons (nth 2 pack-entry) (nth 3 pack-entry))
13988 (cons (nth 7 pack-entry) (nth 8 pack-entry))
13989 depth)
13990 (setq pack-alist (cdr pack-alist))))))
13992 (defun vhdl-speedbar-rescan-hierarchy ()
13993 "Rescan hierarchy for the directory or project under the cursor."
13994 (interactive)
13995 (let (key path)
13996 (cond
13997 ;; current project
13998 (vhdl-speedbar-show-projects
13999 (setq key (vhdl-speedbar-line-project))
14000 (vhdl-scan-project-contents key))
14001 ;; top-level directory
14002 ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14003 (re-search-forward "[0-9]+:" nil t)
14004 (vhdl-scan-directory-contents
14005 (abbreviate-file-name (speedbar-line-path))))
14006 ;; current directory
14007 (t (setq path (speedbar-line-path))
14008 (string-match "^\\(.+[/\\]\\)" path)
14009 (vhdl-scan-directory-contents
14010 (abbreviate-file-name (match-string 1 path)))))
14011 (vhdl-speedbar-refresh key)))
14013 (defun vhdl-speedbar-expand-dirs (directory)
14014 "Expand subdirectories in DIRECTORY according to
14015 `speedbar-shown-directories'."
14016 ;; (nicked from `speedbar-default-directory-list')
14017 (let ((sf (cdr (reverse speedbar-shown-directories)))
14018 (vhdl-speedbar-update-current-unit nil))
14019 (setq speedbar-shown-directories
14020 (list (expand-file-name default-directory)))
14021 (while sf
14022 (when (speedbar-goto-this-file (car sf))
14023 (beginning-of-line)
14024 (when (looking-at "[0-9]+:\\s-*<")
14025 (goto-char (match-end 0))
14026 (speedbar-do-function-pointer)))
14027 (setq sf (cdr sf))))
14028 (vhdl-speedbar-update-current-unit nil t))
14030 (defun vhdl-speedbar-expand-units (key)
14031 "Expand design units in directory/project KEY according to
14032 `vhdl-speedbar-shown-unit-alist'."
14033 (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14034 (vhdl-speedbar-update-current-unit nil)
14035 vhdl-updated-project-list)
14036 (adelete 'vhdl-speedbar-shown-unit-alist key)
14037 (vhdl-prepare-search-1
14038 (while unit-alist ; expand units
14039 (vhdl-speedbar-goto-this-unit key (caar unit-alist))
14040 (beginning-of-line)
14041 (let ((arch-alist (nth 1 (car unit-alist)))
14042 position)
14043 (when (looking-at "^[0-9]+:\\s-*\\[")
14044 (goto-char (match-end 0))
14045 (setq position (point))
14046 (speedbar-do-function-pointer)
14047 (select-frame speedbar-frame)
14048 (while arch-alist ; expand architectures
14049 (goto-char position)
14050 (when (re-search-forward
14051 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
14052 (car arch-alist) "\\>\\)") nil t)
14053 (beginning-of-line)
14054 (when (looking-at "^[0-9]+:\\s-*{")
14055 (goto-char (match-end 0))
14056 (speedbar-do-function-pointer)
14057 (select-frame speedbar-frame)))
14058 (setq arch-alist (cdr arch-alist))))
14059 (setq unit-alist (cdr unit-alist))))))
14060 (vhdl-speedbar-update-current-unit nil t))
14062 (defun vhdl-speedbar-contract-level ()
14063 "Contract current level in current directory/project."
14064 (interactive)
14065 (when (or (save-excursion
14066 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
14067 (and (save-excursion
14068 (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
14069 (re-search-backward
14070 (format "^[0-%d]:\\s-*[[{<]-"
14071 (max (1- (string-to-int (match-string 1))) 0)) nil t)))
14072 (goto-char (match-end 0))
14073 (speedbar-do-function-pointer)
14074 (speedbar-center-buffer-smartly)))
14076 (defun vhdl-speedbar-contract-all ()
14077 "Contract all expanded design units in current directory/project."
14078 (interactive)
14079 (if (and vhdl-speedbar-show-projects
14080 (save-excursion (beginning-of-line) (looking-at "^0:")))
14081 (progn (setq vhdl-speedbar-shown-project-list nil)
14082 (vhdl-speedbar-refresh))
14083 (let ((key (vhdl-speedbar-line-key)))
14084 (adelete 'vhdl-speedbar-shown-unit-alist key)
14085 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
14086 (when (memq 'display vhdl-speedbar-save-cache)
14087 (add-to-list 'vhdl-updated-project-list key)))))
14089 (defun vhdl-speedbar-expand-all ()
14090 "Expand all design units in current directory/project."
14091 (interactive)
14092 (let* ((key (vhdl-speedbar-line-key))
14093 (ent-alist (aget vhdl-entity-alist key t))
14094 (conf-alist (aget vhdl-config-alist key t))
14095 (pack-alist (aget vhdl-package-alist key t))
14096 arch-alist unit-alist subunit-alist)
14097 (add-to-list 'vhdl-speedbar-shown-project-list key)
14098 (while ent-alist
14099 (setq arch-alist (nth 4 (car ent-alist)))
14100 (setq subunit-alist nil)
14101 (while arch-alist
14102 (setq subunit-alist (cons (caar arch-alist) subunit-alist))
14103 (setq arch-alist (cdr arch-alist)))
14104 (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist))
14105 (setq ent-alist (cdr ent-alist)))
14106 (while conf-alist
14107 (setq unit-alist (cons (list (caar conf-alist)) unit-alist))
14108 (setq conf-alist (cdr conf-alist)))
14109 (while pack-alist
14110 (setq unit-alist (cons (list (caar pack-alist)) unit-alist))
14111 (setq pack-alist (cdr pack-alist)))
14112 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14113 (vhdl-speedbar-refresh)
14114 (when (memq 'display vhdl-speedbar-save-cache)
14115 (add-to-list 'vhdl-updated-project-list key))))
14117 (defun vhdl-speedbar-expand-project (text token indent)
14118 "Expand/contract the project under the cursor."
14119 (cond
14120 ((string-match "+" text) ; expand project
14121 (speedbar-change-expand-button-char ?-)
14122 (unless (member token vhdl-speedbar-shown-project-list)
14123 (setq vhdl-speedbar-shown-project-list
14124 (cons token vhdl-speedbar-shown-project-list)))
14125 (speedbar-with-writable
14126 (save-excursion
14127 (end-of-line) (forward-char 1)
14128 (vhdl-speedbar-insert-project-hierarchy token (1+ indent)
14129 speedbar-power-click))))
14130 ((string-match "-" text) ; contract project
14131 (speedbar-change-expand-button-char ?+)
14132 (setq vhdl-speedbar-shown-project-list
14133 (delete token vhdl-speedbar-shown-project-list))
14134 (speedbar-delete-subblock indent))
14135 (t (error "Nothing to display")))
14136 (when (equal (selected-frame) speedbar-frame)
14137 (speedbar-center-buffer-smartly)))
14139 (defun vhdl-speedbar-expand-entity (text token indent)
14140 "Expand/contract the entity under the cursor."
14141 (cond
14142 ((string-match "+" text) ; expand entity
14143 (let* ((key (vhdl-speedbar-line-key indent))
14144 (ent-alist (aget vhdl-entity-alist key t))
14145 (ent-entry (aget ent-alist token t))
14146 (arch-alist (nth 3 ent-entry))
14147 (inst-alist (vhdl-get-instantiations token indent))
14148 (subpack-alist (nth 4 ent-entry))
14149 arch-entry inst-entry)
14150 (if (not (or arch-alist inst-alist subpack-alist))
14151 (speedbar-change-expand-button-char ??)
14152 (speedbar-change-expand-button-char ?-)
14153 ;; add entity to `vhdl-speedbar-shown-unit-alist'
14154 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14155 (aput 'unit-alist token nil)
14156 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14157 (speedbar-with-writable
14158 (save-excursion
14159 (end-of-line) (forward-char 1)
14160 ;; insert architectures
14161 (when arch-alist
14162 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
14163 (while arch-alist
14164 (setq arch-entry (car arch-alist))
14165 (speedbar-make-tag-line
14166 'curly ?+ 'vhdl-speedbar-expand-architecture
14167 (cons token (nth 0 arch-entry))
14168 (nth 1 arch-entry) 'vhdl-speedbar-find-file
14169 (cons (nth 2 arch-entry) (nth 3 arch-entry))
14170 'vhdl-speedbar-architecture-face (1+ indent))
14171 (setq arch-alist (cdr arch-alist)))
14172 ;; insert instantiations
14173 (when inst-alist
14174 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
14175 (while inst-alist
14176 (setq inst-entry (car inst-alist))
14177 (vhdl-speedbar-make-inst-line
14178 (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
14179 (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
14180 nil nil nil (1+ indent) 0 " in ")
14181 (setq inst-alist (cdr inst-alist)))
14182 ;; insert required packages
14183 (vhdl-speedbar-insert-subpackages
14184 subpack-alist (1+ indent) indent)))
14185 (when (memq 'display vhdl-speedbar-save-cache)
14186 (add-to-list 'vhdl-updated-project-list key))
14187 (vhdl-speedbar-update-current-unit t t))))
14188 ((string-match "-" text) ; contract entity
14189 (speedbar-change-expand-button-char ?+)
14190 ;; remove entity from `vhdl-speedbar-shown-unit-alist'
14191 (let* ((key (vhdl-speedbar-line-key indent))
14192 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14193 (adelete 'unit-alist token)
14194 (if unit-alist
14195 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14196 (adelete 'vhdl-speedbar-shown-unit-alist key))
14197 (speedbar-delete-subblock indent)
14198 (when (memq 'display vhdl-speedbar-save-cache)
14199 (add-to-list 'vhdl-updated-project-list key))))
14200 (t (error "Nothing to display")))
14201 (when (equal (selected-frame) speedbar-frame)
14202 (speedbar-center-buffer-smartly)))
14204 (defun vhdl-speedbar-expand-architecture (text token indent)
14205 "Expand/contract the architecture under the cursor."
14206 (cond
14207 ((string-match "+" text) ; expand architecture
14208 (let* ((key (vhdl-speedbar-line-key (1- indent)))
14209 (ent-alist (aget vhdl-entity-alist key t))
14210 (conf-alist (aget vhdl-config-alist key t))
14211 (hier-alist (vhdl-get-hierarchy
14212 ent-alist conf-alist (car token) (cdr token) nil nil
14213 0 (1- indent)))
14214 (ent-entry (aget ent-alist (car token) t))
14215 (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
14216 (subpack-alist (nth 4 arch-entry))
14217 entry)
14218 (if (not (or hier-alist subpack-alist))
14219 (speedbar-change-expand-button-char ??)
14220 (speedbar-change-expand-button-char ?-)
14221 ;; add architecture to `vhdl-speedbar-shown-unit-alist'
14222 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14223 (arch-alist (nth 0 (aget unit-alist (car token) t))))
14224 (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
14225 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14226 (speedbar-with-writable
14227 (save-excursion
14228 (end-of-line) (forward-char 1)
14229 ;; insert instance hierarchy
14230 (when hier-alist
14231 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
14232 (1+ indent)))
14233 (while hier-alist
14234 (setq entry (car hier-alist))
14235 (when (or (= vhdl-speedbar-hierarchy-depth 0)
14236 (< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14237 (vhdl-speedbar-make-inst-line
14238 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14239 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14240 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
14241 (setq hier-alist (cdr hier-alist)))
14242 ;; insert required packages
14243 (vhdl-speedbar-insert-subpackages
14244 subpack-alist (1+ indent) (1- indent))))
14245 (when (memq 'display vhdl-speedbar-save-cache)
14246 (add-to-list 'vhdl-updated-project-list key))
14247 (vhdl-speedbar-update-current-unit t t))))
14248 ((string-match "-" text) ; contract architecture
14249 (speedbar-change-expand-button-char ?+)
14250 ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
14251 (let* ((key (vhdl-speedbar-line-key (1- indent)))
14252 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14253 (arch-alist (nth 0 (aget unit-alist (car token) t))))
14254 (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
14255 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14256 (speedbar-delete-subblock indent)
14257 (when (memq 'display vhdl-speedbar-save-cache)
14258 (add-to-list 'vhdl-updated-project-list key))))
14259 (t (error "Nothing to display")))
14260 (when (equal (selected-frame) speedbar-frame)
14261 (speedbar-center-buffer-smartly)))
14263 (defun vhdl-speedbar-expand-config (text token indent)
14264 "Expand/contract the configuration under the cursor."
14265 (cond
14266 ((string-match "+" text) ; expand configuration
14267 (let* ((key (vhdl-speedbar-line-key indent))
14268 (conf-alist (aget vhdl-config-alist key t))
14269 (conf-entry (aget conf-alist token))
14270 (ent-alist (aget vhdl-entity-alist key t))
14271 (hier-alist (vhdl-get-hierarchy
14272 ent-alist conf-alist (nth 3 conf-entry)
14273 (nth 4 conf-entry) token (nth 5 conf-entry)
14274 0 indent t))
14275 (subpack-alist (nth 6 conf-entry))
14276 entry)
14277 (if (not (or hier-alist subpack-alist))
14278 (speedbar-change-expand-button-char ??)
14279 (speedbar-change-expand-button-char ?-)
14280 ;; add configuration to `vhdl-speedbar-shown-unit-alist'
14281 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14282 (aput 'unit-alist token nil)
14283 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14284 (speedbar-with-writable
14285 (save-excursion
14286 (end-of-line) (forward-char 1)
14287 ;; insert instance hierarchy
14288 (when hier-alist
14289 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
14290 (while hier-alist
14291 (setq entry (car hier-alist))
14292 (when (or (= vhdl-speedbar-hierarchy-depth 0)
14293 (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14294 (vhdl-speedbar-make-inst-line
14295 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14296 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14297 (nth 8 entry) (1+ indent) (nth 9 entry) ": "))
14298 (setq hier-alist (cdr hier-alist)))
14299 ;; insert required packages
14300 (vhdl-speedbar-insert-subpackages
14301 subpack-alist (1+ indent) indent)))
14302 (when (memq 'display vhdl-speedbar-save-cache)
14303 (add-to-list 'vhdl-updated-project-list key))
14304 (vhdl-speedbar-update-current-unit t t))))
14305 ((string-match "-" text) ; contract configuration
14306 (speedbar-change-expand-button-char ?+)
14307 ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
14308 (let* ((key (vhdl-speedbar-line-key indent))
14309 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14310 (adelete 'unit-alist token)
14311 (if unit-alist
14312 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14313 (adelete 'vhdl-speedbar-shown-unit-alist key))
14314 (speedbar-delete-subblock indent)
14315 (when (memq 'display vhdl-speedbar-save-cache)
14316 (add-to-list 'vhdl-updated-project-list key))))
14317 (t (error "Nothing to display")))
14318 (when (equal (selected-frame) speedbar-frame)
14319 (speedbar-center-buffer-smartly)))
14321 (defun vhdl-speedbar-expand-package (text token indent)
14322 "Expand/contract the package under the cursor."
14323 (cond
14324 ((string-match "+" text) ; expand package
14325 (let* ((key (vhdl-speedbar-line-key indent))
14326 (pack-alist (aget vhdl-package-alist key t))
14327 (pack-entry (aget pack-alist token t))
14328 (comp-alist (nth 3 pack-entry))
14329 (func-alist (nth 4 pack-entry))
14330 (func-body-alist (nth 8 pack-entry))
14331 (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
14332 comp-entry func-entry func-body-entry)
14333 (if (not (or comp-alist func-alist subpack-alist))
14334 (speedbar-change-expand-button-char ??)
14335 (speedbar-change-expand-button-char ?-)
14336 ;; add package to `vhdl-speedbar-shown-unit-alist'
14337 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14338 (aput 'unit-alist token nil)
14339 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14340 (speedbar-with-writable
14341 (save-excursion
14342 (end-of-line) (forward-char 1)
14343 ;; insert components
14344 (when comp-alist
14345 (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
14346 (while comp-alist
14347 (setq comp-entry (car comp-alist))
14348 (speedbar-make-tag-line
14349 nil nil nil
14350 (cons token (nth 0 comp-entry))
14351 (nth 1 comp-entry) 'vhdl-speedbar-find-file
14352 (cons (nth 2 comp-entry) (nth 3 comp-entry))
14353 'vhdl-speedbar-entity-face (1+ indent))
14354 (setq comp-alist (cdr comp-alist)))
14355 ;; insert subprograms
14356 (when func-alist
14357 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
14358 (while func-alist
14359 (setq func-entry (car func-alist)
14360 func-body-entry (aget func-body-alist (car func-entry) t))
14361 (when (nth 2 func-entry)
14362 (vhdl-speedbar-make-subprogram-line
14363 (nth 1 func-entry)
14364 (cons (nth 2 func-entry) (nth 3 func-entry))
14365 (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
14366 (1+ indent)))
14367 (setq func-alist (cdr func-alist)))
14368 ;; insert required packages
14369 (vhdl-speedbar-insert-subpackages
14370 subpack-alist (1+ indent) indent)))
14371 (when (memq 'display vhdl-speedbar-save-cache)
14372 (add-to-list 'vhdl-updated-project-list key))
14373 (vhdl-speedbar-update-current-unit t t))))
14374 ((string-match "-" text) ; contract package
14375 (speedbar-change-expand-button-char ?+)
14376 ;; remove package from `vhdl-speedbar-shown-unit-alist'
14377 (let* ((key (vhdl-speedbar-line-key indent))
14378 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14379 (adelete 'unit-alist token)
14380 (if unit-alist
14381 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14382 (adelete 'vhdl-speedbar-shown-unit-alist key))
14383 (speedbar-delete-subblock indent)
14384 (when (memq 'display vhdl-speedbar-save-cache)
14385 (add-to-list 'vhdl-updated-project-list key))))
14386 (t (error "Nothing to display")))
14387 (when (equal (selected-frame) speedbar-frame)
14388 (speedbar-center-buffer-smartly)))
14390 (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
14391 "Insert required packages."
14392 (let* ((pack-alist (aget vhdl-package-alist
14393 (vhdl-speedbar-line-key dir-indent) t))
14394 pack-key lib-name pack-entry)
14395 (when subpack-alist
14396 (vhdl-speedbar-make-title-line "Packages Used:" indent))
14397 (while subpack-alist
14398 (setq pack-key (cdar subpack-alist)
14399 lib-name (caar subpack-alist))
14400 (setq pack-entry (aget pack-alist pack-key t))
14401 (vhdl-speedbar-make-subpack-line
14402 (or (nth 0 pack-entry) pack-key) lib-name
14403 (cons (nth 1 pack-entry) (nth 2 pack-entry)) indent)
14404 (setq subpack-alist (cdr subpack-alist)))))
14406 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14407 ;; Display help functions
14409 (defvar vhdl-speedbar-update-current-unit t
14410 "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
14412 (defun vhdl-speedbar-update-current-project ()
14413 "Highlight project that is currently active."
14414 (when (and vhdl-speedbar-show-projects
14415 (not (equal vhdl-speedbar-last-selected-project vhdl-project))
14416 (and (boundp 'speedbar-frame)
14417 (frame-live-p speedbar-frame)))
14418 (let ((last-frame (selected-frame))
14419 (project-alist vhdl-project-alist)
14420 pos)
14421 (select-frame speedbar-frame)
14422 (speedbar-with-writable
14423 (save-excursion
14424 (while project-alist
14425 (goto-char (point-min))
14426 (when (re-search-forward
14427 (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
14428 (put-text-property (match-beginning 1) (match-end 1) 'face
14429 (if (equal (caar project-alist) vhdl-project)
14430 'speedbar-selected-face
14431 'speedbar-directory-face))
14432 (when (equal (caar project-alist) vhdl-project)
14433 (setq pos (1- (match-beginning 1)))))
14434 (setq project-alist (cdr project-alist))))
14435 (when pos (goto-char pos)))
14436 (select-frame last-frame)
14437 (setq vhdl-speedbar-last-selected-project vhdl-project)))
14440 (defun vhdl-speedbar-update-current-unit (&optional no-position always)
14441 "Highlight all design units that are contained in the current file.
14442 NO-POSITION non-nil means do not re-position cursor."
14443 (let ((last-frame (selected-frame))
14444 (project-list vhdl-speedbar-shown-project-list)
14445 file-alist pos file-name)
14446 ;; get current file name
14447 (if (fboundp 'speedbar-select-attached-frame)
14448 (speedbar-select-attached-frame)
14449 (select-frame speedbar-attached-frame))
14450 (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
14451 (when (and vhdl-speedbar-update-current-unit
14452 (or always (not (equal file-name speedbar-last-selected-file))))
14453 (if vhdl-speedbar-show-projects
14454 (while project-list
14455 (setq file-alist (append file-alist (aget vhdl-file-alist
14456 (car project-list) t)))
14457 (setq project-list (cdr project-list)))
14458 (setq file-alist (aget vhdl-file-alist
14459 (abbreviate-file-name default-directory) t)))
14460 (select-frame speedbar-frame)
14461 (set-buffer speedbar-buffer)
14462 (speedbar-with-writable
14463 (vhdl-prepare-search-1
14464 (save-excursion
14465 ;; unhighlight last units
14466 (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
14467 (vhdl-speedbar-update-units
14468 "\\[.\\] " (nth 0 file-entry)
14469 speedbar-last-selected-file 'vhdl-speedbar-entity-face)
14470 (vhdl-speedbar-update-units
14471 "{.} " (nth 1 file-entry)
14472 speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
14473 (vhdl-speedbar-update-units
14474 "\\[.\\] " (nth 3 file-entry)
14475 speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
14476 (vhdl-speedbar-update-units
14477 "[]>] " (nth 4 file-entry)
14478 speedbar-last-selected-file 'vhdl-speedbar-package-face)
14479 (vhdl-speedbar-update-units
14480 "\\[.\\].+(" '("body")
14481 speedbar-last-selected-file 'vhdl-speedbar-package-face)
14482 (vhdl-speedbar-update-units
14483 "> " (nth 6 file-entry)
14484 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
14485 ;; highlight current units
14486 (let* ((file-entry (aget file-alist file-name t)))
14487 (setq
14488 pos (vhdl-speedbar-update-units
14489 "\\[.\\] " (nth 0 file-entry)
14490 file-name 'vhdl-speedbar-entity-selected-face pos)
14491 pos (vhdl-speedbar-update-units
14492 "{.} " (nth 1 file-entry)
14493 file-name 'vhdl-speedbar-architecture-selected-face pos)
14494 pos (vhdl-speedbar-update-units
14495 "\\[.\\] " (nth 3 file-entry)
14496 file-name 'vhdl-speedbar-configuration-selected-face pos)
14497 pos (vhdl-speedbar-update-units
14498 "[]>] " (nth 4 file-entry)
14499 file-name 'vhdl-speedbar-package-selected-face pos)
14500 pos (vhdl-speedbar-update-units
14501 "\\[.\\].+(" '("body")
14502 file-name 'vhdl-speedbar-package-selected-face pos)
14503 pos (vhdl-speedbar-update-units
14504 "> " (nth 6 file-entry)
14505 file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
14506 ;; move speedbar so the first highlighted unit is visible
14507 (when (and pos (not no-position))
14508 (goto-char pos)
14509 (speedbar-center-buffer-smartly)
14510 (speedbar-position-cursor-on-line))
14511 (setq speedbar-last-selected-file file-name))
14512 (select-frame last-frame)
14515 (defun vhdl-speedbar-update-units (text unit-list file-name face
14516 &optional pos)
14517 "Help function to highlight design units."
14518 (while unit-list
14519 (goto-char (point-min))
14520 (while (re-search-forward
14521 (concat text "\\(" (car unit-list) "\\)\\>") nil t)
14522 (when (equal file-name (car (get-text-property
14523 (match-beginning 1) 'speedbar-token)))
14524 (setq pos (or pos (point-marker)))
14525 (put-text-property (match-beginning 1) (match-end 1) 'face face)))
14526 (setq unit-list (cdr unit-list)))
14527 pos)
14529 (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
14530 ent-name ent-file-marker
14531 arch-name arch-file-marker
14532 conf-name conf-file-marker
14533 lib-name depth offset delimiter)
14534 "Insert instantiation entry."
14535 (let ((start (point))
14536 visible-start)
14537 (insert (int-to-string depth) ":")
14538 (put-text-property start (point) 'invisible t)
14539 (setq visible-start (point))
14540 (insert-char ? (* depth speedbar-indentation-width))
14541 (while (> offset 0)
14542 (insert "|")
14543 (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
14544 (setq offset (1- offset)))
14545 (put-text-property visible-start (point) 'invisible nil)
14546 (setq start (point))
14547 (insert ">")
14548 (speedbar-make-button start (point) nil nil nil)
14549 (setq visible-start (point))
14550 (insert " ")
14551 (setq start (point))
14552 (if (not inst-name)
14553 (insert "(top)")
14554 (insert inst-name)
14555 (speedbar-make-button
14556 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
14557 'vhdl-speedbar-find-file inst-file-marker))
14558 (insert delimiter)
14559 (when ent-name
14560 (setq start (point))
14561 (insert ent-name)
14562 (speedbar-make-button
14563 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
14564 'vhdl-speedbar-find-file ent-file-marker)
14565 (when arch-name
14566 (insert " (")
14567 (setq start (point))
14568 (insert arch-name)
14569 (speedbar-make-button
14570 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
14571 'vhdl-speedbar-find-file arch-file-marker)
14572 (insert ")"))
14573 (when conf-name
14574 (insert " (")
14575 (setq start (point))
14576 (insert conf-name)
14577 (speedbar-make-button
14578 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
14579 'vhdl-speedbar-find-file conf-file-marker)
14580 (insert ")")))
14581 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
14582 (setq start (point))
14583 (insert " (" lib-name ")")
14584 (put-text-property (+ 2 start) (1- (point)) 'face
14585 'vhdl-speedbar-library-face))
14586 (insert-char ?\n 1)
14587 (put-text-property visible-start (point) 'invisible nil)))
14589 (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
14590 body-file-marker depth)
14591 "Insert package entry."
14592 (let ((start (point))
14593 visible-start)
14594 (insert (int-to-string depth) ":")
14595 (put-text-property start (point) 'invisible t)
14596 (setq visible-start (point))
14597 (insert-char ? (* depth speedbar-indentation-width))
14598 (put-text-property visible-start (point) 'invisible nil)
14599 (setq start (point))
14600 (insert "[+]")
14601 (speedbar-make-button
14602 start (point) 'speedbar-button-face 'speedbar-highlight-face
14603 'vhdl-speedbar-expand-package pack-key)
14604 (setq visible-start (point))
14605 (insert-char ? 1 nil)
14606 (setq start (point))
14607 (insert pack-name)
14608 (speedbar-make-button
14609 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14610 'vhdl-speedbar-find-file pack-file-marker)
14611 (unless (car pack-file-marker)
14612 (insert "!"))
14613 (when (car body-file-marker)
14614 (insert " (")
14615 (setq start (point))
14616 (insert "body")
14617 (speedbar-make-button
14618 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14619 'vhdl-speedbar-find-file body-file-marker)
14620 (insert ")"))
14621 (insert-char ?\n 1)
14622 (put-text-property visible-start (point) 'invisible nil)))
14624 (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
14625 depth)
14626 "Insert used package entry."
14627 (let ((start (point))
14628 visible-start)
14629 (insert (int-to-string depth) ":")
14630 (put-text-property start (point) 'invisible t)
14631 (setq visible-start (point))
14632 (insert-char ? (* depth speedbar-indentation-width))
14633 (put-text-property visible-start (point) 'invisible nil)
14634 (setq start (point))
14635 (insert ">")
14636 (speedbar-make-button start (point) nil nil nil)
14637 (setq visible-start (point))
14638 (insert " ")
14639 (setq start (point))
14640 (insert pack-name)
14641 (speedbar-make-button
14642 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14643 'vhdl-speedbar-find-file pack-file-marker)
14644 (setq start (point))
14645 (insert " (" lib-name ")")
14646 (put-text-property (+ 2 start) (1- (point)) 'face
14647 'vhdl-speedbar-library-face)
14648 (insert-char ?\n 1)
14649 (put-text-property visible-start (point) 'invisible nil)))
14651 (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
14652 func-body-file-marker
14653 depth)
14654 "Insert subprogram entry."
14655 (let ((start (point))
14656 visible-start)
14657 (insert (int-to-string depth) ":")
14658 (put-text-property start (point) 'invisible t)
14659 (setq visible-start (point))
14660 (insert-char ? (* depth speedbar-indentation-width))
14661 (put-text-property visible-start (point) 'invisible nil)
14662 (setq start (point))
14663 (insert ">")
14664 (speedbar-make-button start (point) nil nil nil)
14665 (setq visible-start (point))
14666 (insert " ")
14667 (setq start (point))
14668 (insert func-name)
14669 (speedbar-make-button
14670 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
14671 'vhdl-speedbar-find-file func-file-marker)
14672 (when (car func-body-file-marker)
14673 (insert " (")
14674 (setq start (point))
14675 (insert "body")
14676 (speedbar-make-button
14677 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
14678 'vhdl-speedbar-find-file func-body-file-marker)
14679 (insert ")"))
14680 (insert-char ?\n 1)
14681 (put-text-property visible-start (point) 'invisible nil)))
14683 (defun vhdl-speedbar-make-title-line (text &optional depth)
14684 "Insert design unit title entry."
14685 (let ((start (point))
14686 visible-start)
14687 (when depth
14688 (insert (int-to-string depth) ":")
14689 (put-text-property start (point) 'invisible t))
14690 (setq visible-start (point))
14691 (insert-char ? (* (or depth 0) speedbar-indentation-width))
14692 (setq start (point))
14693 (insert text)
14694 (speedbar-make-button start (point) nil nil nil nil)
14695 (insert-char ?\n 1)
14696 (put-text-property visible-start (point) 'invisible nil)))
14698 (defun vhdl-speedbar-insert-dirs (files level)
14699 "Insert subdirectories."
14700 (let ((dirs (car files)))
14701 (while dirs
14702 (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs)
14703 (car dirs) 'speedbar-dir-follow nil
14704 'speedbar-directory-face level)
14705 (setq dirs (cdr dirs)))))
14707 (defun vhdl-speedbar-dired (text token indent)
14708 "Speedbar click handler for directory expand button in hierarchy mode."
14709 (cond ((string-match "+" text) ; we have to expand this dir
14710 (setq speedbar-shown-directories
14711 (cons (expand-file-name
14712 (concat (speedbar-line-path indent) token "/"))
14713 speedbar-shown-directories))
14714 (speedbar-change-expand-button-char ?-)
14715 (speedbar-reset-scanners)
14716 (speedbar-with-writable
14717 (save-excursion
14718 (end-of-line) (forward-char 1)
14719 (vhdl-speedbar-insert-dirs
14720 (speedbar-file-lists
14721 (concat (speedbar-line-path indent) token "/"))
14722 (1+ indent))
14723 (speedbar-reset-scanners)
14724 (vhdl-speedbar-insert-dir-hierarchy
14725 (abbreviate-file-name
14726 (concat (speedbar-line-path indent) token "/"))
14727 (1+ indent) speedbar-power-click)))
14728 (vhdl-speedbar-update-current-unit t t))
14729 ((string-match "-" text) ; we have to contract this node
14730 (speedbar-reset-scanners)
14731 (let ((oldl speedbar-shown-directories)
14732 (newl nil)
14733 (td (expand-file-name
14734 (concat (speedbar-line-path indent) token))))
14735 (while oldl
14736 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
14737 (setq newl (cons (car oldl) newl)))
14738 (setq oldl (cdr oldl)))
14739 (setq speedbar-shown-directories (nreverse newl)))
14740 (speedbar-change-expand-button-char ?+)
14741 (speedbar-delete-subblock indent))
14742 (t (error "Nothing to display")))
14743 (when (equal (selected-frame) speedbar-frame)
14744 (speedbar-center-buffer-smartly)))
14746 (defun vhdl-speedbar-item-info ()
14747 "Derive and display information about this line item."
14748 (save-excursion
14749 (beginning-of-line)
14750 ;; skip invisible number info
14751 (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
14752 (cond
14753 ;; project/directory entry
14754 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
14755 (if vhdl-speedbar-show-projects
14756 (message "Project \"%s\"" (match-string-no-properties 1))
14757 (speedbar-files-item-info)))
14758 ;; design unit entry
14759 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
14760 (goto-char (match-end 1))
14761 (let ((face (get-text-property (point) 'face)))
14762 (message
14763 "%s \"%s\" in \"%s\""
14764 ;; design unit kind
14765 (cond ((or (eq face 'vhdl-speedbar-entity-face)
14766 (eq face 'vhdl-speedbar-entity-selected-face))
14767 (if (equal (match-string 2) ">") "Component" "Entity"))
14768 ((or (eq face 'vhdl-speedbar-architecture-face)
14769 (eq face 'vhdl-speedbar-architecture-selected-face))
14770 "Architecture")
14771 ((or (eq face 'vhdl-speedbar-configuration-face)
14772 (eq face 'vhdl-speedbar-configuration-selected-face))
14773 "Configuration")
14774 ((or (eq face 'vhdl-speedbar-package-face)
14775 (eq face 'vhdl-speedbar-package-selected-face))
14776 "Package")
14777 ((or (eq face 'vhdl-speedbar-instantiation-face)
14778 (eq face 'vhdl-speedbar-instantiation-selected-face))
14779 "Instantiation")
14780 ((eq face 'vhdl-speedbar-subprogram-face)
14781 "Subprogram")
14782 (t ""))
14783 ;; design unit name
14784 (buffer-substring-no-properties
14785 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
14786 (match-end 1))
14787 ;; file name
14788 (file-relative-name
14789 (or (car (get-text-property (point) 'speedbar-token))
14790 "?")
14791 (vhdl-default-directory)))))
14792 (t (message "")))))
14794 (defun vhdl-speedbar-line-text ()
14795 "Calls `speedbar-line-text' and removes text properties."
14796 (let ((string (speedbar-line-text)))
14797 (set-text-properties 0 (length string) nil string)
14798 string))
14800 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14801 ;; Help functions
14803 (defun vhdl-speedbar-line-key (&optional indent)
14804 "Get currently displayed directory of project name."
14805 (if vhdl-speedbar-show-projects
14806 (vhdl-speedbar-line-project)
14807 (abbreviate-file-name
14808 (file-name-as-directory (speedbar-line-path indent)))))
14810 (defun vhdl-speedbar-line-project (&optional indent)
14811 "Get currently displayed project name."
14812 (and vhdl-speedbar-show-projects
14813 (save-excursion
14814 (end-of-line)
14815 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
14816 (match-string-no-properties 1))))
14818 (defun vhdl-add-modified-file ()
14819 "Add file to `vhdl-modified-file-list'."
14820 (when vhdl-file-alist
14821 (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
14822 nil)
14824 (defun vhdl-resolve-paths (path-list)
14825 "Resolve path wildcards in PATH-LIST."
14826 (let (path-list-1 path-list-2 path-beg path-end dir)
14827 ;; eliminate non-existent directories
14828 (while path-list
14829 (setq dir (car path-list))
14830 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
14831 (if (file-directory-p (match-string 2 dir))
14832 (setq path-list-1 (cons dir path-list-1))
14833 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
14834 (setq path-list (cdr path-list)))
14835 ;; resolve path wildcards
14836 (while path-list-1
14837 (setq dir (car path-list-1))
14838 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
14839 (progn
14840 (setq path-beg (match-string 1 dir)
14841 path-end (match-string 5 dir))
14842 (setq path-list-1
14843 (append
14844 (mapcar
14845 (function
14846 (lambda (var) (concat path-beg var path-end)))
14847 (let ((all-list (vhdl-directory-files
14848 (match-string 2 dir) t
14849 (concat "\\<" (wildcard-to-regexp
14850 (match-string 4 dir)))))
14851 dir-list)
14852 (while all-list
14853 (when (file-directory-p (car all-list))
14854 (setq dir-list (cons (car all-list) dir-list)))
14855 (setq all-list (cdr all-list)))
14856 dir-list))
14857 (cdr path-list-1))))
14858 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
14859 (when (file-directory-p (match-string 2 dir))
14860 (setq path-list-2 (cons dir path-list-2)))
14861 (setq path-list-1 (cdr path-list-1))))
14862 (nreverse path-list-2)))
14864 (defun vhdl-speedbar-goto-this-unit (directory unit)
14865 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
14866 (let ((dest (point)))
14867 (if (and (if vhdl-speedbar-show-projects
14868 (progn (goto-char (point-min)) t)
14869 (speedbar-goto-this-file directory))
14870 (re-search-forward (concat "[]}] " unit "\\>") nil t))
14871 (progn (speedbar-position-cursor-on-line)
14873 (goto-char dest)
14874 nil)))
14876 (defun vhdl-speedbar-find-file (text token indent)
14877 "When user clicks on TEXT, load file with name and position in TOKEN.
14878 Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
14879 is already shown in a buffer."
14880 (if (not (car token))
14881 (error "ERROR: File cannot be found")
14882 (let ((buffer (get-file-buffer (car token))))
14883 (speedbar-find-file-in-frame (car token))
14884 (when (or vhdl-speedbar-jump-to-unit buffer)
14885 (goto-line (cdr token))
14886 (recenter))
14887 (vhdl-speedbar-update-current-unit t t)
14888 (speedbar-set-timer speedbar-update-speed)
14889 (speedbar-maybee-jump-to-attached-frame))))
14891 (defun vhdl-speedbar-port-copy ()
14892 "Copy the port of the entity/component or subprogram under the cursor."
14893 (interactive)
14894 (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
14895 (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
14896 (error "ERROR: No entity/component or subprogram under cursor")
14897 (beginning-of-line)
14898 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
14899 (condition-case info
14900 (let ((token (get-text-property
14901 (match-beginning 3) 'speedbar-token)))
14902 (vhdl-visit-file (car token) t
14903 (progn (goto-line (cdr token))
14904 (end-of-line)
14905 (if is-entity
14906 (vhdl-port-copy)
14907 (vhdl-subprog-copy)))))
14908 (error (error "ERROR: %s not scanned successfully\n (%s)"
14909 (if is-entity "Port" "Interface") (cadr info))))
14910 (error "ERROR: No entity/component or subprogram on current line")))))
14912 (defun vhdl-speedbar-place-component ()
14913 "Place the entity/component under the cursor as component."
14914 (interactive)
14915 (if (not (vhdl-speedbar-check-unit 'entity))
14916 (error "ERROR: No entity/component under cursor.")
14917 (vhdl-speedbar-port-copy)
14918 (if (fboundp 'speedbar-select-attached-frame)
14919 (speedbar-select-attached-frame)
14920 (select-frame speedbar-attached-frame))
14921 (vhdl-compose-place-component)
14922 (select-frame speedbar-frame)))
14924 (defun vhdl-speedbar-make-design ()
14925 "Make (compile) design unit or directory/project under the cursor."
14926 (interactive)
14927 (if (not (save-excursion (beginning-of-line)
14928 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
14929 (error "ERROR: No primary design unit or directory/project under cursor")
14930 (let ((is-unit (match-string 2))
14931 (unit-name (vhdl-speedbar-line-text))
14932 (vhdl-project (vhdl-speedbar-line-project))
14933 (directory (file-name-as-directory
14934 (or (speedbar-line-file) (speedbar-line-path)))))
14935 (if (fboundp 'speedbar-select-attached-frame)
14936 (speedbar-select-attached-frame)
14937 (select-frame speedbar-attached-frame))
14938 (let ((default-directory directory))
14939 (vhdl-make (and is-unit unit-name))))))
14941 (defun vhdl-speedbar-generate-makefile ()
14942 "Generate Makefile for directory/project under the cursor."
14943 (interactive)
14944 (let ((vhdl-project (vhdl-speedbar-line-project))
14945 (default-directory (file-name-as-directory
14946 (or (speedbar-line-file) (speedbar-line-path)))))
14947 (vhdl-generate-makefile)))
14949 (defun vhdl-speedbar-check-unit (design-unit)
14950 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
14951 expansion function)."
14952 (save-excursion
14953 (speedbar-position-cursor-on-line)
14954 (cond ((eq design-unit 'entity)
14955 (memq (get-text-property (match-end 0) 'face)
14956 '(vhdl-speedbar-entity-face
14957 vhdl-speedbar-entity-selected-face)))
14958 ((eq design-unit 'subprogram)
14959 (eq (get-text-property (match-end 0) 'face)
14960 'vhdl-speedbar-subprogram-face))
14961 (t nil))))
14963 (defun vhdl-speedbar-set-depth (depth)
14964 "Set hierarchy display depth to DEPTH and refresh speedbar."
14965 (setq vhdl-speedbar-hierarchy-depth depth)
14966 (speedbar-refresh))
14968 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14969 ;; Fontification
14971 (defface vhdl-speedbar-entity-face
14972 '((((class color) (background light)) (:foreground "ForestGreen"))
14973 (((class color) (background dark)) (:foreground "PaleGreen")))
14974 "Face used for displaying entity names."
14975 :group 'speedbar-faces)
14977 (defface vhdl-speedbar-architecture-face
14978 '((((class color) (background light)) (:foreground "Blue"))
14979 (((class color) (background dark)) (:foreground "LightSkyBlue")))
14980 "Face used for displaying architecture names."
14981 :group 'speedbar-faces)
14983 (defface vhdl-speedbar-configuration-face
14984 '((((class color) (background light)) (:foreground "DarkGoldenrod"))
14985 (((class color) (background dark)) (:foreground "Salmon")))
14986 "Face used for displaying configuration names."
14987 :group 'speedbar-faces)
14989 (defface vhdl-speedbar-package-face
14990 '((((class color) (background light)) (:foreground "Grey50"))
14991 (((class color) (background dark)) (:foreground "Grey80")))
14992 "Face used for displaying package names."
14993 :group 'speedbar-faces)
14995 (defface vhdl-speedbar-library-face
14996 '((((class color) (background light)) (:foreground "Purple"))
14997 (((class color) (background dark)) (:foreground "Orchid1")))
14998 "Face used for displaying library names."
14999 :group 'speedbar-faces)
15001 (defface vhdl-speedbar-instantiation-face
15002 '((((class color) (background light)) (:foreground "Brown"))
15003 (((class color) (background dark)) (:foreground "Yellow")))
15004 "Face used for displaying instantiation names."
15005 :group 'speedbar-faces)
15007 (defface vhdl-speedbar-subprogram-face
15008 '((((class color) (background light)) (:foreground "Orchid4"))
15009 (((class color) (background dark)) (:foreground "BurlyWood2")))
15010 "Face used for displaying subprogram names."
15011 :group 'speedbar-faces)
15013 (defface vhdl-speedbar-entity-selected-face
15014 '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
15015 (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
15016 "Face used for displaying entity names."
15017 :group 'speedbar-faces)
15019 (defface vhdl-speedbar-architecture-selected-face
15020 '((((class color) (background light)) (:foreground "Blue" :underline t))
15021 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
15022 "Face used for displaying architecture names."
15023 :group 'speedbar-faces)
15025 (defface vhdl-speedbar-configuration-selected-face
15026 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
15027 (((class color) (background dark)) (:foreground "Salmon" :underline t)))
15028 "Face used for displaying configuration names."
15029 :group 'speedbar-faces)
15031 (defface vhdl-speedbar-package-selected-face
15032 '((((class color) (background light)) (:foreground "Grey50" :underline t))
15033 (((class color) (background dark)) (:foreground "Grey80" :underline t)))
15034 "Face used for displaying package names."
15035 :group 'speedbar-faces)
15037 (defface vhdl-speedbar-instantiation-selected-face
15038 '((((class color) (background light)) (:foreground "Brown" :underline t))
15039 (((class color) (background dark)) (:foreground "Yellow" :underline t)))
15040 "Face used for displaying instantiation names."
15041 :group 'speedbar-faces)
15043 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15044 ;; Initialization
15046 ;; add speedbar
15047 (when (fboundp 'speedbar)
15048 (condition-case ()
15049 (when (and vhdl-speedbar-auto-open
15050 (not (and (boundp 'speedbar-frame)
15051 (frame-live-p speedbar-frame))))
15052 (speedbar-frame-mode 1)
15053 (if (fboundp 'speedbar-select-attached-frame)
15054 (speedbar-select-attached-frame)
15055 (select-frame speedbar-attached-frame)))
15056 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))))
15058 ;; initialize speedbar
15059 (if (not (boundp 'speedbar-frame))
15060 (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
15061 (vhdl-speedbar-initialize)
15062 (when speedbar-frame (vhdl-speedbar-refresh)))
15065 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15066 ;;; Structural composition
15067 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15069 (defun vhdl-get-components-package-name ()
15070 "Return the name of the components package."
15071 (let ((project (vhdl-project-p)))
15072 (if project
15073 (vhdl-replace-string (car vhdl-components-package-name)
15074 (subst-char-in-string ? ?_ project))
15075 (cdr vhdl-components-package-name))))
15077 (defun vhdl-compose-new-component ()
15078 "Create entity and architecture for new component."
15079 (interactive)
15080 (let* ((case-fold-search t)
15081 (ent-name (read-from-minibuffer "entity name: "
15082 nil vhdl-minibuffer-local-map))
15083 (arch-name
15084 (if (equal (cdr vhdl-compose-architecture-name) "")
15085 (read-from-minibuffer "architecture name: "
15086 nil vhdl-minibuffer-local-map)
15087 (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
15088 ent-file-name arch-file-name ent-buffer arch-buffer project)
15089 (message "Creating component \"%s(%s)\"..." ent-name arch-name)
15090 ;; open entity file
15091 (unless (eq vhdl-compose-create-files 'none)
15092 (setq ent-file-name
15093 (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15094 "." (file-name-extension (buffer-file-name))))
15095 (when (and (file-exists-p ent-file-name)
15096 (not (y-or-n-p (concat "File \"" ent-file-name
15097 "\" exists; overwrite? "))))
15098 (error "ERROR: Creating component...aborted"))
15099 (find-file ent-file-name)
15100 (erase-buffer)
15101 (set-buffer-modified-p nil))
15102 ;; insert header
15103 (if vhdl-compose-include-header
15104 (progn (vhdl-template-header)
15105 (goto-char (point-max)))
15106 (vhdl-comment-display-line) (insert "\n\n"))
15107 ;; insert library clause
15108 (vhdl-template-package-std-logic-1164)
15109 (when vhdl-use-components-package
15110 (insert "\n")
15111 (vhdl-template-standard-package (vhdl-work-library)
15112 (vhdl-get-components-package-name)))
15113 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
15114 ;; insert entity declaration
15115 (vhdl-insert-keyword "ENTITY ") (insert ent-name)
15116 (vhdl-insert-keyword " IS\n")
15117 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15118 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
15119 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15120 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15121 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
15122 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15123 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15124 (vhdl-insert-keyword "END ")
15125 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
15126 (insert ent-name ";\n\n")
15127 (vhdl-comment-display-line) (insert "\n")
15128 ;; open architecture file
15129 (if (not (eq vhdl-compose-create-files 'separate))
15130 (insert "\n")
15131 (setq ent-buffer (current-buffer))
15132 (setq arch-file-name
15133 (concat (vhdl-replace-string vhdl-architecture-file-name
15134 (concat ent-name " " arch-name))
15135 "." (file-name-extension (buffer-file-name))))
15136 (when (and (file-exists-p arch-file-name)
15137 (not (y-or-n-p (concat "File \"" arch-file-name
15138 "\" exists; overwrite? "))))
15139 (error "ERROR: Creating component...aborted"))
15140 (find-file arch-file-name)
15141 (erase-buffer)
15142 (set-buffer-modified-p nil)
15143 ;; insert header
15144 (if vhdl-compose-include-header
15145 (progn (vhdl-template-header)
15146 (goto-char (point-max)))
15147 (vhdl-comment-display-line) (insert "\n\n")))
15148 ;; insert architecture body
15149 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
15150 (vhdl-insert-keyword " OF ") (insert ent-name)
15151 (vhdl-insert-keyword " IS\n\n")
15152 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15153 (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
15154 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15155 (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
15156 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15157 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15158 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
15159 (vhdl-insert-keyword "BEGIN")
15160 (when vhdl-self-insert-comments
15161 (insert " -- ")
15162 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15163 (insert arch-name))
15164 (insert "\n\n")
15165 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15166 (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
15167 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15168 (vhdl-insert-keyword "END ")
15169 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15170 (insert arch-name ";\n\n")
15171 ;; insert footer
15172 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15173 (vhdl-template-footer)
15174 (vhdl-comment-display-line) (insert "\n"))
15175 (goto-char (point-min))
15176 (setq arch-buffer (current-buffer))
15177 (when ent-buffer (set-buffer ent-buffer) (save-buffer))
15178 (set-buffer arch-buffer) (save-buffer)
15179 (message
15180 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
15181 (and ent-file-name
15182 (format "\n File created: \"%s\"" ent-file-name))
15183 (and arch-file-name
15184 (format "\n File created: \"%s\"" arch-file-name))))))
15186 (defun vhdl-compose-place-component ()
15187 "Place new component by pasting current port as component declaration and
15188 component instantiation."
15189 (interactive)
15190 (if (not vhdl-port-list)
15191 (error "ERROR: No port has been read")
15192 (save-excursion
15193 (vhdl-prepare-search-2
15194 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15195 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15196 (error "ERROR: No architecture found"))
15197 (let* ((ent-name (match-string 1))
15198 (ent-file-name
15199 (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15200 "." (file-name-extension (buffer-file-name))))
15201 (orig-buffer (current-buffer)))
15202 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
15203 ;; place component declaration
15204 (unless (or vhdl-use-components-package
15205 (vhdl-use-direct-instantiation)
15206 (save-excursion
15207 (re-search-forward
15208 (concat "^\\s-*component\\s-+"
15209 (car vhdl-port-list) "\\>") nil t)))
15210 (re-search-forward "^begin\\>" nil)
15211 (beginning-of-line)
15212 (skip-chars-backward " \t\n")
15213 (insert "\n\n") (indent-to vhdl-basic-offset)
15214 (vhdl-port-paste-component t))
15215 ;; place component instantiation
15216 (re-search-forward "^end\\>" nil)
15217 (beginning-of-line)
15218 (skip-chars-backward " \t\n")
15219 (insert "\n\n") (indent-to vhdl-basic-offset)
15220 (vhdl-port-paste-instance nil t t)
15221 ;; place use clause for used packages
15222 (when (nth 3 vhdl-port-list)
15223 ;; open entity file
15224 (when (file-exists-p ent-file-name)
15225 (find-file ent-file-name))
15226 (goto-char (point-min))
15227 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15228 (error "ERROR: Entity not found: \"%s\"" ent-name))
15229 (goto-char (match-beginning 0))
15230 (if (and (save-excursion
15231 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
15232 (match-string 1))
15233 (progn (goto-char (match-end 0))
15234 (beginning-of-line 2))
15235 (insert "\n")
15236 (backward-char))
15237 (vhdl-port-paste-context-clause)
15238 (switch-to-buffer orig-buffer))
15239 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
15241 (defun vhdl-compose-wire-components ()
15242 "Connect components."
15243 (interactive)
15244 (save-excursion
15245 (vhdl-prepare-search-2
15246 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15247 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15248 (error "ERROR: No architecture found"))
15249 (let* ((ent-name (match-string 1))
15250 (ent-file-name
15251 (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15252 "." (file-name-extension (buffer-file-name))))
15253 (arch-decl-pos (point-marker))
15254 (arch-stat-pos (re-search-forward "^begin\\>" nil))
15255 (arch-end-pos (re-search-forward "^end\\>" nil))
15256 (pack-name (vhdl-get-components-package-name))
15257 (pack-file-name
15258 (concat (vhdl-replace-string vhdl-package-file-name pack-name)
15259 "." (file-name-extension (buffer-file-name))))
15260 inst-name comp-name comp-ent-name comp-ent-file-name has-generic
15261 port-alist generic-alist inst-alist
15262 signal-name signal-entry signal-alist local-list written-list
15263 single-in-list multi-in-list single-out-list multi-out-list
15264 constant-name constant-entry constant-alist single-list multi-list
15265 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
15266 generic-beg-pos generic-pos generic-inst-pos generic-end-pos
15267 signal-beg-pos signal-pos
15268 constant-temp-pos port-temp-pos signal-temp-pos)
15269 (message "Wiring components...")
15270 ;; process all instances
15271 (goto-char arch-stat-pos)
15272 (while (re-search-forward
15273 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
15274 "\\(component[ \t\n]+\\)?\\(\\w+\\)"
15275 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|"
15276 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?"
15277 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t)
15278 (setq inst-name (match-string-no-properties 1)
15279 comp-name (match-string-no-properties 4)
15280 comp-ent-name (match-string-no-properties 12)
15281 has-generic (or (match-string 7) (match-string 17)))
15282 ;; get port ...
15283 (if comp-name
15284 ;; ... from component declaration
15285 (vhdl-visit-file
15286 (when vhdl-use-components-package pack-file-name) t
15287 (save-excursion
15288 (goto-char (point-min))
15289 (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t)
15290 (error "ERROR: Component declaration not found: \"%s\"" comp-name))
15291 (vhdl-port-copy)))
15292 ;; ... from entity declaration (direct instantiation)
15293 (setq comp-ent-file-name
15294 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name)
15295 "." (file-name-extension (buffer-file-name))))
15296 (vhdl-visit-file
15297 comp-ent-file-name t
15298 (save-excursion
15299 (goto-char (point-min))
15300 (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t)
15301 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name))
15302 (vhdl-port-copy))))
15303 (vhdl-port-flatten t)
15304 (setq generic-alist (nth 1 vhdl-port-list)
15305 port-alist (nth 2 vhdl-port-list))
15306 (setq constant-alist nil
15307 signal-alist nil)
15308 (when has-generic
15309 ;; process all constants in generic map
15310 (vhdl-forward-syntactic-ws)
15311 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15312 (setq constant-name (match-string-no-properties 3))
15313 (setq constant-entry
15314 (cons constant-name
15315 (if (match-string 1)
15316 (or (aget generic-alist (match-string 2) t)
15317 (error (format "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
15318 (cdar generic-alist))))
15319 (setq constant-alist (cons constant-entry constant-alist))
15320 (setq constant-name (downcase constant-name))
15321 (if (or (member constant-name single-list)
15322 (member constant-name multi-list))
15323 (progn (setq single-list (delete constant-name single-list))
15324 (add-to-list 'multi-list constant-name))
15325 (add-to-list 'single-list constant-name))
15326 (unless (match-string 1)
15327 (setq generic-alist (cdr generic-alist)))
15328 (vhdl-forward-syntactic-ws))
15329 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t))
15330 ;; process all signals in port map
15331 (vhdl-forward-syntactic-ws)
15332 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15333 (setq signal-name (match-string-no-properties 3))
15334 (setq signal-entry (cons signal-name
15335 (if (match-string 1)
15336 (or (aget port-alist (match-string 2) t)
15337 (error (format "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
15338 (cdar port-alist))))
15339 (setq signal-alist (cons signal-entry signal-alist))
15340 (setq signal-name (downcase signal-name))
15341 (if (equal (upcase (nth 2 signal-entry)) "IN")
15342 ;; input signal
15343 (cond
15344 ((member signal-name local-list)
15345 nil)
15346 ((or (member signal-name single-out-list)
15347 (member signal-name multi-out-list))
15348 (setq single-out-list (delete signal-name single-out-list))
15349 (setq multi-out-list (delete signal-name multi-out-list))
15350 (add-to-list 'local-list signal-name))
15351 ((member signal-name single-in-list)
15352 (setq single-in-list (delete signal-name single-in-list))
15353 (add-to-list 'multi-in-list signal-name))
15354 ((not (member signal-name multi-in-list))
15355 (add-to-list 'single-in-list signal-name)))
15356 ;; output signal
15357 (cond
15358 ((member signal-name local-list)
15359 nil)
15360 ((or (member signal-name single-in-list)
15361 (member signal-name multi-in-list))
15362 (setq single-in-list (delete signal-name single-in-list))
15363 (setq multi-in-list (delete signal-name multi-in-list))
15364 (add-to-list 'local-list signal-name))
15365 ((member signal-name single-out-list)
15366 (setq single-out-list (delete signal-name single-out-list))
15367 (add-to-list 'multi-out-list signal-name))
15368 ((not (member signal-name multi-out-list))
15369 (add-to-list 'single-out-list signal-name))))
15370 (unless (match-string 1)
15371 (setq port-alist (cdr port-alist)))
15372 (vhdl-forward-syntactic-ws))
15373 (setq inst-alist (cons (list inst-name (nreverse constant-alist)
15374 (nreverse signal-alist)) inst-alist)))
15375 ;; prepare signal insertion
15376 (vhdl-goto-marker arch-decl-pos)
15377 (forward-line 1)
15378 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t)
15379 (setq signal-pos (point-marker))
15380 (while (progn (vhdl-forward-syntactic-ws)
15381 (looking-at "signal\\>"))
15382 (beginning-of-line 2)
15383 (delete-region signal-pos (point)))
15384 (setq signal-beg-pos signal-pos)
15385 ;; open entity file
15386 (when (file-exists-p ent-file-name)
15387 (find-file ent-file-name))
15388 (goto-char (point-min))
15389 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15390 (error "ERROR: Entity not found: \"%s\"" ent-name))
15391 ;; prepare generic clause insertion
15392 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t)
15393 (match-string 1))
15394 (goto-char (match-beginning 0))
15395 (indent-to vhdl-basic-offset)
15396 (insert "generic ();\n\n")
15397 (backward-char 4))
15398 (backward-char)
15399 (setq generic-pos (point-marker))
15400 (forward-sexp) (end-of-line)
15401 (delete-region generic-pos (point)) (delete-char 1)
15402 (insert "(\n")
15403 (when multi-list
15404 (insert "\n")
15405 (indent-to (* 2 vhdl-basic-offset))
15406 (insert "-- global generics\n"))
15407 (setq generic-beg-pos (point-marker) generic-pos (point-marker)
15408 generic-inst-pos (point-marker) generic-end-pos (point-marker))
15409 ;; prepare port clause insertion
15410 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t)
15411 (match-string 1))
15412 (goto-char (match-beginning 0))
15413 (indent-to vhdl-basic-offset)
15414 (insert "port ();\n\n")
15415 (backward-char 4))
15416 (backward-char)
15417 (setq port-in-pos (point-marker))
15418 (forward-sexp) (end-of-line)
15419 (delete-region port-in-pos (point)) (delete-char 1)
15420 (insert "(\n")
15421 (when (or multi-in-list multi-out-list)
15422 (insert "\n")
15423 (indent-to (* 2 vhdl-basic-offset))
15424 (insert "-- global ports\n"))
15425 (setq port-beg-pos (point-marker) port-in-pos (point-marker)
15426 port-out-pos (point-marker) port-inst-pos (point-marker)
15427 port-end-pos (point-marker))
15428 ;; insert generics, ports and signals
15429 (setq inst-alist (nreverse inst-alist))
15430 (while inst-alist
15431 (setq inst-name (nth 0 (car inst-alist))
15432 constant-alist (nth 1 (car inst-alist))
15433 signal-alist (nth 2 (car inst-alist))
15434 constant-temp-pos generic-inst-pos
15435 port-temp-pos port-inst-pos
15436 signal-temp-pos signal-pos)
15437 ;; generics
15438 (while constant-alist
15439 (setq constant-name (downcase (caar constant-alist))
15440 constant-entry (car constant-alist))
15441 (cond ((member constant-name written-list)
15442 nil)
15443 ((member constant-name multi-list)
15444 (vhdl-goto-marker generic-pos)
15445 (setq generic-end-pos
15446 (vhdl-max-marker
15447 generic-end-pos
15448 (vhdl-compose-insert-generic constant-entry)))
15449 (setq generic-pos (point-marker))
15450 (add-to-list 'written-list constant-name))
15452 (vhdl-goto-marker
15453 (vhdl-max-marker generic-inst-pos generic-pos))
15454 (setq generic-end-pos
15455 (vhdl-compose-insert-generic constant-entry))
15456 (setq generic-inst-pos (point-marker))
15457 (add-to-list 'written-list constant-name)))
15458 (setq constant-alist (cdr constant-alist)))
15459 (when (/= constant-temp-pos generic-inst-pos)
15460 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
15461 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15462 (insert "-- generics for \"" inst-name "\"\n")
15463 (vhdl-goto-marker generic-inst-pos))
15464 ;; ports and signals
15465 (while signal-alist
15466 (setq signal-name (downcase (caar signal-alist))
15467 signal-entry (car signal-alist))
15468 (cond ((member signal-name written-list)
15469 nil)
15470 ((member signal-name multi-in-list)
15471 (vhdl-goto-marker port-in-pos)
15472 (setq port-end-pos
15473 (vhdl-max-marker
15474 port-end-pos (vhdl-compose-insert-port signal-entry)))
15475 (setq port-in-pos (point-marker))
15476 (add-to-list 'written-list signal-name))
15477 ((member signal-name multi-out-list)
15478 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
15479 (setq port-end-pos
15480 (vhdl-max-marker
15481 port-end-pos (vhdl-compose-insert-port signal-entry)))
15482 (setq port-out-pos (point-marker))
15483 (add-to-list 'written-list signal-name))
15484 ((or (member signal-name single-in-list)
15485 (member signal-name single-out-list))
15486 (vhdl-goto-marker
15487 (vhdl-max-marker
15488 port-inst-pos
15489 (vhdl-max-marker port-out-pos port-in-pos)))
15490 (setq port-end-pos (vhdl-compose-insert-port signal-entry))
15491 (setq port-inst-pos (point-marker))
15492 (add-to-list 'written-list signal-name))
15493 ((equal (upcase (nth 2 signal-entry)) "OUT")
15494 (vhdl-goto-marker signal-pos)
15495 (vhdl-compose-insert-signal signal-entry)
15496 (setq signal-pos (point-marker))
15497 (add-to-list 'written-list signal-name)))
15498 (setq signal-alist (cdr signal-alist)))
15499 (when (/= port-temp-pos port-inst-pos)
15500 (vhdl-goto-marker
15501 (vhdl-max-marker port-temp-pos
15502 (vhdl-max-marker port-in-pos port-out-pos)))
15503 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15504 (insert "-- ports to \"" inst-name "\"\n")
15505 (vhdl-goto-marker port-inst-pos))
15506 (when (/= signal-temp-pos signal-pos)
15507 (vhdl-goto-marker signal-temp-pos)
15508 (insert "\n") (indent-to vhdl-basic-offset)
15509 (insert "-- outputs of \"" inst-name "\"\n")
15510 (vhdl-goto-marker signal-pos))
15511 (setq inst-alist (cdr inst-alist)))
15512 ;; finalize generic/port clause
15513 (vhdl-goto-marker generic-end-pos) (backward-char)
15514 (when (= generic-beg-pos generic-end-pos)
15515 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15516 (insert ";") (backward-char))
15517 (insert ")")
15518 (vhdl-goto-marker port-end-pos) (backward-char)
15519 (when (= port-beg-pos port-end-pos)
15520 (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15521 (insert ";") (backward-char))
15522 (insert ")")
15523 ;; align everything
15524 (when vhdl-auto-align
15525 (vhdl-goto-marker generic-beg-pos)
15526 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
15527 (vhdl-align-region-groups port-beg-pos port-end-pos 1)
15528 (vhdl-goto-marker signal-beg-pos)
15529 (vhdl-align-region-groups signal-beg-pos signal-pos))
15530 (switch-to-buffer (marker-buffer signal-beg-pos))
15531 (message "Wiring components...done")))))
15533 (defun vhdl-compose-insert-generic (entry)
15534 "Insert ENTRY as generic declaration."
15535 (let (pos)
15536 (indent-to (* 2 vhdl-basic-offset))
15537 (insert (nth 0 entry) " : " (nth 1 entry))
15538 (when (nth 2 entry)
15539 (insert " := " (nth 2 entry)))
15540 (insert ";")
15541 (setq pos (point-marker))
15542 (when (and vhdl-include-port-comments (nth 3 entry))
15543 (vhdl-comment-insert-inline (nth 3 entry) t))
15544 (insert "\n")
15545 pos))
15547 (defun vhdl-compose-insert-port (entry)
15548 "Insert ENTRY as port declaration."
15549 (let (pos)
15550 (indent-to (* 2 vhdl-basic-offset))
15551 (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
15552 (setq pos (point-marker))
15553 (when (and vhdl-include-port-comments (nth 4 entry))
15554 (vhdl-comment-insert-inline (nth 4 entry) t))
15555 (insert "\n")
15556 pos))
15558 (defun vhdl-compose-insert-signal (entry)
15559 "Insert ENTRY as signal declaration."
15560 (indent-to vhdl-basic-offset)
15561 (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
15562 (when (and vhdl-include-port-comments (nth 4 entry))
15563 (vhdl-comment-insert-inline (nth 4 entry) t))
15564 (insert "\n"))
15566 (defun vhdl-compose-components-package ()
15567 "Generate a package containing component declarations for all entities in the
15568 current project/directory."
15569 (interactive)
15570 (vhdl-require-hierarchy-info)
15571 (let* ((project (vhdl-project-p))
15572 (pack-name (vhdl-get-components-package-name))
15573 (pack-file-name
15574 (concat (vhdl-replace-string vhdl-package-file-name pack-name)
15575 "." (file-name-extension (buffer-file-name))))
15576 (ent-alist (aget vhdl-entity-alist
15577 (or project default-directory) t))
15578 (lazy-lock-minimum-size 0)
15579 clause-pos component-pos)
15580 (message "Generating components package \"%s\"..." pack-name)
15581 ;; open package file
15582 (when (and (file-exists-p pack-file-name)
15583 (not (y-or-n-p (concat "File \"" pack-file-name
15584 "\" exists; overwrite? "))))
15585 (error "ERROR: Generating components package...aborted"))
15586 (find-file pack-file-name)
15587 (erase-buffer)
15588 ;; insert header
15589 (if vhdl-compose-include-header
15590 (progn (vhdl-template-header
15591 (concat "Components package (generated by Emacs VHDL Mode "
15592 vhdl-version ")"))
15593 (goto-char (point-max)))
15594 (vhdl-comment-display-line) (insert "\n\n"))
15595 ;; insert std_logic_1164 package
15596 (vhdl-template-package-std-logic-1164)
15597 (insert "\n") (setq clause-pos (point-marker))
15598 (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
15599 ;; insert package declaration
15600 (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
15601 (vhdl-insert-keyword " IS\n\n")
15602 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15603 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15604 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15605 (indent-to vhdl-basic-offset)
15606 (setq component-pos (point-marker))
15607 (insert "\n\n") (vhdl-insert-keyword "END ")
15608 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
15609 (insert pack-name ";\n\n")
15610 ;; insert footer
15611 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15612 (vhdl-template-footer)
15613 (vhdl-comment-display-line) (insert "\n"))
15614 ;; insert component declarations
15615 (while ent-alist
15616 (vhdl-visit-file (nth 2 (car ent-alist)) nil
15617 (progn (goto-line (nth 3 (car ent-alist)))
15618 (end-of-line)
15619 (vhdl-port-copy)))
15620 (goto-char component-pos)
15621 (vhdl-port-paste-component t)
15622 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
15623 (setq component-pos (point-marker))
15624 (goto-char clause-pos)
15625 (vhdl-port-paste-context-clause pack-name)
15626 (setq clause-pos (point-marker))
15627 (setq ent-alist (cdr ent-alist)))
15628 (goto-char (point-min))
15629 (save-buffer)
15630 (message "Generating components package \"%s\"...done\n File created: \"%s\""
15631 pack-name pack-file-name)))
15634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15635 ;;; Compilation / Makefile generation
15636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15637 ;; (using `compile.el')
15639 (defun vhdl-makefile-name ()
15640 "Return the Makefile name of the current project or the current compiler if
15641 no project is defined."
15642 (let ((project-alist (aget vhdl-project-alist vhdl-project))
15643 (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
15644 (vhdl-replace-string
15645 (cons "\\(.*\\)\n\\(.*\\)"
15646 (or (nth 8 project-alist) (nth 8 compiler-alist)))
15647 (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
15649 (defun vhdl-compile-directory ()
15650 "Return the directory where compilation/make should be run."
15651 (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
15652 (compiler (aget vhdl-compiler-alist vhdl-compiler))
15653 (directory (vhdl-resolve-env-variable
15654 (if project
15655 (vhdl-replace-string
15656 (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
15657 (nth 6 compiler)))))
15658 (file-name-as-directory
15659 (if (file-name-absolute-p directory)
15660 directory
15661 (expand-file-name directory (vhdl-default-directory))))))
15663 (defun vhdl-uniquify (in-list)
15664 "Remove duplicate elements from IN-LIST."
15665 (let (out-list)
15666 (while in-list
15667 (add-to-list 'out-list (car in-list))
15668 (setq in-list (cdr in-list)))
15669 out-list))
15671 (defun vhdl-set-compiler (name)
15672 "Set current compiler to NAME."
15673 (interactive
15674 (list (let ((completion-ignore-case t))
15675 (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
15676 (if (assoc name vhdl-compiler-alist)
15677 (progn (setq vhdl-compiler name)
15678 (message "Current compiler: \"%s\"" vhdl-compiler))
15679 (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
15681 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15682 ;; Compilation
15684 (defun vhdl-compile-init ()
15685 "Initialize for compilation."
15686 (when (or (null compilation-error-regexp-alist)
15687 (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
15688 compilation-error-regexp-alist)))
15689 ;; `compilation-error-regexp-alist'
15690 (let ((commands-alist vhdl-compiler-alist)
15691 regexp-alist sublist)
15692 (while commands-alist
15693 (setq sublist (nth 11 (car commands-alist)))
15694 (unless (or (equal "" (car sublist))
15695 (assoc (car sublist) regexp-alist))
15696 (setq regexp-alist (cons (list (nth 0 sublist)
15697 (if (= 0 (nth 1 sublist))
15698 (if vhdl-xemacs 9 nil)
15699 (nth 1 sublist))
15700 (nth 2 sublist) (nth 3 sublist))
15701 regexp-alist)))
15702 (setq commands-alist (cdr commands-alist)))
15703 (setq compilation-error-regexp-alist
15704 (append compilation-error-regexp-alist (nreverse regexp-alist))))
15705 ;; `compilation-file-regexp-alist'
15706 (let ((commands-alist vhdl-compiler-alist)
15707 regexp-alist sublist)
15708 ;; matches vhdl-mode file name output
15709 (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
15710 (while commands-alist
15711 (setq sublist (nth 12 (car commands-alist)))
15712 (unless (or (equal "" (car sublist))
15713 (assoc (car sublist) regexp-alist))
15714 (setq regexp-alist (cons sublist regexp-alist)))
15715 (setq commands-alist (cdr commands-alist)))
15716 (setq compilation-file-regexp-alist
15717 (append compilation-file-regexp-alist (nreverse regexp-alist))))))
15719 (defvar vhdl-compile-file-name nil
15720 "Name of file to be compiled.")
15722 (defun vhdl-compile-print-file-name ()
15723 "Function called within `compile' to print out file name for compilers that
15724 do not print any file names."
15725 (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
15727 (defun vhdl-get-compile-options (project compiler file-name
15728 &optional file-options-only)
15729 "Get compiler options. Returning nil means do not compile this file."
15730 (let* ((compiler-options (nth 1 compiler))
15731 (project-entry (aget (nth 4 project) vhdl-compiler))
15732 (project-options (nth 0 project-entry))
15733 (exception-list (and file-name (nth 2 project-entry)))
15734 (work-library (vhdl-work-library))
15735 (case-fold-search nil)
15736 file-options)
15737 (while (and exception-list
15738 (not (string-match (caar exception-list) file-name)))
15739 (setq exception-list (cdr exception-list)))
15740 (if (and exception-list (not (cdar exception-list)))
15742 (if (and file-options-only (not exception-list))
15743 'default
15744 (setq file-options (cdar exception-list))
15745 ;; insert library name in compiler-specific options
15746 (setq compiler-options
15747 (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
15748 work-library))
15749 ;; insert compiler-specific options in project-specific options
15750 (when project-options
15751 (setq project-options
15752 (vhdl-replace-string
15753 (cons "\\(.*\\)\n\\(.*\\)" project-options)
15754 (concat work-library "\n" compiler-options))))
15755 ;; insert project-specific options in file-specific options
15756 (when file-options
15757 (setq file-options
15758 (vhdl-replace-string
15759 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
15760 (concat work-library "\n" compiler-options "\n"
15761 project-options))))
15762 ;; return options
15763 (or file-options project-options compiler-options)))))
15765 (defun vhdl-get-make-options (project compiler)
15766 "Get make options."
15767 (let* ((compiler-options (nth 3 compiler))
15768 (project-entry (aget (nth 4 project) vhdl-compiler))
15769 (project-options (nth 1 project-entry))
15770 (makefile-name (vhdl-makefile-name)))
15771 ;; insert Makefile name in compiler-specific options
15772 (setq compiler-options
15773 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
15774 makefile-name))
15775 ;; insert compiler-specific options in project-specific options
15776 (when project-options
15777 (setq project-options
15778 (vhdl-replace-string
15779 (cons "\\(.*\\)\n\\(.*\\)" project-options)
15780 (concat makefile-name "\n" compiler-options))))
15781 ;; return options
15782 (or project-options compiler-options)))
15784 (defun vhdl-compile ()
15785 "Compile current buffer using the VHDL compiler specified in
15786 `vhdl-compiler'."
15787 (interactive)
15788 (vhdl-compile-init)
15789 (let* ((project (aget vhdl-project-alist vhdl-project))
15790 (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
15791 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
15792 (command (nth 0 compiler))
15793 (file-name (buffer-file-name))
15794 (options (vhdl-get-compile-options project compiler file-name))
15795 (default-directory (vhdl-compile-directory))
15796 compilation-process-setup-function)
15797 (unless (file-directory-p default-directory)
15798 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
15799 ;; put file name into quotes if it contains spaces
15800 (when (string-match " " file-name)
15801 (setq file-name (concat "\"" file-name "\"")))
15802 ;; print out file name if compiler does not
15803 (setq vhdl-compile-file-name (buffer-file-name))
15804 (when (and (= 0 (nth 1 (nth 10 compiler)))
15805 (= 0 (nth 1 (nth 11 compiler))))
15806 (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
15807 ;; run compilation
15808 (if options
15809 (when command
15810 (compile (concat command " " options " " file-name)))
15811 (vhdl-warning "Your project settings tell me not to compile this file"))))
15813 (defun vhdl-make (&optional target)
15814 "Call make command for compilation of all updated source files (requires
15815 `Makefile'). Optional argument TARGET allows to compile the design
15816 specified by a target."
15817 (interactive)
15818 (vhdl-compile-init)
15819 (let* ((project (aget vhdl-project-alist vhdl-project))
15820 (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
15821 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
15822 (command (nth 2 compiler))
15823 (options (vhdl-get-make-options project compiler))
15824 (default-directory (vhdl-compile-directory)))
15825 (unless (file-directory-p default-directory)
15826 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory))
15827 ;; run make
15828 (compile (concat (if (equal command "") "make" command)
15829 " " options " " target))))
15831 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15832 ;; Makefile generation
15834 (defun vhdl-generate-makefile ()
15835 "Generate `Makefile'."
15836 (interactive)
15837 (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
15838 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler)))
15839 (command (nth 4 compiler)))
15840 ;; generate makefile
15841 (if command
15842 (let ((default-directory (vhdl-compile-directory)))
15843 (compile (vhdl-replace-string
15844 (cons "\\(.*\\) \\(.*\\)" command)
15845 (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
15846 (vhdl-generate-makefile-1))))
15848 (defun vhdl-get-packages (lib-alist work-library)
15849 "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
15850 (let (pack-list)
15851 (while lib-alist
15852 (when (equal (downcase (caar lib-alist)) (downcase work-library))
15853 (setq pack-list (cons (cdar lib-alist) pack-list)))
15854 (setq lib-alist (cdr lib-alist)))
15855 pack-list))
15857 (defun vhdl-generate-makefile-1 ()
15858 "Generate Makefile for current project or directory."
15859 ;; scan hierarchy if required
15860 (if (vhdl-project-p)
15861 (unless (or (assoc vhdl-project vhdl-file-alist)
15862 (vhdl-load-cache vhdl-project))
15863 (vhdl-scan-project-contents vhdl-project))
15864 (let ((directory (abbreviate-file-name default-directory)))
15865 (unless (or (assoc directory vhdl-file-alist)
15866 (vhdl-load-cache directory))
15867 (vhdl-scan-directory-contents directory))))
15868 (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
15869 (project (vhdl-project-p))
15870 (ent-alist (aget vhdl-entity-alist (or project directory) t))
15871 (conf-alist (aget vhdl-config-alist (or project directory) t))
15872 (pack-alist (aget vhdl-package-alist (or project directory) t))
15873 (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
15874 (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
15875 (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
15876 (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
15877 (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
15878 (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
15879 (adjust-case (nth 5 regexp-list))
15880 (work-library (downcase (vhdl-work-library)))
15881 (compile-directory (expand-file-name (vhdl-compile-directory)
15882 default-directory))
15883 (makefile-name (vhdl-makefile-name))
15884 rule-alist arch-alist inst-alist
15885 target-list depend-list unit-list prim-list second-list subcomp-list
15886 lib-alist lib-body-alist pack-list all-pack-list
15887 ent-key ent-file-name arch-key arch-file-name ent-arch-key
15888 conf-key conf-file-name pack-key pack-file-name
15889 ent-entry arch-entry conf-entry pack-entry inst-entry
15890 pack-body-key pack-body-file-name inst-ent-key inst-conf-key
15891 tmp-key tmp-list rule)
15892 ;; check prerequisites
15893 (unless (file-exists-p compile-directory)
15894 (make-directory compile-directory t))
15895 (unless regexp-list
15896 (error "Please contact the VHDL Mode maintainer for support of \"%s\""
15897 vhdl-compiler))
15898 (message "Generating makefile \"%s\"..." makefile-name)
15899 ;; rules for all entities
15900 (setq tmp-list ent-alist)
15901 (while ent-alist
15902 (setq ent-entry (car ent-alist)
15903 ent-key (nth 0 ent-entry))
15904 (when (nth 2 ent-entry)
15905 (setq ent-file-name (file-relative-name
15906 (nth 2 ent-entry) compile-directory)
15907 arch-alist (nth 4 ent-entry)
15908 lib-alist (nth 5 ent-entry)
15909 rule (aget rule-alist ent-file-name)
15910 target-list (nth 0 rule)
15911 depend-list (nth 1 rule)
15912 second-list nil
15913 subcomp-list nil)
15914 (setq tmp-key (vhdl-replace-string
15915 ent-regexp (funcall adjust-case ent-key)))
15916 (setq unit-list (cons (cons ent-key tmp-key) unit-list))
15917 ;; rule target for this entity
15918 (setq target-list (cons ent-key target-list))
15919 ;; rule dependencies for all used packages
15920 (setq pack-list (vhdl-get-packages lib-alist work-library))
15921 (setq depend-list (append depend-list pack-list))
15922 (setq all-pack-list pack-list)
15923 ;; add rule
15924 (aput 'rule-alist ent-file-name (list target-list depend-list))
15925 ;; rules for all corresponding architectures
15926 (while arch-alist
15927 (setq arch-entry (car arch-alist)
15928 arch-key (nth 0 arch-entry)
15929 ent-arch-key (concat ent-key "-" arch-key)
15930 arch-file-name (file-relative-name (nth 2 arch-entry)
15931 compile-directory)
15932 inst-alist (nth 4 arch-entry)
15933 lib-alist (nth 5 arch-entry)
15934 rule (aget rule-alist arch-file-name)
15935 target-list (nth 0 rule)
15936 depend-list (nth 1 rule))
15937 (setq tmp-key (vhdl-replace-string
15938 arch-regexp
15939 (funcall adjust-case (concat arch-key " " ent-key))))
15940 (setq unit-list
15941 (cons (cons ent-arch-key tmp-key) unit-list))
15942 (setq second-list (cons ent-arch-key second-list))
15943 ;; rule target for this architecture
15944 (setq target-list (cons ent-arch-key target-list))
15945 ;; rule dependency for corresponding entity
15946 (setq depend-list (cons ent-key depend-list))
15947 ;; rule dependencies for contained component instantiations
15948 (while inst-alist
15949 (setq inst-entry (car inst-alist))
15950 (when (or (null (nth 8 inst-entry))
15951 (equal (downcase (nth 8 inst-entry)) work-library))
15952 (setq inst-ent-key (or (nth 7 inst-entry)
15953 (nth 5 inst-entry)))
15954 (setq depend-list (cons inst-ent-key depend-list)
15955 subcomp-list (cons inst-ent-key subcomp-list)))
15956 (setq inst-alist (cdr inst-alist)))
15957 ;; rule dependencies for all used packages
15958 (setq pack-list (vhdl-get-packages lib-alist work-library))
15959 (setq depend-list (append depend-list pack-list))
15960 (setq all-pack-list (append all-pack-list pack-list))
15961 ;; add rule
15962 (aput 'rule-alist arch-file-name (list target-list depend-list))
15963 (setq arch-alist (cdr arch-alist)))
15964 (setq prim-list (cons (list ent-key second-list
15965 (append subcomp-list all-pack-list))
15966 prim-list)))
15967 (setq ent-alist (cdr ent-alist)))
15968 (setq ent-alist tmp-list)
15969 ;; rules for all configurations
15970 (setq tmp-list conf-alist)
15971 (while conf-alist
15972 (setq conf-entry (car conf-alist)
15973 conf-key (nth 0 conf-entry)
15974 conf-file-name (file-relative-name
15975 (nth 2 conf-entry) compile-directory)
15976 ent-key (nth 4 conf-entry)
15977 arch-key (nth 5 conf-entry)
15978 inst-alist (nth 6 conf-entry)
15979 lib-alist (nth 7 conf-entry)
15980 rule (aget rule-alist conf-file-name)
15981 target-list (nth 0 rule)
15982 depend-list (nth 1 rule)
15983 subcomp-list (list ent-key))
15984 (setq tmp-key (vhdl-replace-string
15985 conf-regexp (funcall adjust-case conf-key)))
15986 (setq unit-list (cons (cons conf-key tmp-key) unit-list))
15987 ;; rule target for this configuration
15988 (setq target-list (cons conf-key target-list))
15989 ;; rule dependency for corresponding entity and architecture
15990 (setq depend-list
15991 (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
15992 ;; rule dependencies for used packages
15993 (setq pack-list (vhdl-get-packages lib-alist work-library))
15994 (setq depend-list (append depend-list pack-list))
15995 ;; rule dependencies for contained component configurations
15996 (while inst-alist
15997 (setq inst-entry (car inst-alist))
15998 (setq inst-ent-key (nth 2 inst-entry)
15999 ; comp-arch-key (nth 2 inst-entry))
16000 inst-conf-key (nth 4 inst-entry))
16001 (when (equal (downcase (nth 5 inst-entry)) work-library)
16002 (when inst-ent-key
16003 (setq depend-list (cons inst-ent-key depend-list)
16004 subcomp-list (cons inst-ent-key subcomp-list)))
16005 ; (when comp-arch-key
16006 ; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key)
16007 ; depend-list)))
16008 (when inst-conf-key
16009 (setq depend-list (cons inst-conf-key depend-list)
16010 subcomp-list (cons inst-conf-key subcomp-list))))
16011 (setq inst-alist (cdr inst-alist)))
16012 ;; add rule
16013 (aput 'rule-alist conf-file-name (list target-list depend-list))
16014 (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list))
16015 prim-list))
16016 (setq conf-alist (cdr conf-alist)))
16017 (setq conf-alist tmp-list)
16018 ;; rules for all packages
16019 (setq tmp-list pack-alist)
16020 (while pack-alist
16021 (setq pack-entry (car pack-alist)
16022 pack-key (nth 0 pack-entry)
16023 pack-body-key nil)
16024 (when (nth 2 pack-entry)
16025 (setq pack-file-name (file-relative-name (nth 2 pack-entry)
16026 compile-directory)
16027 lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
16028 rule (aget rule-alist pack-file-name)
16029 target-list (nth 0 rule) depend-list (nth 1 rule))
16030 (setq tmp-key (vhdl-replace-string
16031 pack-regexp (funcall adjust-case pack-key)))
16032 (setq unit-list (cons (cons pack-key tmp-key) unit-list))
16033 ;; rule target for this package
16034 (setq target-list (cons pack-key target-list))
16035 ;; rule dependencies for all used packages
16036 (setq pack-list (vhdl-get-packages lib-alist work-library))
16037 (setq depend-list (append depend-list pack-list))
16038 (setq all-pack-list pack-list)
16039 ;; add rule
16040 (aput 'rule-alist pack-file-name (list target-list depend-list))
16041 ;; rules for this package's body
16042 (when (nth 7 pack-entry)
16043 (setq pack-body-key (concat pack-key "-body")
16044 pack-body-file-name (file-relative-name (nth 7 pack-entry)
16045 compile-directory)
16046 rule (aget rule-alist pack-body-file-name)
16047 target-list (nth 0 rule)
16048 depend-list (nth 1 rule))
16049 (setq tmp-key (vhdl-replace-string
16050 pack-body-regexp (funcall adjust-case pack-key)))
16051 (setq unit-list
16052 (cons (cons pack-body-key tmp-key) unit-list))
16053 ;; rule target for this package's body
16054 (setq target-list (cons pack-body-key target-list))
16055 ;; rule dependency for corresponding package declaration
16056 (setq depend-list (cons pack-key depend-list))
16057 ;; rule dependencies for all used packages
16058 (setq pack-list (vhdl-get-packages lib-body-alist work-library))
16059 (setq depend-list (append depend-list pack-list))
16060 (setq all-pack-list (append all-pack-list pack-list))
16061 ;; add rule
16062 (aput 'rule-alist pack-body-file-name
16063 (list target-list depend-list)))
16064 (setq prim-list
16065 (cons (list pack-key (when pack-body-key (list pack-body-key))
16066 all-pack-list)
16067 prim-list)))
16068 (setq pack-alist (cdr pack-alist)))
16069 (setq pack-alist tmp-list)
16070 ;; generate Makefile
16071 (let* ((project (aget vhdl-project-alist project))
16072 (compiler (aget vhdl-compiler-alist vhdl-compiler))
16073 (compiler-id (nth 9 compiler))
16074 (library-directory
16075 (vhdl-resolve-env-variable
16076 (vhdl-replace-string
16077 (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
16078 compiler-id)))
16079 (makefile-path-name (expand-file-name
16080 makefile-name compile-directory))
16081 (orig-buffer (current-buffer))
16082 cell second-list subcomp-list options unit-key unit-name)
16083 ;; sort lists
16084 (setq unit-list (vhdl-sort-alist unit-list))
16085 (setq prim-list (vhdl-sort-alist prim-list))
16086 (setq tmp-list rule-alist)
16087 (while tmp-list ; pre-sort rule targets
16088 (setq cell (cdar tmp-list))
16089 (setcar cell (sort (car cell) 'string<))
16090 (setq tmp-list (cdr tmp-list)))
16091 (setq rule-alist ; sort by first rule target
16092 (sort rule-alist
16093 (function (lambda (a b)
16094 (string< (car (cadr a)) (car (cadr b)))))))
16095 ;; open and clear Makefile
16096 (set-buffer (find-file-noselect makefile-path-name t t))
16097 (erase-buffer)
16098 (insert "# -*- Makefile -*-\n"
16099 "### " (file-name-nondirectory makefile-name)
16100 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
16101 "\n")
16102 (if project
16103 (insert "\n# Project : " (nth 0 project))
16104 (insert "\n# Directory : \"" directory "\""))
16105 (insert "\n# Platform : " vhdl-compiler
16106 "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
16107 (user-login-name) "\n")
16108 ;; insert compile and option variable settings
16109 (insert "\n\n# Define compilation command and options\n"
16110 "\nCOMPILE = " (nth 0 compiler)
16111 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
16112 "\n")
16113 ;; insert library paths
16114 (setq library-directory
16115 (directory-file-name
16116 (if (file-name-absolute-p library-directory)
16117 library-directory
16118 (file-relative-name
16119 (expand-file-name library-directory directory)
16120 compile-directory))))
16121 (insert "\n\n# Define library paths\n"
16122 "\nLIBRARY-" work-library " = " library-directory "\n")
16123 ;; insert variable definitions for all library unit files
16124 (insert "\n\n# Define library unit files\n")
16125 (setq tmp-list unit-list)
16126 (while unit-list
16127 (insert "\nUNIT-" work-library "-" (caar unit-list)
16128 " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
16129 (setq unit-list (cdr unit-list)))
16130 ;; insert variable definition for list of all library unit files
16131 (insert "\n\n\n# Define list of all library unit files\n"
16132 "\nALL_UNITS =")
16133 (setq unit-list tmp-list)
16134 (while unit-list
16135 (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
16136 (setq unit-list (cdr unit-list)))
16137 (insert "\n")
16138 (setq unit-list tmp-list)
16139 ;; insert `make all' rule
16140 (insert "\n\n\n# Rule for compiling entire design\n"
16141 "\nall :"
16142 " \\\n\t\tlibrary"
16143 " \\\n\t\t$(ALL_UNITS)\n")
16144 ;; insert `make clean' rule
16145 (insert "\n\n# Rule for cleaning entire design\n"
16146 "\nclean : "
16147 "\n\t-rm -f $(ALL_UNITS)\n")
16148 ;; insert `make library' rule
16149 (insert "\n\n# Rule for creating library directory\n"
16150 "\nlibrary :"
16151 " \\\n\t\t$(LIBRARY-" work-library ")\n"
16152 "\n$(LIBRARY-" work-library ") :"
16153 "\n\t"
16154 (vhdl-replace-string
16155 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
16156 (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
16157 "\n")
16158 ;; insert rule for each library unit
16159 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
16160 (while prim-list
16161 (setq second-list (sort (nth 1 (car prim-list)) 'string<))
16162 (setq subcomp-list
16163 (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
16164 (setq unit-key (caar prim-list)
16165 unit-name (or (nth 0 (aget ent-alist unit-key t))
16166 (nth 0 (aget conf-alist unit-key t))
16167 (nth 0 (aget pack-alist unit-key t))))
16168 (insert "\n" unit-key)
16169 (unless (equal unit-key unit-name)
16170 (insert " \\\n" unit-name))
16171 (insert " :"
16172 " \\\n\t\tlibrary"
16173 " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
16174 (while second-list
16175 (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
16176 (setq second-list (cdr second-list)))
16177 (while subcomp-list
16178 (when (assoc (car subcomp-list) unit-list)
16179 (insert " \\\n\t\t" (car subcomp-list)))
16180 (setq subcomp-list (cdr subcomp-list)))
16181 (insert "\n")
16182 (setq prim-list (cdr prim-list)))
16183 ;; insert rule for each library unit file
16184 (insert "\n\n# Rules for compiling single library unit files\n")
16185 (while rule-alist
16186 (setq rule (car rule-alist))
16187 ;; get compiler options for this file
16188 (setq options
16189 (vhdl-get-compile-options project compiler (nth 0 rule) t))
16190 ;; insert rule if file is supposed to be compiled
16191 (setq target-list (nth 1 rule)
16192 depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
16193 ;; insert targets
16194 (setq tmp-list target-list)
16195 (while target-list
16196 (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
16197 (if (cdr target-list) " \\" " :"))
16198 (setq target-list (cdr target-list)))
16199 (setq target-list tmp-list)
16200 ;; insert file name as first dependency
16201 (insert " \\\n\t\t" (nth 0 rule))
16202 ;; insert dependencies (except if also target or unit does not exist)
16203 (while depend-list
16204 (when (and (not (member (car depend-list) target-list))
16205 (assoc (car depend-list) unit-list))
16206 (insert " \\\n\t\t"
16207 "$(UNIT-" work-library "-" (car depend-list) ")"))
16208 (setq depend-list (cdr depend-list)))
16209 ;; insert compile command
16210 (if options
16211 (insert "\n\t$(COMPILE) "
16212 (if (eq options 'default) "$(OPTIONS)" options) " "
16213 (nth 0 rule) "\n")
16214 (setq tmp-list target-list)
16215 (while target-list
16216 (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
16217 (if (cdr target-list) " \\" "\n"))
16218 (setq target-list (cdr target-list)))
16219 (setq target-list tmp-list))
16220 (setq rule-alist (cdr rule-alist)))
16221 (insert "\n\n### " makefile-name " ends here\n")
16222 ;; run Makefile generation hook
16223 (run-hooks 'vhdl-makefile-generation-hook)
16224 (message "Generating makefile \"%s\"...done" makefile-name)
16225 ;; save and close file
16226 (if (file-writable-p makefile-path-name)
16227 (progn (save-buffer)
16228 (kill-buffer (current-buffer))
16229 (set-buffer orig-buffer)
16230 (setq file-name-history
16231 (cons makefile-path-name file-name-history)))
16232 (vhdl-warning-when-idle
16233 (format "File not writable: \"%s\""
16234 (abbreviate-file-name makefile-path-name)))
16235 (switch-to-buffer (current-buffer))))))
16238 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16239 ;;; Bug reports
16240 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16241 ;; (using `reporter.el')
16243 (defconst vhdl-mode-help-address
16244 "Reto Zimmermann <reto@gnu.org>"
16245 "Address for VHDL Mode bug reports.")
16247 (defun vhdl-submit-bug-report ()
16248 "Submit via mail a bug report on VHDL Mode."
16249 (interactive)
16250 ;; load in reporter
16251 (and
16252 (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
16253 (let ((reporter-prompt-for-summary-p t))
16254 (reporter-submit-bug-report
16255 vhdl-mode-help-address
16256 (concat "VHDL Mode " vhdl-version)
16257 (list
16258 ;; report all important user options
16259 'vhdl-offsets-alist
16260 'vhdl-comment-only-line-offset
16261 'tab-width
16262 'vhdl-electric-mode
16263 'vhdl-stutter-mode
16264 'vhdl-indent-tabs-mode
16265 'vhdl-project-alist
16266 'vhdl-project
16267 'vhdl-project-file-name
16268 'vhdl-project-auto-load
16269 'vhdl-project-sort
16270 'vhdl-compiler-alist
16271 'vhdl-compiler
16272 'vhdl-compile-use-local-error-regexp
16273 'vhdl-makefile-generation-hook
16274 'vhdl-default-library
16275 'vhdl-standard
16276 'vhdl-basic-offset
16277 'vhdl-upper-case-keywords
16278 'vhdl-upper-case-types
16279 'vhdl-upper-case-attributes
16280 'vhdl-upper-case-enum-values
16281 'vhdl-upper-case-constants
16282 'vhdl-use-direct-instantiation
16283 'vhdl-entity-file-name
16284 'vhdl-architecture-file-name
16285 'vhdl-package-file-name
16286 'vhdl-file-name-case
16287 'vhdl-electric-keywords
16288 'vhdl-optional-labels
16289 'vhdl-insert-empty-lines
16290 'vhdl-argument-list-indent
16291 'vhdl-association-list-with-formals
16292 'vhdl-conditions-in-parenthesis
16293 'vhdl-zero-string
16294 'vhdl-one-string
16295 'vhdl-file-header
16296 'vhdl-file-footer
16297 'vhdl-company-name
16298 'vhdl-copyright-string
16299 'vhdl-platform-spec
16300 'vhdl-date-format
16301 'vhdl-modify-date-prefix-string
16302 'vhdl-modify-date-on-saving
16303 'vhdl-reset-kind
16304 'vhdl-reset-active-high
16305 'vhdl-clock-rising-edge
16306 'vhdl-clock-edge-condition
16307 'vhdl-clock-name
16308 'vhdl-reset-name
16309 'vhdl-model-alist
16310 'vhdl-include-port-comments
16311 'vhdl-include-direction-comments
16312 'vhdl-include-type-comments
16313 'vhdl-include-group-comments
16314 'vhdl-actual-port-name
16315 'vhdl-instance-name
16316 'vhdl-testbench-entity-name
16317 'vhdl-testbench-architecture-name
16318 'vhdl-testbench-configuration-name
16319 'vhdl-testbench-dut-name
16320 'vhdl-testbench-include-header
16321 'vhdl-testbench-declarations
16322 'vhdl-testbench-statements
16323 'vhdl-testbench-initialize-signals
16324 'vhdl-testbench-include-library
16325 'vhdl-testbench-include-configuration
16326 'vhdl-testbench-create-files
16327 'vhdl-compose-create-files
16328 'vhdl-compose-include-header
16329 'vhdl-compose-architecture-name
16330 'vhdl-components-package-name
16331 'vhdl-use-components-package
16332 'vhdl-self-insert-comments
16333 'vhdl-prompt-for-comments
16334 'vhdl-inline-comment-column
16335 'vhdl-end-comment-column
16336 'vhdl-auto-align
16337 'vhdl-align-groups
16338 'vhdl-align-group-separate
16339 'vhdl-align-same-indent
16340 'vhdl-highlight-keywords
16341 'vhdl-highlight-names
16342 'vhdl-highlight-special-words
16343 'vhdl-highlight-forbidden-words
16344 'vhdl-highlight-verilog-keywords
16345 'vhdl-highlight-translate-off
16346 'vhdl-highlight-case-sensitive
16347 'vhdl-special-syntax-alist
16348 'vhdl-forbidden-words
16349 'vhdl-forbidden-syntax
16350 'vhdl-directive-keywords
16351 'vhdl-speedbar-auto-open
16352 'vhdl-speedbar-display-mode
16353 'vhdl-speedbar-scan-limit
16354 'vhdl-speedbar-jump-to-unit
16355 'vhdl-speedbar-update-on-saving
16356 'vhdl-speedbar-save-cache
16357 'vhdl-speedbar-cache-file-name
16358 'vhdl-index-menu
16359 'vhdl-source-file-menu
16360 'vhdl-hideshow-menu
16361 'vhdl-hide-all-init
16362 'vhdl-print-two-column
16363 'vhdl-print-customize-faces
16364 'vhdl-intelligent-tab
16365 'vhdl-indent-syntax-based
16366 'vhdl-word-completion-case-sensitive
16367 'vhdl-word-completion-in-minibuffer
16368 'vhdl-underscore-is-part-of-word
16369 'vhdl-mode-hook)
16370 (function
16371 (lambda ()
16372 (insert
16373 (if vhdl-special-indent-hook
16374 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
16375 "vhdl-special-indent-hook is set to '"
16376 (format "%s" vhdl-special-indent-hook)
16377 ".\nPerhaps this is your problem?\n"
16378 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
16379 "\n"))))
16381 "Hi Reto,"))))
16384 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16385 ;;; Documentation
16386 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16388 (defconst vhdl-doc-release-notes nil
16390 Release Notes for VHDL Mode 3.32
16391 ================================
16393 - New Features
16394 - Enhanced Features
16395 - User Options
16396 - Remarks
16399 New Features
16400 ------------
16402 STRUCTURAL COMPOSITION:
16403 - Enables simple structural composition similar to graphical editors.
16404 Simplifies the creation of higher design levels where subcomponents
16405 are simply sticked together:
16406 1. Create a skeleton for a new component
16407 2. Place subcomponents in it directly from the hierarchy browser
16408 3. Automatically connect all subcomponents and create the ports
16409 for the new component (based on names of actual ports)
16410 - Automatic generation of a components package (package containing
16411 component declarations for all entities).
16412 - Find more information in the online documentation (`C-c C-h').
16414 PORT TRANSLATION:
16415 - Reverse direction of ports (useful for testbenches).
16417 SUBPROGRAM TRANSLATION:
16418 - Copy/paste of subprogram interfaces (similar to port translation).
16420 CODE FILLING:
16421 - Condense code using code-sensitive block filling.
16423 CODE STATISTICS:
16424 - Calculate number of code lines and statements in a buffer.
16427 Enhanced Features
16428 -----------------
16430 TESTBENCH GENERATION:
16431 - Enhanced templates and user option default values.
16433 Emacs 21 compatibility/enhancements:
16434 - `lazy-lock-mode' is not used anymore (built-in `jit-lock-mode' is faster).
16436 And many other minor fixes and enhancements.
16439 User Options
16440 ------------
16442 `vhdl-project-file-name': (enhanced)
16443 Include user name in project setup file name.
16444 `vhdl-speedbar-cache-file-name': (enhanced, changed default)
16445 Include user name in cache file name.
16446 `vhdl-default-library': (new)
16447 Default working library if no project is active.
16448 `vhdl-architecture-file-name': (new)
16449 Specify how the architecture file name is obtained.
16450 `vhdl-package-file-name': (new)
16451 Specify how the package file name is obtained.
16452 `vhdl-file-name-case': (new)
16453 Allows to change case when deriving file names.
16454 `vhdl-compose-create-files': (new)
16455 Specify whether new files should be created for a new component.
16456 `vhdl-compose-include-header': (new)
16457 Specify whether a header is included in a new component's file.
16458 `vhdl-compose-architecture-name': (new)
16459 Specify how a new component's architecture name is obtained.
16460 `vhdl-components-package-name': (new)
16461 Specify how the name for the components package is obtained.
16462 `vhdl-use-components-package': (new)
16463 Specify whether component declarations go in a components package.
16464 `vhdl-use-direct-instantiation': (new)
16465 Specify whether to use VHDL'93 direct component instantiation.
16466 `vhdl-instance-name': (changed default)
16467 Allows insertion of a running number to generate unique instance names.
16468 `vhdl-testbench-entity-header', `vhdl-testbench-architecture-header':(obsolete)
16469 Headers are now automatically derived from the standard header.
16470 `vhdl-testbench-include-header': (new)
16471 Specify whether a header is included in testbench files.
16472 `vhdl-testbench-declaration', `vhdl-testbench-statements': (changed default)
16473 Non-empty default values for more complete testbench templates.
16476 Remarks
16477 -------
16479 - Changed key binding for `vhdl-comment-uncomment-region': `C-c c'
16480 (`C-c C-c ...' is now used for structural composition).
16482 - Automatic buffer highlighting (font-lock) is now controlled by option
16483 `global-font-lock-mode' in GNU Emacs (`font-lock-auto-fontify' in XEmacs).
16484 \(Important: You MUST customize this option in order to turn automatic
16485 buffer highlighting on.)
16489 (defconst vhdl-doc-keywords nil
16491 Reserved words in VHDL
16492 ----------------------
16494 VHDL'93 (IEEE Std 1076-1993):
16495 `vhdl-93-keywords' : keywords
16496 `vhdl-93-types' : standardized types
16497 `vhdl-93-attributes' : standardized attributes
16498 `vhdl-93-enum-values' : standardized enumeration values
16499 `vhdl-93-functions' : standardized functions
16500 `vhdl-93-packages' : standardized packages and libraries
16502 VHDL-AMS (IEEE Std 1076.1):
16503 `vhdl-ams-keywords' : keywords
16504 `vhdl-ams-types' : standardized types
16505 `vhdl-ams-attributes' : standardized attributes
16506 `vhdl-ams-enum-values' : standardized enumeration values
16507 `vhdl-ams-functions' : standardized functions
16509 Math Packages (IEEE Std 1076.2):
16510 `vhdl-math-types' : standardized types
16511 `vhdl-math-constants' : standardized constants
16512 `vhdl-math-functions' : standardized functions
16513 `vhdl-math-packages' : standardized packages
16515 Forbidden words:
16516 `vhdl-verilog-keywords' : Verilog reserved words
16518 NOTE: click `mouse-2' on variable names above (not in XEmacs).")
16521 (defconst vhdl-doc-coding-style nil
16523 For VHDL coding style and naming convention guidelines, see the following
16524 references:
16526 \[1] Ben Cohen.
16527 \"VHDL Coding Styles and Methodologies\".
16528 Kluwer Academic Publishers, 1999.
16529 http://members.aol.com/vhdlcohen/vhdl/
16531 \[2] Michael Keating and Pierre Bricaud.
16532 \"Reuse Methodology Manual, Second Edition\".
16533 Kluwer Academic Publishers, 1999.
16534 http://www.openmore.com/openmore/rmm2.html
16536 \[3] European Space Agency.
16537 \"VHDL Modelling Guidelines\".
16538 ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
16540 Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
16541 to visually support naming conventions.")
16544 (defun vhdl-version ()
16545 "Echo the current version of VHDL Mode in the minibuffer."
16546 (interactive)
16547 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
16548 (vhdl-keep-region-active))
16550 (defun vhdl-doc-variable (variable)
16551 "Display VARIABLE's documentation in *Help* buffer."
16552 (interactive)
16553 (with-output-to-temp-buffer "*Help*"
16554 (princ (documentation-property variable 'variable-documentation))
16555 (unless vhdl-xemacs
16556 (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
16557 (save-excursion
16558 (set-buffer standard-output)
16559 (help-mode))
16560 (print-help-return-message)))
16562 (defun vhdl-doc-mode ()
16563 "Display VHDL Mode documentation in *Help* buffer."
16564 (interactive)
16565 (with-output-to-temp-buffer "*Help*"
16566 (princ mode-name)
16567 (princ " mode:\n")
16568 (princ (documentation 'vhdl-mode))
16569 (unless vhdl-xemacs
16570 (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
16571 (save-excursion
16572 (set-buffer standard-output)
16573 (help-mode))
16574 (print-help-return-message)))
16577 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16579 (provide 'vhdl-mode)
16581 ;;; vhdl-mode.el ends here