code.delx.au - gnu-emacs/blob - lisp/progmodes/vhdl-mode.el

   1 ;;; vhdl-mode.el --- major mode for editing VHDL code
   2
   3 ;; Copyright (C) 1992-2015 Free Software Foundation, Inc.
   4
   5 ;; Authors:     Reto Zimmermann <reto@gnu.org>
   6 ;;              Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
   7 ;; Maintainer:  Reto Zimmermann <reto@gnu.org>
   8 ;; Keywords:    languages vhdl
   9 ;; WWW:         http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
  10
  11 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
  12 ;; file on 18/3/2008, and the maintainer agreed that when a bug is
  13 ;; filed in the Emacs bug reporting system against this file, a copy
  14 ;; of the bug report be sent to the maintainer's email address.
  15
  16 (defconst vhdl-version "3.37.1"
  17   "VHDL Mode version number.")
  18
  19 (defconst vhdl-time-stamp "2015-01-15"
  20   "VHDL Mode time stamp for last update.")
  21
  22 ;; This file is part of GNU Emacs.
  23
  24 ;; GNU Emacs is free software: you can redistribute it and/or modify
  25 ;; it under the terms of the GNU General Public License as published by
  26 ;; the Free Software Foundation, either version 3 of the License, or
  27 ;; (at your option) any later version.
  28
  29 ;; GNU Emacs is distributed in the hope that it will be useful,
  30 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  31 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  32 ;; GNU General Public License for more details.
  33
  34 ;; You should have received a copy of the GNU General Public License
  35 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  36
  37 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38 ;;; Commentary:
  39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  40
  41 ;; This package provides an Emacs major mode for editing VHDL code.
  42 ;; It includes the following features:
  43
  44 ;;   - Syntax highlighting
  45 ;;   - Indentation
  46 ;;   - Template insertion (electrification)
  47 ;;   - Insertion of file headers
  48 ;;   - Insertion of user-specified models
  49 ;;   - Port translation / testbench generation
  50 ;;   - Structural composition
  51 ;;   - Configuration generation
  52 ;;   - Sensitivity list updating
  53 ;;   - File browser
  54 ;;   - Design hierarchy browser
  55 ;;   - Source file compilation (syntax analysis)
  56 ;;   - Makefile generation
  57 ;;   - Code hiding
  58 ;;   - Word/keyword completion
  59 ;;   - Block commenting
  60 ;;   - Code fixing/alignment/beautification
  61 ;;   - PostScript printing
  62 ;;   - VHDL'87/'93/'02/'08 and VHDL-AMS supported
  63 ;;   - Comprehensive menu
  64 ;;   - Fully customizable
  65 ;;   - Works under GNU Emacs (recommended) and XEmacs
  66
  67 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  68 ;; Documentation
  69
  70 ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
  71
  72 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73 ;; Emacs Versions
  74
  75 ;; this updated version was only tested on: GNU Emacs 24.1
  76
  77 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  78 ;; Installation
  79
  80 ;; Prerequisites:  GNU Emacs 20/21/22/23/24, XEmacs 20/21.
  81
  82 ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
  83 ;; or into an arbitrary directory that is added to the load path by the
  84 ;; following line in your Emacs start-up file `.emacs':
  85
  86 ;;   (push (expand-file-name "<directory-name>") load-path)
  87
  88 ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
  89 ;; directory.  Otherwise, byte-compile the source file:
  90 ;;   Emacs:  M-x byte-compile-file RET vhdl-mode.el RET
  91 ;;   Unix:   emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
  92
  93 ;; Add the following lines to the `site-start.el' file in the `site-lisp'
  94 ;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
  95 ;; (not required in Emacs 20 and higher):
  96
  97 ;;   (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
  98 ;;   (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)
  99
 100 ;; More detailed installation instructions are included in the official
 101 ;; VHDL Mode distribution.
 102
 103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 104 ;; Acknowledgments
 105
 106 ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
 107 ;; and Steve Grout.
 108
 109 ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
 110 ;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
 111
 112 ;; Many thanks to all the users who sent me bug reports and enhancement
 113 ;; requests.
 114 ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
 115 ;; enhancement suggestions and the fruitful discussions.
 116 ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
 117 ;; Thanks to Ulf Klaperski for the indentation speedup hint.
 118
 119 ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated
 120 ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for
 121 ;; giving me the opportunity to develop this code.
 122 ;; This work has been funded in part by MICROSWISS, a Microelectronics Program
 123 ;; of the Swiss Government.
 124
 125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 126
 127 ;;; Code:
 128
 129 ;; Emacs 21+ handling
 130 (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
 131   "Non-nil if GNU Emacs 21, 22, ... is used.")
 132 ;; Emacs 22+ handling
 133 (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
 134   "Non-nil if GNU Emacs 22, ... is used.")
 135
 136 (defvar compilation-file-regexp-alist)
 137 (defvar conf-alist)
 138 (defvar conf-entry)
 139 (defvar conf-key)
 140 (defvar ent-alist)
 141 (defvar itimer-version)
 142 (defvar lazy-lock-defer-contextually)
 143 (defvar lazy-lock-defer-on-scrolling)
 144 (defvar lazy-lock-defer-on-the-fly)
 145 (defvar speedbar-attached-frame)
 146
 147
 148 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 149 ;;; Variables
 150 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 151
 152 ;; help function for user options
 153 (defun vhdl-custom-set (variable value &rest functions)
 154   "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
 155   (if (fboundp 'custom-set-default)
 156       (custom-set-default variable value)
 157     (set-default variable value))
 158   (while functions
 159     (when (fboundp (car functions)) (funcall (car functions)))
 160     (setq functions (cdr functions))))
 161
 162 (defun vhdl-widget-directory-validate (widget)
 163   "Check that the value of WIDGET is a valid directory entry (i.e. ends with
 164 '/' or is empty)."
 165   (let ((val (widget-value widget)))
 166     (unless (string-match "^\\(\\|.*/\\)$" val)
 167       (widget-put widget :error "Invalid directory entry: must end with '/'")
 168       widget)))
 169
 170 ;; help string for user options
 171 (defconst vhdl-name-doc-string "
 172
 173 FROM REGEXP is a regular expression matching the original name:
 174   \".*\"       matches the entire string
 175   \"\\(...\\)\"  matches a substring
 176 TO STRING specifies the string to be inserted as new name:
 177   \"\\&\"  means substitute entire matched text
 178   \"\\N\"  means substitute what matched the Nth \"\\(...\\)\"
 179 Examples:
 180   \".*\"           \"\\&\"    inserts original string
 181   \".*\"           \"\\&_i\"  attaches \"_i\" to original string
 182   \"\\(.*\\)_[io]$\" \"\\1\"    strips off \"_i\" or \"_o\" from original string
 183   \".*\"           \"foo\"   inserts constant string \"foo\"
 184   \".*\"           \"\"      inserts empty string")
 185
 186 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 187 ;; User variables (customization options)
 188
 189 (defgroup vhdl nil
 190   "Customizations for VHDL Mode."
 191   :prefix "vhdl-"
 192   :group 'languages
 193 ;  :version "21.2"  ; comment out for XEmacs
 194   )
 195
 196 (defgroup vhdl-mode nil
 197   "Customizations for modes."
 198   :group 'vhdl)
 199
 200 (defcustom vhdl-indent-tabs-mode nil
 201   "Non-nil means indentation can insert tabs.
 202 Overrides local variable `indent-tabs-mode'."
 203   :type 'boolean
 204   :group 'vhdl-mode)
 205
 206
 207 (defgroup vhdl-compile nil
 208   "Customizations for compilation."
 209   :group 'vhdl)
 210
 211 (defcustom vhdl-compiler-alist
 212   '(
 213     ;;     60:       docal  <= false;
 214     ;;               ^^^^^
 215     ;; [Error] Assignment error: variable is illegal target of signal assignment
 216     ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1"
 217      nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms"
 218      ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1)
 219      ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
 220       "PACK/\\1.vif" "BODY/\\1.vif" upcase))
 221     ;; Aldec
 222     ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3
 223     ("Aldec" "vcom" "-work \\1" "make" "-f \\1"
 224      nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec"
 225      ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0)
 226      nil)
 227     ;; Cadence Leapfrog: cv -file test.vhd
 228     ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
 229     ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
 230      nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
 231      ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0)
 232      ("\\1/entity" "\\2/\\1" "\\1/configuration"
 233       "\\1/package" "\\1/body" downcase))
 234     ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
 235     ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
 236     ;; (PLL_400X_TOP) is not declared [10.3].
 237     ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
 238      nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
 239      ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
 240      ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db"
 241       "\\1/package/pc.db" "\\1/body/pc.db" downcase))
 242     ;; ghdl vhdl
 243     ;; ghdl -a bad_counter.vhdl
 244     ;; bad_counter.vhdl:13:14: operator "=" is overloaded
 245     ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1"
 246      nil "mkdir \\1" "./" "work/" "Makefile" "ghdl"
 247      ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
 248      ("\\1/entity" "\\2/\\1" "\\1/configuration"
 249       "\\1/package" "\\1/body" downcase))
 250     ;; IBM Compiler
 251     ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6
 252     ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1"
 253      nil "mkdir \\1" "./" "work/" "Makefile" "ibm"
 254      ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0)
 255      nil)
 256     ;; Ikos Voyager: analyze test.vhd
 257     ;; analyze test.vhd
 258     ;; E L4/C5:        this library unit is inaccessible
 259     ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
 260      nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
 261      ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2)
 262      ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
 263      nil)
 264     ;; ModelSim, Model Technology: vcom test.vhd
 265     ;; ERROR: test.vhd(14): Unknown identifier: positiv
 266     ;; WARNING[2]: test.vhd(85): Possible infinite loop
 267     ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ...
 268     ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
 269     ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
 270      nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
 271      ("^\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \t\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0)
 272      ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
 273       "\\1/_primary.dat" "\\1/body.dat" downcase))
 274     ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
 275     ;; test.vhd:34: error message
 276     ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
 277      nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
 278      ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
 279      ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
 280       "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
 281     ;; Quartus compiler
 282     ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used
 283     ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text
 284     ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal
 285     ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library
 286     ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ...
 287     ("Quartus" "make" "-work \\1" "make" "-f \\1"
 288      nil "mkdir \\1" "./" "work/" "Makefile" "quartus"
 289      ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0)
 290      nil)
 291     ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
 292     ;; ERROR: test.vhd(24): near "dnd": expecting: END
 293     ;; WARNING[4]: test.vhd(30): A space is required between ...
 294     ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
 295      nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
 296      ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0)
 297      ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
 298       "\\1/_primary.dat" "\\1/body.dat" downcase))
 299     ;; Savant: scram -publish-cc test.vhd
 300     ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
 301     ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
 302      nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
 303      ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0)
 304      ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
 305       "\\1_config.vhdl" "\\1_package.vhdl"
 306       "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
 307     ;; Simili: vhdlp -work test.vhd
 308     ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
 309     ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
 310      nil "mkdir \\1" "./" "work/" "Makefile" "simili"
 311      ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0)
 312      ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
 313       "\\1/prim.var" "\\1/_body.var" downcase))
 314     ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
 315     ;;     ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
 316     ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
 317      nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
 318      ("^ *ERROR\[[0-9]+\]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0)
 319      nil)
 320     ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
 321     ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
 322     ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
 323      nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
 324      ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
 325      ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
 326     ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
 327     ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
 328     ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
 329      nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
 330      ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0)
 331      ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
 332     ;; Synplify:
 333     ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
 334     ("Synplify" "n/a" "n/a" "make" "-f \\1"
 335      nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
 336      ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
 337      nil)
 338     ;; Vantage: analyze -libfile vsslib.ini -src test.vhd
 339     ;;     Compiling "test.vhd" line 1...
 340     ;; **Error: LINE 49 *** No aggregate value is valid in this context.
 341     ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
 342      nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
 343      ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
 344      ("^ *Compiling \"\\(.+\\)\" " 1)
 345      nil)
 346     ;; VeriBest: vc vhdl test.vhd
 347     ;; (no file name printed out!)
 348     ;;     32:   Z <=  A and BitA ;
 349     ;;                       ^^^^
 350     ;; [Error] Name BITA is unknown
 351     ("VeriBest" "vc" "vhdl" "make" "-f \\1"
 352      nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
 353      ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0)
 354      nil)
 355     ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
 356     ;;     Compiling "test.vhd" line 1...
 357     ;; **Error: LINE 49 *** No aggregate value is valid in this context.
 358     ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
 359      nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
 360      ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil)
 361      ("^ *Compiling \"\\(.+\\)\" " 1)
 362      nil)
 363     ;; Xilinx XST:
 364     ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error
 365     ("Xilinx XST" "xflow" "" "make" "-f \\1"
 366      nil "mkdir \\1" "./" "work/" "Makefile" "xilinx"
 367      ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0)
 368      nil)
 369     )
 370   "List of available VHDL compilers and their properties.
 371 Each list entry specifies the following items for a compiler:
 372 Compiler:
 373   Compiler name    : name used in option `vhdl-compiler' to choose compiler
 374   Compile command  : command used for source file compilation
 375   Compile options  : compile options (\"\\1\" inserts library name)
 376   Make command     : command used for compilation using a Makefile
 377   Make options     : make options (\"\\1\" inserts Makefile name)
 378   Generate Makefile: use built-in function or command to generate a Makefile
 379                      \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
 380   Library command  : command to create library directory \(\"\\1\" inserts
 381                      library directory, \"\\2\" inserts library name)
 382   Compile directory: where compilation is run and the Makefile is placed
 383   Library directory: directory of default library
 384   Makefile name    : name of Makefile (default is \"Makefile\")
 385   ID string        : compiler identification string (see `vhdl-project-alist')
 386 Error message:
 387   Regexp           : regular expression to match error messages (*)
 388   File subexp index: index of subexpression that matches the file name
 389   Line subexp index: index of subexpression that matches the line number
 390   Column subexp idx: index of subexpression that matches the column number
 391 File message:
 392   Regexp           : regular expression to match a file name message
 393   File subexp index: index of subexpression that matches the file name
 394 Unit-to-file name mapping: mapping of library unit names to names of files
 395                      generated by the compiler (used for Makefile generation)
 396   To string        : string a name is mapped to (\"\\1\" inserts the unit name,
 397                      \"\\2\" inserts the entity name for architectures,
 398                      \"\\3\" inserts the library name)
 399   Case adjustment  : adjust case of inserted unit names
 400
 401 \(*) The regular expression must match the error message starting from the
 402     beginning of the line (but not necessarily to the end of the line).
 403
 404 Compile options allows insertion of the library name (see `vhdl-project-alist')
 405 in order to set the compilers library option (e.g. \"vcom -work my_lib\").
 406
 407 For Makefile generation, the built-in function can be used (requires
 408 specification of the unit-to-file name mapping).  Alternatively, an
 409 external command can be specified.  Work directory allows specification of
 410 an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
 411 used for Makefile generation).  To use another library name than \"work\",
 412 customize `vhdl-project-alist'.  The library command is inserted in Makefiles
 413 to automatically create the library directory if not existent.
 414
 415 Compile options, compile directory, library directory, and Makefile name are
 416 overwritten by the project settings if a project is defined (see
 417 `vhdl-project-alist').  Directory paths are relative to the source file
 418 directory.
 419
 420 Some compilers do not include the file name in the error message, but print
 421 out a file name message in advance.  In this case, set \"File Subexp Index\"
 422 under \"Error Message\" to 0 and fill out the \"File Message\" entries.
 423 If no file name at all is printed out, set both \"File Message\" entries to 0
 424 \(a default file name message will be printed out instead, does not work in
 425 XEmacs).
 426
 427 A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
 428 assigning its name to option `vhdl-compiler'.
 429
 430 Please send any missing or erroneous compiler properties to the maintainer for
 431 updating.
 432
 433 NOTE: Activate new error and file message regexps and reflect the new setting
 434       in the choice list of option `vhdl-compiler' by restarting Emacs."
 435   :type '(repeat
 436           (list :tag "Compiler" :indent 2
 437                 (string :tag "Compiler name      ")
 438                 (string :tag "Compile command    ")
 439                 (string :tag "Compile options    " "-work \\1")
 440                 (string :tag "Make command       " "make")
 441                 (string :tag "Make options       " "-f \\1")
 442                 (choice :tag "Generate Makefile  "
 443                         (const :tag "Built-in function" nil)
 444                         (string :tag "Command" "vmake \\2 > \\1"))
 445                 (string :tag "Library command    " "mkdir \\1")
 446                 (directory :tag "Compile directory  "
 447                            :validate vhdl-widget-directory-validate "./")
 448                 (directory :tag "Library directory  "
 449                            :validate vhdl-widget-directory-validate "work/")
 450                 (file :tag "Makefile name      " "Makefile")
 451                 (string :tag "ID string          ")
 452                 (list :tag "Error message" :indent 4
 453                       (regexp  :tag "Regexp           ")
 454                       (choice  :tag "File subexp      "
 455                               (integer :tag "Index")
 456                               (const :tag "No file name" nil))
 457                       (integer :tag "Line subexp index")
 458                       (choice  :tag "Column subexp    "
 459                               (integer :tag "Index")
 460                               (const :tag "No column number" nil)))
 461                 (list :tag "File message" :indent 4
 462                       (regexp  :tag "Regexp           ")
 463                       (integer :tag "File subexp index"))
 464                 (choice :tag "Unit-to-file name mapping"
 465                         :format "%t: %[Value Menu%] %v\n"
 466                         (const :tag "Not defined" nil)
 467                         (list :tag "To string" :indent 4
 468                               (string :tag "Entity           " "\\1.vhd")
 469                               (string :tag "Architecture     " "\\2_\\1.vhd")
 470                               (string :tag "Configuration    " "\\1.vhd")
 471                               (string :tag "Package          " "\\1.vhd")
 472                               (string :tag "Package Body     " "\\1_body.vhd")
 473                               (choice :tag "Case adjustment  "
 474                                       (const :tag "None" identity)
 475                                       (const :tag "Upcase" upcase)
 476                                       (const :tag "Downcase" downcase))))))
 477   :set (lambda (variable value)
 478          (vhdl-custom-set variable value 'vhdl-update-mode-menu))
 479   :version "24.4"
 480   :group 'vhdl-compile)
 481
 482 (defcustom vhdl-compiler "GHDL"
 483   "Specifies the VHDL compiler to be used for syntax analysis.
 484 Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
 485   :type (let ((alist vhdl-compiler-alist) list)
 486           (while alist
 487             (push (list 'const (caar alist)) list)
 488             (setq alist (cdr alist)))
 489           (append '(choice) (nreverse list)))
 490   :group 'vhdl-compile)
 491
 492 (defcustom vhdl-compile-use-local-error-regexp nil
 493   "Non-nil means use buffer-local `compilation-error-regexp-alist'.
 494 In this case, only error message regexps for VHDL compilers are active if
 495 compilation is started from a VHDL buffer.  Otherwise, the error message
 496 regexps are appended to the predefined global regexps, and all regexps are
 497 active all the time.  Note that by doing that, the predefined global regexps
 498 might result in erroneous parsing of error messages for some VHDL compilers.
 499
 500 NOTE: Activate the new setting by restarting Emacs."
 501   :version "25.1"                       ; t -> nil
 502   :type 'boolean
 503   :group 'vhdl-compile)
 504
 505 (defcustom vhdl-makefile-default-targets '("all" "clean" "library")
 506   "List of default target names in Makefiles.
 507 Automatically generated Makefiles include three default targets to compile
 508 the entire design, clean the entire design and to create the design library.
 509 This option allows you to change the names of these targets to avoid conflicts
 510 with other user Makefiles."
 511   :type '(list (string :tag "Compile entire design")
 512                (string :tag "Clean entire design  ")
 513                (string :tag "Create design library"))
 514   :version "24.3"
 515   :group 'vhdl-compile)
 516
 517 (defcustom vhdl-makefile-generation-hook nil
 518   "Functions to run at the end of Makefile generation.
 519 Allows you to insert user specific parts into a Makefile.
 520
 521 Example:
 522   \(lambda nil
 523     \(re-search-backward \"^# Rule for compiling entire design\")
 524     \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
 525   :type 'hook
 526   :group 'vhdl-compile)
 527
 528 (defcustom vhdl-default-library "work"
 529   "Name of default library.
 530 Is overwritten by project settings if a project is active."
 531   :type 'string
 532   :group 'vhdl-compile)
 533
 534
 535 (defgroup vhdl-project nil
 536   "Customizations for projects."
 537   :group 'vhdl)
 538
 539 (defcustom vhdl-project-alist
 540   '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
 541      "~/example1/" ("src/system/" "src/components/") ""
 542      (("ModelSim" "-87 \\2" "-f \\1 top_level" nil)
 543       ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
 544      "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
 545     ("Example 2" "Individual source files, multiple compilers in different directories"
 546      "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
 547      nil "\\1/" "work" "\\1/work/" "Makefile" "")
 548     ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
 549      "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
 550      nil "./" "work" "work-\\1/" "Makefile-\\1" "\
 551 -------------------------------------------------------------------------------
 552 -- This is a multi-line project description
 553 -- that can be used as a project dependent part of the file header.
 554 "))
 555   "List of projects and their properties.
 556   Name             : name used in option `vhdl-project' to choose project
 557   Title            : title of project (single-line string)
 558   Default directory: default project directory (absolute path)
 559   Sources          : a) source files  : path + \"/\" + file name
 560                      b) directory     : path + \"/\"
 561                      c) directory tree: \"-r \" + path + \"/\"
 562   Exclude regexp   : matches file/directory names to be excluded as sources
 563   Compile options  : project-specific options for each compiler
 564     Compiler name  : name of compiler for which these options are valid
 565     Compile options: project-specific compiler options
 566                      (\"\\1\" inserts library name, \"\\2\" default options)
 567     Make options:    project-specific make options
 568                      (\"\\1\" inserts Makefile name, \"\\2\" default options)
 569     Exceptions     : file-specific exceptions
 570       File name regexp: matches file names for which exceptions are valid
 571       - Options       : file-specific compiler options string
 572                         (\"\\1\" inserts library name, \"\\2\" default options,
 573                         \"\\3\" project-specific options)
 574       - Do not compile: do not compile this file (in Makefile)
 575   Compile directory: where compilation is run and the Makefile is placed
 576                      \(\"\\1\" inserts compiler ID string)
 577   Library name     : name of library (default is \"work\")
 578   Library directory: path to library (\"\\1\" inserts compiler ID string)
 579   Makefile name    : name of Makefile
 580                      (\"\\1\" inserts compiler ID string, \"\\2\" library name)
 581   Description      : description of project (multi-line string)
 582
 583 Project title and description are used to insert into the file header (see
 584 option `vhdl-file-header').
 585
 586 The default directory must have an absolute path (use `M-TAB' for completion).
 587 All other paths can be absolute or relative to the default directory.  All
 588 paths must end with '/'.
 589
 590 The design units found in the sources (files and directories) are shown in the
 591 hierarchy browser.  Path and file name can contain wildcards `*' and `?' as
 592 well as \"./\" and \"../\" (\"sh\" syntax).  Paths can also be absolute.
 593 Environment variables (e.g. \"$EXAMPLE2\") are resolved.  If no sources are
 594 specified, the default directory is taken as source directory.  Otherwise,
 595 the default directory is only taken as source directory if there is a sources
 596 entry with the empty string or \"./\".  Exclude regexp allows you to filter
 597 out specific file and directory names from the list of sources (e.g. CVS
 598 directories).
 599
 600 Files are compiled in the compile directory.  Makefiles are also placed into
 601 the compile directory.  Library directory specifies which directory the
 602 compiler compiles into (used to generate the Makefile).
 603
 604 Since different compile/library directories and Makefiles may exist for
 605 different compilers within one project, these paths and names allow the
 606 insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
 607 Compile options, compile directory, library directory, and Makefile name
 608 overwrite the settings of the current compiler.
 609
 610 File-specific compiler options (highest priority) overwrite project-specific
 611 options which overwrite default options (lowest priority).  Lower priority
 612 options can be inserted in higher priority options.  This allows you to reuse
 613 default options (e.g. \"-file\") in project- or file-specific options (e.g.
 614 \"-93 -file\").
 615
 616 NOTE: Reflect the new setting in the choice list of option `vhdl-project'
 617       by restarting Emacs."
 618   :type `(repeat
 619           (list :tag "Project" :indent 2
 620                 (string :tag "Name             ")
 621                 (string :tag "Title            ")
 622                 (directory :tag "Default directory"
 623                            :validate vhdl-widget-directory-validate
 624                            ,(abbreviate-file-name default-directory))
 625                 (repeat :tag "Sources          " :indent 4
 626                         (directory :format "     %v" "./"))
 627                 (regexp :tag "Exclude regexp   ")
 628                 (repeat
 629                  :tag "Compile options  " :indent 4
 630                  (list :tag "Compiler" :indent 6
 631                        ,(let ((alist vhdl-compiler-alist) list)
 632                           (while alist
 633                             (push (list 'const (caar alist)) list)
 634                             (setq alist (cdr alist)))
 635                           (append '(choice :tag "Compiler name")
 636                                   (nreverse list)))
 637                        (string :tag "Compile options" "\\2")
 638                        (string :tag "Make options   " "\\2")
 639                        (repeat
 640                         :tag "Exceptions   " :indent 8
 641                         (cons :format "%v"
 642                               (regexp :tag "File name regexp    ")
 643                               (choice :format "%[Value Menu%] %v"
 644                                       (string :tag "Options" "\\3")
 645                                       (const :tag "Do not compile" nil))))))
 646                 (directory :tag "Compile directory"
 647                            :validate vhdl-widget-directory-validate "./")
 648                 (string :tag "Library name     " "work")
 649                 (directory :tag "Library directory"
 650                            :validate vhdl-widget-directory-validate "work/")
 651                 (file :tag "Makefile name    " "Makefile")
 652                 (string :tag "Description: (type `C-j' for newline)"
 653                         :format "%t\n%v\n")))
 654   :set (lambda (variable value)
 655          (vhdl-custom-set variable value
 656                           'vhdl-update-mode-menu
 657                           'vhdl-speedbar-refresh))
 658   :group 'vhdl-project)
 659
 660 (defcustom vhdl-project nil
 661   "Specifies the default for the current project.
 662 Select a project name from the ones defined in option `vhdl-project-alist'.
 663 Is used to determine the project title and description to be inserted in file
 664 headers and the source files/directories to be scanned in the hierarchy
 665 browser.  The current project can also be changed temporarily in the menu."
 666   :type (let ((alist vhdl-project-alist) list)
 667           (while alist
 668             (push (list 'const (caar alist)) list)
 669             (setq alist (cdr alist)))
 670           (append '(choice (const :tag "None" nil) (const :tag "--"))
 671                   (nreverse list)))
 672   :group 'vhdl-project)
 673
 674 (defcustom vhdl-project-file-name '("\\1.prj")
 675   "List of file names/paths for importing/exporting project setups.
 676 \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
 677 replaced by the user name (allows you to have user-specific project setups).
 678 The first entry is used as file name to import/export individual project
 679 setups.  All entries are used to automatically import project setups at
 680 startup (see option `vhdl-project-auto-load').  Projects loaded from the
 681 first entry are automatically made current.  Hint: specify local project
 682 setups in first entry, global setups in following entries; loading a local
 683 project setup will make it current, while loading the global setups
 684 is done without changing the current project.
 685 Names can also have an absolute path (i.e. project setups can be stored
 686 in global directories)."
 687   :type '(repeat (string :tag "File name" "\\1.prj"))
 688   :group 'vhdl-project)
 689
 690 (defcustom vhdl-project-auto-load '(startup)
 691   "Automatically load project setups from files.
 692 All project setup files that match the file names specified in option
 693 `vhdl-project-file-name' are automatically loaded.  The project of the
 694 \(alphabetically) last loaded setup of the first `vhdl-project-file-name'
 695 entry is activated.
 696 A project setup file can be obtained by exporting a project (see menu).
 697   At startup: project setup file is loaded at Emacs startup"
 698   :type '(set (const :tag "At startup" startup))
 699   :group 'vhdl-project)
 700
 701 (defcustom vhdl-project-sort t
 702   "Non-nil means projects are displayed in alphabetical order."
 703   :type 'boolean
 704   :group 'vhdl-project)
 705
 706
 707 (defgroup vhdl-style nil
 708   "Customizations for coding styles."
 709   :group 'vhdl
 710   :group 'vhdl-template
 711   :group 'vhdl-port
 712   :group 'vhdl-compose)
 713
 714 (defcustom vhdl-standard '(93 nil)
 715   "VHDL standards used.
 716 Basic standard:
 717   VHDL'87      : IEEE Std 1076-1987
 718   VHDL'93/02   : IEEE Std 1076-1993/2002
 719   VHDL'08      : IEEE Std 1076-2008
 720 Additional standards:
 721   VHDL-AMS     : IEEE Std 1076.1 (analog-mixed-signal)
 722   Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
 723
 724 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
 725       \"Activate Options\"."
 726   :type '(list (choice :tag "Basic standard"
 727                        (const :tag "VHDL'87" 87)
 728                        (const :tag "VHDL'93/02" 93)
 729                        (const :tag "VHDL'08" 08))
 730                (set :tag "Additional standards" :indent 2
 731                     (const :tag "VHDL-AMS" ams)
 732                     (const :tag "Math packages" math)))
 733   :set (lambda (variable value)
 734          (vhdl-custom-set variable value
 735                           'vhdl-template-map-init
 736                           'vhdl-mode-abbrev-table-init
 737                           'vhdl-template-construct-alist-init
 738                           'vhdl-template-package-alist-init
 739                           'vhdl-update-mode-menu
 740                           'vhdl-words-init 'vhdl-font-lock-init))
 741   :group 'vhdl-style)
 742
 743 (defcustom vhdl-basic-offset 2
 744   "Amount of basic offset used for indentation.
 745 This value is used by + and - symbols in `vhdl-offsets-alist'."
 746   :type 'integer
 747   :group 'vhdl-style)
 748
 749 (defcustom vhdl-upper-case-keywords nil
 750   "Non-nil means convert keywords to upper case.
 751 This is done when typed or expanded or by the fix case functions."
 752   :type 'boolean
 753   :set (lambda (variable value)
 754          (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
 755   :group 'vhdl-style)
 756
 757 (defcustom vhdl-upper-case-types nil
 758   "Non-nil means convert standardized types to upper case.
 759 This is done when expanded or by the fix case functions."
 760   :type 'boolean
 761   :set (lambda (variable value)
 762          (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
 763   :group 'vhdl-style)
 764
 765 (defcustom vhdl-upper-case-attributes nil
 766   "Non-nil means convert standardized attributes to upper case.
 767 This is done when expanded or by the fix case functions."
 768   :type 'boolean
 769   :set (lambda (variable value)
 770          (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
 771   :group 'vhdl-style)
 772
 773 (defcustom vhdl-upper-case-enum-values nil
 774   "Non-nil means convert standardized enumeration values to upper case.
 775 This is done when expanded or by the fix case functions."
 776   :type 'boolean
 777   :set (lambda (variable value)
 778          (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
 779   :group 'vhdl-style)
 780
 781 (defcustom vhdl-upper-case-constants t
 782   "Non-nil means convert standardized constants to upper case.
 783 This is done when expanded."
 784   :type 'boolean
 785   :set (lambda (variable value)
 786          (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
 787   :group 'vhdl-style)
 788
 789 (defcustom vhdl-use-direct-instantiation 'standard
 790   "Non-nil means use VHDL'93 direct component instantiation.
 791   Never   : never
 792   Standard: only in VHDL standards that allow it (VHDL'93 and higher)
 793   Always  : always"
 794   :type '(choice (const :tag "Never" never)
 795                  (const :tag "Standard" standard)
 796                  (const :tag "Always" always))
 797   :group 'vhdl-style)
 798
 799 (defcustom vhdl-array-index-record-field-in-sensitivity-list t
 800   "Non-nil means include array indices / record fields in sensitivity list.
 801 If a signal read in a process is a record field or pointed to by an array
 802 index, the record field or array index is included with the record name in
 803 the sensitivity list (e.g. \"in1(0)\", \"in2.f0\").
 804 Otherwise, only the record name is included (e.g. \"in1\", \"in2\")."
 805   :type 'boolean
 806   :version "24.3"
 807   :group 'vhdl-style)
 808
 809 (defgroup vhdl-naming nil
 810   "Customizations for naming conventions."
 811   :group 'vhdl)
 812
 813 (defcustom vhdl-entity-file-name '(".*" . "\\&")
 814   (concat
 815    "Specifies how the entity file name is obtained.
 816 The entity file name can be obtained by modifying the entity name (e.g.
 817 attaching or stripping off a substring).  The file extension is automatically
 818 taken from the file name of the current buffer."
 819    vhdl-name-doc-string)
 820   :type '(cons (regexp :tag "From regexp")
 821                (string :tag "To string  "))
 822   :group 'vhdl-naming
 823   :group 'vhdl-compose)
 824
 825 (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
 826   (concat
 827    "Specifies how the architecture file name is obtained.
 828 The architecture file name can be obtained by modifying the entity
 829 and/or architecture name (e.g. attaching or stripping off a substring).  The
 830 file extension is automatically taken from the file name of the current
 831 buffer.  The string that is matched against the regexp is the concatenation
 832 of the entity and the architecture name separated by a space.  This gives
 833 access to both names (see default setting as example)."
 834    vhdl-name-doc-string)
 835   :type '(cons (regexp :tag "From regexp")
 836                (string :tag "To string  "))
 837   :group 'vhdl-naming
 838   :group 'vhdl-compose)
 839
 840 (defcustom vhdl-configuration-file-name '(".*" . "\\&")
 841   (concat
 842    "Specifies how the configuration file name is obtained.
 843 The configuration file name can be obtained by modifying the configuration
 844 name (e.g. attaching or stripping off a substring).  The file extension is
 845 automatically taken from the file name of the current buffer."
 846    vhdl-name-doc-string)
 847   :type '(cons (regexp :tag "From regexp")
 848                (string :tag "To string  "))
 849   :group 'vhdl-naming
 850   :group 'vhdl-compose)
 851
 852 (defcustom vhdl-package-file-name '(".*" . "\\&")
 853   (concat
 854    "Specifies how the package file name is obtained.
 855 The package file name can be obtained by modifying the package name (e.g.
 856 attaching or stripping off a substring).  The file extension is automatically
 857 taken from the file name of the current buffer.  Package files can be created
 858 in a different directory by prepending a relative or absolute path to the
 859 file name."
 860    vhdl-name-doc-string)
 861   :type '(cons (regexp :tag "From regexp")
 862                (string :tag "To string  "))
 863   :group 'vhdl-naming
 864   :group 'vhdl-compose)
 865
 866 (defcustom vhdl-file-name-case 'identity
 867   "Specifies how to change case for obtaining file names.
 868 When deriving a file name from a VHDL unit name, case can be changed as
 869 follows:
 870   As Is:      case is not changed (taken as is)
 871   Lower Case: whole name is changed to lower case
 872   Upper Case: whole name is changed to upper case
 873   Capitalize: first letter of each word in name is capitalized"
 874   :type '(choice (const :tag "As Is" identity)
 875                  (const :tag "Lower Case" downcase)
 876                  (const :tag "Upper Case" upcase)
 877                  (const :tag "Capitalize" capitalize))
 878   :group 'vhdl-naming
 879   :group 'vhdl-compose)
 880
 881
 882 (defgroup vhdl-template nil
 883   "Customizations for electrification."
 884   :group 'vhdl)
 885
 886 (defcustom vhdl-electric-keywords '(vhdl user)
 887   "Type of keywords for which electrification is enabled.
 888   VHDL keywords: invoke built-in templates
 889   User keywords: invoke user models (see option `vhdl-model-alist')"
 890   :type '(set (const :tag "VHDL keywords" vhdl)
 891               (const :tag "User model keywords" user))
 892   :set (lambda (variable value)
 893          (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
 894   :group 'vhdl-template)
 895
 896 (defcustom vhdl-optional-labels 'process
 897   "Constructs for which labels are to be queried.
 898 Template generators prompt for optional labels for:
 899   None          : no constructs
 900   Processes only: processes only (also procedurals in VHDL-AMS)
 901   All constructs: all constructs with optional labels and keyword END"
 902   :type '(choice (const :tag "None" none)
 903                  (const :tag "Processes only" process)
 904                  (const :tag "All constructs" all))
 905   :group 'vhdl-template)
 906
 907 (defcustom vhdl-insert-empty-lines 'unit
 908   "Specifies whether to insert empty lines in some templates.
 909 This improves readability of code.  Empty lines are inserted in:
 910   None             : no constructs
 911   Design units only: entities, architectures, configurations, packages only
 912   All constructs   : also all constructs with BEGIN...END parts
 913
 914 Replaces option `vhdl-additional-empty-lines'."
 915   :type '(choice (const :tag "None" none)
 916                  (const :tag "Design units only" unit)
 917                  (const :tag "All constructs" all))
 918   :group 'vhdl-template
 919   :group 'vhdl-port
 920   :group 'vhdl-compose)
 921
 922 (defcustom vhdl-argument-list-indent nil
 923   "Non-nil means indent argument lists relative to opening parenthesis.
 924 That is, argument, association, and port lists start on the same line as the
 925 opening parenthesis and subsequent lines are indented accordingly.
 926 Otherwise, lists start on a new line and are indented as normal code."
 927   :type 'boolean
 928   :group 'vhdl-template
 929   :group 'vhdl-port
 930   :group 'vhdl-compose)
 931
 932 (defcustom vhdl-association-list-with-formals t
 933   "Non-nil means write association lists with formal parameters.
 934 Templates prompt for formal and actual parameters (ports/generics).
 935 When pasting component instantiations, formals are included.
 936 If nil, only a list of actual parameters is entered."
 937   :type 'boolean
 938   :group 'vhdl-template
 939   :group 'vhdl-port
 940   :group 'vhdl-compose)
 941
 942 (defcustom vhdl-conditions-in-parenthesis nil
 943   "Non-nil means place parenthesis around condition expressions."
 944   :type 'boolean
 945   :group 'vhdl-template)
 946
 947 (defcustom vhdl-sensitivity-list-all t
 948   "Non-nil means use 'all' keyword in sensitivity list."
 949   :version "25.1"
 950   :type 'boolean
 951   :group 'vhdl-template)
 952
 953 (defcustom vhdl-zero-string "'0'"
 954   "String to use for a logic zero."
 955   :type 'string
 956   :group 'vhdl-template)
 957
 958 (defcustom vhdl-one-string "'1'"
 959   "String to use for a logic one."
 960   :type 'string
 961   :group 'vhdl-template)
 962
 963
 964 (defgroup vhdl-header nil
 965   "Customizations for file header."
 966   :group 'vhdl-template
 967   :group 'vhdl-compose)
 968
 969 (defcustom vhdl-file-header "\
 970 -------------------------------------------------------------------------------
 971 -- Title      : <title string>
 972 -- Project    : <project>
 973 -------------------------------------------------------------------------------
 974 -- File       : <filename>
 975 -- Author     : <author>
 976 -- Company    : <company>
 977 -- Created    : <date>
 978 -- Last update: <date>
 979 -- Platform   : <platform>
 980 -- Standard   : <standard>
 981 <projectdesc>-------------------------------------------------------------------------------
 982 -- Description: <cursor>
 983 <copyright>-------------------------------------------------------------------------------
 984 -- Revisions  :
 985 -- Date        Version  Author  Description
 986 -- <date>  1.0      <login>\tCreated
 987 -------------------------------------------------------------------------------
 988
 989 "
 990   "String or file to insert as file header.
 991 If the string specifies an existing file name, the contents of the file is
 992 inserted, otherwise the string itself is inserted as file header.
 993 Type `C-j' for newlines.
 994 If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS>
 995 if the header needs to be version controlled.
 996
 997 The following keywords for template generation are supported:
 998   <filename>    : replaced by the name of the buffer
 999   <author>      : replaced by the user name and email address
1000                   \(`user-full-name',`mail-host-address', `user-mail-address')
1001   <authorfull>  : replaced by the user full name (`user-full-name')
1002   <login>       : replaced by user login name (`user-login-name')
1003   <company>     : replaced by contents of option `vhdl-company-name'
1004   <date>        : replaced by the current date
1005   <year>        : replaced by the current year
1006   <project>     : replaced by title of current project (`vhdl-project')
1007   <projectdesc> : replaced by description of current project (`vhdl-project')
1008   <copyright>   : replaced by copyright string (`vhdl-copyright-string')
1009   <platform>    : replaced by contents of option `vhdl-platform-spec'
1010   <standard>    : replaced by the VHDL language standard(s) used
1011   <... string>  : replaced by a queried string (\"...\" is the prompt word)
1012   <title string>: replaced by file title in automatically generated files
1013   <cursor>      : final cursor position
1014
1015 The (multi-line) project description <projectdesc> can be used as a project
1016 dependent part of the file header and can also contain the above keywords."
1017   :type 'string
1018   :group 'vhdl-header)
1019
1020 (defcustom vhdl-file-footer ""
1021   "String or file to insert as file footer.
1022 If the string specifies an existing file name, the contents of the file is
1023 inserted, otherwise the string itself is inserted as file footer (i.e. at
1024 the end of the file).
1025 Type `C-j' for newlines.
1026 The same keywords as in option `vhdl-file-header' can be used."
1027   :type 'string
1028   :group 'vhdl-header)
1029
1030 (defcustom vhdl-company-name ""
1031   "Name of company to insert in file header.
1032 See option `vhdl-file-header'."
1033   :type 'string
1034   :group 'vhdl-header)
1035
1036 (defcustom vhdl-copyright-string "\
1037 -------------------------------------------------------------------------------
1038 -- Copyright (c) <year> <company>
1039 "
1040   "Copyright string to insert in file header.
1041 Can be multi-line string (type `C-j' for newline) and contain other file
1042 header keywords (see option `vhdl-file-header')."
1043   :type 'string
1044   :group 'vhdl-header)
1045
1046 (defcustom vhdl-platform-spec ""
1047   "Specification of VHDL platform to insert in file header.
1048 The platform specification should contain names and versions of the
1049 simulation and synthesis tools used.
1050 See option `vhdl-file-header'."
1051   :type 'string
1052   :group 'vhdl-header)
1053
1054 (defcustom vhdl-date-format "%Y-%m-%d"
1055   "Specifies the date format to use in the header.
1056 This string is passed as argument to the command `format-time-string'.
1057 For more information on format strings, see the documentation for the
1058 `format-time-string' command (C-h f `format-time-string')."
1059   :type 'string
1060   :group 'vhdl-header)
1061
1062 (defcustom vhdl-modify-date-prefix-string "-- Last update: "
1063   "Prefix string of modification date in VHDL file header.
1064 If actualization of the modification date is called (menu,
1065 `\\[vhdl-template-modify]'), this string is searched and the rest
1066 of the line replaced by the current date."
1067   :type 'string
1068   :group 'vhdl-header)
1069
1070 (defcustom vhdl-modify-date-on-saving t
1071   "Non-nil means update the modification date when the buffer is saved.
1072 Calls function `\\[vhdl-template-modify]').
1073
1074 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1075       \"Activate Options\"."
1076   :type 'boolean
1077   :group 'vhdl-header)
1078
1079
1080 (defgroup vhdl-sequential-process nil
1081   "Customizations for sequential processes."
1082   :group 'vhdl-template)
1083
1084 (defcustom vhdl-reset-kind 'async
1085   "Specifies which kind of reset to use in sequential processes."
1086   :type '(choice (const :tag "None" none)
1087                  (const :tag "Synchronous" sync)
1088                  (const :tag "Asynchronous" async)
1089                  (const :tag "Query" query))
1090   :group 'vhdl-sequential-process)
1091
1092 (defcustom vhdl-reset-active-high nil
1093   "Non-nil means reset in sequential processes is active high.
1094 Otherwise, reset is active low."
1095   :type 'boolean
1096   :group 'vhdl-sequential-process)
1097
1098 (defcustom vhdl-clock-rising-edge t
1099   "Non-nil means rising edge of clock triggers sequential processes.
1100 Otherwise, falling edge triggers."
1101   :type 'boolean
1102   :group 'vhdl-sequential-process)
1103
1104 (defcustom vhdl-clock-edge-condition 'standard
1105   "Syntax of the clock edge condition.
1106   Standard: \"clk'event and clk = '1'\"
1107   Function: \"rising_edge(clk)\""
1108   :type '(choice (const :tag "Standard" standard)
1109                  (const :tag "Function" function))
1110   :group 'vhdl-sequential-process)
1111
1112 (defcustom vhdl-clock-name ""
1113   "Name of clock signal to use in templates."
1114   :type 'string
1115   :group 'vhdl-sequential-process)
1116
1117 (defcustom vhdl-reset-name ""
1118   "Name of reset signal to use in templates."
1119   :type 'string
1120   :group 'vhdl-sequential-process)
1121
1122
1123 (defgroup vhdl-model nil
1124   "Customizations for user models."
1125   :group 'vhdl)
1126
1127 (defcustom vhdl-model-alist
1128   '(("Example Model"
1129      "<label> : process (<clock>, <reset>)
1130 begin  -- process <label>
1131   if <reset> = '0' then  -- asynchronous reset (active low)
1132     <cursor>
1133   elsif <clock>'event and <clock> = '1' then  -- rising clock edge
1134     if <enable> = '1' then  -- synchronous load
1135
1136     end if;
1137   end if;
1138 end process <label>;"
1139      "e" ""))
1140   "List of user models.
1141 VHDL models (templates) can be specified by the user in this list.  They can be
1142 invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1143 electrification (i.e. overriding existing or creating new keywords, see
1144 option `vhdl-electric-keywords').
1145   Name       : name of model (string of words and spaces)
1146   String     : string or name of file to be inserted as model (newline: `C-j')
1147   Key Binding: key binding to invoke model, added to prefix `C-c C-m'
1148                 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\")
1149   Keyword    : keyword to invoke model
1150
1151 The models can contain prompts to be queried.  A prompt is of the form \"<...>\".
1152 A prompt that appears several times is queried once and replaced throughout
1153 the model.  Special prompts are:
1154   <clock> : name specified in `vhdl-clock-name' (if not empty)
1155   <reset> : name specified in `vhdl-reset-name' (if not empty)
1156   <cursor>: final cursor position
1157 File header prompts (see variable `vhdl-file-header') are automatically
1158 replaced, so that user models can also be used to insert different types of
1159 headers.
1160
1161 If the string specifies an existing file name, the contents of the file is
1162 inserted, otherwise the string itself is inserted.
1163 The code within the models should be correctly indented.
1164 Type `C-j' for newlines.
1165
1166 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1167       \"Activate Options\"."
1168   :type '(repeat (list :tag "Model" :indent 2
1169                        (string :tag "Name       ")
1170                        (string :tag "String     : (type `C-j' for newline)"
1171                                :format "%t\n%v")
1172                        (sexp   :tag "Key binding" x)
1173                        (string :tag "Keyword    " :format "%t: %v\n")))
1174   :set (lambda (variable value)
1175          (vhdl-custom-set variable value
1176                           'vhdl-model-map-init
1177                           'vhdl-model-defun
1178                           'vhdl-mode-abbrev-table-init
1179                           'vhdl-update-mode-menu))
1180   :group 'vhdl-model)
1181
1182
1183 (defgroup vhdl-compose nil
1184   "Customizations for structural composition."
1185   :group 'vhdl)
1186
1187 (defcustom vhdl-compose-architecture-name '(".*" . "str")
1188   (concat
1189    "Specifies how the component architecture name is obtained.
1190 The component architecture name can be obtained by modifying the entity name
1191 \(e.g. attaching or stripping off a substring).
1192 If TO STRING is empty, the architecture name is queried."
1193    vhdl-name-doc-string)
1194   :type '(cons (regexp :tag "From regexp")
1195                (string :tag "To string  "))
1196   :group 'vhdl-compose)
1197
1198 (defcustom vhdl-compose-configuration-name
1199   '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
1200   (concat
1201    "Specifies how the configuration name is obtained.
1202 The configuration name can be obtained by modifying the entity and/or
1203 architecture name (e.g. attaching or stripping off a substring).  The string
1204 that is matched against the regexp is the concatenation of the entity and the
1205 architecture name separated by a space.  This gives access to both names (see
1206 default setting as example)."
1207    vhdl-name-doc-string)
1208   :type '(cons (regexp :tag "From regexp")
1209                (string :tag "To string  "))
1210   :group 'vhdl-compose)
1211
1212 (defcustom vhdl-components-package-name
1213   '((".*" . "\\&_components") . "components")
1214   (concat
1215    "Specifies how the name for the components package is obtained.
1216 The components package is a package containing all component declarations for
1217 the current design.  Its name can be obtained by modifying the project name
1218 \(e.g. attaching or stripping off a substring).  If no project is defined, the
1219 DIRECTORY entry is chosen."
1220    vhdl-name-doc-string)
1221   :type '(cons (cons :tag "Project" :indent 2
1222                      (regexp :tag "From regexp")
1223                      (string :tag "To string  "))
1224                (string :tag "Directory:\n  String     "))
1225   :group 'vhdl-compose)
1226
1227 (defcustom vhdl-use-components-package nil
1228   "Non-nil means use a separate components package for component declarations.
1229 Otherwise, component declarations are inserted and searched for in the
1230 architecture declarative parts."
1231   :type 'boolean
1232   :group 'vhdl-compose)
1233
1234 (defcustom vhdl-compose-include-header t
1235   "Non-nil means include a header in automatically generated files."
1236   :type 'boolean
1237   :group 'vhdl-compose)
1238
1239 (defcustom vhdl-compose-create-files 'single
1240   "Specifies whether new files should be created for the new component.
1241 The component's entity and architecture are inserted:
1242   None          : in current buffer
1243   Single file   : in new single file
1244   Separate files: in two separate files
1245 The file names are obtained from variables `vhdl-entity-file-name' and
1246 `vhdl-architecture-file-name'."
1247   :type '(choice (const :tag "None" none)
1248                  (const :tag "Single file" single)
1249                  (const :tag "Separate files" separate))
1250   :group 'vhdl-compose)
1251
1252 (defcustom vhdl-compose-configuration-create-file nil
1253   "Specifies whether a new file should be created for the configuration.
1254 If non-nil, a new file is created for the configuration.
1255 The file name is obtained from variable `vhdl-configuration-file-name'."
1256   :type 'boolean
1257   :group 'vhdl-compose)
1258
1259 (defcustom vhdl-compose-configuration-hierarchical t
1260   "Specifies whether hierarchical configurations should be created.
1261 If non-nil, automatically created configurations are hierarchical and include
1262 the whole hierarchy of subcomponents.  Otherwise the configuration only
1263 includes one level of subcomponents."
1264   :type 'boolean
1265   :group 'vhdl-compose)
1266
1267 (defcustom vhdl-compose-configuration-use-subconfiguration t
1268   "Specifies whether subconfigurations should be used inside configurations.
1269 If non-nil, automatically created configurations use configurations in binding
1270 indications for subcomponents, if such configurations exist.  Otherwise,
1271 entities are used in binding indications for subcomponents."
1272   :type 'boolean
1273   :group 'vhdl-compose)
1274
1275
1276 (defgroup vhdl-port nil
1277   "Customizations for port translation functions."
1278   :group 'vhdl
1279   :group 'vhdl-compose)
1280
1281 (defcustom vhdl-include-port-comments nil
1282   "Non-nil means include port comments when a port is pasted."
1283   :type 'boolean
1284   :group 'vhdl-port)
1285
1286 (defcustom vhdl-include-direction-comments nil
1287   "Non-nil means include port direction in instantiations as comments."
1288   :type 'boolean
1289   :group 'vhdl-port)
1290
1291 (defcustom vhdl-include-type-comments nil
1292   "Non-nil means include generic/port type in instantiations as comments."
1293   :type 'boolean
1294   :group 'vhdl-port)
1295
1296 (defcustom vhdl-include-group-comments 'never
1297   "Specifies whether to include group comments and spacings.
1298 The comments and empty lines between groups of ports are pasted:
1299   Never       : never
1300   Declarations: in entity/component/constant/signal declarations only
1301   Always      : also in generic/port maps"
1302   :type '(choice (const :tag "Never" never)
1303                  (const :tag "Declarations" decl)
1304                  (const :tag "Always" always))
1305   :group 'vhdl-port)
1306
1307 (defcustom vhdl-actual-generic-name '(".*" . "\\&")
1308   (concat
1309    "Specifies how actual generic names are obtained from formal generic names.
1310 In a component instantiation, an actual generic name can be
1311 obtained by modifying the formal generic name (e.g. attaching or stripping
1312 off a substring)."
1313    vhdl-name-doc-string)
1314   :type '(cons (regexp :tag "From regexp")
1315                (string :tag "To string  "))
1316   :group 'vhdl-port
1317   :version "24.4")
1318
1319 (defcustom vhdl-actual-port-name '(".*" . "\\&")
1320   (concat
1321    "Specifies how actual port names are obtained from formal port names.
1322 In a component instantiation, an actual port name can be obtained by
1323 modifying the formal port name (e.g. attaching or stripping off a substring)."
1324    vhdl-name-doc-string)
1325   :type '(cons (regexp :tag "From regexp")
1326                (string :tag "To string  "))
1327   :group 'vhdl-port)
1328
1329 (defcustom vhdl-instance-name '(".*" . "\\&_%d")
1330   (concat
1331    "Specifies how an instance name is obtained.
1332 The instance name can be obtained by modifying the name of the component to be
1333 instantiated (e.g. attaching or stripping off a substring).  \"%d\" is replaced
1334 by a unique number (starting with 1).
1335 If TO STRING is empty, the instance name is queried."
1336    vhdl-name-doc-string)
1337   :type '(cons (regexp :tag "From regexp")
1338                (string :tag "To string  "))
1339   :group 'vhdl-port)
1340
1341
1342 (defgroup vhdl-testbench nil
1343   "Customizations for testbench generation."
1344   :group 'vhdl-port)
1345
1346 (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
1347   (concat
1348    "Specifies how the testbench entity name is obtained.
1349 The entity name of a testbench can be obtained by modifying the name of
1350 the component to be tested (e.g. attaching or stripping off a substring)."
1351    vhdl-name-doc-string)
1352   :type '(cons (regexp :tag "From regexp")
1353                (string :tag "To string  "))
1354   :group 'vhdl-testbench)
1355
1356 (defcustom vhdl-testbench-architecture-name '(".*" . "")
1357   (concat
1358    "Specifies how the testbench architecture name is obtained.
1359 The testbench architecture name can be obtained by modifying the name of
1360 the component to be tested (e.g. attaching or stripping off a substring).
1361 If TO STRING is empty, the architecture name is queried."
1362    vhdl-name-doc-string)
1363   :type '(cons (regexp :tag "From regexp")
1364                (string :tag "To string  "))
1365   :group 'vhdl-testbench)
1366
1367 (defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name
1368   (concat
1369    "Specifies how the testbench configuration name is obtained.
1370 The configuration name of a testbench can be obtained by modifying the entity
1371 and/or architecture name (e.g. attaching or stripping off a substring).  The
1372 string that is matched against the regexp is the concatenation of the entity
1373 and the architecture name separated by a space.  This gives access to both
1374 names (see default setting as example)."
1375    vhdl-name-doc-string)
1376   :type '(cons (regexp :tag "From regexp")
1377                (string :tag "To string  "))
1378   :group 'vhdl-testbench)
1379
1380 (defcustom vhdl-testbench-dut-name '(".*" . "DUT")
1381   (concat
1382    "Specifies how a DUT instance name is obtained.
1383 The design-under-test instance name (i.e. the component instantiated in the
1384 testbench) can be obtained by modifying the component name (e.g. attaching
1385 or stripping off a substring)."
1386    vhdl-name-doc-string)
1387   :type '(cons (regexp :tag "From regexp")
1388                (string :tag "To string  "))
1389   :group 'vhdl-testbench)
1390
1391 (defcustom vhdl-testbench-include-header t
1392   "Non-nil means include a header in automatically generated files."
1393   :type 'boolean
1394   :group 'vhdl-testbench)
1395
1396 (defcustom vhdl-testbench-declarations "\
1397   -- clock
1398   signal Clk : std_logic := '1';
1399 "
1400   "String or file to be inserted in the testbench declarative part.
1401 If the string specifies an existing file name, the contents of the file is
1402 inserted, otherwise the string itself is inserted in the testbench
1403 architecture before the BEGIN keyword.
1404 Type `C-j' for newlines."
1405   :type 'string
1406   :group 'vhdl-testbench)
1407
1408 (defcustom vhdl-testbench-statements "\
1409   -- clock generation
1410   Clk <= not Clk after 10 ns;
1411
1412   -- waveform generation
1413   WaveGen_Proc: process
1414   begin
1415     -- insert signal assignments here
1416
1417     wait until Clk = '1';
1418   end process WaveGen_Proc;
1419 "
1420   "String or file to be inserted in the testbench statement part.
1421 If the string specifies an existing file name, the contents of the file is
1422 inserted, otherwise the string itself is inserted in the testbench
1423 architecture before the END keyword.
1424 Type `C-j' for newlines."
1425   :type 'string
1426   :group 'vhdl-testbench)
1427
1428 (defcustom vhdl-testbench-initialize-signals nil
1429   "Non-nil means initialize signals with `0' when declared in testbench."
1430   :type 'boolean
1431   :group 'vhdl-testbench)
1432
1433 (defcustom vhdl-testbench-include-library t
1434   "Non-nil means a library/use clause for std_logic_1164 is included."
1435   :type 'boolean
1436   :group 'vhdl-testbench)
1437
1438 (defcustom vhdl-testbench-include-configuration t
1439   "Non-nil means a testbench configuration is attached at the end."
1440   :type 'boolean
1441   :group 'vhdl-testbench)
1442
1443 (defcustom vhdl-testbench-create-files 'single
1444   "Specifies whether new files should be created for the testbench.
1445 testbench entity and architecture are inserted:
1446   None          : in current buffer
1447   Single file   : in new single file
1448   Separate files: in two separate files
1449 The file names are obtained from variables `vhdl-testbench-entity-file-name'
1450 and `vhdl-testbench-architecture-file-name'."
1451   :type '(choice (const :tag "None" none)
1452                  (const :tag "Single file" single)
1453                  (const :tag "Separate files" separate))
1454   :group 'vhdl-testbench)
1455
1456 (defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name
1457   (concat
1458    "Specifies how the testbench entity file name is obtained.
1459 The entity file name can be obtained by modifying the testbench entity name
1460 \(e.g. attaching or stripping off a substring).  The file extension is
1461 automatically taken from the file name of the current buffer.  Testbench
1462 files can be created in a different directory by prepending a relative or
1463 absolute path to the file name."
1464    vhdl-name-doc-string)
1465   :type '(cons (regexp :tag "From regexp")
1466                (string :tag "To string  "))
1467   :group 'vhdl-testbench)
1468
1469 (defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name
1470   (concat
1471    "Specifies how the testbench architecture file name is obtained.
1472 The architecture file name can be obtained by modifying the testbench entity
1473 and/or architecture name (e.g. attaching or stripping off a substring).  The
1474 string that is matched against the regexp is the concatenation of the entity
1475 and the architecture name separated by a space.  This gives access to both
1476 names (see default setting as example).  Testbench files can be created in
1477 a different directory by prepending a relative or absolute path to the file
1478 name."
1479    vhdl-name-doc-string)
1480   :type '(cons (regexp :tag "From regexp")
1481                (string :tag "To string  "))
1482   :group 'vhdl-testbench)
1483
1484
1485 (defgroup vhdl-comment nil
1486   "Customizations for comments."
1487   :group 'vhdl)
1488
1489 (defcustom vhdl-self-insert-comments t
1490   "Non-nil means various templates automatically insert help comments."
1491   :type 'boolean
1492   :group 'vhdl-comment)
1493
1494 (defcustom vhdl-prompt-for-comments t
1495   "Non-nil means various templates prompt for user definable comments."
1496   :type 'boolean
1497   :group 'vhdl-comment)
1498
1499 (defcustom vhdl-inline-comment-column 40
1500   "Column to indent and align inline comments to.
1501 Overrides local option `comment-column'.
1502
1503 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1504       \"Activate Options\"."
1505   :type 'integer
1506   :group 'vhdl-comment)
1507
1508 (defcustom vhdl-end-comment-column 79
1509   "End of comment column.
1510 Comments that exceed this column number are wrapped.
1511
1512 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1513       \"Activate Options\"."
1514   :type 'integer
1515   :group 'vhdl-comment)
1516
1517 (defvar end-comment-column)
1518
1519
1520 (defgroup vhdl-beautify nil
1521   "Customizations for beautification."
1522   :group 'vhdl)
1523
1524 (defcustom vhdl-auto-align t
1525   "Non-nil means align some templates automatically after generation."
1526   :type 'boolean
1527   :group 'vhdl-beautify)
1528
1529 (defcustom vhdl-align-groups t
1530   "Non-nil means align groups of code lines separately.
1531 A group of code lines is a region of consecutive lines between two lines that
1532 match the regexp in option `vhdl-align-group-separate'."
1533   :type 'boolean
1534   :group 'vhdl-beautify)
1535
1536 (defcustom vhdl-align-group-separate "^\\s-*$"
1537   "Regexp for matching a line that separates groups of lines for alignment.
1538 Examples:
1539   \"^\\s-*$\":          matches an empty line
1540   \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1541   :type 'regexp
1542   :group 'vhdl-beautify)
1543
1544 (defcustom vhdl-align-same-indent t
1545   "Non-nil means align blocks with same indent separately.
1546 When a region or the entire buffer is aligned, the code is divided into
1547 blocks of same indent which are aligned separately (except for argument/port
1548 lists).  This gives nicer alignment in most cases.
1549 Option `vhdl-align-groups' still applies within these blocks."
1550   :type 'boolean
1551   :group 'vhdl-beautify)
1552
1553 (defcustom vhdl-beautify-options '(t t t t t)
1554   "List of options for beautifying code.
1555 Allows you to disable individual features of code beautification."
1556   :type '(list (boolean :tag "Whitespace cleanup       ")
1557                (boolean :tag "Single statement per line")
1558                (boolean :tag "Indentation              ")
1559                (boolean :tag "Alignment                ")
1560                (boolean :tag "Case fixing              "))
1561   :group 'vhdl-beautify
1562   :version "24.4")
1563
1564
1565 (defgroup vhdl-highlight nil
1566   "Customizations for highlighting."
1567   :group 'vhdl)
1568
1569 (defcustom vhdl-highlight-keywords t
1570   "Non-nil means highlight VHDL keywords and other standardized words.
1571 The following faces are used:
1572   `font-lock-keyword-face'       : keywords
1573   `font-lock-type-face'          : standardized types
1574   `vhdl-font-lock-attribute-face': standardized attributes
1575   `vhdl-font-lock-enumvalue-face': standardized enumeration values
1576   `vhdl-font-lock-function-face' : standardized function and package names
1577
1578 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1579       entry \"Fontify Buffer\")."
1580   :type 'boolean
1581   :set (lambda (variable value)
1582          (vhdl-custom-set variable value 'vhdl-font-lock-init))
1583   :group 'vhdl-highlight)
1584
1585 (defcustom vhdl-highlight-names t
1586   "Non-nil means highlight declaration names and construct labels.
1587 The following faces are used:
1588   `font-lock-function-name-face' : names in declarations of units,
1589      subprograms, components, as well as labels of VHDL constructs
1590   `font-lock-type-face'          : names in type/nature declarations
1591   `vhdl-font-lock-attribute-face': names in attribute declarations
1592   `font-lock-variable-name-face' : names in declarations of signals,
1593      variables, constants, subprogram parameters, generics, and ports
1594
1595 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1596       entry \"Fontify Buffer\")."
1597   :type 'boolean
1598   :set (lambda (variable value)
1599          (vhdl-custom-set variable value 'vhdl-font-lock-init))
1600   :group 'vhdl-highlight)
1601
1602 (defcustom vhdl-highlight-special-words nil
1603   "Non-nil means highlight words with special syntax.
1604 The words with syntax and color specified in option `vhdl-special-syntax-alist'
1605 are highlighted accordingly.
1606 Can be used for visual support of naming conventions.
1607
1608 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1609       entry \"Fontify Buffer\")."
1610   :type 'boolean
1611   :set (lambda (variable value)
1612          (vhdl-custom-set variable value 'vhdl-font-lock-init))
1613   :group 'vhdl-highlight)
1614
1615 (defcustom vhdl-highlight-forbidden-words nil
1616   "Non-nil means highlight forbidden words.
1617 The reserved words specified in option `vhdl-forbidden-words' or having the
1618 syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1619 warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1620 use them.
1621
1622 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1623       entry \"Fontify Buffer\")."
1624   :type 'boolean
1625   :set (lambda (variable value)
1626          (vhdl-custom-set variable value
1627                           'vhdl-words-init 'vhdl-font-lock-init))
1628   :group 'vhdl-highlight)
1629
1630 (defcustom vhdl-highlight-verilog-keywords nil
1631   "Non-nil means highlight Verilog keywords as reserved words.
1632 Verilog keywords are highlighted in a warning color (face
1633 `vhdl-font-lock-reserved-words-face') to indicate not to use them.
1634
1635 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1636       entry \"Fontify Buffer\")."
1637   :type 'boolean
1638   :set (lambda (variable value)
1639          (vhdl-custom-set variable value
1640                           'vhdl-words-init 'vhdl-font-lock-init))
1641   :group 'vhdl-highlight)
1642
1643 (defcustom vhdl-highlight-translate-off nil
1644   "Non-nil means background-highlight code excluded from translation.
1645 That is, all code between \"-- pragma translate_off\" and
1646 \"-- pragma translate_on\" is highlighted using a different background color
1647 \(face `vhdl-font-lock-translate-off-face').
1648 Note: this might slow down on-the-fly fontification (and thus editing).
1649
1650 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1651       entry \"Fontify Buffer\")."
1652   :type 'boolean
1653   :set (lambda (variable value)
1654          (vhdl-custom-set variable value 'vhdl-font-lock-init))
1655   :group 'vhdl-highlight)
1656
1657 (defcustom vhdl-highlight-case-sensitive nil
1658   "Non-nil means consider case for highlighting.
1659 Possible trade-off:
1660   non-nil  also upper-case VHDL words are highlighted, but case of words with
1661            special syntax is not considered
1662   nil      only lower-case VHDL words are highlighted, but case of words with
1663            special syntax is considered
1664 Overrides local option `font-lock-keywords-case-fold-search'.
1665
1666 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1667       entry \"Fontify Buffer\")."
1668   :type 'boolean
1669   :group 'vhdl-highlight)
1670
1671 (defcustom vhdl-special-syntax-alist
1672   '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil)
1673     ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil)
1674     ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil))
1675   "List of special syntax to be highlighted.
1676 If option `vhdl-highlight-special-words' is non-nil, words with the specified
1677 syntax (as regular expression) are highlighted in the corresponding color.
1678
1679   Name         : string of words and spaces
1680   Regexp       : regular expression describing word syntax
1681                  (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\")
1682                  expression must start with \"\\\\=\<\" and end with \"\\\\=\>\"
1683                  if only whole words should be matched (no substrings)
1684   Color (light): foreground color for light background
1685                  (matching color examples: Gold3, Grey50, LimeGreen, Tomato,
1686                  LightSeaGreen, DodgerBlue, Gold, PaleVioletRed)
1687   Color (dark) : foreground color for dark background
1688                  (matching color examples: BurlyWood1, Grey80, Green, Coral,
1689                  AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1690   In comments  : If non-nil, words are also highlighted inside comments
1691
1692 Can be used for visual support of naming conventions, such as highlighting
1693 different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1694 \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1695 common substrings or name suffices.
1696 For each entry, a new face is generated with the specified colors and name
1697 \"vhdl-font-lock-\" + name + \"-face\".
1698
1699 NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1700       entry \"Fontify Buffer\").  All other changes require restarting Emacs."
1701   :type '(repeat (list :tag "Face" :indent 2
1702                        (string :tag "Name         ")
1703                        (regexp :tag "Regexp       " "\\w+_")
1704                        (string :tag "Color (light)")
1705                        (string :tag "Color (dark) ")
1706                        (boolean :tag "In comments  ")))
1707   :set (lambda (variable value)
1708          (vhdl-custom-set variable value 'vhdl-font-lock-init))
1709   :group 'vhdl-highlight)
1710
1711 (defcustom vhdl-forbidden-words '()
1712   "List of forbidden words to be highlighted.
1713 If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1714 words are highlighted in a warning color to indicate not to use them.
1715
1716 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1717       entry \"Fontify Buffer\")."
1718   :type '(repeat (string :format "%v"))
1719   :set (lambda (variable value)
1720          (vhdl-custom-set variable value
1721                           'vhdl-words-init 'vhdl-font-lock-init))
1722   :group 'vhdl-highlight)
1723
1724 (defcustom vhdl-forbidden-syntax ""
1725   "Syntax of forbidden words to be highlighted.
1726 If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1727 syntax are highlighted in a warning color to indicate not to use them.
1728 Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1729 highlights identifiers with 10 or more characters).
1730
1731 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1732       entry \"Fontify Buffer\")."
1733   :type 'regexp
1734   :set (lambda (variable value)
1735          (vhdl-custom-set variable value
1736                           'vhdl-words-init 'vhdl-font-lock-init))
1737   :group 'vhdl-highlight)
1738
1739 (defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys")
1740   "List of compiler directive keywords recognized for highlighting.
1741
1742 NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1743       entry \"Fontify Buffer\")."
1744   :type '(repeat (string :format "%v"))
1745   :set (lambda (variable value)
1746          (vhdl-custom-set variable value
1747                           'vhdl-words-init 'vhdl-font-lock-init))
1748   :group 'vhdl-highlight)
1749
1750
1751 (defgroup vhdl-speedbar nil
1752   "Customizations for speedbar."
1753   :group 'vhdl)
1754
1755 (defcustom vhdl-speedbar-auto-open nil
1756   "Non-nil means automatically open speedbar at startup.
1757 Alternatively, the speedbar can be opened from the VHDL menu."
1758   :type 'boolean
1759   :group 'vhdl-speedbar)
1760
1761 (defcustom vhdl-speedbar-display-mode 'files
1762   "Specifies the default displaying mode when opening speedbar.
1763 Alternatively, the displaying mode can be selected from the speedbar menu or
1764 by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1765   :type '(choice (const :tag "Files" files)
1766                  (const :tag "Directory hierarchy" directory)
1767                  (const :tag "Project hierarchy" project))
1768   :group 'vhdl-speedbar)
1769
1770 (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
1771   "Limits scanning of large files and netlists.
1772 Design units: maximum file size to scan for design units
1773 Hierarchy (instances of subcomponents):
1774   File size: maximum file size to scan for instances (in bytes)
1775   Instances per arch: maximum number of instances to scan per architecture
1776
1777 \"None\" always means that there is no limit.
1778 In case of files not or incompletely scanned, a warning message and the file
1779 names are printed out.
1780 Background: scanning for instances is considerably slower than scanning for
1781 design units, especially when there are many instances.  These limits should
1782 prevent the scanning of large netlists."
1783   :type '(list (choice :tag "Design units"
1784                        :format "%t        : %[Value Menu%] %v"
1785                        (const :tag "None" nil)
1786                        (integer :tag "File size"))
1787                (list :tag "Hierarchy" :indent 2
1788                      (choice :tag "File size"
1789                              :format "%t         : %[Value Menu%] %v"
1790                              (const :tag "None" nil)
1791                              (integer :tag "Size     "))
1792                      (choice :tag "Instances per arch"
1793                              (const :tag "None" nil)
1794                              (integer :tag "Number   "))))
1795   :group 'vhdl-speedbar)
1796
1797 (defcustom vhdl-speedbar-jump-to-unit t
1798   "Non-nil means jump to the design unit code when opened in a buffer.
1799 The buffer cursor position is left unchanged otherwise."
1800   :type 'boolean
1801   :group 'vhdl-speedbar)
1802
1803 (defcustom vhdl-speedbar-update-on-saving t
1804   "Automatically update design hierarchy when buffer is saved."
1805   :type 'boolean
1806   :group 'vhdl-speedbar)
1807
1808 (defcustom vhdl-speedbar-save-cache '(hierarchy display)
1809   "Automatically save modified hierarchy caches when exiting Emacs.
1810   Hierarchy: design hierarchy information
1811   Display:   displaying information (which design units to expand)"
1812   :type '(set (const :tag "Hierarchy" hierarchy)
1813               (const :tag "Display"   display))
1814   :group 'vhdl-speedbar)
1815
1816 (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
1817   "Name of file for saving hierarchy cache.
1818 \"\\1\" is replaced by the project name if a project is specified,
1819 \"directory\" otherwise.  \"\\2\" is replaced by the user name (allows for
1820 different users to have cache files in the same directory). Can also have
1821 an absolute path (i.e. all caches can be stored in one global directory)."
1822   :type 'string
1823   :group 'vhdl-speedbar)
1824
1825
1826 (defgroup vhdl-menu nil
1827   "Customizations for menus."
1828   :group 'vhdl)
1829
1830 (defcustom vhdl-index-menu nil
1831   "Non-nil means add an index menu for a source file when loading.
1832 Alternatively, the speedbar can be used.  Note that the index menu scans a file
1833 when it is opened, while speedbar only scans the file upon request."
1834   :type 'boolean
1835   :group 'vhdl-menu)
1836
1837 (defcustom vhdl-source-file-menu nil
1838   "Non-nil means add a menu of all source files in current directory.
1839 Alternatively, the speedbar can be used."
1840   :type 'boolean
1841   :group 'vhdl-menu)
1842
1843 (defcustom vhdl-hideshow-menu nil
1844   "Non-nil means add hideshow menu and functionality at startup.
1845 Hideshow can also be enabled from the VHDL Mode menu.
1846 Hideshow allows hiding code of various VHDL constructs.
1847
1848 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1849       \"Activate Options\"."
1850   :type 'boolean
1851   :group 'vhdl-menu)
1852
1853 (defcustom vhdl-hide-all-init nil
1854   "Non-nil means hide all design units initially after a file is loaded."
1855   :type 'boolean
1856   :group 'vhdl-menu)
1857
1858
1859 (defgroup vhdl-print nil
1860   "Customizations for printing."
1861   :group 'vhdl)
1862
1863 (defcustom vhdl-print-two-column t
1864   "Non-nil means print code in two columns and landscape format.
1865 Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
1866 prints VHDL files in a nice two-column landscape style.
1867
1868 NOTE: Activate the new setting by restarting Emacs.
1869       Overrides `ps-print' settings locally."
1870   :type 'boolean
1871   :group 'vhdl-print)
1872
1873 (defcustom vhdl-print-customize-faces t
1874   "Non-nil means use an optimized set of faces for PostScript printing.
1875
1876 NOTE: Activate the new setting by restarting Emacs.
1877       Overrides `ps-print' settings locally."
1878   :type 'boolean
1879   :group 'vhdl-print)
1880
1881
1882 (defgroup vhdl-misc nil
1883   "Miscellaneous customizations."
1884   :group 'vhdl)
1885
1886 (defcustom vhdl-intelligent-tab t
1887   "Non-nil means `TAB' does indentation, word completion and tab insertion.
1888 That is, if preceding character is part of a word then complete word,
1889 else if not at beginning of line then insert tab,
1890 else if last command was a `TAB' or `RET' then dedent one step,
1891 else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1892 If nil, TAB always indents current line (i.e. `TAB' is bound to
1893 `indent-according-to-mode').
1894
1895 NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1896       \"Activate Options\"."
1897   :type 'boolean
1898   :group 'vhdl-misc)
1899
1900 (defcustom vhdl-indent-syntax-based t
1901   "Non-nil means indent lines of code based on their syntactic context.
1902 Otherwise, a line is indented like the previous nonblank line.  This can be
1903 useful in large files where syntax-based indentation gets very slow."
1904   :type 'boolean
1905   :group 'vhdl-misc)
1906
1907 (defcustom vhdl-indent-comment-like-next-code-line t
1908   "Non-nil means comment lines are indented like the following code line.
1909 Otherwise, comment lines are indented like the preceding code line.
1910 Indenting comment lines like the following code line gives nicer indentation
1911 when comments precede the code that they refer to."
1912   :type 'boolean
1913   :version "24.3"
1914   :group 'vhdl-misc)
1915
1916 (defcustom vhdl-word-completion-case-sensitive nil
1917   "Non-nil means word completion using `TAB' is case sensitive.
1918 That is, `TAB' completes words that start with the same letters and case.
1919 Otherwise, case is ignored."
1920   :type 'boolean
1921   :group 'vhdl-misc)
1922
1923 (defcustom vhdl-word-completion-in-minibuffer t
1924   "Non-nil enables word completion in minibuffer (for template prompts).
1925
1926 NOTE: Activate the new setting by restarting Emacs."
1927   :type 'boolean
1928   :group 'vhdl-misc)
1929
1930 (defcustom vhdl-underscore-is-part-of-word nil
1931   "Non-nil means consider the underscore character `_' as part of word.
1932 An identifier containing underscores is then treated as a single word in
1933 select and move operations.  All parts of an identifier separated by underscore
1934 are treated as single words otherwise."
1935   :type 'boolean
1936   :group 'vhdl-misc)
1937 (make-obsolete-variable 'vhdl-underscore-is-part-of-word
1938                         'superword-mode "24.4")
1939
1940
1941 (defgroup vhdl-related nil
1942   "Related general customizations."
1943   :group 'vhdl)
1944
1945 ;; add related general customizations
1946 (custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
1947 (if (featurep 'xemacs)
1948     (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
1949   (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
1950 (custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
1951 (custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
1952 (custom-add-to-group 'vhdl-related 'comment-style 'custom-variable)
1953 (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
1954 (unless (featurep 'xemacs)
1955   (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
1956 (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
1957 (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
1958 (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
1959
1960 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1961 ;; Hidden user variables
1962
1963 (defvar vhdl-compile-absolute-path nil
1964   "If non-nil, use absolute instead of relative path for compiled files.")
1965
1966 (defvar vhdl-comment-display-line-char ?-
1967   "Character to use in comment display line.")
1968
1969 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1970 ;; Internal variables
1971
1972 (defvar vhdl-menu-max-size 20
1973   "Specifies the maximum size of a menu before splitting it into submenus.")
1974
1975 (defvar vhdl-progress-interval 1
1976   "Interval used to update progress status during long operations.
1977 If a number, percentage complete gets updated after each interval of
1978 that many seconds.  To inhibit all messages, set this option to nil.")
1979
1980 (defvar vhdl-inhibit-startup-warnings-p nil
1981   "If non-nil, inhibits start up compatibility warnings.")
1982
1983 (defvar vhdl-strict-syntax-p nil
1984   "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'.
1985 If the syntactic symbol for a particular line does not match a symbol
1986 in the offsets alist, an error is generated, otherwise no error is
1987 reported and the syntactic symbol is ignored.")
1988
1989 (defvar vhdl-echo-syntactic-information-p nil
1990   "If non-nil, syntactic info is echoed when the line is indented.")
1991
1992 (defconst vhdl-offsets-alist-default
1993   '((string                . -1000)
1994     (cpp-macro             . -1000)
1995     (block-open            . 0)
1996     (block-close           . 0)
1997     (statement             . 0)
1998     (statement-cont        . vhdl-lineup-statement-cont)
1999     (statement-block-intro . +)
2000     (statement-case-intro  . +)
2001     (case-alternative      . +)
2002     (comment               . vhdl-lineup-comment)
2003     (arglist-intro         . +)
2004     (arglist-cont          . 0)
2005     (arglist-cont-nonempty . vhdl-lineup-arglist)
2006     (arglist-close         . vhdl-lineup-arglist)
2007     (entity                . 0)
2008     (configuration         . 0)
2009     (package               . 0)
2010     (architecture          . 0)
2011     (package-body          . 0)
2012     (context               . 0)
2013     (directive             . 0)
2014     )
2015   "Default settings for offsets of syntactic elements.
2016 Do not change this constant!  See the variable `vhdl-offsets-alist' for
2017 more information.")
2018
2019 (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)
2020   "Association list of syntactic element symbols and indentation offsets.
2021 As described below, each cons cell in this list has the form:
2022
2023     (SYNTACTIC-SYMBOL . OFFSET)
2024
2025 When a line is indented, `vhdl-mode' first determines the syntactic
2026 context of the line by generating a list of symbols called syntactic
2027 elements.  This list can contain more than one syntactic element and
2028 the global variable `vhdl-syntactic-context' contains the context list
2029 for the line being indented.  Each element in this list is actually a
2030 cons cell of the syntactic symbol and a buffer position.  This buffer
2031 position is call the relative indent point for the line.  Some
2032 syntactic symbols may not have a relative indent point associated with
2033 them.
2034
2035 After the syntactic context list for a line is generated, `vhdl-mode'
2036 calculates the absolute indentation for the line by looking at each
2037 syntactic element in the list.  First, it compares the syntactic
2038 element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'.  When it
2039 finds a match, it adds the OFFSET to the column of the relative indent
2040 point.  The sum of this calculation for each element in the syntactic
2041 list is the absolute offset for line being indented.
2042
2043 If the syntactic element does not match any in the `vhdl-offsets-alist',
2044 an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise
2045 the element is ignored.
2046
2047 Actually, OFFSET can be an integer, a function, a variable, or one of
2048 the following symbols: `+', `-', `++', or `--'.  These latter
2049 designate positive or negative multiples of `vhdl-basic-offset',
2050 respectively: *1, *-1, *2, and *-2.  If OFFSET is a function, it is
2051 called with a single argument containing the cons of the syntactic
2052 element symbol and the relative indent point.  The function should
2053 return an integer offset.
2054
2055 Here is the current list of valid syntactic element symbols:
2056
2057  string                 -- inside multi-line string
2058  block-open             -- statement block open
2059  block-close            -- statement block close
2060  statement              -- a VHDL statement
2061  statement-cont         -- a continuation of a VHDL statement
2062  statement-block-intro  -- the first line in a new statement block
2063  statement-case-intro   -- the first line in a case alternative block
2064  case-alternative       -- a case statement alternative clause
2065  comment                -- a line containing only a comment
2066  arglist-intro          -- the first line in an argument list
2067  arglist-cont           -- subsequent argument list lines when no
2068                            arguments follow on the same line as
2069                            the arglist opening paren
2070  arglist-cont-nonempty  -- subsequent argument list lines when at
2071                            least one argument follows on the same
2072                            line as the arglist opening paren
2073  arglist-close          -- the solo close paren of an argument list
2074  entity                 -- inside an entity declaration
2075  configuration          -- inside a configuration declaration
2076  package                -- inside a package declaration
2077  architecture           -- inside an architecture body
2078  package-body           -- inside a package body
2079  context                -- inside a context declaration")
2080
2081 (defvar vhdl-comment-only-line-offset 0
2082   "Extra offset for line which contains only the start of a comment.
2083 Can contain an integer or a cons cell of the form:
2084
2085  (NON-ANCHORED-OFFSET . ANCHORED-OFFSET)
2086
2087 Where NON-ANCHORED-OFFSET is the amount of offset given to
2088 non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is
2089 the amount of offset to give column-zero anchored comment-only lines.
2090 Just an integer as value is equivalent to (<val> . 0)")
2091
2092 (defvar vhdl-special-indent-hook nil
2093   "Hook for user defined special indentation adjustments.
2094 This hook gets called after a line is indented by the mode.")
2095
2096 (defvar vhdl-style-alist
2097   '(("IEEE"
2098      (vhdl-basic-offset . 4)
2099      (vhdl-offsets-alist . ())))
2100   "Styles of Indentation.
2101 Elements of this alist are of the form:
2102
2103   (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...])
2104
2105 where STYLE-STRING is a short descriptive string used to select a
2106 style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended
2107 value for that variable when using the selected style.
2108
2109 There is one special case when VARIABLE is `vhdl-offsets-alist'.  In this
2110 case, the VALUE is a list containing elements of the form:
2111
2112   (SYNTACTIC-SYMBOL . VALUE)
2113
2114 as described in `vhdl-offsets-alist'.  These are passed directly to
2115 `vhdl-set-offset' so there is no need to set every syntactic symbol in
2116 your style, only those that are different from the default.")
2117
2118 ;; dynamically append the default value of most variables
2119 (or (assoc "Default" vhdl-style-alist)
2120     (let* ((varlist '(vhdl-inhibit-startup-warnings-p
2121                       vhdl-strict-syntax-p
2122                       vhdl-echo-syntactic-information-p
2123                       vhdl-basic-offset
2124                       vhdl-offsets-alist
2125                       vhdl-comment-only-line-offset))
2126            (default (cons "Default"
2127                           (mapcar
2128                            (function
2129                             (lambda (var)
2130                               (cons var (symbol-value var))))
2131                            varlist))))
2132       (push default vhdl-style-alist)))
2133
2134 (defvar vhdl-mode-hook nil
2135   "Hook called by `vhdl-mode'.")
2136
2137
2138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2139 ;;; Required packages
2140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2141
2142 ;; mandatory
2143 (require 'compile)                      ; XEmacs
2144 (require 'easymenu)
2145 (require 'hippie-exp)
2146
2147 ;; optional (minimize warning messages during compile)
2148 (unless (featurep 'xemacs)
2149 (eval-when-compile
2150   (require 'font-lock)
2151   (require 'ps-print)
2152     (require 'speedbar)))               ; for speedbar-with-writable
2153
2154 (defun vhdl-aput (alist-symbol key &optional value)
2155   "Insert a key-value pair into an alist.
2156 The alist is referenced by ALIST-SYMBOL.  The key-value pair is made
2157 from KEY and VALUE.  If the key-value pair referenced by KEY can be
2158 found in the alist, the value of KEY will be set to VALUE.  If the
2159 key-value pair cannot be found in the alist, it will be inserted into
2160 the head of the alist."
2161   (let* ((alist (symbol-value alist-symbol))
2162          (elem (assoc key alist)))
2163     (if elem
2164         (setcdr elem value)
2165       (set alist-symbol (cons (cons key value) alist)))))
2166
2167 (defun vhdl-adelete (alist-symbol key)
2168   "Delete a key-value pair from the alist.
2169 Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
2170 is pair matching KEY."
2171   (let ((alist (symbol-value alist-symbol)) alist-cdr)
2172     (while (equal key (caar alist))
2173       (setq alist (cdr alist))
2174       (set alist-symbol alist))
2175     (while (setq alist-cdr (cdr alist))
2176       (if (equal key (caar alist-cdr))
2177           (setcdr alist (cdr alist-cdr))
2178         (setq alist alist-cdr)))))
2179
2180 (defun vhdl-aget (alist key)
2181   "Return the value in ALIST that is associated with KEY.  If KEY is
2182 not found, then nil is returned."
2183   (cdr (assoc key alist)))
2184
2185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2186 ;;; Compatibility
2187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2188
2189 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2190 ;; XEmacs compatibility
2191
2192 ;; active regions
2193 (defun vhdl-keep-region-active ()
2194   "Do whatever is necessary to keep the region active in XEmacs.
2195 Ignore byte-compiler warnings you might see."
2196   (and (featurep 'xemacs)
2197        (setq zmacs-region-stays t)))
2198
2199 ;; `wildcard-to-regexp' is included only in XEmacs 21
2200 (unless (fboundp 'wildcard-to-regexp)
2201   (defun wildcard-to-regexp (wildcard)
2202     "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'."
2203     (let* ((i (string-match "[*?]" wildcard))
2204            (result (substring wildcard 0 i))
2205            (len (length wildcard)))
2206       (when i
2207         (while (< i len)
2208           (let ((ch (aref wildcard i)))
2209             (setq result (concat result
2210                                  (cond ((eq ch ?*)  "[^\000]*")
2211                                        ((eq ch ??)  "[^\000]")
2212                                        (t (char-to-string ch)))))
2213             (setq i (1+ i)))))
2214       (concat "\\`" result "\\'"))))
2215
2216 ;; `regexp-opt' undefined (`xemacs-devel' not installed)
2217 ;; `regexp-opt' accelerates fontification by 10-20%
2218 (unless (fboundp 'regexp-opt)
2219 ;  (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
2220   (defun regexp-opt (strings &optional paren)
2221     (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
2222       (concat open (mapconcat 'regexp-quote strings "\\|") close))))
2223
2224 ;; `match-string-no-properties' undefined (XEmacs, what else?)
2225 (unless (fboundp 'match-string-no-properties)
2226   (defalias 'match-string-no-properties 'match-string))
2227
2228 ;; `subst-char-in-string' undefined (XEmacs)
2229 (unless (fboundp 'subst-char-in-string)
2230   (defun subst-char-in-string (fromchar tochar string &optional inplace)
2231     (let ((i (length string))
2232           (newstr (if inplace string (copy-sequence string))))
2233       (while (> i 0)
2234         (setq i (1- i))
2235         (if (eq (aref newstr i) fromchar) (aset newstr i tochar)))
2236       newstr)))
2237
2238 ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
2239 (when (and (featurep 'xemacs) (string< itimer-version "1.09")
2240            (not noninteractive))
2241   (load "itimer")
2242   (when (string< itimer-version "1.09")
2243     (message "WARNING:  Install included `itimer.el' patch first (see INSTALL file)")
2244     (beep) (sit-for 5)))
2245
2246 ;; `file-expand-wildcards' undefined (XEmacs)
2247 (unless (fboundp 'file-expand-wildcards)
2248   (defun file-expand-wildcards (pattern &optional full)
2249     "Taken from Emacs's `files.el'."
2250     (let* ((nondir (file-name-nondirectory pattern))
2251            (dirpart (file-name-directory pattern))
2252            (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2253                      (mapcar 'file-name-as-directory
2254                              (file-expand-wildcards (directory-file-name dirpart)))
2255                    (list dirpart)))
2256            contents)
2257       (while dirs
2258         (when (or (null (car dirs))     ; Possible if DIRPART is not wild.
2259                   (file-directory-p (directory-file-name (car dirs))))
2260           (let ((this-dir-contents
2261                  (delq nil
2262                        (mapcar #'(lambda (name)
2263                                    (unless (string-match "\\`\\.\\.?\\'"
2264                                                          (file-name-nondirectory name))
2265                                      name))
2266                                (directory-files (or (car dirs) ".") full
2267                                                 (wildcard-to-regexp nondir))))))
2268             (setq contents
2269                   (nconc
2270                    (if (and (car dirs) (not full))
2271                        (mapcar (function (lambda (name) (concat (car dirs) name)))
2272                                this-dir-contents)
2273                      this-dir-contents)
2274                    contents))))
2275         (setq dirs (cdr dirs)))
2276       contents)))
2277
2278 ;; `member-ignore-case' undefined (XEmacs)
2279 (unless (fboundp 'member-ignore-case)
2280   (defalias 'member-ignore-case 'member))
2281
2282 ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different
2283 ;; behavior in XEmacs
2284 (defvar vhdl-last-input-event)
2285 (if (featurep 'xemacs)
2286     (defvaralias 'vhdl-last-input-event 'last-input-char)
2287   (defvaralias 'vhdl-last-input-event 'last-input-event))
2288
2289 ;; `help-print-return-message' changed to `print-help-return-message' in Emacs
2290 ;;;(unless (fboundp 'help-print-return-message)
2291 ;;;  (defalias 'help-print-return-message 'print-help-return-message))
2292
2293 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2294 ;; Compatibility with older VHDL Mode versions
2295
2296 (defvar vhdl-warnings nil
2297   "Warnings to tell the user during start up.")
2298
2299 (defun vhdl-run-when-idle (secs repeat function)
2300   "Wait until idle, then run FUNCTION."
2301   (if (fboundp 'start-itimer)
2302       (start-itimer "vhdl-mode" function secs repeat t)
2303     ;; explicitly activate timer (necessary when Emacs is already idle)
2304     (aset (run-with-idle-timer secs repeat function) 0 nil)))
2305
2306 (defun vhdl-warning-when-idle (&rest args)
2307   "Wait until idle, then print out warning STRING and beep."
2308   (if noninteractive
2309       (vhdl-warning (apply 'format args) t)
2310     (unless vhdl-warnings
2311       (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2312     (push (apply 'format args) vhdl-warnings)))
2313
2314 (defun vhdl-warning (string &optional nobeep)
2315   "Print out warning STRING and beep."
2316   (message "WARNING:  %s" string)
2317   (unless (or nobeep noninteractive) (beep)))
2318
2319 (defun vhdl-print-warnings ()
2320   "Print out messages in variable `vhdl-warnings'."
2321   (let ((no-warnings (length vhdl-warnings)))
2322     (setq vhdl-warnings (nreverse vhdl-warnings))
2323     (while vhdl-warnings
2324       (message "WARNING:  %s" (car vhdl-warnings))
2325       (setq vhdl-warnings (cdr vhdl-warnings)))
2326     (beep)
2327     (when (> no-warnings 1)
2328       (message "WARNING:  See warnings in message buffer (type `C-c M-m')."))))
2329
2330 ;; Backward compatibility checks and fixes
2331 ;; option `vhdl-compiler' changed format
2332 (unless (stringp vhdl-compiler)
2333   (setq vhdl-compiler "ModelSim")
2334   (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2335
2336 ;; option `vhdl-standard' changed format
2337 (unless (listp vhdl-standard)
2338   (setq vhdl-standard '(87 nil))
2339   (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2340
2341 ;; option `vhdl-model-alist' changed format
2342 (when (= (length (car vhdl-model-alist)) 3)
2343   (let ((old-alist vhdl-model-alist)
2344         new-alist)
2345     (while old-alist
2346       (push (append (car old-alist) '("")) new-alist)
2347       (setq old-alist (cdr old-alist)))
2348     (setq vhdl-model-alist (nreverse new-alist)))
2349   (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2350
2351 ;; option `vhdl-project-alist' changed format
2352 (when (= (length (car vhdl-project-alist)) 3)
2353   (let ((old-alist vhdl-project-alist)
2354         new-alist)
2355     (while old-alist
2356       (push (append (car old-alist) '("")) new-alist)
2357       (setq old-alist (cdr old-alist)))
2358     (setq vhdl-project-alist (nreverse new-alist)))
2359   (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2360
2361 ;; option `vhdl-project-alist' changed format (3.31.1)
2362 (when (= (length (car vhdl-project-alist)) 4)
2363   (let ((old-alist vhdl-project-alist)
2364         new-alist elem)
2365     (while old-alist
2366       (setq elem (car old-alist))
2367       (setq new-alist
2368             (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2369                         nil "./" "work" "work/" "Makefile" (nth 3 elem))
2370                   new-alist))
2371       (setq old-alist (cdr old-alist)))
2372     (setq vhdl-project-alist (nreverse new-alist)))
2373   (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2374
2375 ;; option `vhdl-project-alist' changed format (3.31.12)
2376 (when (= (length (car vhdl-project-alist)) 10)
2377   (let ((tmp-alist vhdl-project-alist))
2378     (while tmp-alist
2379       (setcdr (nthcdr 3 (car tmp-alist))
2380               (cons "" (nthcdr 4 (car tmp-alist))))
2381       (setq tmp-alist (cdr tmp-alist))))
2382   (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2383
2384 ;; option `vhdl-compiler-alist' changed format (3.31.1)
2385 (when (= (length (car vhdl-compiler-alist)) 7)
2386   (let ((old-alist vhdl-compiler-alist)
2387         new-alist elem)
2388     (while old-alist
2389       (setq elem (car old-alist))
2390       (setq new-alist
2391             (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2392                         (if (equal (nth 3 elem) "") nil (nth 3 elem))
2393                         (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2394                         (nth 5 elem) (nth 6 elem) nil)
2395                   new-alist))
2396       (setq old-alist (cdr old-alist)))
2397     (setq vhdl-compiler-alist (nreverse new-alist)))
2398   (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2399
2400 ;; option `vhdl-compiler-alist' changed format (3.31.10)
2401 (when (= (length (car vhdl-compiler-alist)) 12)
2402   (let ((tmp-alist vhdl-compiler-alist))
2403     (while tmp-alist
2404       (setcdr (nthcdr 4 (car tmp-alist))
2405               (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2406       (setq tmp-alist (cdr tmp-alist))))
2407   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2408
2409 ;; option `vhdl-compiler-alist' changed format (3.31.11)
2410 (when (= (length (car vhdl-compiler-alist)) 13)
2411   (let ((tmp-alist vhdl-compiler-alist))
2412     (while tmp-alist
2413       (setcdr (nthcdr 3 (car tmp-alist))
2414               (cons "" (nthcdr 4 (car tmp-alist))))
2415       (setq tmp-alist (cdr tmp-alist))))
2416   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2417
2418 ;; option `vhdl-compiler-alist' changed format (3.32.7)
2419 (when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2420   (let ((tmp-alist vhdl-compiler-alist))
2421     (while tmp-alist
2422       (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2423               '(0 . nil))
2424       (setq tmp-alist (cdr tmp-alist))))
2425   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2426
2427 ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2428 (when (equal vhdl-project "")
2429   (setq vhdl-project nil)
2430   (customize-save-variable 'vhdl-project vhdl-project))
2431
2432 ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2433 (when (stringp vhdl-project-file-name)
2434   (setq vhdl-project-file-name (list vhdl-project-file-name))
2435   (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2436
2437 ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2438 (if (not (boundp 'speedbar-indentation-width))
2439     (defvar speedbar-indentation-width 2)
2440   ;; set default to 2 if not already customized
2441   (unless (get 'speedbar-indentation-width 'saved-value)
2442     (setq speedbar-indentation-width 2)))
2443
2444 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2445 ;;; Help functions / inline substitutions / macros
2446 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2447
2448 (defun vhdl-standard-p (standard)
2449   "Check if STANDARD is specified as used standard."
2450   (or (eq standard (car vhdl-standard))
2451       (memq standard (cadr vhdl-standard))))
2452
2453 (defun vhdl-project-p (&optional warning)
2454   "Return non-nil if a project is displayed, i.e. directories or files are
2455 specified."
2456   (if (assoc vhdl-project vhdl-project-alist)
2457       vhdl-project
2458     (when (and vhdl-project warning)
2459       (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2460     nil))
2461
2462 (defun vhdl-resolve-env-variable (string)
2463   "Resolve environment variables in STRING."
2464   (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2465     (setq string (concat (match-string 1 string)
2466                          (getenv (match-string 2 string))
2467                          (match-string 4 string))))
2468   string)
2469
2470 (defun vhdl-default-directory ()
2471   "Return the default directory of the current project or the directory of the
2472 current buffer if no project is defined."
2473   (if (vhdl-project-p)
2474       (expand-file-name (vhdl-resolve-env-variable
2475                          (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
2476     default-directory))
2477
2478 (defmacro vhdl-prepare-search-1 (&rest body)
2479   "Enable case insensitive search and switch to syntax table that includes '_',
2480 then execute BODY, and finally restore the old environment.  Used for
2481 consistent searching."
2482   `(let ((case-fold-search t))          ; case insensitive search
2483      ;; use extended syntax table
2484      (with-syntax-table vhdl-mode-ext-syntax-table
2485        ,@body)))
2486
2487 (defmacro vhdl-prepare-search-2 (&rest body)
2488   "Enable case insensitive search, switch to syntax table that includes '_',
2489 arrange to ignore `intangible' overlays, then execute BODY, and finally restore
2490 the old environment.  Used for consistent searching."
2491   `(let ((case-fold-search t)           ; case insensitive search
2492          (current-syntax-table (syntax-table))
2493          (inhibit-point-motion-hooks t))
2494      ;; use extended syntax table
2495      (set-syntax-table vhdl-mode-ext-syntax-table)
2496      ;; execute BODY safely
2497      (unwind-protect
2498          (progn ,@body)
2499        ;; restore syntax table
2500        (set-syntax-table current-syntax-table))))
2501
2502 (defmacro vhdl-visit-file (file-name issue-error &rest body)
2503   "Visit file FILE-NAME and execute BODY."
2504   `(if (null ,file-name)
2505        (progn ,@body)
2506      (unless (file-directory-p ,file-name)
2507        (let ((source-buffer (current-buffer))
2508              (visiting-buffer (find-buffer-visiting ,file-name))
2509              file-opened)
2510          (when (or (and visiting-buffer (set-buffer visiting-buffer))
2511                    (condition-case ()
2512                        (progn (set-buffer (create-file-buffer ,file-name))
2513                               (setq file-opened t)
2514                               (vhdl-insert-file-contents ,file-name)
2515                               ;; FIXME: This modifies a global syntax-table!
2516                               (modify-syntax-entry ?\- ". 12" (syntax-table))
2517                               (modify-syntax-entry ?\n ">" (syntax-table))
2518                               (modify-syntax-entry ?\^M ">" (syntax-table))
2519                               (modify-syntax-entry ?_ "w" (syntax-table))
2520                               t)
2521                      (error
2522                       (if ,issue-error
2523                           (progn
2524                             (when file-opened (kill-buffer (current-buffer)))
2525                             (set-buffer source-buffer)
2526                             (error "ERROR:  File cannot be opened: \"%s\"" ,file-name))
2527                         (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
2528                         nil))))
2529            (condition-case info
2530                (progn ,@body)
2531              (error
2532               (if ,issue-error
2533                   (progn
2534                     (when file-opened (kill-buffer (current-buffer)))
2535                     (set-buffer source-buffer)
2536                     (error (cadr info)))
2537                 (vhdl-warning (cadr info))))))
2538          (when file-opened (kill-buffer (current-buffer)))
2539          (set-buffer source-buffer)))))
2540
2541 (defun vhdl-insert-file-contents (filename)
2542   "Nicked from `insert-file-contents-literally', but allow coding system
2543 conversion."
2544   (let ((format-alist nil)
2545         (after-insert-file-functions nil)
2546         (jka-compr-compression-info-list nil))
2547     (insert-file-contents filename t)))
2548
2549 (defun vhdl-sort-alist (alist)
2550   "Sort ALIST."
2551   (sort alist (function (lambda (a b) (string< (car a) (car b))))))
2552
2553 (defun vhdl-get-subdirs (directory)
2554   "Recursively get subdirectories of DIRECTORY."
2555   (let ((dir-list (list (file-name-as-directory directory)))
2556         file-list)
2557     (setq file-list (vhdl-directory-files directory t "\\w.*"))
2558     (while file-list
2559       (when (file-directory-p (car file-list))
2560         (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2561       (setq file-list (cdr file-list)))
2562     dir-list))
2563
2564 (defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
2565   "As `aput', but delete key-value pair if VALUE is nil."
2566   (if value
2567       (vhdl-aput alist-symbol key value)
2568     (vhdl-adelete alist-symbol key)))
2569
2570 (defun vhdl-delete (elt list)
2571   "Delete by side effect the first occurrence of ELT as a member of LIST."
2572   (push nil list)
2573   (let ((list1 list))
2574     (while (and (cdr list1) (not (equal elt (cadr list1))))
2575       (setq list1 (cdr list1)))
2576     (when list
2577       (setcdr list1 (cddr list1))))
2578   (cdr list))
2579
2580 (declare-function speedbar-refresh "speedbar" (&optional arg))
2581 (declare-function speedbar-do-function-pointer "speedbar" ())
2582
2583 (defun vhdl-speedbar-refresh (&optional key)
2584   "Refresh directory or project with name KEY."
2585   (when (and (boundp 'speedbar-frame)
2586              (frame-live-p speedbar-frame))
2587     (let ((pos (point))
2588           (last-frame (selected-frame)))
2589       (if (null key)
2590           (speedbar-refresh)
2591         (select-frame speedbar-frame)
2592         (when (save-excursion
2593                 (goto-char (point-min))
2594                 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2595           (goto-char (match-end 1))
2596           (speedbar-do-function-pointer)
2597           (backward-char 2)
2598           (speedbar-do-function-pointer)
2599           (message "Refreshing speedbar...done"))
2600         (select-frame last-frame)))))
2601
2602 (defun vhdl-show-messages ()
2603   "Get *Messages* buffer to show recent messages."
2604   (interactive)
2605   (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*")))
2606
2607 (defun vhdl-use-direct-instantiation ()
2608   "Return whether direct instantiation is used."
2609   (or (eq vhdl-use-direct-instantiation 'always)
2610       (and (eq vhdl-use-direct-instantiation 'standard)
2611            (not (vhdl-standard-p '87)))))
2612
2613 (defun vhdl-max-marker (marker1 marker2)
2614   "Return larger marker."
2615   (if (> marker1 marker2) marker1 marker2))
2616
2617 (defun vhdl-goto-marker (marker)
2618   "Goto marker in appropriate buffer."
2619   (when (markerp marker)
2620     (set-buffer (marker-buffer marker)))
2621   (goto-char marker))
2622
2623 (defun vhdl-menu-split (list title)
2624   "Split menu LIST into several submenus, if number of
2625 elements > `vhdl-menu-max-size'."
2626   (if (> (length list) vhdl-menu-max-size)
2627       (let ((remain list)
2628             (result '())
2629             (sublist '())
2630             (menuno 1)
2631             (i 0))
2632         (while remain
2633           (push (car remain) sublist)
2634           (setq remain (cdr remain))
2635           (setq i (+ i 1))
2636           (if (= i vhdl-menu-max-size)
2637               (progn
2638                 (push (cons (format "%s %s" title menuno)
2639                             (nreverse sublist)) result)
2640                 (setq i 0)
2641                 (setq menuno (+ menuno 1))
2642                 (setq sublist '()))))
2643         (and sublist
2644              (push (cons (format "%s %s" title menuno)
2645                          (nreverse sublist)) result))
2646         (nreverse result))
2647     list))
2648
2649
2650 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2651 ;;; Bindings
2652 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2653
2654 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2655 ;; Key bindings
2656
2657 (defvar vhdl-template-map nil
2658   "Keymap for VHDL templates.")
2659
2660 (defun vhdl-template-map-init ()
2661   "Initialize `vhdl-template-map'."
2662   (setq vhdl-template-map (make-sparse-keymap))
2663   ;; key bindings for VHDL templates
2664   (define-key vhdl-template-map "al"    'vhdl-template-alias)
2665   (define-key vhdl-template-map "ar"    'vhdl-template-architecture)
2666   (define-key vhdl-template-map "at"    'vhdl-template-assert)
2667   (define-key vhdl-template-map "ad"    'vhdl-template-attribute-decl)
2668   (define-key vhdl-template-map "as"    'vhdl-template-attribute-spec)
2669   (define-key vhdl-template-map "bl"    'vhdl-template-block)
2670   (define-key vhdl-template-map "ca"    'vhdl-template-case-is)
2671   (define-key vhdl-template-map "cd"    'vhdl-template-component-decl)
2672   (define-key vhdl-template-map "ci"    'vhdl-template-component-inst)
2673   (define-key vhdl-template-map "cs"    'vhdl-template-conditional-signal-asst)
2674   (define-key vhdl-template-map "Cb"    'vhdl-template-block-configuration)
2675   (define-key vhdl-template-map "Cc"    'vhdl-template-component-conf)
2676   (define-key vhdl-template-map "Cd"    'vhdl-template-configuration-decl)
2677   (define-key vhdl-template-map "Cs"    'vhdl-template-configuration-spec)
2678   (define-key vhdl-template-map "co"    'vhdl-template-constant)
2679   (define-key vhdl-template-map "ct"    'vhdl-template-context)
2680   (define-key vhdl-template-map "di"    'vhdl-template-disconnect)
2681   (define-key vhdl-template-map "el"    'vhdl-template-else)
2682   (define-key vhdl-template-map "ei"    'vhdl-template-elsif)
2683   (define-key vhdl-template-map "en"    'vhdl-template-entity)
2684   (define-key vhdl-template-map "ex"    'vhdl-template-exit)
2685   (define-key vhdl-template-map "fi"    'vhdl-template-file)
2686   (define-key vhdl-template-map "fg"    'vhdl-template-for-generate)
2687   (define-key vhdl-template-map "fl"    'vhdl-template-for-loop)
2688   (define-key vhdl-template-map "\C-f"  'vhdl-template-footer)
2689   (define-key vhdl-template-map "fb"    'vhdl-template-function-body)
2690   (define-key vhdl-template-map "fd"    'vhdl-template-function-decl)
2691   (define-key vhdl-template-map "ge"    'vhdl-template-generic)
2692   (define-key vhdl-template-map "gd"    'vhdl-template-group-decl)
2693   (define-key vhdl-template-map "gt"    'vhdl-template-group-template)
2694   (define-key vhdl-template-map "\C-h"  'vhdl-template-header)
2695   (define-key vhdl-template-map "ig"    'vhdl-template-if-generate)
2696   (define-key vhdl-template-map "it"    'vhdl-template-if-then)
2697   (define-key vhdl-template-map "li"    'vhdl-template-library)
2698   (define-key vhdl-template-map "lo"    'vhdl-template-bare-loop)
2699   (define-key vhdl-template-map "\C-m"  'vhdl-template-modify)
2700   (define-key vhdl-template-map "\C-t"  'vhdl-template-insert-date)
2701   (define-key vhdl-template-map "ma"    'vhdl-template-map)
2702   (define-key vhdl-template-map "ne"    'vhdl-template-next)
2703   (define-key vhdl-template-map "ot"    'vhdl-template-others)
2704   (define-key vhdl-template-map "Pd"    'vhdl-template-package-decl)
2705   (define-key vhdl-template-map "Pb"    'vhdl-template-package-body)
2706   (define-key vhdl-template-map "("     'vhdl-template-paired-parens)
2707   (define-key vhdl-template-map "po"    'vhdl-template-port)
2708   (define-key vhdl-template-map "pb"    'vhdl-template-procedure-body)
2709   (define-key vhdl-template-map "pd"    'vhdl-template-procedure-decl)
2710   (define-key vhdl-template-map "pc"    'vhdl-template-process-comb)
2711   (define-key vhdl-template-map "ps"    'vhdl-template-process-seq)
2712   (define-key vhdl-template-map "rp"    'vhdl-template-report)
2713   (define-key vhdl-template-map "rt"    'vhdl-template-return)
2714   (define-key vhdl-template-map "ss"    'vhdl-template-selected-signal-asst)
2715   (define-key vhdl-template-map "si"    'vhdl-template-signal)
2716   (define-key vhdl-template-map "su"    'vhdl-template-subtype)
2717   (define-key vhdl-template-map "ty"    'vhdl-template-type)
2718   (define-key vhdl-template-map "us"    'vhdl-template-use)
2719   (define-key vhdl-template-map "va"    'vhdl-template-variable)
2720   (define-key vhdl-template-map "wa"    'vhdl-template-wait)
2721   (define-key vhdl-template-map "wl"    'vhdl-template-while-loop)
2722   (define-key vhdl-template-map "wi"    'vhdl-template-with)
2723   (define-key vhdl-template-map "wc"    'vhdl-template-clocked-wait)
2724   (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
2725   (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
2726   (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
2727   (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
2728   (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
2729   (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed)
2730   (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio)
2731   (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned)
2732   (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
2733   (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
2734   (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
2735   (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
2736   (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
2737   (define-key vhdl-template-map "\C-q"  'vhdl-template-search-prompt)
2738   (when (vhdl-standard-p 'ams)
2739     (define-key vhdl-template-map "br"  'vhdl-template-break)
2740     (define-key vhdl-template-map "cu"  'vhdl-template-case-use)
2741     (define-key vhdl-template-map "iu"  'vhdl-template-if-use)
2742     (define-key vhdl-template-map "lm"  'vhdl-template-limit)
2743     (define-key vhdl-template-map "na"  'vhdl-template-nature)
2744     (define-key vhdl-template-map "pa"  'vhdl-template-procedural)
2745     (define-key vhdl-template-map "qf"  'vhdl-template-quantity-free)
2746     (define-key vhdl-template-map "qb"  'vhdl-template-quantity-branch)
2747     (define-key vhdl-template-map "qs"  'vhdl-template-quantity-source)
2748     (define-key vhdl-template-map "sn"  'vhdl-template-subnature)
2749     (define-key vhdl-template-map "te"  'vhdl-template-terminal)
2750     )
2751   (when (vhdl-standard-p 'math)
2752     (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
2753     (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
2754     ))
2755
2756 ;; initialize template map for VHDL Mode
2757 (vhdl-template-map-init)
2758
2759 (defun vhdl-function-name (prefix string &optional postfix)
2760   "Generate a Lisp function name.
2761 PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in
2762 STRING are replaced by `-' and substrings are converted to lower case."
2763   (let ((name prefix))
2764     (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
2765       (setq name
2766             (concat name "-" (downcase (substring string 0 (match-end 1)))))
2767       (setq string (substring string (match-beginning 2))))
2768     (when postfix (setq name (concat name "-" postfix)))
2769     (intern name)))
2770
2771 (defvar vhdl-model-map nil
2772   "Keymap for VHDL models.")
2773
2774 (defun vhdl-model-map-init ()
2775   "Initialize `vhdl-model-map'."
2776   (setq vhdl-model-map (make-sparse-keymap))
2777   ;; key bindings for VHDL models
2778   (let ((model-alist vhdl-model-alist) model)
2779     (while model-alist
2780       (setq model (car model-alist))
2781       (define-key vhdl-model-map (nth 2 model)
2782         (vhdl-function-name "vhdl-model" (nth 0 model)))
2783       (setq model-alist (cdr model-alist)))))
2784
2785 ;; initialize user model map for VHDL Mode
2786 (vhdl-model-map-init)
2787
2788 (defvar vhdl-mode-map nil
2789   "Keymap for VHDL Mode.")
2790
2791 (defun vhdl-mode-map-init ()
2792   "Initialize `vhdl-mode-map'."
2793   (setq vhdl-mode-map (make-sparse-keymap))
2794   ;; template key bindings
2795   (define-key vhdl-mode-map "\C-c\C-t"     vhdl-template-map)
2796   ;; model key bindings
2797   (define-key vhdl-mode-map "\C-c\C-m"     vhdl-model-map)
2798   ;; standard key bindings
2799   (define-key vhdl-mode-map "\M-a"         'vhdl-beginning-of-statement)
2800   (define-key vhdl-mode-map "\M-e"         'vhdl-end-of-statement)
2801   (define-key vhdl-mode-map "\M-\C-f"      'vhdl-forward-sexp)
2802   (define-key vhdl-mode-map "\M-\C-b"      'vhdl-backward-sexp)
2803   (define-key vhdl-mode-map "\M-\C-u"      'vhdl-backward-up-list)
2804   (define-key vhdl-mode-map "\M-\C-a"      'vhdl-backward-same-indent)
2805   (define-key vhdl-mode-map "\M-\C-e"      'vhdl-forward-same-indent)
2806   (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
2807     (define-key vhdl-mode-map "\M-\C-h"    'vhdl-mark-defun))
2808   (define-key vhdl-mode-map "\M-\C-q"      'vhdl-indent-sexp)
2809   (define-key vhdl-mode-map "\M-^"         'vhdl-delete-indentation)
2810   ;; mode specific key bindings
2811   (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
2812   (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
2813   (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
2814   (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
2815   (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
2816   (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
2817   (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
2818   (define-key vhdl-mode-map "\C-c\C-k"     'vhdl-compile)
2819   (define-key vhdl-mode-map "\C-c\M-\C-k"  'vhdl-make)
2820   (define-key vhdl-mode-map "\C-c\M-k"     'vhdl-generate-makefile)
2821   (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
2822   (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
2823   (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
2824   (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
2825   (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
2826   (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
2827   (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
2828   (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
2829       (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
2830     (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
2831   (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
2832   (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
2833   (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
2834   (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
2835   (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
2836   (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
2837   (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
2838   (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
2839   (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
2840   (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
2841   (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component)
2842   (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component)
2843   (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components)
2844   (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration)
2845   (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package)
2846   (define-key vhdl-mode-map "\C-c\C-c"     'vhdl-comment-uncomment-region)
2847   (define-key vhdl-mode-map "\C-c-"        'vhdl-comment-append-inline)
2848   (define-key vhdl-mode-map "\C-c\M--"     'vhdl-comment-display-line)
2849   (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
2850   (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
2851   (define-key vhdl-mode-map "\M-\C-\\"     'vhdl-indent-region)
2852   (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
2853   (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
2854   (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
2855   (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
2856   (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
2857   (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
2858   (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
2859   (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
2860   (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
2861   (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
2862   (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
2863   (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
2864   (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
2865   (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
2866   (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
2867   (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
2868   (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
2869   (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
2870   (define-key vhdl-mode-map "\C-c\C-l\t"   'vhdl-line-expand)
2871   (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
2872   (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
2873   (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
2874   (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
2875   (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
2876   (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region)
2877   (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer)
2878   (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
2879   (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
2880   (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
2881   (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
2882   (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
2883   (define-key vhdl-mode-map "\C-c\M-b"     'vhdl-beautify-region)
2884   (define-key vhdl-mode-map "\C-c\C-b"     'vhdl-beautify-buffer)
2885   (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
2886   (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
2887   (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer)
2888   (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer)
2889   (define-key vhdl-mode-map "\C-c\M-m"     'vhdl-show-messages)
2890   (define-key vhdl-mode-map "\C-c\C-h"     'vhdl-doc-mode)
2891   (define-key vhdl-mode-map "\C-c\C-v"     'vhdl-version)
2892   (define-key vhdl-mode-map "\M-\t"        'insert-tab)
2893   ;; insert commands bindings
2894   (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
2895   (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
2896   (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
2897   (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
2898   ;; electric key bindings
2899   (define-key vhdl-mode-map " "            'vhdl-electric-space)
2900   (when vhdl-intelligent-tab
2901     (define-key vhdl-mode-map "\t"         'vhdl-electric-tab))
2902   (define-key vhdl-mode-map "\r"           'vhdl-electric-return)
2903   (define-key vhdl-mode-map "-"            'vhdl-electric-dash)
2904   (define-key vhdl-mode-map "["            'vhdl-electric-open-bracket)
2905   (define-key vhdl-mode-map "]"            'vhdl-electric-close-bracket)
2906   (define-key vhdl-mode-map "'"            'vhdl-electric-quote)
2907   (define-key vhdl-mode-map ";"            'vhdl-electric-semicolon)
2908   (define-key vhdl-mode-map ","            'vhdl-electric-comma)
2909   (define-key vhdl-mode-map "."            'vhdl-electric-period)
2910   (when (vhdl-standard-p 'ams)
2911     (define-key vhdl-mode-map "="          'vhdl-electric-equal)))
2912
2913 ;; initialize mode map for VHDL Mode
2914 (vhdl-mode-map-init)
2915
2916 ;; define special minibuffer keymap for enabling word completion in minibuffer
2917 ;; (useful in template generator prompts)
2918 (defvar vhdl-minibuffer-local-map
2919   (let ((map (make-sparse-keymap)))
2920     (set-keymap-parent map minibuffer-local-map)
2921     (when vhdl-word-completion-in-minibuffer
2922       (define-key map "\t" 'vhdl-minibuffer-tab))
2923     map)
2924   "Keymap for minibuffer used in VHDL Mode.")
2925
2926 ;; set up electric character functions to work with
2927 ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2928 (mapc
2929  (function
2930   (lambda (sym)
2931     (put sym 'delete-selection t)       ; for `delete-selection-mode' (Emacs)
2932     (put sym 'pending-delete t)))       ; for `pending-delete-mode' (XEmacs)
2933  '(vhdl-electric-space
2934    vhdl-electric-tab
2935    vhdl-electric-return
2936    vhdl-electric-dash
2937    vhdl-electric-open-bracket
2938    vhdl-electric-close-bracket
2939    vhdl-electric-quote
2940    vhdl-electric-semicolon
2941    vhdl-electric-comma
2942    vhdl-electric-period
2943    vhdl-electric-equal))
2944
2945 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2946 ;; Syntax table
2947
2948 (defvar vhdl-mode-syntax-table
2949   (let ((st (make-syntax-table)))
2950     ;; define punctuation
2951     (modify-syntax-entry ?\# "."    st)
2952     (modify-syntax-entry ?\$ "."    st)
2953     (modify-syntax-entry ?\% "."    st)
2954     (modify-syntax-entry ?\& "."    st)
2955     (modify-syntax-entry ?\' "."    st)
2956     (modify-syntax-entry ?\* "."    st)
2957     (modify-syntax-entry ?\+ "."    st)
2958     (modify-syntax-entry ?\. "."    st)
2959 ;;;    (modify-syntax-entry ?\/ "."    st)
2960     (modify-syntax-entry ?\: "."    st)
2961     (modify-syntax-entry ?\; "."    st)
2962     (modify-syntax-entry ?\< "."    st)
2963     (modify-syntax-entry ?\= "."    st)
2964     (modify-syntax-entry ?\> "."    st)
2965     (modify-syntax-entry ?\\ "."    st)
2966     (modify-syntax-entry ?\| "."    st)
2967     ;; define string
2968     (modify-syntax-entry ?\" "\""   st)
2969     ;; define underscore
2970     (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
2971     ;; single-line comments
2972     (modify-syntax-entry ?\- ". 12b" st)
2973     ;; multi-line comments
2974     (modify-syntax-entry ?\/ ". 14b" st)
2975     (modify-syntax-entry ?*  ". 23" st)
2976     (modify-syntax-entry ?\n "> b"  st)
2977     (modify-syntax-entry ?\^M "> b"   st)
2978     ;; define parentheses to match
2979     (modify-syntax-entry ?\( "()"   st)
2980     (modify-syntax-entry ?\) ")("   st)
2981     (modify-syntax-entry ?\[ "(]"   st)
2982     (modify-syntax-entry ?\] ")["   st)
2983     (modify-syntax-entry ?\{ "(}"   st)
2984     (modify-syntax-entry ?\} "){"   st)
2985     st)
2986   "Syntax table used in `vhdl-mode' buffers.")
2987
2988 (defvar vhdl-mode-ext-syntax-table
2989   ;; Extended syntax table including '_' (for simpler search regexps).
2990   (let ((st (copy-syntax-table vhdl-mode-syntax-table)))
2991     (modify-syntax-entry ?_ "w" st)
2992     st)
2993   "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2994
2995 (defvar vhdl-syntactic-context nil
2996   "Buffer local variable containing syntactic analysis list.")
2997 (make-variable-buffer-local 'vhdl-syntactic-context)
2998
2999 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3000 ;; Abbrev hook bindings
3001
3002 (defvar vhdl-mode-abbrev-table nil
3003   "Abbrev table to use in `vhdl-mode' buffers.")
3004
3005 (defun vhdl-mode-abbrev-table-init ()
3006   "Initialize `vhdl-mode-abbrev-table'."
3007   (define-abbrev-table 'vhdl-mode-abbrev-table
3008     (append
3009      (when (memq 'vhdl vhdl-electric-keywords)
3010        ;; VHDL'02 keywords
3011        (mapcar (if (featurep 'xemacs)
3012                    (lambda (x) (list (car x) "" (cdr x) 0))
3013                  (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3014                '(
3015                  ("--"            . vhdl-template-display-comment-hook)
3016                  ("abs"           . vhdl-template-default-hook)
3017                  ("access"        . vhdl-template-default-hook)
3018                  ("after"         . vhdl-template-default-hook)
3019                  ("alias"         . vhdl-template-alias-hook)
3020                  ("all"           . vhdl-template-default-hook)
3021                  ("and"           . vhdl-template-default-hook)
3022                  ("arch"          . vhdl-template-architecture-hook)
3023                  ("architecture"  . vhdl-template-architecture-hook)
3024                  ("array"         . vhdl-template-default-hook)
3025                  ("assert"        . vhdl-template-assert-hook)
3026                  ("attr"          . vhdl-template-attribute-hook)
3027                  ("attribute"     . vhdl-template-attribute-hook)
3028                  ("begin"         . vhdl-template-default-indent-hook)
3029                  ("block"         . vhdl-template-block-hook)
3030                  ("body"          . vhdl-template-default-hook)
3031                  ("buffer"        . vhdl-template-default-hook)
3032                  ("bus"           . vhdl-template-default-hook)
3033                  ("case"          . vhdl-template-case-hook)
3034                  ("comp"          . vhdl-template-component-hook)
3035                  ("component"     . vhdl-template-component-hook)
3036                  ("cond"          . vhdl-template-conditional-signal-asst-hook)
3037                  ("conditional"   . vhdl-template-conditional-signal-asst-hook)
3038                  ("conf"          . vhdl-template-configuration-hook)
3039                  ("configuration" . vhdl-template-configuration-hook)
3040                  ("cons"          . vhdl-template-constant-hook)
3041                  ("constant"      . vhdl-template-constant-hook)
3042                  ("context"       . vhdl-template-context-hook)
3043                  ("disconnect"    . vhdl-template-disconnect-hook)
3044                  ("downto"        . vhdl-template-default-hook)
3045                  ("else"          . vhdl-template-else-hook)
3046                  ("elseif"        . vhdl-template-elsif-hook)
3047                  ("elsif"         . vhdl-template-elsif-hook)
3048                  ("end"           . vhdl-template-default-indent-hook)
3049                  ("entity"        . vhdl-template-entity-hook)
3050                  ("exit"          . vhdl-template-exit-hook)
3051                  ("file"          . vhdl-template-file-hook)
3052                  ("for"           . vhdl-template-for-hook)
3053                  ("func"          . vhdl-template-function-hook)
3054                  ("function"      . vhdl-template-function-hook)
3055                  ("generic"       . vhdl-template-generic-hook)
3056                  ("group"         . vhdl-template-group-hook)
3057                  ("guarded"       . vhdl-template-default-hook)
3058                  ("if"            . vhdl-template-if-hook)
3059                  ("impure"        . vhdl-template-default-hook)
3060                  ("in"            . vhdl-template-default-hook)
3061                  ("inertial"      . vhdl-template-default-hook)
3062                  ("inout"         . vhdl-template-default-hook)
3063                  ("inst"          . vhdl-template-instance-hook)
3064                  ("instance"      . vhdl-template-instance-hook)
3065                  ("is"            . vhdl-template-default-hook)
3066                  ("label"         . vhdl-template-default-hook)
3067                  ("library"       . vhdl-template-library-hook)
3068                  ("linkage"       . vhdl-template-default-hook)
3069                  ("literal"       . vhdl-template-default-hook)
3070                  ("loop"          . vhdl-template-bare-loop-hook)
3071                  ("map"           . vhdl-template-map-hook)
3072                  ("mod"           . vhdl-template-default-hook)
3073                  ("nand"          . vhdl-template-default-hook)
3074                  ("new"           . vhdl-template-default-hook)
3075                  ("next"          . vhdl-template-next-hook)
3076                  ("nor"           . vhdl-template-default-hook)
3077                  ("not"           . vhdl-template-default-hook)
3078                  ("null"          . vhdl-template-default-hook)
3079                  ("of"            . vhdl-template-default-hook)
3080                  ("on"            . vhdl-template-default-hook)
3081                  ("open"          . vhdl-template-default-hook)
3082                  ("or"            . vhdl-template-default-hook)
3083                  ("others"        . vhdl-template-others-hook)
3084                  ("out"           . vhdl-template-default-hook)
3085                  ("pack"          . vhdl-template-package-hook)
3086                  ("package"       . vhdl-template-package-hook)
3087                  ("port"          . vhdl-template-port-hook)
3088                  ("postponed"     . vhdl-template-default-hook)
3089                  ("procedure"     . vhdl-template-procedure-hook)
3090                  ("process"       . vhdl-template-process-hook)
3091                  ("pure"          . vhdl-template-default-hook)
3092                  ("range"         . vhdl-template-default-hook)
3093                  ("record"        . vhdl-template-default-hook)
3094                  ("register"      . vhdl-template-default-hook)
3095                  ("reject"        . vhdl-template-default-hook)
3096                  ("rem"           . vhdl-template-default-hook)
3097                  ("report"        . vhdl-template-report-hook)
3098                  ("return"        . vhdl-template-return-hook)
3099                  ("rol"           . vhdl-template-default-hook)
3100                  ("ror"           . vhdl-template-default-hook)
3101                  ("select"        . vhdl-template-selected-signal-asst-hook)
3102                  ("severity"      . vhdl-template-default-hook)
3103                  ("shared"        . vhdl-template-default-hook)
3104                  ("sig"           . vhdl-template-signal-hook)
3105                  ("signal"        . vhdl-template-signal-hook)
3106                  ("sla"           . vhdl-template-default-hook)
3107                  ("sll"           . vhdl-template-default-hook)
3108                  ("sra"           . vhdl-template-default-hook)
3109                  ("srl"           . vhdl-template-default-hook)
3110                  ("subtype"       . vhdl-template-subtype-hook)
3111                  ("then"          . vhdl-template-default-hook)
3112                  ("to"            . vhdl-template-default-hook)
3113                  ("transport"     . vhdl-template-default-hook)
3114                  ("type"          . vhdl-template-type-hook)
3115                  ("unaffected"    . vhdl-template-default-hook)
3116                  ("units"         . vhdl-template-default-hook)
3117                  ("until"         . vhdl-template-default-hook)
3118                  ("use"           . vhdl-template-use-hook)
3119                  ("var"           . vhdl-template-variable-hook)
3120                  ("variable"      . vhdl-template-variable-hook)
3121                  ("wait"          . vhdl-template-wait-hook)
3122                  ("when"          . vhdl-template-when-hook)
3123                  ("while"         . vhdl-template-while-loop-hook)
3124                  ("with"          . vhdl-template-with-hook)
3125                  ("xnor"          . vhdl-template-default-hook)
3126                  ("xor"           . vhdl-template-default-hook)
3127                  )))
3128      ;; VHDL-AMS keywords
3129      (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
3130        (mapcar (if (featurep 'xemacs)
3131                    (lambda (x) (list (car x) "" (cdr x) 0))
3132                  (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3133                '(
3134                  ("across"     . vhdl-template-default-hook)
3135                  ("break"      . vhdl-template-break-hook)
3136                  ("limit"      . vhdl-template-limit-hook)
3137                  ("nature"     . vhdl-template-nature-hook)
3138                  ("noise"      . vhdl-template-default-hook)
3139                  ("procedural" . vhdl-template-procedural-hook)
3140                  ("quantity"   . vhdl-template-quantity-hook)
3141                  ("reference"  . vhdl-template-default-hook)
3142                  ("spectrum"   . vhdl-template-default-hook)
3143                  ("subnature"  . vhdl-template-subnature-hook)
3144                  ("terminal"   . vhdl-template-terminal-hook)
3145                  ("through"    . vhdl-template-default-hook)
3146                  ("tolerance"  . vhdl-template-default-hook)
3147                  )))
3148      ;; user model keywords
3149      (when (memq 'user vhdl-electric-keywords)
3150        (let (abbrev-list keyword)
3151          (dolist (elem vhdl-model-alist)
3152            (setq keyword (nth 3 elem))
3153            (unless (equal keyword "")
3154              (push (list keyword ""
3155                          (vhdl-function-name
3156                           "vhdl-model" (nth 0 elem) "hook") 0 'system)
3157                    abbrev-list)))
3158          abbrev-list)))))
3159
3160 ;; initialize abbrev table for VHDL Mode
3161 (vhdl-mode-abbrev-table-init)
3162
3163 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3164 ;; Template completion lists
3165
3166 (defvar vhdl-template-construct-alist nil
3167   "List of built-in construct templates.")
3168
3169 (defun vhdl-template-construct-alist-init ()
3170   "Initialize `vhdl-template-construct-alist'."
3171   (setq
3172    vhdl-template-construct-alist
3173    (append
3174     '(
3175       ("alias declaration"                 vhdl-template-alias)
3176       ("architecture body"                 vhdl-template-architecture)
3177       ("assertion"                         vhdl-template-assert)
3178       ("attribute declaration"             vhdl-template-attribute-decl)
3179       ("attribute specification"           vhdl-template-attribute-spec)
3180       ("block configuration"               vhdl-template-block-configuration)
3181       ("block statement"                   vhdl-template-block)
3182       ("case statement"                    vhdl-template-case-is)
3183       ("component configuration"           vhdl-template-component-conf)
3184       ("component declaration"             vhdl-template-component-decl)
3185       ("component instantiation statement" vhdl-template-component-inst)
3186       ("conditional signal assignment"     vhdl-template-conditional-signal-asst)
3187       ("configuration declaration"         vhdl-template-configuration-decl)
3188       ("configuration specification"       vhdl-template-configuration-spec)
3189       ("constant declaration"              vhdl-template-constant)
3190       ("context declaration"               vhdl-template-context)
3191       ("disconnection specification"       vhdl-template-disconnect)
3192       ("entity declaration"                vhdl-template-entity)
3193       ("exit statement"                    vhdl-template-exit)
3194       ("file declaration"                  vhdl-template-file)
3195       ("generate statement"                vhdl-template-generate)
3196       ("generic clause"                    vhdl-template-generic)
3197       ("group declaration"                 vhdl-template-group-decl)
3198       ("group template declaration"        vhdl-template-group-template)
3199       ("if statement"                      vhdl-template-if-then)
3200       ("library clause"                    vhdl-template-library)
3201       ("loop statement"                    vhdl-template-loop)
3202       ("next statement"                    vhdl-template-next)
3203       ("package declaration"               vhdl-template-package-decl)
3204       ("package body"                      vhdl-template-package-body)
3205       ("port clause"                       vhdl-template-port)
3206       ("process statement"                 vhdl-template-process)
3207       ("report statement"                  vhdl-template-report)
3208       ("return statement"                  vhdl-template-return)
3209       ("selected signal assignment"        vhdl-template-selected-signal-asst)
3210       ("signal declaration"                vhdl-template-signal)
3211       ("subprogram declaration"            vhdl-template-subprogram-decl)
3212       ("subprogram body"                   vhdl-template-subprogram-body)
3213       ("subtype declaration"               vhdl-template-subtype)
3214       ("type declaration"                  vhdl-template-type)
3215       ("use clause"                        vhdl-template-use)
3216       ("variable declaration"              vhdl-template-variable)
3217       ("wait statement"                    vhdl-template-wait)
3218       )
3219     (when (vhdl-standard-p 'ams)
3220       '(
3221         ("break statement"                   vhdl-template-break)
3222         ("nature declaration"                vhdl-template-nature)
3223         ("quantity declaration"              vhdl-template-quantity)
3224         ("simultaneous case statement"       vhdl-template-case-use)
3225         ("simultaneous if statement"         vhdl-template-if-use)
3226         ("simultaneous procedural statement" vhdl-template-procedural)
3227         ("step limit specification"          vhdl-template-limit)
3228         ("subnature declaration"             vhdl-template-subnature)
3229         ("terminal declaration"              vhdl-template-terminal)
3230         )))))
3231
3232 ;; initialize for VHDL Mode
3233 (vhdl-template-construct-alist-init)
3234
3235 (defvar vhdl-template-package-alist nil
3236   "List of built-in package templates.")
3237
3238 (defun vhdl-template-package-alist-init ()
3239   "Initialize `vhdl-template-package-alist'."
3240   (setq
3241    vhdl-template-package-alist
3242    (append
3243     '(
3244       ("numeric_bit"        vhdl-template-package-numeric-bit)
3245       ("numeric_std"        vhdl-template-package-numeric-std)
3246       ("std_logic_1164"     vhdl-template-package-std-logic-1164)
3247       ("std_logic_arith"    vhdl-template-package-std-logic-arith)
3248       ("std_logic_misc"     vhdl-template-package-std-logic-misc)
3249       ("std_logic_signed"   vhdl-template-package-std-logic-signed)
3250       ("std_logic_textio"   vhdl-template-package-std-logic-textio)
3251       ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned)
3252       ("textio"             vhdl-template-package-textio)
3253       )
3254     (when (vhdl-standard-p 'math)
3255       '(
3256         ("math_complex" vhdl-template-package-math-complex)
3257         ("math_real"    vhdl-template-package-math-real)
3258         )))))
3259
3260 ;; initialize for VHDL Mode
3261 (vhdl-template-package-alist-init)
3262
3263 (defvar vhdl-template-directive-alist
3264   '(
3265     ("translate_on"     vhdl-template-directive-translate-on)
3266     ("translate_off"    vhdl-template-directive-translate-off)
3267     ("synthesis_on"     vhdl-template-directive-synthesis-on)
3268     ("synthesis_off"    vhdl-template-directive-synthesis-off)
3269     )
3270   "List of built-in directive templates.")
3271
3272
3273 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3274 ;;; Menus
3275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3276
3277 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3278 ;; VHDL menu (using `easy-menu.el')
3279
3280 (defun vhdl-customize ()
3281   "Call the customize function with `vhdl' as argument."
3282   (interactive)
3283   (customize-browse 'vhdl))
3284
3285 (defun vhdl-create-mode-menu ()
3286   "Create VHDL Mode menu."
3287   `("VHDL"
3288     ,(append
3289       '("Project"
3290         ["None"                 (vhdl-set-project "")
3291                                 :style radio :selected (null vhdl-project)]
3292         "--")
3293       ;; add menu entries for defined projects
3294       (let ((project-alist vhdl-project-alist) menu-list name)
3295         (while project-alist
3296           (setq name (caar project-alist))
3297           (setq menu-list
3298                 (cons `[,name (vhdl-set-project ,name)
3299                         :style radio :selected (equal ,name vhdl-project)]
3300                       menu-list))
3301           (setq project-alist (cdr project-alist)))
3302         (setq menu-list
3303               (if vhdl-project-sort
3304                   (sort menu-list
3305                         (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
3306                 (nreverse menu-list)))
3307         (vhdl-menu-split menu-list "Project"))
3308       '("--" "--"
3309         ["Select Project..."    vhdl-set-project t]
3310         ["Set As Default Project" vhdl-set-default-project t]
3311         "--"
3312         ["Duplicate Project"    vhdl-duplicate-project vhdl-project]
3313         ["Import Project..."    vhdl-import-project
3314                                 :keys "C-c C-p C-m" :active t]
3315         ["Export Project"       vhdl-export-project vhdl-project]
3316         "--"
3317         ["Customize Project..." (customize-option 'vhdl-project-alist) t]))
3318     "--"
3319     ("Compile"
3320      ["Compile Buffer"          vhdl-compile t]
3321      ["Stop Compilation"        kill-compilation t]
3322      "--"
3323      ["Make"                    vhdl-make t]
3324      ["Generate Makefile"       vhdl-generate-makefile t]
3325      "--"
3326      ["Next Error"              next-error t]
3327      ["Previous Error"          previous-error t]
3328      ["First Error"             first-error t]
3329      "--"
3330      ,(append
3331        '("Compiler")
3332        ;; add menu entries for defined compilers
3333        (let ((comp-alist vhdl-compiler-alist) menu-list name)
3334          (while comp-alist
3335            (setq name (caar comp-alist))
3336            (setq menu-list
3337                  (cons `[,name (setq vhdl-compiler ,name)
3338                          :style radio :selected (equal ,name vhdl-compiler)]
3339                        menu-list))
3340            (setq comp-alist (cdr comp-alist)))
3341          (setq menu-list (nreverse menu-list))
3342          (vhdl-menu-split menu-list "Compiler"))
3343        '("--" "--"
3344          ["Select Compiler..."  vhdl-set-compiler t]
3345          "--"
3346          ["Customize Compiler..."
3347           (customize-option 'vhdl-compiler-alist) t])))
3348     "--"
3349     ,(append
3350       '("Template"
3351         ("VHDL Construct 1"
3352          ["Alias"               vhdl-template-alias t]
3353          ["Architecture"        vhdl-template-architecture t]
3354          ["Assert"              vhdl-template-assert t]
3355          ["Attribute (Decl)"    vhdl-template-attribute-decl t]
3356          ["Attribute (Spec)"    vhdl-template-attribute-spec t]
3357          ["Block"               vhdl-template-block t]
3358          ["Case"                vhdl-template-case-is t]
3359          ["Component (Decl)"    vhdl-template-component-decl t]
3360          ["(Component) Instance"        vhdl-template-component-inst t]
3361          ["Conditional (Signal Asst)"   vhdl-template-conditional-signal-asst t]
3362          ["Configuration (Block)"       vhdl-template-block-configuration t]
3363          ["Configuration (Comp)"        vhdl-template-component-conf t]
3364          ["Configuration (Decl)"        vhdl-template-configuration-decl t]
3365          ["Configuration (Spec)"        vhdl-template-configuration-spec t]
3366          ["Constant"            vhdl-template-constant t]
3367          ["Context"             vhdl-template-context t]
3368          ["Disconnect"          vhdl-template-disconnect t]
3369          ["Else"                vhdl-template-else t]
3370          ["Elsif"               vhdl-template-elsif t]
3371          ["Entity"              vhdl-template-entity t]
3372          ["Exit"                vhdl-template-exit t]
3373          ["File"                vhdl-template-file t]
3374          ["For (Generate)"      vhdl-template-for-generate t]
3375          ["For (Loop)"          vhdl-template-for-loop t]
3376          ["Function (Body)"     vhdl-template-function-body t]
3377          ["Function (Decl)"     vhdl-template-function-decl t]
3378          ["Generic"             vhdl-template-generic t]
3379          ["Group (Decl)"        vhdl-template-group-decl t]
3380          ["Group (Template)"    vhdl-template-group-template t])
3381         ("VHDL Construct 2"
3382          ["If (Generate)"       vhdl-template-if-generate t]
3383          ["If (Then)"           vhdl-template-if-then t]
3384          ["Library"             vhdl-template-library t]
3385          ["Loop"                vhdl-template-bare-loop t]
3386          ["Map"                 vhdl-template-map t]
3387          ["Next"                vhdl-template-next t]
3388          ["Others (Aggregate)"  vhdl-template-others t]
3389          ["Package (Decl)"      vhdl-template-package-decl t]
3390          ["Package (Body)"      vhdl-template-package-body t]
3391          ["Port"                vhdl-template-port t]
3392          ["Procedure (Body)"    vhdl-template-procedure-body t]
3393          ["Procedure (Decl)"    vhdl-template-procedure-decl t]
3394          ["Process (Comb)"      vhdl-template-process-comb t]
3395          ["Process (Seq)"       vhdl-template-process-seq t]
3396          ["Report"              vhdl-template-report t]
3397          ["Return"              vhdl-template-return t]
3398          ["Select"              vhdl-template-selected-signal-asst t]
3399          ["Signal"              vhdl-template-signal t]
3400          ["Subtype"             vhdl-template-subtype t]
3401          ["Type"                vhdl-template-type t]
3402          ["Use"                 vhdl-template-use t]
3403          ["Variable"            vhdl-template-variable t]
3404          ["Wait"                vhdl-template-wait t]
3405          ["(Clocked Wait)"      vhdl-template-clocked-wait t]
3406          ["When"                vhdl-template-when t]
3407          ["While (Loop)"        vhdl-template-while-loop t]
3408          ["With"                vhdl-template-with t]))
3409       (when (vhdl-standard-p 'ams)
3410         '(("VHDL-AMS Construct"
3411            ["Break"             vhdl-template-break t]
3412            ["Case (Use)"        vhdl-template-case-use t]
3413            ["If (Use)"          vhdl-template-if-use t]
3414            ["Limit"             vhdl-template-limit t]
3415            ["Nature"            vhdl-template-nature t]
3416            ["Procedural"        vhdl-template-procedural t]
3417            ["Quantity (Free)"   vhdl-template-quantity-free t]
3418            ["Quantity (Branch)" vhdl-template-quantity-branch t]
3419            ["Quantity (Source)" vhdl-template-quantity-source t]
3420            ["Subnature"         vhdl-template-subnature t]
3421            ["Terminal"          vhdl-template-terminal t])))
3422       '(["Insert Construct..."  vhdl-template-insert-construct
3423                                 :keys "C-c C-i C-t"]
3424         "--")
3425       (list
3426        (append
3427         '("Package")
3428         '(["numeric_bit"        vhdl-template-package-numeric-bit t]
3429           ["numeric_std"        vhdl-template-package-numeric-std t]
3430           ["std_logic_1164"     vhdl-template-package-std-logic-1164 t]
3431           ["textio"             vhdl-template-package-textio t]
3432           "--"
3433           ["std_logic_arith"    vhdl-template-package-std-logic-arith t]
3434           ["std_logic_signed"   vhdl-template-package-std-logic-signed t]
3435           ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
3436           ["std_logic_misc"     vhdl-template-package-std-logic-misc t]
3437           ["std_logic_textio"   vhdl-template-package-std-logic-textio t]
3438           "--")
3439         (when (vhdl-standard-p 'ams)
3440           '(["fundamental_constants" vhdl-template-package-fundamental-constants t]
3441             ["material_constants" vhdl-template-package-material-constants t]
3442             ["energy_systems"   vhdl-template-package-energy-systems t]
3443             ["electrical_systems" vhdl-template-package-electrical-systems t]
3444             ["mechanical_systems" vhdl-template-package-mechanical-systems t]
3445             ["radiant_systems"  vhdl-template-package-radiant-systems t]
3446             ["thermal_systems"  vhdl-template-package-thermal-systems t]
3447             ["fluidic_systems"  vhdl-template-package-fluidic-systems t]
3448             "--"))
3449         (when (vhdl-standard-p 'math)
3450           '(["math_complex"     vhdl-template-package-math-complex t]
3451             ["math_real"        vhdl-template-package-math-real t]
3452             "--"))
3453         '(["Insert Package..."  vhdl-template-insert-package
3454                                 :keys "C-c C-i C-p"])))
3455       '(("Directive"
3456          ["translate_on"        vhdl-template-directive-translate-on t]
3457          ["translate_off"       vhdl-template-directive-translate-off t]
3458          ["synthesis_on"        vhdl-template-directive-synthesis-on t]
3459          ["synthesis_off"       vhdl-template-directive-synthesis-off t]
3460          "--"
3461          ["Insert Directive..." vhdl-template-insert-directive
3462                                 :keys "C-c C-i C-d"])
3463         "--"
3464         ["Insert Header"        vhdl-template-header :keys "C-c C-t C-h"]
3465         ["Insert Footer"        vhdl-template-footer t]
3466         ["Insert Date"          vhdl-template-insert-date t]
3467         ["Modify Date"          vhdl-template-modify :keys "C-c C-t C-m"]
3468         "--"
3469         ["Query Next Prompt"    vhdl-template-search-prompt t]))
3470     ,(append
3471       '("Model")
3472       ;; add menu entries for defined models
3473       (let ((model-alist vhdl-model-alist) menu-list model)
3474         (while model-alist
3475           (setq model (car model-alist))
3476           (setq menu-list
3477                 (cons
3478                  (vector
3479                   (nth 0 model)
3480                   (vhdl-function-name "vhdl-model" (nth 0 model))
3481                   :keys (concat "C-c C-m " (key-description (nth 2 model))))
3482                  menu-list))
3483           (setq model-alist (cdr model-alist)))
3484         (setq menu-list (nreverse menu-list))
3485         (vhdl-menu-split menu-list "Model"))
3486       '("--" "--"
3487         ["Insert Model..."      vhdl-model-insert :keys "C-c C-i C-m"]
3488         ["Customize Model..."   (customize-option 'vhdl-model-alist) t]))
3489     ("Port"
3490      ["Copy"                    vhdl-port-copy t]
3491      "--"
3492      ["Paste As Entity"         vhdl-port-paste-entity vhdl-port-list]
3493      ["Paste As Component"      vhdl-port-paste-component vhdl-port-list]
3494      ["Paste As Instance"       vhdl-port-paste-instance
3495                                 :keys "C-c C-p C-i" :active vhdl-port-list]
3496      ["Paste As Signals"        vhdl-port-paste-signals vhdl-port-list]
3497      ["Paste As Constants"      vhdl-port-paste-constants vhdl-port-list]
3498      ["Paste As Generic Map"    vhdl-port-paste-generic-map vhdl-port-list]
3499      ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3500      "--"
3501      ["Paste As Testbench"      vhdl-port-paste-testbench vhdl-port-list]
3502      "--"
3503      ["Flatten"                 vhdl-port-flatten
3504       :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3505      ["Reverse Direction"       vhdl-port-reverse-direction
3506       :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3507     ("Compose"
3508      ["New Component"           vhdl-compose-new-component t]
3509      ["Copy Component"          vhdl-port-copy t]
3510      ["Place Component"         vhdl-compose-place-component vhdl-port-list]
3511      ["Wire Components"         vhdl-compose-wire-components t]
3512      "--"
3513      ["Generate Configuration"  vhdl-compose-configuration t]
3514      ["Generate Components Package"     vhdl-compose-components-package t])
3515     ("Subprogram"
3516      ["Copy"                    vhdl-subprog-copy t]
3517      "--"
3518      ["Paste As Declaration"    vhdl-subprog-paste-declaration vhdl-subprog-list]
3519      ["Paste As Body"           vhdl-subprog-paste-body vhdl-subprog-list]
3520      ["Paste As Call"           vhdl-subprog-paste-call vhdl-subprog-list]
3521      "--"
3522      ["Flatten"                 vhdl-subprog-flatten
3523       :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3524     "--"
3525     ("Comment"
3526      ["(Un)Comment Out Region"  vhdl-comment-uncomment-region (mark)]
3527      "--"
3528      ["Insert Inline Comment"   vhdl-comment-append-inline t]
3529      ["Insert Horizontal Line"  vhdl-comment-display-line t]
3530      ["Insert Display Comment"  vhdl-comment-display t]
3531      "--"
3532      ["Fill Comment"            fill-paragraph t]
3533      ["Fill Comment Region"     fill-region (mark)]
3534      ["Kill Comment Region"     vhdl-comment-kill-region (mark)]
3535      ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3536     ("Line"
3537      ["Kill"                    vhdl-line-kill t]
3538      ["Copy"                    vhdl-line-copy t]
3539      ["Yank"                    vhdl-line-yank t]
3540      ["Expand"                  vhdl-line-expand t]
3541      "--"
3542      ["Transpose Next"          vhdl-line-transpose-next t]
3543      ["Transpose Prev"          vhdl-line-transpose-previous t]
3544      ["Open"                    vhdl-line-open t]
3545      ["Join"                    vhdl-delete-indentation t]
3546      "--"
3547      ["Goto"                    goto-line t]
3548      ["(Un)Comment Out"         vhdl-comment-uncomment-line t])
3549     ("Move"
3550      ["Forward Statement"       vhdl-end-of-statement t]
3551      ["Backward Statement"      vhdl-beginning-of-statement t]
3552      ["Forward Expression"      vhdl-forward-sexp t]
3553      ["Backward Expression"     vhdl-backward-sexp t]
3554      ["Forward Same Indent"     vhdl-forward-same-indent t]
3555      ["Backward Same Indent"    vhdl-backward-same-indent t]
3556      ["Forward Function"        vhdl-end-of-defun t]
3557      ["Backward Function"       vhdl-beginning-of-defun t]
3558      ["Mark Function"           vhdl-mark-defun t])
3559     "--"
3560     ("Indent"
3561      ["Line"                    indent-according-to-mode :keys "C-c C-i C-l"]
3562      ["Group"                   vhdl-indent-group :keys "C-c C-i C-g"]
3563      ["Region"                  vhdl-indent-region (mark)]
3564      ["Buffer"                  vhdl-indent-buffer :keys "C-c C-i C-b"])
3565     ("Align"
3566      ["Group"                   vhdl-align-group t]
3567      ["Same Indent"             vhdl-align-same-indent :keys "C-c C-a C-i"]
3568      ["List"                    vhdl-align-list t]
3569      ["Declarations"            vhdl-align-declarations t]
3570      ["Region"                  vhdl-align-region (mark)]
3571      ["Buffer"                  vhdl-align-buffer t]
3572      "--"
3573      ["Inline Comment Group"    vhdl-align-inline-comment-group t]
3574      ["Inline Comment Region"   vhdl-align-inline-comment-region (mark)]
3575      ["Inline Comment Buffer"   vhdl-align-inline-comment-buffer t])
3576     ("Fill"
3577      ["List"                    vhdl-fill-list t]
3578      ["Group"                   vhdl-fill-group t]
3579      ["Same Indent"             vhdl-fill-same-indent :keys "C-c C-f C-i"]
3580      ["Region"                  vhdl-fill-region (mark)])
3581     ("Beautify"
3582      ["Region"                  vhdl-beautify-region (mark)]
3583      ["Buffer"                  vhdl-beautify-buffer t])
3584     ("Fix"
3585      ["Generic/Port Clause"     vhdl-fix-clause t]
3586      ["Generic/Port Clause Buffer" vhdl-fix-clause t]
3587      "--"
3588      ["Case Region"             vhdl-fix-case-region (mark)]
3589      ["Case Buffer"             vhdl-fix-case-buffer t]
3590      "--"
3591      ["Whitespace Region"       vhdl-fixup-whitespace-region (mark)]
3592      ["Whitespace Buffer"       vhdl-fixup-whitespace-buffer t]
3593      "--"
3594      ["Statement Region"        vhdl-fix-statement-region (mark)]
3595      ["Statement Buffer"        vhdl-fix-statement-buffer t]
3596      "--"
3597      ["Trailing Spaces Buffer"  vhdl-remove-trailing-spaces t])
3598     ("Update"
3599      ["Sensitivity List"        vhdl-update-sensitivity-list-process t]
3600      ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t])
3601     "--"
3602     ["Fontify Buffer"           vhdl-fontify-buffer t]
3603     ["Statistics Buffer"        vhdl-statistics-buffer t]
3604     ["Show Messages"            vhdl-show-messages t]
3605     ["Syntactic Info"           vhdl-show-syntactic-information t]
3606     "--"
3607     ["Speedbar"                 vhdl-speedbar t]
3608     ["Hide/Show"                vhdl-hs-minor-mode t]
3609     "--"
3610     ("Documentation"
3611      ["VHDL Mode"               vhdl-doc-mode :keys "C-c C-h"]
3612      ["Release Notes"           (vhdl-doc-variable 'vhdl-doc-release-notes) t]
3613      ["Reserved Words"          (vhdl-doc-variable 'vhdl-doc-keywords) t]
3614      ["Coding Style"            (vhdl-doc-variable 'vhdl-doc-coding-style) t])
3615     ["Version"                  vhdl-version t]
3616     ["Bug Report..."            vhdl-submit-bug-report t]
3617     "--"
3618     ("Options"
3619      ("Mode"
3620       ["Electric Mode"
3621        (progn (customize-set-variable 'vhdl-electric-mode
3622                                       (not vhdl-electric-mode))
3623               (vhdl-mode-line-update))
3624        :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3625       ["Stutter Mode"
3626        (progn (customize-set-variable 'vhdl-stutter-mode
3627                                       (not vhdl-stutter-mode))
3628               (vhdl-mode-line-update))
3629        :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3630       ["Indent Tabs Mode"
3631        (progn (customize-set-variable 'vhdl-indent-tabs-mode
3632                                       (not vhdl-indent-tabs-mode))
3633               (setq indent-tabs-mode vhdl-indent-tabs-mode))
3634        :style toggle :selected vhdl-indent-tabs-mode]
3635       "--"
3636       ["Customize Group..." (customize-group 'vhdl-mode) t])
3637      ("Project"
3638       ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3639       ,(append
3640         '("Selected Project at Startup"
3641           ["None" (progn (customize-set-variable 'vhdl-project nil)
3642                          (vhdl-set-project ""))
3643            :style radio :selected (null vhdl-project)]
3644           "--")
3645         ;; add menu entries for defined projects
3646         (let ((project-alist vhdl-project-alist) menu-list name)
3647           (while project-alist
3648             (setq name (caar project-alist))
3649             (setq menu-list
3650                   (cons `[,name (progn (customize-set-variable
3651                                         'vhdl-project ,name)
3652                                        (vhdl-set-project ,name))
3653                           :style radio :selected (equal ,name vhdl-project)]
3654                         menu-list))
3655             (setq project-alist (cdr project-alist)))
3656           (setq menu-list (nreverse menu-list))
3657           (vhdl-menu-split menu-list "Project")))
3658       ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3659       ("Auto Load Setup File"
3660        ["At Startup"
3661         (customize-set-variable 'vhdl-project-auto-load
3662                                 (if (memq 'startup vhdl-project-auto-load)
3663                                    (delq 'startup vhdl-project-auto-load)
3664                                  (cons 'startup vhdl-project-auto-load)))
3665        :style toggle :selected (memq 'startup vhdl-project-auto-load)])
3666       ["Sort Projects"
3667        (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3668        :style toggle :selected vhdl-project-sort]
3669       "--"
3670       ["Customize Group..." (customize-group 'vhdl-project) t])
3671      ("Compiler"
3672       ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3673       ,(append
3674         '("Selected Compiler at Startup")
3675         ;; add menu entries for defined compilers
3676         (let ((comp-alist vhdl-compiler-alist) menu-list name)
3677           (while comp-alist
3678             (setq name (caar comp-alist))
3679             (setq menu-list
3680                   (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3681                           :style radio :selected (equal ,name vhdl-compiler)]
3682                         menu-list))
3683             (setq comp-alist (cdr comp-alist)))
3684           (setq menu-list (nreverse menu-list))
3685           (vhdl-menu-split menu-list "Compiler")))
3686       ["Use Local Error Regexp"
3687        (customize-set-variable 'vhdl-compile-use-local-error-regexp
3688                                (not vhdl-compile-use-local-error-regexp))
3689        :style toggle :selected vhdl-compile-use-local-error-regexp]
3690       ["Makefile Default Targets..."
3691        (customize-option 'vhdl-makefile-default-targets) t]
3692       ["Makefile Generation Hook..."
3693        (customize-option 'vhdl-makefile-generation-hook) t]
3694       ["Default Library Name" (customize-option 'vhdl-default-library) t]
3695       "--"
3696       ["Customize Group..." (customize-group 'vhdl-compiler) t])
3697      ("Style"
3698       ("VHDL Standard"
3699        ["VHDL'87"
3700         (progn (customize-set-variable 'vhdl-standard
3701                                        (list '87 (cadr vhdl-standard)))
3702                (vhdl-activate-customizations))
3703         :style radio :selected (eq '87 (car vhdl-standard))]
3704        ["VHDL'93/02"
3705         (progn (customize-set-variable 'vhdl-standard
3706                                        (list '93 (cadr vhdl-standard)))
3707                (vhdl-activate-customizations))
3708         :style radio :selected (eq '93 (car vhdl-standard))]
3709        ["VHDL'08"
3710         (progn (customize-set-variable 'vhdl-standard
3711                                        (list '08 (cadr vhdl-standard)))
3712                (vhdl-activate-customizations))
3713         :style radio :selected (eq '08 (car vhdl-standard))]
3714        "--"
3715        ["VHDL-AMS"
3716         (progn (customize-set-variable
3717                 'vhdl-standard (list (car vhdl-standard)
3718                                      (if (memq 'ams (cadr vhdl-standard))
3719                                          (delq 'ams (cadr vhdl-standard))
3720                                        (cons 'ams (cadr vhdl-standard)))))
3721                (vhdl-activate-customizations))
3722         :style toggle :selected (memq 'ams (cadr vhdl-standard))]
3723        ["Math Packages"
3724         (progn (customize-set-variable
3725                 'vhdl-standard (list (car vhdl-standard)
3726                                      (if (memq 'math (cadr vhdl-standard))
3727                                          (delq 'math (cadr vhdl-standard))
3728                                        (cons 'math (cadr vhdl-standard)))))
3729                (vhdl-activate-customizations))
3730         :style toggle :selected (memq 'math (cadr vhdl-standard))])
3731       ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3732       ["Upper Case Keywords"
3733        (customize-set-variable 'vhdl-upper-case-keywords
3734                                (not vhdl-upper-case-keywords))
3735        :style toggle :selected vhdl-upper-case-keywords]
3736       ["Upper Case Types"
3737        (customize-set-variable 'vhdl-upper-case-types
3738                                (not vhdl-upper-case-types))
3739        :style toggle :selected vhdl-upper-case-types]
3740       ["Upper Case Attributes"
3741        (customize-set-variable 'vhdl-upper-case-attributes
3742                                (not vhdl-upper-case-attributes))
3743        :style toggle :selected vhdl-upper-case-attributes]
3744       ["Upper Case Enumeration Values"
3745        (customize-set-variable 'vhdl-upper-case-enum-values
3746                                (not vhdl-upper-case-enum-values))
3747        :style toggle :selected vhdl-upper-case-enum-values]
3748       ["Upper Case Constants"
3749        (customize-set-variable 'vhdl-upper-case-constants
3750                                (not vhdl-upper-case-constants))
3751        :style toggle :selected vhdl-upper-case-constants]
3752       ("Use Direct Instantiation"
3753        ["Never"
3754         (customize-set-variable 'vhdl-use-direct-instantiation 'never)
3755         :style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3756        ["Standard"
3757         (customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3758         :style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3759        ["Always"
3760         (customize-set-variable 'vhdl-use-direct-instantiation 'always)
3761         :style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3762       ["Include Array Index and Record Field in Sensitivity List"
3763        (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
3764                                (not vhdl-array-index-record-field-in-sensitivity-list))
3765        :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list]
3766       "--"
3767       ["Customize Group..." (customize-group 'vhdl-style) t])
3768      ("Naming"
3769       ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3770       ["Architecture File Name..."
3771        (customize-option 'vhdl-architecture-file-name) t]
3772       ["Configuration File Name..."
3773        (customize-option 'vhdl-configuration-file-name) t]
3774       ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3775       ("File Name Case"
3776        ["As Is"
3777         (customize-set-variable 'vhdl-file-name-case 'identity)
3778         :style radio :selected (eq 'identity vhdl-file-name-case)]
3779        ["Lower Case"
3780         (customize-set-variable 'vhdl-file-name-case 'downcase)
3781         :style radio :selected (eq 'downcase vhdl-file-name-case)]
3782        ["Upper Case"
3783         (customize-set-variable 'vhdl-file-name-case 'upcase)
3784         :style radio :selected (eq 'upcase vhdl-file-name-case)]
3785        ["Capitalize"
3786         (customize-set-variable 'vhdl-file-name-case 'capitalize)
3787         :style radio :selected (eq 'capitalize vhdl-file-name-case)])
3788       "--"
3789       ["Customize Group..." (customize-group 'vhdl-naming) t])
3790      ("Template"
3791       ("Electric Keywords"
3792        ["VHDL Keywords"
3793         (customize-set-variable 'vhdl-electric-keywords
3794                                 (if (memq 'vhdl vhdl-electric-keywords)
3795                                     (delq 'vhdl vhdl-electric-keywords)
3796                                   (cons 'vhdl vhdl-electric-keywords)))
3797         :style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3798        ["User Model Keywords"
3799         (customize-set-variable 'vhdl-electric-keywords
3800                                 (if (memq 'user vhdl-electric-keywords)
3801                                      (delq 'user vhdl-electric-keywords)
3802                                    (cons 'user vhdl-electric-keywords)))
3803         :style toggle :selected (memq 'user vhdl-electric-keywords)])
3804       ("Insert Optional Labels"
3805        ["None"
3806         (customize-set-variable 'vhdl-optional-labels 'none)
3807         :style radio :selected (eq 'none vhdl-optional-labels)]
3808        ["Processes Only"
3809         (customize-set-variable 'vhdl-optional-labels 'process)
3810         :style radio :selected (eq 'process vhdl-optional-labels)]
3811        ["All Constructs"
3812         (customize-set-variable 'vhdl-optional-labels 'all)
3813         :style radio :selected (eq 'all vhdl-optional-labels)])
3814       ("Insert Empty Lines"
3815        ["None"
3816         (customize-set-variable 'vhdl-insert-empty-lines 'none)
3817         :style radio :selected (eq 'none vhdl-insert-empty-lines)]
3818        ["Design Units Only"
3819         (customize-set-variable 'vhdl-insert-empty-lines 'unit)
3820         :style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3821        ["All Constructs"
3822         (customize-set-variable 'vhdl-insert-empty-lines 'all)
3823         :style radio :selected (eq 'all vhdl-insert-empty-lines)])
3824       ["Argument List Indent"
3825        (customize-set-variable 'vhdl-argument-list-indent
3826                                (not vhdl-argument-list-indent))
3827        :style toggle :selected vhdl-argument-list-indent]
3828       ["Association List with Formals"
3829        (customize-set-variable 'vhdl-association-list-with-formals
3830                                (not vhdl-association-list-with-formals))
3831        :style toggle :selected vhdl-association-list-with-formals]
3832       ["Conditions in Parenthesis"
3833        (customize-set-variable 'vhdl-conditions-in-parenthesis
3834                                (not vhdl-conditions-in-parenthesis))
3835        :style toggle :selected vhdl-conditions-in-parenthesis]
3836       ["Sensitivity List uses 'all'"
3837        (customize-set-variable 'vhdl-sensitivity-list-all
3838                                (not vhdl-sensitivity-list-all))
3839        :style toggle :selected vhdl-sensitivity-list-all]
3840       ["Zero String..." (customize-option 'vhdl-zero-string) t]
3841       ["One String..." (customize-option 'vhdl-one-string) t]
3842       ("File Header"
3843        ["Header String..." (customize-option 'vhdl-file-header) t]
3844        ["Footer String..." (customize-option 'vhdl-file-footer) t]
3845        ["Company Name..." (customize-option 'vhdl-company-name) t]
3846        ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3847        ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3848        ["Date Format..." (customize-option 'vhdl-date-format) t]
3849        ["Modify Date Prefix String..."
3850         (customize-option 'vhdl-modify-date-prefix-string) t]
3851        ["Modify Date on Saving"
3852         (progn (customize-set-variable 'vhdl-modify-date-on-saving
3853                                        (not vhdl-modify-date-on-saving))
3854                (vhdl-activate-customizations))
3855         :style toggle :selected vhdl-modify-date-on-saving])
3856       ("Sequential Process"
3857        ("Kind of Reset"
3858         ["None"
3859          (customize-set-variable 'vhdl-reset-kind 'none)
3860          :style radio :selected (eq 'none vhdl-reset-kind)]
3861         ["Synchronous"
3862          (customize-set-variable 'vhdl-reset-kind 'sync)
3863          :style radio :selected (eq 'sync vhdl-reset-kind)]
3864         ["Asynchronous"
3865          (customize-set-variable 'vhdl-reset-kind 'async)
3866          :style radio :selected (eq 'async vhdl-reset-kind)]
3867         ["Query"
3868          (customize-set-variable 'vhdl-reset-kind 'query)
3869          :style radio :selected (eq 'query vhdl-reset-kind)])
3870        ["Reset is Active High"
3871         (customize-set-variable 'vhdl-reset-active-high
3872                                 (not vhdl-reset-active-high))
3873         :style toggle :selected vhdl-reset-active-high]
3874        ["Use Rising Clock Edge"
3875         (customize-set-variable 'vhdl-clock-rising-edge
3876                                 (not vhdl-clock-rising-edge))
3877         :style toggle :selected vhdl-clock-rising-edge]
3878        ("Clock Edge Condition"
3879         ["Standard"
3880          (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3881          :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3882         ["Function \"rising_edge\""
3883          (customize-set-variable 'vhdl-clock-edge-condition 'function)
3884          :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3885        ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3886        ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3887       "--"
3888       ["Customize Group..." (customize-group 'vhdl-template) t])
3889      ("Model"
3890       ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3891      ("Port"
3892       ["Include Port Comments"
3893        (customize-set-variable 'vhdl-include-port-comments
3894                                (not vhdl-include-port-comments))
3895        :style toggle :selected vhdl-include-port-comments]
3896       ["Include Direction Comments"
3897        (customize-set-variable 'vhdl-include-direction-comments
3898                                (not vhdl-include-direction-comments))
3899        :style toggle :selected vhdl-include-direction-comments]
3900       ["Include Type Comments"
3901        (customize-set-variable 'vhdl-include-type-comments
3902                                (not vhdl-include-type-comments))
3903        :style toggle :selected vhdl-include-type-comments]
3904       ("Include Group Comments"
3905        ["Never"
3906         (customize-set-variable 'vhdl-include-group-comments 'never)
3907         :style radio :selected (eq 'never vhdl-include-group-comments)]
3908        ["Declarations"
3909         (customize-set-variable 'vhdl-include-group-comments 'decl)
3910         :style radio :selected (eq 'decl vhdl-include-group-comments)]
3911        ["Always"
3912         (customize-set-variable 'vhdl-include-group-comments 'always)
3913         :style radio :selected (eq 'always vhdl-include-group-comments)])
3914       ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t]
3915       ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3916       ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3917       ("Testbench"
3918        ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3919        ["Architecture Name..."
3920         (customize-option 'vhdl-testbench-architecture-name) t]
3921        ["Configuration Name..."
3922         (customize-option 'vhdl-testbench-configuration-name) t]
3923        ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3924        ["Include Header"
3925         (customize-set-variable 'vhdl-testbench-include-header
3926                                 (not vhdl-testbench-include-header))
3927         :style toggle :selected vhdl-testbench-include-header]
3928        ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3929        ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3930        ["Initialize Signals"
3931         (customize-set-variable 'vhdl-testbench-initialize-signals
3932                                 (not vhdl-testbench-initialize-signals))
3933         :style toggle :selected vhdl-testbench-initialize-signals]
3934        ["Include Library Clause"
3935         (customize-set-variable 'vhdl-testbench-include-library
3936                                 (not vhdl-testbench-include-library))
3937         :style toggle :selected vhdl-testbench-include-library]
3938        ["Include Configuration"
3939         (customize-set-variable 'vhdl-testbench-include-configuration
3940                                 (not vhdl-testbench-include-configuration))
3941         :style toggle :selected vhdl-testbench-include-configuration]
3942        ("Create Files"
3943         ["None"
3944          (customize-set-variable 'vhdl-testbench-create-files 'none)
3945          :style radio :selected (eq 'none vhdl-testbench-create-files)]
3946         ["Single"
3947          (customize-set-variable 'vhdl-testbench-create-files 'single)
3948          :style radio :selected (eq 'single vhdl-testbench-create-files)]
3949         ["Separate"
3950          (customize-set-variable 'vhdl-testbench-create-files 'separate)
3951          :style radio :selected (eq 'separate vhdl-testbench-create-files)])
3952        ["Testbench Entity File Name..."
3953         (customize-option 'vhdl-testbench-entity-file-name) t]
3954        ["Testbench Architecture File Name..."
3955         (customize-option 'vhdl-testbench-architecture-file-name) t])
3956       "--"
3957       ["Customize Group..." (customize-group 'vhdl-port) t])
3958      ("Compose"
3959       ["Architecture Name..."
3960        (customize-option 'vhdl-compose-architecture-name) t]
3961       ["Configuration Name..."
3962        (customize-option 'vhdl-compose-configuration-name) t]
3963       ["Components Package Name..."
3964        (customize-option 'vhdl-components-package-name) t]
3965       ["Use Components Package"
3966        (customize-set-variable 'vhdl-use-components-package
3967                                (not vhdl-use-components-package))
3968        :style toggle :selected vhdl-use-components-package]
3969       ["Include Header"
3970        (customize-set-variable 'vhdl-compose-include-header
3971                                (not vhdl-compose-include-header))
3972        :style toggle :selected vhdl-compose-include-header]
3973       ("Create Entity/Architecture Files"
3974        ["None"
3975         (customize-set-variable 'vhdl-compose-create-files 'none)
3976         :style radio :selected (eq 'none vhdl-compose-create-files)]
3977        ["Single"
3978         (customize-set-variable 'vhdl-compose-create-files 'single)
3979         :style radio :selected (eq 'single vhdl-compose-create-files)]
3980        ["Separate"
3981         (customize-set-variable 'vhdl-compose-create-files 'separate)
3982         :style radio :selected (eq 'separate vhdl-compose-create-files)])
3983       ["Create Configuration File"
3984        (customize-set-variable 'vhdl-compose-configuration-create-file
3985                                (not vhdl-compose-configuration-create-file))
3986        :style toggle :selected vhdl-compose-configuration-create-file]
3987       ["Hierarchical Configuration"
3988        (customize-set-variable 'vhdl-compose-configuration-hierarchical
3989                                (not vhdl-compose-configuration-hierarchical))
3990        :style toggle :selected vhdl-compose-configuration-hierarchical]
3991       ["Use Subconfiguration"
3992        (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration
3993                                (not vhdl-compose-configuration-use-subconfiguration))
3994        :style toggle :selected vhdl-compose-configuration-use-subconfiguration]
3995       "--"
3996       ["Customize Group..." (customize-group 'vhdl-compose) t])
3997      ("Comment"
3998       ["Self Insert Comments"
3999        (customize-set-variable 'vhdl-self-insert-comments
4000                                (not vhdl-self-insert-comments))
4001        :style toggle :selected vhdl-self-insert-comments]
4002       ["Prompt for Comments"
4003        (customize-set-variable 'vhdl-prompt-for-comments
4004                                (not vhdl-prompt-for-comments))
4005        :style toggle :selected vhdl-prompt-for-comments]
4006       ["Inline Comment Column..."
4007        (customize-option 'vhdl-inline-comment-column) t]
4008       ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
4009       "--"
4010       ["Customize Group..." (customize-group 'vhdl-comment) t])
4011      ("Beautify"
4012       ["Auto Align Templates"
4013        (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
4014        :style toggle :selected vhdl-auto-align]
4015       ["Align Line Groups"
4016        (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
4017        :style toggle :selected vhdl-align-groups]
4018       ["Group Separation String..."
4019        (customize-option 'vhdl-align-group-separate) t]
4020       ["Align Lines with Same Indent"
4021        (customize-set-variable 'vhdl-align-same-indent
4022                                (not vhdl-align-same-indent))
4023        :style toggle :selected vhdl-align-same-indent]
4024       ["Beautify Options..." (customize-option 'vhdl-beautify-options) t]
4025       "--"
4026       ["Customize Group..." (customize-group 'vhdl-beautify) t])
4027      ("Highlight"
4028       ["Highlighting On/Off..."
4029        (customize-option
4030         (if (fboundp 'global-font-lock-mode)
4031             'global-font-lock-mode 'font-lock-auto-fontify)) t]
4032       ["Highlight Keywords"
4033        (progn (customize-set-variable 'vhdl-highlight-keywords
4034                                       (not vhdl-highlight-keywords))
4035               (vhdl-fontify-buffer))
4036        :style toggle :selected vhdl-highlight-keywords]
4037       ["Highlight Names"
4038        (progn (customize-set-variable 'vhdl-highlight-names
4039                                       (not vhdl-highlight-names))
4040               (vhdl-fontify-buffer))
4041        :style toggle :selected vhdl-highlight-names]
4042       ["Highlight Special Words"
4043        (progn (customize-set-variable 'vhdl-highlight-special-words
4044                                       (not vhdl-highlight-special-words))
4045               (vhdl-fontify-buffer))
4046        :style toggle :selected vhdl-highlight-special-words]
4047       ["Highlight Forbidden Words"
4048        (progn (customize-set-variable 'vhdl-highlight-forbidden-words
4049                                       (not vhdl-highlight-forbidden-words))
4050               (vhdl-fontify-buffer))
4051        :style toggle :selected vhdl-highlight-forbidden-words]
4052       ["Highlight Verilog Keywords"
4053        (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
4054                                       (not vhdl-highlight-verilog-keywords))
4055               (vhdl-fontify-buffer))
4056        :style toggle :selected vhdl-highlight-verilog-keywords]
4057       ["Highlight \"translate_off\""
4058        (progn (customize-set-variable 'vhdl-highlight-translate-off
4059                                       (not vhdl-highlight-translate-off))
4060               (vhdl-fontify-buffer))
4061        :style toggle :selected vhdl-highlight-translate-off]
4062       ["Case Sensitive Highlighting"
4063        (progn (customize-set-variable 'vhdl-highlight-case-sensitive
4064                                       (not vhdl-highlight-case-sensitive))
4065               (vhdl-fontify-buffer))
4066        :style toggle :selected vhdl-highlight-case-sensitive]
4067       ["Special Syntax Definition..."
4068        (customize-option 'vhdl-special-syntax-alist) t]
4069       ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
4070       ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
4071       ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
4072       ["Colors..." (customize-group 'vhdl-highlight-faces) t]
4073       "--"
4074       ["Customize Group..." (customize-group 'vhdl-highlight) t])
4075      ("Speedbar"
4076       ["Auto Open at Startup"
4077        (customize-set-variable 'vhdl-speedbar-auto-open
4078                                (not vhdl-speedbar-auto-open))
4079        :style toggle :selected vhdl-speedbar-auto-open]
4080       ("Default Displaying Mode"
4081        ["Files"
4082         (customize-set-variable 'vhdl-speedbar-display-mode 'files)
4083         :style radio :selected (eq 'files vhdl-speedbar-display-mode)]
4084        ["Directory Hierarchy"
4085         (customize-set-variable 'vhdl-speedbar-display-mode 'directory)
4086         :style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
4087        ["Project Hierarchy"
4088         (customize-set-variable 'vhdl-speedbar-display-mode 'project)
4089         :style radio :selected (eq 'project vhdl-speedbar-display-mode)])
4090       ["Indentation Offset..."
4091        (customize-option 'speedbar-indentation-width) t]
4092       ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
4093       ["Jump to Unit when Opening"
4094        (customize-set-variable 'vhdl-speedbar-jump-to-unit
4095                                (not vhdl-speedbar-jump-to-unit))
4096        :style toggle :selected vhdl-speedbar-jump-to-unit]
4097       ["Update Hierarchy on File Saving"
4098        (customize-set-variable 'vhdl-speedbar-update-on-saving
4099                                (not vhdl-speedbar-update-on-saving))
4100        :style toggle :selected vhdl-speedbar-update-on-saving]
4101       ("Save in Cache File"
4102        ["Hierarchy Information"
4103         (customize-set-variable 'vhdl-speedbar-save-cache
4104                                 (if (memq 'hierarchy vhdl-speedbar-save-cache)
4105                                     (delq 'hierarchy vhdl-speedbar-save-cache)
4106                                   (cons 'hierarchy vhdl-speedbar-save-cache)))
4107         :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
4108        ["Displaying Status"
4109         (customize-set-variable 'vhdl-speedbar-save-cache
4110                                 (if (memq 'display vhdl-speedbar-save-cache)
4111                                     (delq 'display vhdl-speedbar-save-cache)
4112                                   (cons 'display vhdl-speedbar-save-cache)))
4113         :style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
4114       ["Cache File Name..."
4115        (customize-option 'vhdl-speedbar-cache-file-name) t]
4116       "--"
4117       ["Customize Group..." (customize-group 'vhdl-speedbar) t])
4118      ("Menu"
4119       ["Add Index Menu when Loading File"
4120        (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
4121               (vhdl-index-menu-init))
4122        :style toggle :selected vhdl-index-menu]
4123       ["Add Source File Menu when Loading File"
4124        (progn (customize-set-variable 'vhdl-source-file-menu
4125                                       (not vhdl-source-file-menu))
4126               (vhdl-add-source-files-menu))
4127        :style toggle :selected vhdl-source-file-menu]
4128       ["Add Hideshow Menu at Startup"
4129        (progn (customize-set-variable 'vhdl-hideshow-menu
4130                                       (not vhdl-hideshow-menu))
4131               (vhdl-activate-customizations))
4132        :style toggle :selected vhdl-hideshow-menu]
4133       ["Hide Everything Initially"
4134        (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
4135        :style toggle :selected vhdl-hide-all-init]
4136       "--"
4137       ["Customize Group..." (customize-group 'vhdl-menu) t])
4138      ("Print"
4139       ["In Two Column Format"
4140        (progn (customize-set-variable 'vhdl-print-two-column
4141                                       (not vhdl-print-two-column))
4142               (message "Activate new setting by saving options and restarting Emacs"))
4143        :style toggle :selected vhdl-print-two-column]
4144       ["Use Customized Faces"
4145        (progn (customize-set-variable 'vhdl-print-customize-faces
4146                                       (not vhdl-print-customize-faces))
4147               (message "Activate new setting by saving options and restarting Emacs"))
4148        :style toggle :selected vhdl-print-customize-faces]
4149       "--"
4150       ["Customize Group..." (customize-group 'vhdl-print) t])
4151      ("Miscellaneous"
4152       ["Use Intelligent Tab"
4153        (progn (customize-set-variable 'vhdl-intelligent-tab
4154                                       (not vhdl-intelligent-tab))
4155               (vhdl-activate-customizations))
4156        :style toggle :selected vhdl-intelligent-tab]
4157       ["Indent Syntax-Based"
4158        (customize-set-variable 'vhdl-indent-syntax-based
4159                                (not vhdl-indent-syntax-based))
4160        :style toggle :selected vhdl-indent-syntax-based]
4161       ["Indent Comments Like Next Code Line"
4162        (customize-set-variable 'vhdl-indent-comment-like-next-code-line
4163                                (not vhdl-indent-comment-like-next-code-line))
4164        :style toggle :selected vhdl-indent-comment-like-next-code-line]
4165       ["Word Completion is Case Sensitive"
4166        (customize-set-variable 'vhdl-word-completion-case-sensitive
4167                                (not vhdl-word-completion-case-sensitive))
4168        :style toggle :selected vhdl-word-completion-case-sensitive]
4169       ["Word Completion in Minibuffer"
4170        (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
4171                                       (not vhdl-word-completion-in-minibuffer))
4172               (message "Activate new setting by saving options and restarting Emacs"))
4173        :style toggle :selected vhdl-word-completion-in-minibuffer]
4174       ["Underscore is Part of Word"
4175        (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
4176                                       (not vhdl-underscore-is-part-of-word))
4177               (vhdl-activate-customizations))
4178        :style toggle :selected vhdl-underscore-is-part-of-word]
4179       "--"
4180       ["Customize Group..." (customize-group 'vhdl-misc) t])
4181      ["Related..." (customize-browse 'vhdl-related) t]
4182      "--"
4183      ["Save Options" customize-save-customized t]
4184      ["Activate Options" vhdl-activate-customizations t]
4185      ["Browse Options..." vhdl-customize t])))
4186
4187 (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
4188   "VHDL Mode menu.")
4189
4190 (defun vhdl-update-mode-menu ()
4191   "Update VHDL Mode menu."
4192   (interactive)
4193   (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
4194   (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
4195   (easy-menu-add vhdl-mode-menu-list)   ; for XEmacs
4196   (easy-menu-define vhdl-mode-menu vhdl-mode-map
4197                     "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
4198
4199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4200 ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
4201
4202 (defconst vhdl-imenu-generic-expression
4203   '(
4204     ("Subprogram"
4205      "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4206      4)
4207     ("Instance"
4208      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
4209      1)
4210     ("Component"
4211      "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4212      2)
4213     ("Procedural"
4214      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
4215      1)
4216     ("Process"
4217      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
4218      1)
4219     ("Block"
4220      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
4221      1)
4222     ("Package"
4223      "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4224      3)
4225     ("Configuration"
4226      "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4227      2)
4228     ("Architecture"
4229      "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4230      2)
4231     ("Entity"
4232      "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4233      2)
4234     ("Context"
4235      "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4236      2)
4237     )
4238   "Imenu generic expression for VHDL Mode.  See `imenu-generic-expression'.")
4239
4240 (defun vhdl-index-menu-init ()
4241   "Initialize index menu."
4242   (set (make-local-variable 'imenu-case-fold-search) t)
4243   (set (make-local-variable 'imenu-generic-expression)
4244        vhdl-imenu-generic-expression)
4245   (when (and vhdl-index-menu (fboundp 'imenu))
4246     (imenu-add-to-menubar "Index")))
4247
4248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4249 ;; Source file menu (using `easy-menu.el')
4250
4251 (defvar vhdl-sources-menu nil)
4252
4253 (defun vhdl-directory-files (directory &optional full match)
4254   "Call `directory-files' if DIRECTORY exists, otherwise generate error
4255 message."
4256   (if (not (file-directory-p directory))
4257       (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
4258     (let ((dir (directory-files directory full match)))
4259       (setq dir (delete "." dir))
4260       (setq dir (delete ".." dir))
4261       dir)))
4262
4263 (defun vhdl-get-source-files (&optional full directory)
4264   "Get list of VHDL source files in DIRECTORY or current directory."
4265   (let ((mode-alist auto-mode-alist)
4266         filename-regexp)
4267     ;; create regular expressions for matching file names
4268     (setq filename-regexp "\\`[^.].*\\(")
4269     (while mode-alist
4270       (when (eq (cdar mode-alist) 'vhdl-mode)
4271         (setq filename-regexp
4272               (concat filename-regexp (caar mode-alist) "\\|")))
4273       (setq mode-alist (cdr mode-alist)))
4274     (setq filename-regexp
4275           (concat (substring filename-regexp 0
4276                              (string-match "\\\\|$" filename-regexp)) "\\)"))
4277     ;; find files
4278     (vhdl-directory-files
4279      (or directory default-directory) full filename-regexp)))
4280
4281 (defun vhdl-add-source-files-menu ()
4282   "Scan directory for all VHDL source files and generate menu.
4283 The directory of the current source file is scanned."
4284   (interactive)
4285   (message "Scanning directory for source files ...")
4286   (let ((newmap (current-local-map))
4287         (file-list (vhdl-get-source-files))
4288         menu-list found)
4289     ;; Create list for menu
4290     (setq found nil)
4291     (while file-list
4292       (setq found t)
4293       (push (vector (car file-list) (list 'find-file (car file-list)) t)
4294             menu-list)
4295       (setq file-list (cdr file-list)))
4296     (setq menu-list (vhdl-menu-split menu-list "Sources"))
4297     (when found (push "--" menu-list))
4298     (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list)
4299     (push "Sources" menu-list)
4300     ;; Create menu
4301     (easy-menu-add menu-list)
4302     (easy-menu-define vhdl-sources-menu newmap
4303                       "VHDL source files menu" menu-list))
4304   (message ""))
4305
4306
4307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4308 ;;; Mode definition
4309 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4310 ;; performs all buffer local initializations
4311
4312 ;;;###autoload
4313 (define-derived-mode vhdl-mode prog-mode
4314   '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/"))
4315            (vhdl-electric-mode "e")
4316            (vhdl-stutter-mode "s"))
4317   "Major mode for editing VHDL code.
4318
4319 Usage:
4320 ------
4321
4322   TEMPLATE INSERTION (electrification):
4323     After typing a VHDL keyword and entering `SPC', you are prompted for
4324     arguments while a template is generated for that VHDL construct.  Typing
4325     `RET' or `C-g' at the first \(mandatory) prompt aborts the current
4326     template generation.  Optional arguments are indicated by square
4327     brackets and removed if the queried string is left empty.  Prompts for
4328     mandatory arguments remain in the code if the queried string is left
4329     empty.  They can be queried again by `C-c C-t C-q'.  Enabled
4330     electrification is indicated by `/e' in the mode line.
4331
4332       Typing `M-SPC' after a keyword inserts a space without calling the
4333     template generator.  Automatic template generation (i.e.
4334     electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4335     setting option `vhdl-electric-mode' (see OPTIONS).
4336
4337       Template generators can be invoked from the VHDL menu, by key
4338     bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4339     the keyword (i.e. first word of menu entry not in parenthesis) and
4340     `SPC'.  The following abbreviations can also be used: arch, attr, cond,
4341     conf, comp, cons, func, inst, pack, sig, var.
4342
4343       Template styles can be customized in customization group
4344     `vhdl-template' \(see OPTIONS).
4345
4346
4347   HEADER INSERTION:
4348     A file header can be inserted by `C-c C-t C-h'.  A file footer
4349     (template at the end of the file) can be inserted by `C-c C-t C-f'.
4350     See customization group `vhdl-header'.
4351
4352
4353   STUTTERING:
4354     Double striking of some keys inserts cumbersome VHDL syntax elements.
4355     Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4356     option `vhdl-stutter-mode'.  Enabled stuttering is indicated by `/s' in
4357     the mode line.  The stuttering keys and their effects are:
4358
4359       ;;   -->  \" : \"       [   -->  (        --    -->  comment
4360       ;;;  -->  \" := \"      [[  -->  [        --CR  -->  comment-out code
4361       ..   -->  \" => \"      ]   -->  )        ---   -->  horizontal line
4362       ,,   -->  \" <= \"      ]]  -->  ]        ----  -->  display comment
4363       ==   -->  \" == \"      ''  -->  \\\"
4364
4365
4366   WORD COMPLETION:
4367     Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4368     word in the buffer that starts alike, inserts it and adjusts case.
4369     Re-typing `TAB' toggles through alternative word completions.  This also
4370     works in the minibuffer (i.e. in template generator prompts).
4371
4372       Typing `TAB' after `(' looks for and inserts complete parenthesized
4373     expressions (e.g. for array index ranges).  All keywords as well as
4374     standard types and subprograms of VHDL have predefined abbreviations
4375     \(e.g. type \"std\" and `TAB' will toggle through all standard types
4376     beginning with \"std\").
4377
4378       Typing `TAB' after a non-word character indents the line if at the
4379     beginning of a line (i.e. no preceding non-blank characters), and
4380     inserts a tabulator stop otherwise.  `M-TAB' always inserts a tabulator
4381     stop.
4382
4383
4384   COMMENTS:
4385         `--'       puts a single comment.
4386         `---'      draws a horizontal line for separating code segments.
4387         `----'     inserts a display comment, i.e. two horizontal lines
4388                    with a comment in between.
4389         `--CR'     comments out code on that line.  Re-hitting CR comments
4390                    out following lines.
4391         `C-c C-c'  comments out a region if not commented out,
4392                    uncomments a region if already commented out.  Option
4393                    `comment-style' defines where the comment characters
4394                    should be placed (beginning of line, indent, etc.).
4395
4396       You are prompted for comments after object definitions (i.e. signals,
4397     variables, constants, ports) and after subprogram and process
4398     specifications if option `vhdl-prompt-for-comments' is non-nil.
4399     Comments are automatically inserted as additional labels (e.g. after
4400     begin statements) and as help comments if `vhdl-self-insert-comments' is
4401     non-nil.
4402
4403       Inline comments (i.e. comments after a piece of code on the same line)
4404     are indented at least to `vhdl-inline-comment-column'.  Comments go at
4405     maximum to `vhdl-end-comment-column'.  `RET' after a space in a comment
4406     will open a new comment line.  Typing beyond `vhdl-end-comment-column'
4407     in a comment automatically opens a new comment line.  `M-q' re-fills
4408     multi-line comments.
4409
4410
4411   INDENTATION:
4412     `TAB' indents a line if at the beginning of the line.  The amount of
4413     indentation is specified by option `vhdl-basic-offset'.  `C-c C-i C-l'
4414     always indents the current line (is bound to `TAB' if option
4415     `vhdl-intelligent-tab' is nil).  If a region is active, `TAB' indents
4416     the entire region.
4417
4418       Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4419     \(`M-C-\\') or the entire buffer (menu).  Argument and port lists are
4420     indented normally (nil) or relative to the opening parenthesis (non-nil)
4421     according to option `vhdl-argument-list-indent'.
4422
4423       If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4424     tabs.  `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
4425     and vice versa.
4426
4427       Syntax-based indentation can be very slow in large files.  Option
4428     `vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
4429
4430       Option `vhdl-indent-comment-like-next-code-line' controls whether
4431     comment lines are indented like the preceding or like the following code
4432     line.
4433
4434
4435   ALIGNMENT:
4436     The alignment functions align operators, keywords, and inline comments
4437     to beautify the code.  `C-c C-a C-a' aligns a group of consecutive lines
4438     separated by blank lines, `C-c C-a C-i' a block of lines with same
4439     indent.  `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4440     a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4441     C-a C-d' all lines within the declarative part of a design unit.  `C-c
4442     C-a M-a' aligns an entire region.  `C-c C-a C-c' aligns inline comments
4443     for a group of lines, and `C-c C-a M-c' for a region.
4444
4445       If option `vhdl-align-groups' is non-nil, groups of code lines
4446     separated by special lines (see option `vhdl-align-group-separate') are
4447     aligned individually.  If option `vhdl-align-same-indent' is non-nil,
4448     blocks of lines with same indent are aligned separately.  Some templates
4449     are automatically aligned after generation if option `vhdl-auto-align'
4450     is non-nil.
4451
4452       Alignment tries to align inline comments at
4453     `vhdl-inline-comment-column' and tries inline comment not to exceed
4454     `vhdl-end-comment-column'.
4455
4456       `C-c C-x M-w' fixes up whitespace in a region.  That is, operator
4457     symbols are surrounded by one space, and multiple spaces are eliminated.
4458
4459
4460   CODE FILLING:
4461     Code filling allows you to condense code (e.g. sensitivity lists or port
4462     maps) by removing comments and newlines and re-wrapping so that all
4463     lines are maximally filled (block filling).  `C-c C-f C-f' fills a list
4464     enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4465     blank lines, `C-c C-f C-i' a block of lines with same indent, and
4466     `C-c C-f M-f' an entire region.
4467
4468
4469   CODE BEAUTIFICATION:
4470     `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4471     buffer respectively.  This includes indentation, alignment, and case
4472     fixing.  Code beautification can also be run non-interactively using the
4473     command:
4474
4475       emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4476
4477
4478   PORT TRANSLATION:
4479     Generic and port clauses from entity or component declarations can be
4480     copied (`C-c C-p C-w') and pasted as entity and component declarations,
4481     as component instantiations and corresponding internal constants and
4482     signals, as a generic map with constants as actual generics, and as
4483     internal signal initializations (menu).
4484
4485       To include formals in component instantiations, see option
4486     `vhdl-association-list-with-formals'.  To include comments in pasting,
4487     see options `vhdl-include-...-comments'.
4488
4489       A clause with several generic/port names on the same line can be
4490     flattened (`C-c C-p C-f') so that only one name per line exists.  The
4491     direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4492     outputs and vice versa, which can be useful in testbenches.  (This
4493     reversion is done on the internal data structure and is only reflected
4494     in subsequent paste operations.)
4495
4496       Names for actual ports, instances, testbenches, and
4497     design-under-test instances can be derived from existing names according
4498     to options `vhdl-...-name'.  See customization group `vhdl-port'.
4499
4500
4501   SUBPROGRAM TRANSLATION:
4502     Similar functionality exists for copying/pasting the interface of
4503     subprograms (function/procedure).  A subprogram interface can be copied
4504     and then pasted as a subprogram declaration, body or call (uses
4505     association list with formals).
4506
4507
4508   TESTBENCH GENERATION:
4509     A copied port can also be pasted as a testbench.  The generated
4510     testbench includes an entity, an architecture, and an optional
4511     configuration.  The architecture contains the component declaration and
4512     instantiation of the DUT as well as internal constant and signal
4513     declarations.  Additional user-defined templates can be inserted.  The
4514     names used for entity/architecture/configuration/DUT as well as the file
4515     structure to be generated can be customized. See customization group
4516    `vhdl-testbench'.
4517
4518
4519   KEY BINDINGS:
4520     Key bindings (`C-c ...') exist for most commands (see in menu).
4521
4522
4523   VHDL MENU:
4524     All commands can be found in the VHDL menu including their key bindings.
4525
4526
4527   FILE BROWSER:
4528     The speedbar allows browsing of directories and file contents.  It can
4529     be accessed from the VHDL menu and is automatically opened if option
4530     `vhdl-speedbar-auto-open' is non-nil.
4531
4532       In speedbar, open files and directories with `mouse-2' on the name and
4533     browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4534
4535
4536   DESIGN HIERARCHY BROWSER:
4537     The speedbar can also be used for browsing the hierarchy of design units
4538     contained in the source files of the current directory or the specified
4539     projects (see option `vhdl-project-alist').
4540
4541       The speedbar can be switched between file, directory hierarchy and
4542     project hierarchy browsing mode in the speedbar menu or by typing `f',
4543     `h' or `H' in speedbar.
4544
4545       In speedbar, open design units with `mouse-2' on the name and browse
4546     their hierarchy with `mouse-2' on the `+'.  Ports can directly be copied
4547     from entities and components (in packages).  Individual design units and
4548     complete designs can directly be compiled (\"Make\" menu entry).
4549
4550       The hierarchy is automatically updated upon saving a modified source
4551     file when option `vhdl-speedbar-update-on-saving' is non-nil.  The
4552     hierarchy is only updated for projects that have been opened once in the
4553     speedbar.  The hierarchy is cached between Emacs sessions in a file (see
4554     options in group `vhdl-speedbar').
4555
4556       Simple design consistency checks are done during scanning, such as
4557     multiple declarations of the same unit or missing primary units that are
4558     required by secondary units.
4559
4560
4561   STRUCTURAL COMPOSITION:
4562     Enables simple structural composition.  `C-c C-m C-n' creates a skeleton
4563     for a new component.  Subcomponents (i.e. component declaration and
4564     instantiation) can be automatically placed from a previously read port
4565     \(`C-c C-m C-p') or directly from the hierarchy browser (`P').  Finally,
4566     all subcomponents can be automatically connected using internal signals
4567     and ports (`C-c C-m C-w') following these rules:
4568       - subcomponent actual ports with same name are considered to be
4569         connected by a signal (internal signal or port)
4570       - signals that are only inputs to subcomponents are considered as
4571         inputs to this component -> input port created
4572       - signals that are only outputs from subcomponents are considered as
4573         outputs from this component -> output port created
4574       - signals that are inputs to AND outputs from subcomponents are
4575         considered as internal connections -> internal signal created
4576
4577       Purpose:  With appropriate naming conventions it is possible to
4578     create higher design levels with only a few mouse clicks or key
4579     strokes.  A new design level can be created by simply generating a new
4580     component, placing the required subcomponents from the hierarchy
4581     browser, and wiring everything automatically.
4582
4583       Note: Automatic wiring only works reliably on templates of new
4584     components and component instantiations that were created by VHDL mode.
4585
4586       Component declarations can be placed in a components package (option
4587     `vhdl-use-components-package') which can be automatically generated for
4588     an entire directory or project (`C-c C-m M-p').  The VHDL'93 direct
4589     component instantiation is also supported (option
4590     `vhdl-use-direct-instantiation').
4591
4592       Configuration declarations can automatically be generated either from
4593     the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
4594     the speedbar menu (for the architecture under the cursor).  The
4595     configurations can optionally be hierarchical (i.e. include all
4596     component levels of a hierarchical design, option
4597     `vhdl-compose-configuration-hierarchical') or include subconfigurations
4598     (option `vhdl-compose-configuration-use-subconfiguration').  For
4599     subcomponents in hierarchical configurations, the most-recently-analyzed
4600     (mra) architecture is selected.  If another architecture is desired, it
4601     can be marked as most-recently-analyzed (speedbar menu) before
4602     generating the configuration.
4603
4604       Note: Configurations of subcomponents (i.e. hierarchical configuration
4605     declarations) are currently not considered when displaying
4606     configurations in speedbar.
4607
4608       See the options group `vhdl-compose' for all relevant user options.
4609
4610
4611   SOURCE FILE COMPILATION:
4612     The syntax of the current buffer can be analyzed by calling a VHDL
4613     compiler (menu, `C-c C-k').  The compiler to be used is specified by
4614     option `vhdl-compiler'.  The available compilers are listed in option
4615     `vhdl-compiler-alist' including all required compilation command,
4616     command options, compilation directory, and error message syntax
4617     information.  New compilers can be added.
4618
4619       All the source files of an entire design can be compiled by the `make'
4620     command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4621
4622
4623   MAKEFILE GENERATION:
4624     Makefiles can be generated automatically by an internal generation
4625     routine (`C-c M-k').  The library unit dependency information is
4626     obtained from the hierarchy browser.  Makefile generation can be
4627     customized for each compiler in option `vhdl-compiler-alist'.
4628
4629       Makefile generation can also be run non-interactively using the
4630     command:
4631
4632         emacs -batch -l ~/.emacs -l vhdl-mode
4633               [-compiler compilername] [-project projectname]
4634               -f vhdl-generate-makefile
4635
4636       The Makefile's default target \"all\" compiles the entire design, the
4637     target \"clean\" removes it and the target \"library\" creates the
4638     library directory if not existent.  These target names can be customized
4639     by option `vhdl-makefile-default-targets'.  The Makefile also includes a
4640     target for each primary library unit which allows selective compilation
4641     of this unit, its secondary units and its subhierarchy (example:
4642     compilation of a design specified by a configuration).  User specific
4643     parts can be inserted into a Makefile with option
4644     `vhdl-makefile-generation-hook'.
4645
4646     Limitations:
4647       - Only library units and dependencies within the current library are
4648         considered.  Makefiles for designs that span multiple libraries are
4649         not (yet) supported.
4650       - Only one-level configurations are supported (also hierarchical),
4651         but configurations that go down several levels are not.
4652       - The \"others\" keyword in configurations is not supported.
4653
4654
4655   PROJECTS:
4656     Projects can be defined in option `vhdl-project-alist' and a current
4657     project be selected using option `vhdl-project' (permanently) or from
4658     the menu or speedbar (temporarily).  For each project, title and
4659     description strings (for the file headers), source files/directories
4660     (for the hierarchy browser and Makefile generation), library name, and
4661     compiler-dependent options, exceptions and compilation directory can be
4662     specified.  Compilation settings overwrite the settings of option
4663     `vhdl-compiler-alist'.
4664
4665       Project setups can be exported (i.e. written to a file) and imported.
4666     Imported setups are not automatically saved in `vhdl-project-alist' but
4667     can be saved afterwards in its customization buffer.  When starting
4668     Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4669     vhdl-mode\") in a directory with an existing project setup file, it is
4670     automatically loaded and its project activated if option
4671     `vhdl-project-auto-load' is non-nil.  Names/paths of the project setup
4672     files can be specified in option `vhdl-project-file-name'.  Multiple
4673     project setups can be automatically loaded from global directories.
4674     This is an alternative to specifying project setups with option
4675     `vhdl-project-alist'.
4676
4677
4678   SPECIAL MENUES:
4679     As an alternative to the speedbar, an index menu can be added (set
4680     option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4681     (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4682     file) for browsing the file contents (is not populated if buffer is
4683     larger than 256000).  Also, a source file menu can be
4684     added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4685     current directory for VHDL source files.
4686
4687
4688   VHDL STANDARDS:
4689     The VHDL standards to be used are specified in option `vhdl-standard'.
4690     Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
4691
4692
4693   KEYWORD CASE:
4694     Lower and upper case for keywords and standardized types, attributes,
4695     and enumeration values is supported.  If the option
4696     `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4697     lower case and are converted into upper case automatically (not for
4698     types, attributes, and enumeration values).  The case of keywords,
4699     types, attributes,and enumeration values can be fixed for an entire
4700     region (menu) or buffer (`C-c C-x C-c') according to the options
4701     `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4702
4703
4704   HIGHLIGHTING (fontification):
4705     Keywords and standardized types, attributes, enumeration values, and
4706     function names (controlled by option `vhdl-highlight-keywords'), as well
4707     as comments, strings, and template prompts are highlighted using
4708     different colors.  Unit, subprogram, signal, variable, constant,
4709     parameter and generic/port names in declarations as well as labels are
4710     highlighted if option `vhdl-highlight-names' is non-nil.
4711
4712       Additional reserved words or words with a forbidden syntax (e.g. words
4713     that should be avoided) can be specified in option
4714     `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4715     a warning color (option `vhdl-highlight-forbidden-words').  Verilog
4716     keywords are highlighted as forbidden words if option
4717     `vhdl-highlight-verilog-keywords' is non-nil.
4718
4719       Words with special syntax can be highlighted by specifying their
4720     syntax and color in option `vhdl-special-syntax-alist' and by setting
4721     option `vhdl-highlight-special-words' to non-nil.  This allows you to
4722     establish some naming conventions (e.g. to distinguish different kinds
4723     of signals or other objects by using name suffices) and to support them
4724     visually.
4725
4726       Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4727     to support case-sensitive highlighting.  However, keywords are then only
4728     highlighted if written in lower case.
4729
4730       Code between \"translate_off\" and \"translate_on\" pragmas is
4731     highlighted using a different background color if option
4732     `vhdl-highlight-translate-off' is non-nil.
4733
4734       For documentation and customization of the used colors see
4735     customization group `vhdl-highlight-faces' (`M-x customize-group').  For
4736     highlighting of matching parenthesis, see customization group
4737     `paren-showing'.  Automatic buffer highlighting is turned on/off by
4738     option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4739
4740
4741   USER MODELS:
4742     VHDL models (templates) can be specified by the user and made accessible
4743     in the menu, through key bindings (`C-c C-m ...'), or by keyword
4744     electrification.  See option `vhdl-model-alist'.
4745
4746
4747   HIDE/SHOW:
4748     The code of blocks, processes, subprograms, component declarations and
4749     instantiations, generic/port clauses, and configuration declarations can
4750     be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4751     the code (see customization group `vhdl-menu').  XEmacs: limited
4752     functionality due to old `hideshow.el' package.
4753
4754
4755   CODE UPDATING:
4756     - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4757       current process, `C-c C-u M-s' of all processes in the current buffer.
4758       Limitations:
4759         - Only declared local signals (ports, signals declared in
4760           architecture and blocks) are automatically inserted.
4761         - Global signals declared in packages are not automatically inserted.
4762           Insert them once manually (will be kept afterwards).
4763         - Out parameters of procedures are considered to be read.
4764       Use option `vhdl-entity-file-name' to specify the entity file name
4765       \(used to obtain the port names).
4766       Use option `vhdl-array-index-record-field-in-sensitivity-list' to
4767       specify whether to include array indices and record fields in
4768       sensitivity lists.
4769
4770
4771   CODE FIXING:
4772     `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4773     \(e.g. if the closing parenthesis is on the wrong line or is missing).
4774
4775
4776   PRINTING:
4777     PostScript printing with different faces (an optimized set of faces is
4778     used if `vhdl-print-customize-faces' is non-nil) or colors \(if
4779     `ps-print-color-p' is non-nil) is possible using the standard Emacs
4780     PostScript printing commands.  Option `vhdl-print-two-column' defines
4781     appropriate default settings for nice landscape two-column printing.
4782     The paper format can be set by option `ps-paper-type'.  Do not forget to
4783     switch `ps-print-color-p' to nil for printing on black-and-white
4784     printers.
4785
4786
4787   OPTIONS:
4788     User options allow customization of VHDL Mode.  All options are
4789     accessible from the \"Options\" menu entry.  Simple options (switches
4790     and choices) can directly be changed, while for complex options a
4791     customization buffer is opened.  Changed options can be saved for future
4792     sessions using the \"Save Options\" menu entry.
4793
4794       Options and their detailed descriptions can also be accessed by using
4795     the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
4796     customize-group' for groups).  Some customizations only take effect
4797     after some action (read the NOTE in the option documentation).
4798     Customization can also be done globally (i.e. site-wide, read the
4799     INSTALL file).
4800
4801       Not all options are described in this documentation, so go and see
4802     what other useful user options there are (`M-x vhdl-customize' or menu)!
4803
4804
4805   FILE EXTENSIONS:
4806     As default, files with extensions \".vhd\" and \".vhdl\" are
4807     automatically recognized as VHDL source files.  To add an extension
4808     \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4809
4810       \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)
4811
4812
4813   HINTS:
4814     - To start Emacs with open VHDL hierarchy browser without having to load
4815       a VHDL file first, use the command:
4816
4817         emacs -l vhdl-mode -f speedbar-frame-mode
4818
4819     - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4820
4821     - Some features only work on properly indented code.
4822
4823
4824   RELEASE NOTES:
4825     See also the release notes (menu) for added features in new releases.
4826
4827
4828 Maintenance:
4829 ------------
4830
4831 To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
4832 Add a description of the problem and include a reproducible test case.
4833
4834 Questions and enhancement requests can be sent to <reto@gnu.org>.
4835
4836 The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4837 The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4838 releases.  You are kindly invited to participate in beta testing.  Subscribe
4839 to above mailing lists by sending an email to <reto@gnu.org>.
4840
4841 VHDL Mode is officially distributed at
4842 http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
4843 where the latest version can be found.
4844
4845
4846 Known problems:
4847 ---------------
4848
4849 - XEmacs: Incorrect start-up when automatically opening speedbar.
4850 - XEmacs: Indentation in XEmacs 21.4 (and higher).
4851 - Indentation incorrect for new 'postponed' VHDL keyword.
4852 - Indentation incorrect for 'protected body' construct.
4853
4854
4855                                                 The VHDL Mode Authors
4856                                             Reto Zimmermann and Rod Whitby
4857
4858 Key bindings:
4859 -------------
4860
4861 \\{vhdl-mode-map}"
4862   :abbrev-table vhdl-mode-abbrev-table
4863
4864   ;; set local variables
4865   (set (make-local-variable 'paragraph-start)
4866        "\\s-*\\(--+\\s-*$\\|$\\)")
4867   (set (make-local-variable 'paragraph-separate) paragraph-start)
4868   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4869   (set (make-local-variable 'parse-sexp-ignore-comments) t)
4870   (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
4871   (set (make-local-variable 'comment-start) "--")
4872   (set (make-local-variable 'comment-end) "")
4873   (when vhdl-emacs-21
4874     (set (make-local-variable 'comment-padding) ""))
4875   (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4876   (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4877   (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4878   (set (make-local-variable 'comment-multi-line) nil)
4879   (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
4880   (set (make-local-variable 'hippie-expand-verbose) nil)
4881
4882   ;; setup the comment indent variable in a Emacs version portable way
4883   ;; ignore any byte compiler warnings you might get here
4884   (when (boundp 'comment-indent-function)
4885     (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent))
4886
4887   ;; initialize font locking
4888   (set (make-local-variable 'font-lock-defaults)
4889        (list
4890         '(nil vhdl-font-lock-keywords) nil
4891         (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
4892   (if (eval-when-compile (fboundp 'syntax-propertize-rules))
4893       (set (make-local-variable 'syntax-propertize-function)
4894            (syntax-propertize-rules
4895             ;; Mark single quotes as having string quote syntax in
4896             ;; 'c' instances.
4897             ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
4898     (set (make-local-variable 'font-lock-syntactic-keywords)
4899          vhdl-font-lock-syntactic-keywords))
4900   (unless vhdl-emacs-21
4901     (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4902     (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4903     (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4904     (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4905
4906   ;; variables for source file compilation
4907   (when vhdl-compile-use-local-error-regexp
4908     (set (make-local-variable 'compilation-error-regexp-alist) nil)
4909     (set (make-local-variable 'compilation-file-regexp-alist) nil))
4910
4911   ;; add index menu
4912   (vhdl-index-menu-init)
4913   ;; add source file menu
4914   (if vhdl-source-file-menu (vhdl-add-source-files-menu))
4915   ;; add VHDL menu
4916   (easy-menu-add vhdl-mode-menu-list)   ; for XEmacs
4917   (easy-menu-define vhdl-mode-menu vhdl-mode-map
4918                     "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4919   ;; initialize hideshow and add menu
4920   (vhdl-hideshow-init)
4921   (run-hooks 'menu-bar-update-hook)
4922
4923   ;; miscellaneous
4924   (vhdl-ps-print-init)
4925   (vhdl-write-file-hooks-init)
4926   (message "VHDL Mode %s.%s" vhdl-version
4927            (if noninteractive "" "  See menu for documentation and release notes.")))
4928
4929 (defun vhdl-activate-customizations ()
4930   "Activate all customizations on local variables."
4931   (interactive)
4932   (vhdl-mode-map-init)
4933   (use-local-map vhdl-mode-map)
4934   (set-syntax-table vhdl-mode-syntax-table)
4935   (setq comment-column vhdl-inline-comment-column)
4936   (setq end-comment-column vhdl-end-comment-column)
4937   (vhdl-write-file-hooks-init)
4938   (vhdl-update-mode-menu)
4939   (vhdl-hideshow-init)
4940   (run-hooks 'menu-bar-update-hook))
4941
4942 (defun vhdl-write-file-hooks-init ()
4943   "Add/remove hooks when buffer is saved."
4944   (if vhdl-modify-date-on-saving
4945       (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t)
4946     (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t))
4947   (if (featurep 'xemacs) (make-local-hook 'after-save-hook))
4948   (add-hook 'after-save-hook 'vhdl-add-modified-file nil t))
4949
4950 (defun vhdl-process-command-line-option (option)
4951   "Process command line options for VHDL Mode."
4952   (cond
4953    ;; set compiler
4954    ((equal option "-compiler")
4955     (vhdl-set-compiler (car command-line-args-left))
4956     (setq command-line-args-left (cdr command-line-args-left)))
4957    ;; set project
4958    ((equal option "-project")
4959     (vhdl-set-project (car command-line-args-left))
4960     (setq command-line-args-left (cdr command-line-args-left)))))
4961
4962 ;; make Emacs process VHDL Mode options
4963 (setq command-switch-alist
4964       (append command-switch-alist
4965               '(("-compiler" . vhdl-process-command-line-option)
4966                 ("-project" . vhdl-process-command-line-option))))
4967
4968
4969 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4970 ;;; Keywords and standardized words
4971 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4972
4973 (defconst vhdl-02-keywords
4974   '(
4975     "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4976     "assert" "attribute"
4977     "begin" "block" "body" "buffer" "bus"
4978     "case" "component" "configuration" "constant"
4979     "disconnect" "downto"
4980     "else" "elsif" "end" "entity" "exit"
4981     "file" "for" "function"
4982     "generate" "generic" "group" "guarded"
4983     "if" "impure" "in" "inertial" "inout" "is"
4984     "label" "library" "linkage" "literal" "loop"
4985     "map" "mod"
4986     "nand" "new" "next" "nor" "not" "null"
4987     "of" "on" "open" "or" "others" "out"
4988     "package" "port" "postponed" "procedure" "process" "protected" "pure"
4989     "range" "record" "register" "reject" "rem" "report" "return"
4990     "rol" "ror"
4991     "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
4992     "then" "to" "transport" "type"
4993     "unaffected" "units" "until" "use"
4994     "variable"
4995     "wait" "when" "while" "with"
4996     "xnor" "xor"
4997     )
4998   "List of VHDL'02 keywords.")
4999
5000 (defconst vhdl-08-keywords
5001   '(
5002     "context" "force" "property" "release" "sequence"
5003     )
5004   "List of VHDL'08 keywords.")
5005
5006 (defconst vhdl-ams-keywords
5007   '(
5008     "across" "break" "limit" "nature" "noise" "procedural" "quantity"
5009     "reference" "spectrum" "subnature" "terminal" "through"
5010     "tolerance"
5011     )
5012   "List of VHDL-AMS keywords.")
5013
5014 (defconst vhdl-verilog-keywords
5015   '(
5016     "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
5017     "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
5018     "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
5019     "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
5020     "endprimitive" "endspecify" "endtable" "endtask" "event"
5021     "for" "force" "forever" "fork" "function"
5022     "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
5023     "macromodule" "makefile" "medium" "module"
5024     "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
5025     "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
5026     "pullup"
5027     "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
5028     "rtranif0" "rtranif1"
5029     "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
5030     "strong1" "supply" "supply0" "supply1"
5031     "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
5032     "triand" "trior" "trireg"
5033     "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
5034     )
5035   "List of Verilog keywords as candidate for additional reserved words.")
5036
5037 (defconst vhdl-02-types
5038   '(
5039     "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
5040     "real" "time" "natural" "positive" "string" "line" "text" "side"
5041     "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
5042     "std_logic" "std_logic_vector"
5043     "std_ulogic" "std_ulogic_vector"
5044     )
5045   "List of VHDL'02 standardized types.")
5046
5047 (defconst vhdl-08-types
5048   '(
5049     "boolean_vector" "integer_vector" "real_vector" "time_vector"
5050     )
5051   "List of VHDL'08 standardized types.")
5052
5053 (defconst vhdl-ams-types
5054   ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
5055   '(
5056     ;; package `standard'
5057     "domain_type" "real_vector"
5058     ;; package `energy_systems'
5059     "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
5060     "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
5061     "real_across_vector" "real_through_vector"
5062     ;; package `electrical_systems'
5063     "voltage" "current" "charge" "resistance" "conductance" "capacitance"
5064     "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
5065     "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
5066     "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
5067     "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
5068     "magnetic_flux_vector" "charge_vector" "resistance_vector"
5069     "conductance_vector" "capacitance_vector" "electric_flux_vector"
5070     "electric_flux_density_vector" "electric_field_strength_vector"
5071     "magnetic_flux_density_vector" "magnetic_field_strength_vector"
5072     "inductance_vector" "reluctance_vector" "ground"
5073     ;; package `mechanical_systems'
5074     "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
5075     "damping" "momentum" "angle" "torque" "angular_velocity"
5076     "angular_acceleration" "moment_inertia" "angular_momentum"
5077     "angular_stiffness" "angular_damping" "translational"
5078     "translational_vector" "translational_velocity"
5079     "translational_velocity_vector" "rotational" "rotational_vector"
5080     "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
5081     "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
5082     "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
5083     "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
5084     "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
5085     "angular_momentum_vector" "angular_stiffness_vector"
5086     "angular_damping_vector" "anchor" "translational_v_ref"
5087     "rotational_v_ref" "translational_v" "rotational_v"
5088     ;; package `radiant_systems'
5089     "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
5090     "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
5091     "illuminance_vector" "irradiance_vector"
5092     ;; package `thermal_systems'
5093     "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
5094     "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
5095     "heat_flow_vector" "thermal_capacitance_vector"
5096     "thermal_resistance_vector" "thermal_conductance_vector"
5097     ;; package `fluidic_systems'
5098     "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
5099     "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
5100     "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
5101     "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
5102     "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
5103     "density_vector" "viscosity_vector" "fresistance_vector"
5104     "fconductance_vector" "fcapacitance_vector" "inertance_vector"
5105     "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
5106     "cfinertance_vector"
5107     )
5108   "List of VHDL-AMS standardized types.")
5109
5110 (defconst vhdl-math-types
5111   '(
5112     "complex" "complex_polar" "positive_real" "principal_value"
5113     )
5114   "List of Math Packages standardized types.")
5115
5116 (defconst vhdl-02-attributes
5117   '(
5118     "base" "left" "right" "high" "low" "pos" "val" "succ"
5119     "pred" "leftof" "rightof" "range" "reverse_range"
5120     "length" "delayed" "stable" "quiet" "transaction"
5121     "event" "active" "last_event" "last_active" "last_value"
5122     "driving" "driving_value" "ascending" "value" "image"
5123     "simple_name" "instance_name" "path_name"
5124     "foreign"
5125     )
5126   "List of VHDL'02 standardized attributes.")
5127
5128 (defconst vhdl-08-attributes
5129   '(
5130     "instance_name" "path_name"
5131     )
5132   "List of VHDL'08 standardized attributes.")
5133
5134 (defconst vhdl-ams-attributes
5135   '(
5136     "across" "through"
5137     "reference" "contribution" "tolerance"
5138     "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
5139     "ramp" "slew"
5140     )
5141   "List of VHDL-AMS standardized attributes.")
5142
5143 (defconst vhdl-02-enum-values
5144   '(
5145     "true" "false"
5146     "note" "warning" "error" "failure"
5147     "read_mode" "write_mode" "append_mode"
5148     "open_ok" "status_error" "name_error" "mode_error"
5149     "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
5150     "right" "left"
5151     )
5152   "List of VHDL'02 standardized enumeration values.")
5153
5154 (defconst vhdl-ams-enum-values
5155   '(
5156     "quiescent_domain" "time_domain" "frequency_domain"
5157     ;; from `nature_pkg' package
5158     "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
5159     )
5160   "List of VHDL-AMS standardized enumeration values.")
5161
5162 (defconst vhdl-ams-constants
5163   ;; standard: IEEE Std 1076.1.1-2004
5164   '(
5165     ;; package `fundamental_constants'
5166     "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
5167     "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
5168     "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
5169     "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
5170     ;; package `material_constants'
5171     "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
5172     "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
5173     "ambient_temperature" "ambient_pressure" "ambient_illuminance"
5174     )
5175   "List of VHDL-AMS standardized constants.")
5176
5177 (defconst vhdl-math-constants
5178   ;; standard: IEEE Std 1076.2-1996
5179   '(
5180     "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
5181     "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
5182     "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
5183     "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
5184     "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
5185     "math_sqrt_pi"
5186     )
5187   "List of Math Packages standardized constants.")
5188
5189 (defconst vhdl-02-functions
5190   '(
5191     "now" "resolved" "rising_edge" "falling_edge"
5192     "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
5193     "endfile"
5194     "resize" "is_X" "std_match"
5195     "shift_left" "shift_right" "rotate_left" "rotate_right"
5196     "to_unsigned" "to_signed" "to_integer"
5197     "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
5198     "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
5199     "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
5200     "shl" "shr" "ext" "sxt"
5201     "deallocate"
5202     )
5203   "List of VHDL'02 standardized functions.")
5204
5205 (defconst vhdl-08-functions
5206   '(
5207     "finish" "flush" "justify" "maximum" "minimum"
5208     "resolution_limit" "rising_edge" "stop" "swrite"
5209     "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
5210     "to_octalstring" "to_ostring" "to_string"
5211     )
5212   "List of VHDL'08 standardized functions.")
5213
5214 (defconst vhdl-ams-functions
5215   '(
5216     ;; package `standard'
5217     "frequency"
5218     )
5219   "List of VHDL-AMS standardized functions.")
5220
5221 (defconst vhdl-math-functions
5222   ;; standard: IEEE Std 1076.2-1996
5223   '(
5224     "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
5225     "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
5226     "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
5227     "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
5228     "tan" "tanh" "trunc" "uniform"
5229     )
5230   "List of Math Packages standardized functions.")
5231
5232 (defconst vhdl-02-packages
5233   '(
5234     "std_logic_1164" "numeric_std" "numeric_bit"
5235     "standard" "textio"
5236     "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
5237     "std_logic_misc" "std_logic_textio"
5238     "ieee" "std" "work"
5239     )
5240   "List of VHDL'02 standardized packages and libraries.")
5241
5242 (defconst vhdl-08-packages
5243   '(
5244     "env" "numeric_std_signed" "numeric_std_unsigned"
5245     "ieee_bit_context" "ieee_std_context"  ;; contexts
5246     )
5247   "List of VHDL'08 standardized packages and libraries.")
5248
5249 (defconst vhdl-ams-packages
5250   '(
5251     "fundamental_constants" "material_constants" "energy_systems"
5252     "electrical_systems" "mechanical_systems" "radiant_systems"
5253     "thermal_systems" "fluidic_systems"
5254     )
5255   "List of VHDL-AMS standardized packages and libraries.")
5256
5257 (defconst vhdl-math-packages
5258   '(
5259     "math_real" "math_complex"
5260     )
5261   "List of Math Packages standardized packages and libraries.")
5262
5263 (defconst vhdl-08-directives
5264   '(
5265     "author" "author_info" "begin" "begin_protected" "comment"
5266     "data_block" "data_keyname" "data_keyowner" "data_method"
5267     "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
5268     "digest_keyowner" "digest_method"
5269     "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
5270     "key_block" "key_keyname" "key_keyowner" "key_method"
5271     "runtime_license" "viewport"
5272     )
5273   "List of VHDL'08 standardized tool directives.")
5274
5275 (defvar vhdl-keywords nil
5276   "List of VHDL keywords.")
5277
5278 (defvar vhdl-types nil
5279   "List of VHDL standardized types.")
5280
5281 (defvar vhdl-attributes nil
5282   "List of VHDL standardized attributes.")
5283
5284 (defvar vhdl-enum-values nil
5285   "List of VHDL standardized enumeration values.")
5286
5287 (defvar vhdl-constants nil
5288   "List of VHDL standardized constants.")
5289
5290 (defvar vhdl-functions nil
5291   "List of VHDL standardized functions.")
5292
5293 (defvar vhdl-packages nil
5294   "List of VHDL standardized packages and libraries.")
5295
5296 (defvar vhdl-directives nil
5297   "List of VHDL standardized packages and libraries.")
5298
5299 (defvar vhdl-reserved-words nil
5300   "List of additional reserved words.")
5301
5302 (defvar vhdl-keywords-regexp nil
5303   "Regexp for VHDL keywords.")
5304
5305 (defvar vhdl-types-regexp nil
5306   "Regexp for VHDL standardized types.")
5307
5308 (defvar vhdl-attributes-regexp nil
5309   "Regexp for VHDL standardized attributes.")
5310
5311 (defvar vhdl-enum-values-regexp nil
5312   "Regexp for VHDL standardized enumeration values.")
5313
5314 (defvar vhdl-constants-regexp nil
5315   "Regexp for VHDL standardized constants.")
5316
5317 (defvar vhdl-functions-regexp nil
5318   "Regexp for VHDL standardized functions.")
5319
5320 (defvar vhdl-packages-regexp nil
5321   "Regexp for VHDL standardized packages and libraries.")
5322
5323 (defvar vhdl-reserved-words-regexp nil
5324   "Regexp for additional reserved words.")
5325
5326 (defvar vhdl-directive-keywords-regexp nil
5327   "Regexp for compiler directive keywords.")
5328
5329 (defun vhdl-upcase-list (condition list)
5330   "Upcase all elements in LIST based on CONDITION."
5331   (when condition
5332     (let ((tmp-list list))
5333       (while tmp-list
5334         (setcar tmp-list (upcase (car tmp-list)))
5335         (setq tmp-list (cdr tmp-list)))))
5336   list)
5337
5338 (defun vhdl-words-init ()
5339   "Initialize reserved words."
5340   (setq vhdl-keywords
5341         (vhdl-upcase-list
5342          (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
5343          (append vhdl-02-keywords
5344                  (when (vhdl-standard-p '08) vhdl-08-keywords)
5345                  (when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
5346   (setq vhdl-types
5347         (vhdl-upcase-list
5348          (and vhdl-highlight-case-sensitive vhdl-upper-case-types)
5349          (append vhdl-02-types
5350                  (when (vhdl-standard-p '08) vhdl-08-types)
5351                  (when (vhdl-standard-p 'ams) vhdl-ams-types)
5352                  (when (vhdl-standard-p 'math) vhdl-math-types))))
5353   (setq vhdl-attributes
5354         (vhdl-upcase-list
5355          (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
5356          (append vhdl-02-attributes
5357                  (when (vhdl-standard-p '08) vhdl-08-attributes)
5358                  (when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
5359   (setq vhdl-enum-values
5360         (vhdl-upcase-list
5361          (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values)
5362          (append vhdl-02-enum-values
5363                  (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))))
5364   (setq vhdl-constants
5365         (vhdl-upcase-list
5366          (and vhdl-highlight-case-sensitive vhdl-upper-case-constants)
5367          (append (when (vhdl-standard-p 'ams) vhdl-ams-constants)
5368                  (when (vhdl-standard-p 'math) vhdl-math-constants)
5369                  '(""))))
5370   (setq vhdl-functions
5371         (append vhdl-02-functions
5372                 (when (vhdl-standard-p '08) vhdl-08-functions)
5373                 (when (vhdl-standard-p 'ams) vhdl-ams-functions)
5374                 (when (vhdl-standard-p 'math) vhdl-math-functions)))
5375   (setq vhdl-packages
5376         (append vhdl-02-packages
5377                 (when (vhdl-standard-p '08) vhdl-08-packages)
5378                 (when (vhdl-standard-p 'ams) vhdl-ams-packages)
5379                 (when (vhdl-standard-p 'math) vhdl-math-packages)))
5380   (setq vhdl-directives
5381         (append (when (vhdl-standard-p '08) vhdl-08-directives)))
5382   (setq vhdl-reserved-words
5383         (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
5384                 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
5385                 '("")))
5386   (setq vhdl-keywords-regexp
5387         (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>"))
5388   (setq vhdl-types-regexp
5389         (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>"))
5390   (setq vhdl-attributes-regexp
5391         (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
5392   (setq vhdl-enum-values-regexp
5393         (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
5394   (setq vhdl-constants-regexp
5395         (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>"))
5396   (setq vhdl-functions-regexp
5397         (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
5398   (setq vhdl-packages-regexp
5399         (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>"))
5400   (setq vhdl-reserved-words-regexp
5401         (concat "\\<\\("
5402                 (unless (equal vhdl-forbidden-syntax "")
5403                   (concat vhdl-forbidden-syntax "\\|"))
5404                 (regexp-opt vhdl-reserved-words)
5405                 "\\)\\>"))
5406   (setq vhdl-directive-keywords-regexp
5407         (concat "\\<\\(" (mapconcat 'regexp-quote
5408                                     vhdl-directive-keywords "\\|") "\\)\\>"))
5409   (vhdl-abbrev-list-init))
5410
5411 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5412 ;; Words to expand
5413
5414 (defvar vhdl-abbrev-list nil
5415   "Predefined abbreviations for VHDL.")
5416
5417 (defun vhdl-abbrev-list-init ()
5418   (setq vhdl-abbrev-list
5419         (append
5420          (list vhdl-upper-case-keywords) vhdl-keywords
5421          (list vhdl-upper-case-types) vhdl-types
5422          (list vhdl-upper-case-attributes) vhdl-attributes
5423          (list vhdl-upper-case-enum-values) vhdl-enum-values
5424          (list vhdl-upper-case-constants) vhdl-constants
5425          (list nil) vhdl-functions
5426          (list nil) vhdl-packages
5427          (list nil) vhdl-directives)))
5428
5429 ;; initialize reserved words for VHDL Mode
5430 (vhdl-words-init)
5431
5432
5433 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5434 ;;; Indentation
5435 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5436
5437 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5438 ;; Syntax analysis
5439
5440 ;; constant regular expressions for looking at various constructs
5441
5442 (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
5443   "Regexp describing a VHDL symbol.
5444 We cannot use just `word' syntax class since `_' cannot be in word
5445 class.  Putting underscore in word class breaks forward word movement
5446 behavior that users are familiar with.")
5447
5448 (defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
5449   "Regexp describing a case statement header key.")
5450
5451 (defconst vhdl-label-key
5452   (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]")
5453   "Regexp describing a VHDL label.")
5454
5455 ;; Macro definitions:
5456
5457 (defmacro vhdl-point (position)
5458   "Return the value of point at certain commonly referenced POSITIONs.
5459 POSITION can be one of the following symbols:
5460
5461 bol  -- beginning of line
5462 eol  -- end of line
5463 bod  -- beginning of defun
5464 boi  -- back to indentation
5465 eoi  -- last whitespace on line
5466 ionl -- indentation of next line
5467 iopl -- indentation of previous line
5468 bonl -- beginning of next line
5469 bopl -- beginning of previous line
5470
5471 This function does not modify point or mark."
5472   (or (and (eq 'quote (car-safe position))
5473            (null (cddr position)))
5474       (error "ERROR:  Bad buffer position requested: %s" position))
5475   (setq position (nth 1 position))
5476   `(let ((here (point)))
5477      ,@(cond
5478         ((eq position 'bol)  '((beginning-of-line)))
5479         ((eq position 'eol)  '((end-of-line)))
5480         ((eq position 'bod)  '((save-match-data
5481                                  (vhdl-beginning-of-defun))))
5482         ((eq position 'boi)  '((back-to-indentation)))
5483         ((eq position 'eoi)  '((end-of-line) (skip-chars-backward " \t")))
5484         ((eq position 'bonl) '((forward-line 1)))
5485         ((eq position 'bopl) '((forward-line -1)))
5486         ((eq position 'iopl)
5487          '((forward-line -1)
5488            (back-to-indentation)))
5489         ((eq position 'ionl)
5490          '((forward-line 1)
5491            (back-to-indentation)))
5492         (t (error "ERROR:  Unknown buffer position requested: %s" position))
5493         )
5494      (prog1
5495          (point)
5496        (goto-char here))
5497      ;; workaround for an Emacs18 bug -- blech! Well, at least it
5498      ;; doesn't hurt for v19
5499      ,@nil
5500      ))
5501
5502 (defmacro vhdl-safe (&rest body)
5503   "Safely execute BODY, return nil if an error occurred."
5504   `(condition-case nil
5505        (progn ,@body)
5506      (error nil)))
5507
5508 (defmacro vhdl-add-syntax (symbol &optional relpos)
5509   "A simple macro to append the syntax in SYMBOL to the syntax list.
5510 Try to increase performance by using this macro."
5511   `(setq vhdl-syntactic-context
5512          (cons (cons ,symbol ,relpos) vhdl-syntactic-context)))
5513
5514 (defmacro vhdl-has-syntax (symbol)
5515   "A simple macro to return check the syntax list.
5516 Try to increase performance by using this macro."
5517   `(assoc ,symbol vhdl-syntactic-context))
5518
5519 ;; Syntactic element offset manipulation:
5520
5521 (defun vhdl-read-offset (langelem)
5522   "Read new offset value for LANGELEM from minibuffer.
5523 Return a valid value only."
5524   (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
5525         (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5526         (prompt "Offset: ")
5527         offset input interned)
5528     (while (not offset)
5529       (setq input (read-string prompt oldoff)
5530             offset (cond ((string-equal "+" input) '+)
5531                          ((string-equal "-" input) '-)
5532                          ((string-equal "++" input) '++)
5533                          ((string-equal "--" input) '--)
5534                          ((string-match "^-?[0-9]+$" input)
5535                           (string-to-number input))
5536                          ((fboundp (setq interned (intern input)))
5537                           interned)
5538                          ((boundp interned) interned)
5539                          ;; error, but don't signal one, keep trying
5540                          ;; to read an input value
5541                          (t (ding)
5542                             (setq prompt errmsg)
5543                             nil))))
5544     offset))
5545
5546 (defun vhdl-set-offset (symbol offset &optional add-p)
5547   "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5548 SYMBOL is the syntactic element symbol to change and OFFSET is the new
5549 offset for that syntactic element.  Optional ADD-P says to add SYMBOL to
5550 `vhdl-offsets-alist' if it doesn't already appear there."
5551   (interactive
5552    (let* ((langelem
5553            (intern (completing-read
5554                     (concat "Syntactic symbol to change"
5555                             (if current-prefix-arg " or add" "")
5556                             ": ")
5557                     (mapcar
5558                      (function
5559                       (lambda (langelem)
5560                         (cons (format "%s" (car langelem)) nil)))
5561                      vhdl-offsets-alist)
5562                     nil (not current-prefix-arg)
5563                     ;; initial contents tries to be the last element
5564                     ;; on the syntactic analysis list for the current
5565                     ;; line
5566                     (let* ((syntax (vhdl-get-syntactic-context))
5567                            (len (length syntax))
5568                            (ic (format "%s" (car (nth (1- len) syntax)))))
5569                       ic)
5570                     )))
5571           (offset (vhdl-read-offset langelem)))
5572      (list langelem offset current-prefix-arg)))
5573   ;; sanity check offset
5574   (or (eq offset '+)
5575       (eq offset '-)
5576       (eq offset '++)
5577       (eq offset '--)
5578       (integerp offset)
5579       (fboundp offset)
5580       (boundp offset)
5581       (error "ERROR:  Offset must be int, func, var, or one of +, -, ++, --: %s"
5582              offset))
5583   (let ((entry (assq symbol vhdl-offsets-alist)))
5584     (if entry
5585         (setcdr entry offset)
5586       (if add-p
5587           (setq vhdl-offsets-alist
5588                 (cons (cons symbol offset) vhdl-offsets-alist))
5589         (error "ERROR:  %s is not a valid syntactic symbol" symbol))))
5590   (vhdl-keep-region-active))
5591
5592 (defun vhdl-set-style (style &optional local)
5593   "Set `vhdl-mode' variables to use one of several different indentation styles.
5594 STYLE is a string representing the desired style and optional LOCAL is
5595 a flag which, if non-nil, means to make the style variables being
5596 changed buffer local, instead of the default, which is to set the
5597 global variables.  Interactively, the flag comes from the prefix
5598 argument.  The styles are chosen from the `vhdl-style-alist' variable."
5599   (interactive (list (completing-read "Use which VHDL indentation style? "
5600                                       vhdl-style-alist nil t)
5601                      current-prefix-arg))
5602   (let ((vars (cdr (assoc style vhdl-style-alist))))
5603     (or vars
5604         (error "ERROR:  Invalid VHDL indentation style `%s'" style))
5605     ;; set all the variables
5606     (mapc
5607      (function
5608       (lambda (varentry)
5609         (let ((var (car varentry))
5610               (val (cdr varentry)))
5611           ;; special case for vhdl-offsets-alist
5612           (if (not (eq var 'vhdl-offsets-alist))
5613               (set (if local (make-local-variable var) var) val)
5614             ;; reset vhdl-offsets-alist to the default value first
5615             (set (if local (make-local-variable var) var)
5616                  (copy-alist vhdl-offsets-alist-default))
5617             ;; now set the langelems that are different
5618             (mapcar
5619              (function
5620               (lambda (langentry)
5621                 (let ((langelem (car langentry))
5622                       (offset (cdr langentry)))
5623                   (vhdl-set-offset langelem offset)
5624                   )))
5625              val))
5626           )))
5627      vars))
5628   (vhdl-keep-region-active))
5629
5630 (defun vhdl-get-offset (langelem)
5631   "Get offset from LANGELEM which is a cons cell of the form:
5632 \(SYMBOL . RELPOS).  The symbol is matched against
5633 vhdl-offsets-alist and the offset found there is either returned,
5634 or added to the indentation at RELPOS.  If RELPOS is nil, then
5635 the offset is simply returned."
5636   (let* ((symbol (car langelem))
5637          (relpos (cdr langelem))
5638          (match  (assq symbol vhdl-offsets-alist))
5639          (offset (cdr-safe match)))
5640     ;; offset can be a number, a function, a variable, or one of the
5641     ;; symbols + or -
5642     (cond
5643      ((not match)
5644       (if vhdl-strict-syntax-p
5645           (error "ERROR:  Don't know how to indent a %s" symbol)
5646         (setq offset 0
5647               relpos 0)))
5648      ((eq offset '+)  (setq offset vhdl-basic-offset))
5649      ((eq offset '-)  (setq offset (- vhdl-basic-offset)))
5650      ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
5651      ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
5652      ((and (not (numberp offset))
5653            (fboundp offset))
5654       (setq offset (funcall offset langelem)))
5655      ((not (numberp offset))
5656       (setq offset (eval offset)))
5657      )
5658     (+ (if (and relpos
5659                 (< relpos (vhdl-point 'bol)))
5660            (save-excursion
5661              (goto-char relpos)
5662              (current-column))
5663          0)
5664        offset)))
5665
5666 ;; Syntactic support functions:
5667
5668 (defun vhdl-in-comment-p (&optional pos)
5669   "Check if point is in a comment (include multi-line comments)."
5670   (let ((parse (lambda (p)
5671                  (let ((c (char-after p)))
5672                    (or (and c (eq (char-syntax c) ?<))
5673                        (nth 4 (parse-partial-sexp
5674                                (save-excursion
5675                                  (beginning-of-defun)
5676                                  (point)) p)))))))
5677     (save-excursion
5678       (goto-char (or pos (point)))
5679       (or (funcall parse (point))
5680           ;; `parse-partial-sexp's notion of comments doesn't span lines
5681           (progn
5682             (back-to-indentation)
5683             (unless (eolp)
5684               (forward-char)
5685               (funcall parse (point))))))))
5686
5687 (defun vhdl-in-string-p ()
5688   "Check if point is in a string."
5689   (eq (vhdl-in-literal) 'string))
5690
5691 (defun vhdl-in-quote-p ()
5692   "Check if point is in a quote ('x')."
5693   (or (and (> (point) (point-min))
5694            (< (1+ (point)) (point-max))
5695            (= (char-before (point)) ?\')
5696            (= (char-after (1+ (point))) ?\'))
5697       (and (> (1- (point)) (point-min))
5698            (< (point) (point-max))
5699            (= (char-before (1- (point))) ?\')
5700            (= (char-after (point)) ?\'))))
5701
5702 (defun vhdl-in-literal ()
5703   "Determine if point is in a VHDL literal."
5704   (save-excursion
5705     (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
5706       (cond
5707        ((nth 3 state) 'string)
5708        ((nth 4 state) 'comment)
5709        ((vhdl-beginning-of-macro) 'pound)
5710        ((vhdl-beginning-of-directive) 'directive)
5711        ;; for multi-line comments
5712        ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
5713        (t nil)))))
5714
5715 (defun vhdl-in-extended-identifier-p ()
5716   "Determine if point is inside extended identifier (delimited by ‘\\’)."
5717   (save-match-data
5718     (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
5719          (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
5720
5721 (defun vhdl-forward-comment (&optional direction)
5722   "Skip all comments (including whitespace).  Skip backwards if DIRECTION is
5723 negative, skip forward otherwise."
5724   (interactive "p")
5725   (if (and direction (< direction 0))
5726       ;; skip backwards
5727       (progn
5728         (skip-chars-backward " \t\n\r\f")
5729         (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5730           (goto-char (match-beginning 3))
5731           (skip-chars-backward " \t\n\r\f")))
5732     ;; skip forwards
5733     (skip-chars-forward " \t\n\r\f")
5734     (while (looking-at "--.*")
5735       (goto-char (match-end 0))
5736       (skip-chars-forward " \t\n\r\f"))))
5737
5738 ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5739 (unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
5740   (defalias 'vhdl-forward-comment 'forward-comment))
5741
5742 (defun vhdl-back-to-indentation ()
5743   "Move point to the first non-whitespace character on this line."
5744   (interactive)
5745   (beginning-of-line 1)
5746   (skip-syntax-forward " " (vhdl-point 'eol)))
5747
5748 ;; XEmacs hack: work around old `back-to-indentation' in XEmacs
5749 (when (featurep 'xemacs)
5750   (defalias 'back-to-indentation 'vhdl-back-to-indentation))
5751
5752 ;; This is the best we can do in Win-Emacs.
5753 (defun vhdl-win-il (&optional lim)
5754   "Determine if point is in a VHDL literal."
5755   (save-excursion
5756     (let* ((here (point))
5757            (state nil)
5758            (match nil)
5759            (lim  (or lim (vhdl-point 'bod))))
5760       (goto-char lim )
5761       (while (< (point) here)
5762         (setq match
5763               (and (re-search-forward "--\\|[\"']\\|`"
5764                                       here 'move)
5765                    (buffer-substring (match-beginning 0) (match-end 0))))
5766         (setq state
5767               (cond
5768                ;; no match
5769                ((null match) nil)
5770                ;; looking at the opening of a VHDL style comment
5771                ((string= "--" match)
5772                 (if (<= here (progn (end-of-line) (point))) 'comment))
5773                ;; looking at a directive
5774                ((string= "`" match)
5775                 (if (<= here (progn (end-of-line) (point))) 'directive))
5776                ;; looking at the opening of a double quote string
5777                ((string= "\"" match)
5778                 (if (not (save-restriction
5779                            ;; this seems to be necessary since the
5780                            ;; re-search-forward will not work without it
5781                            (narrow-to-region (point) here)
5782                            (re-search-forward
5783                             ;; this regexp matches a double quote
5784                             ;; which is preceded by an even number
5785                             ;; of backslashes, including zero
5786                             "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
5787                     'string))
5788                ;; looking at the opening of a single quote string
5789                ((string= "'" match)
5790                 (if (not (save-restriction
5791                            ;; see comments from above
5792                            (narrow-to-region (point) here)
5793                            (re-search-forward
5794                             ;; this matches a single quote which is
5795                             ;; preceded by zero or two backslashes.
5796                             "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5797                             here 'move)))
5798                     'string))
5799                (t nil)))
5800         ) ; end-while
5801       state)))
5802
5803 (and (string-match "Win-Emacs" emacs-version)
5804      (fset 'vhdl-in-literal 'vhdl-win-il))
5805
5806 ;; Skipping of "syntactic whitespace".  Syntactic whitespace is
5807 ;; defined as lexical whitespace or comments.  Search no farther back
5808 ;; or forward than optional LIM.  If LIM is omitted, (point-min) is
5809 ;; used for backward skipping, (point-max) is used for forward
5810 ;; skipping.
5811
5812 (defun vhdl-forward-syntactic-ws (&optional lim)
5813   "Forward skip of syntactic whitespace."
5814   (let* ((here (point-max))
5815          (hugenum (point-max)))
5816     (while (/= here (point))
5817       (setq here (point))
5818       (vhdl-forward-comment hugenum)
5819       ;; skip preprocessor directives
5820       (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
5821                  (= (vhdl-point 'boi) (point)))
5822         (while (and (eq (char-before (vhdl-point 'eol)) ?\\)
5823                     (= (forward-line 1) 0)))
5824         (end-of-line)))
5825     (if lim (goto-char (min (point) lim)))))
5826
5827
5828 ;; This is the best we can do in Win-Emacs.
5829 (defun vhdl-win-fsws (&optional lim)
5830   "Forward skip syntactic whitespace for Win-Emacs."
5831   (let ((lim (or lim (point-max)))
5832         stop)
5833     (while (not stop)
5834       (skip-chars-forward " \t\n\r\f" lim)
5835       (cond
5836        ;; vhdl comment
5837        ((looking-at "--") (end-of-line))
5838        ;; none of the above
5839        (t (setq stop t))))))
5840
5841 (and (string-match "Win-Emacs" emacs-version)
5842      (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
5843
5844 (defun vhdl-beginning-of-macro (&optional lim)
5845   "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5846   (let ((here (point)))
5847     (beginning-of-line)
5848     (while (eq (char-before (1- (point))) ?\\)
5849       (forward-line -1))
5850     (back-to-indentation)
5851     (if (and (<= (point) here)
5852              (eq (char-after) ?#))
5853         t
5854       (goto-char here)
5855       nil)))
5856
5857 (defun vhdl-beginning-of-directive (&optional lim)
5858   "Go to the beginning of a directive (nicked from `cc-engine')."
5859   (let ((here (point)))
5860     (beginning-of-line)
5861     (while (eq (char-before (1- (point))) ?\\)
5862       (forward-line -1))
5863     (back-to-indentation)
5864     (if (and (<= (point) here)
5865              (eq (char-after) ?`))
5866         t
5867       (goto-char here)
5868       nil)))
5869
5870 (defun vhdl-backward-syntactic-ws (&optional lim)
5871   "Backward skip over syntactic whitespace."
5872   (let* ((here (point-min))
5873          (hugenum (- (point-max))))
5874     (while (/= here (point))
5875       (setq here (point))
5876       (vhdl-forward-comment hugenum)
5877       (vhdl-beginning-of-macro))
5878     (if lim (goto-char (max (point) lim)))))
5879
5880 ;; This is the best we can do in Win-Emacs.
5881 (defun vhdl-win-bsws (&optional lim)
5882   "Backward skip syntactic whitespace for Win-Emacs."
5883   (let ((lim (or lim (vhdl-point 'bod)))
5884         stop)
5885     (while (not stop)
5886       (skip-chars-backward " \t\n\r\f" lim)
5887       (cond
5888        ;; vhdl comment
5889        ((eq (vhdl-in-literal) 'comment)
5890         (skip-chars-backward "^-" lim)
5891         (skip-chars-backward "-" lim)
5892         (while (not (or (and (= (following-char) ?-)
5893                              (= (char-after (1+ (point))) ?-))
5894                         (<= (point) lim)))
5895           (skip-chars-backward "^-" lim)
5896           (skip-chars-backward "-" lim)))
5897        ;; none of the above
5898        (t (setq stop t))))))
5899
5900 (and (string-match "Win-Emacs" emacs-version)
5901     (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
5902
5903 ;; Functions to help finding the correct indentation column:
5904
5905 (defun vhdl-first-word (point)
5906   "If the keyword at POINT is at boi, then return (current-column) at
5907 that point, else nil."
5908   (save-excursion
5909     (and (goto-char point)
5910          (eq (point) (vhdl-point 'boi))
5911          (current-column))))
5912
5913 (defun vhdl-last-word (point)
5914   "If the keyword at POINT is at eoi, then return (current-column) at
5915 that point, else nil."
5916   (save-excursion
5917     (and (goto-char point)
5918          (save-excursion (or (eq (progn (forward-sexp) (point))
5919                                  (vhdl-point 'eoi))
5920                              (looking-at "\\s-*\\(--\\)?")))
5921          (current-column))))
5922
5923 ;; Core syntactic evaluation functions:
5924
5925 (defconst vhdl-libunit-re
5926   "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
5927
5928 (defun vhdl-libunit-p ()
5929   (and
5930    (save-excursion
5931      (forward-sexp)
5932      (skip-chars-forward " \t\n\r\f")
5933      (not (looking-at "is\\b[^_]")))
5934    (save-excursion
5935      (backward-sexp)
5936      (and (not (looking-at "use\\b[^_]"))
5937           (progn
5938             (forward-sexp)
5939             (vhdl-forward-syntactic-ws)
5940             (/= (following-char) ?:))))
5941    ))
5942
5943 (defconst vhdl-defun-re
5944   "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5945
5946 (defun vhdl-defun-p ()
5947   (save-excursion
5948     (if (looking-at "block\\|process\\|procedural")
5949         ;; "block", "process", "procedural":
5950         (save-excursion
5951           (backward-sexp)
5952           (not (looking-at "end\\s-+\\w")))
5953       ;; "architecture", "configuration", "context", "entity",
5954       ;; "package", "procedure", "function":
5955       t)))
5956
5957 (defun vhdl-corresponding-defun ()
5958   "If the word at the current position corresponds to a \"defun\"
5959 keyword, then return a string that can be used to find the
5960 corresponding \"begin\" keyword, else return nil."
5961   (save-excursion
5962     (and (looking-at vhdl-defun-re)
5963          (vhdl-defun-p)
5964          (if (looking-at "block\\|process\\|procedural")
5965              ;; "block", "process". "procedural:
5966              (buffer-substring (match-beginning 0) (match-end 0))
5967            ;; "architecture", "configuration", "context", "entity", "package",
5968            ;; "procedure", "function":
5969            "is"))))
5970
5971 (defconst vhdl-begin-fwd-re
5972   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
5973   "A regular expression for searching forward that matches all known
5974 \"begin\" keywords.")
5975
5976 (defconst vhdl-begin-bwd-re
5977   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
5978   "A regular expression for searching backward that matches all known
5979 \"begin\" keywords.")
5980
5981 (defun vhdl-begin-p (&optional lim)
5982   "Return t if we are looking at a real \"begin\" keyword.
5983 Assumes that the caller will make sure that we are looking at
5984 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5985 the middle of an identifier that just happens to contain a \"begin\"
5986 keyword."
5987   (cond
5988    ;; "[architecture|case|configuration|context|entity|package|
5989    ;;   procedure|function] ... is":
5990    ((and (looking-at "i")
5991          (save-excursion
5992            ;; Skip backward over first sexp (needed to skip over a
5993            ;; procedure interface list, and is harmless in other
5994            ;; situations).  Note that we need "return" in the
5995            ;; following search list so that we don't run into
5996            ;; semicolons in the function interface list.
5997            (backward-sexp)
5998            (let (foundp)
5999              (while (and (not foundp)
6000                          (re-search-backward
6001                           ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
6002                           lim 'move))
6003                (if (or (= (preceding-char) ?_)
6004                        (vhdl-in-literal))
6005                    (backward-char)
6006                  (setq foundp t))))
6007            (and (/= (following-char) ?\;)
6008                 (not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
6009     t)
6010    ;; "begin", "then", "use":
6011    ((looking-at "be\\|t\\|use")
6012     t)
6013    ;; "else":
6014    ((and (looking-at "e")
6015          ;; make sure that the "else" isn't inside a
6016          ;; conditional signal assignment.
6017          (save-excursion
6018            (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6019            (or (eq (following-char) ?\;)
6020                (eq (point) lim))))
6021     t)
6022    ;; "block", "generate", "loop", "process", "procedural",
6023    ;; "units", "record", "protected body":
6024    ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
6025          (save-excursion
6026            (backward-sexp)
6027            (not (looking-at "end\\s-+\\w"))))
6028     t)
6029    ;; "component":
6030    ((and (looking-at "c")
6031          (save-excursion
6032            (backward-sexp)
6033            (not (looking-at "end\\s-+\\w")))
6034          ;; look out for the dreaded entity class in an attribute
6035          (save-excursion
6036            (vhdl-backward-syntactic-ws lim)
6037            (/= (preceding-char) ?:)))
6038     t)
6039    ;; "for" (inside configuration declaration):
6040    ((and (looking-at "f")
6041          (save-excursion
6042            (backward-sexp)
6043            (not (looking-at "end\\s-+\\w")))
6044          (vhdl-has-syntax 'configuration))
6045     t)
6046    ))
6047
6048 (defun vhdl-corresponding-mid (&optional lim)
6049   (cond
6050    ((looking-at "is\\|block\\|generate\\|process\\|procedural")
6051     "begin")
6052    ((looking-at "then\\|use")
6053     "<else>")
6054    (t
6055     "end")))
6056
6057 (defun vhdl-corresponding-end (&optional lim)
6058   "If the word at the current position corresponds to a \"begin\"
6059 keyword, then return a vector containing enough information to find
6060 the corresponding \"end\" keyword, else return nil.  The keyword to
6061 search forward for is aref 0.  The column in which the keyword must
6062 appear is aref 1 or nil if any column is suitable.
6063 Assumes that the caller will make sure that we are not in the middle
6064 of an identifier that just happens to contain a \"begin\" keyword."
6065   (save-excursion
6066     (and (looking-at vhdl-begin-fwd-re)
6067          (or (not (looking-at "\\<use\\>"))
6068              (save-excursion (back-to-indentation)
6069                              (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6070          (/= (preceding-char) ?_)
6071          (not (vhdl-in-literal))
6072          (vhdl-begin-p lim)
6073          (cond
6074           ;; "is", "generate", "loop":
6075           ((looking-at "[igl]")
6076            (vector "end"
6077                    (and (vhdl-last-word (point))
6078                         (or (vhdl-first-word (point))
6079                             (save-excursion
6080                               (vhdl-beginning-of-statement-1 lim)
6081                               (vhdl-backward-skip-label lim)
6082                               (vhdl-first-word (point)))))))
6083           ;; "begin", "else", "for":
6084           ((looking-at "be\\|[ef]")
6085            (vector "end"
6086                    (and (vhdl-last-word (point))
6087                         (or (vhdl-first-word (point))
6088                             (save-excursion
6089                               (vhdl-beginning-of-statement-1 lim)
6090                               (vhdl-backward-skip-label lim)
6091                               (vhdl-first-word (point)))))))
6092           ;; "component", "units", "record", "protected body":
6093           ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
6094            ;; The first end found will close the block
6095            (vector "end" nil))
6096           ;; "block", "process", "procedural":
6097           ((looking-at "bl\\|p")
6098            (vector "end"
6099                    (or (vhdl-first-word (point))
6100                        (save-excursion
6101                          (vhdl-beginning-of-statement-1 lim)
6102                          (vhdl-backward-skip-label lim)
6103                          (vhdl-first-word (point))))))
6104           ;; "then":
6105           ((looking-at "t\\|use")
6106            (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
6107                    (and (vhdl-last-word (point))
6108                         (or (vhdl-first-word (point))
6109                             (save-excursion
6110                               (vhdl-beginning-of-statement-1 lim)
6111                               (vhdl-backward-skip-label lim)
6112                               (vhdl-first-word (point)))))))
6113           ))))
6114
6115 (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
6116
6117 (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]")
6118
6119 (defun vhdl-end-p (&optional lim)
6120   "Return t if we are looking at a real \"end\" keyword.
6121 Assumes that the caller will make sure that we are looking at
6122 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
6123 the middle of an identifier that just happens to contain an \"end\"
6124 keyword."
6125   (or (not (looking-at "else"))
6126       ;; make sure that the "else" isn't inside a conditional signal
6127       ;; assignment.
6128       (save-excursion
6129         (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6130         (or (eq (following-char) ?\;)
6131             (eq (point) lim)
6132             (vhdl-in-literal)))))
6133
6134 (defun vhdl-corresponding-begin (&optional lim)
6135   "If the word at the current position corresponds to an \"end\"
6136 keyword, then return a vector containing enough information to find
6137 the corresponding \"begin\" keyword, else return nil.  The keyword to
6138 search backward for is aref 0.  The column in which the keyword must
6139 appear is aref 1 or nil if any column is suitable.  The supplementary
6140 keyword to search forward for is aref 2 or nil if this is not
6141 required.  If aref 3 is t, then the \"begin\" keyword may be found in
6142 the middle of a statement.
6143 Assumes that the caller will make sure that we are not in the middle
6144 of an identifier that just happens to contain an \"end\" keyword."
6145   (save-excursion
6146     (let (pos)
6147       (if (and (looking-at vhdl-end-fwd-re)
6148                (not (vhdl-in-literal))
6149                (vhdl-end-p lim))
6150           (if (looking-at "el")
6151               ;; "else", "elsif":
6152               (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
6153             ;; "end ...":
6154             (setq pos (point))
6155             (forward-sexp)
6156             (skip-chars-forward " \t\n\r\f")
6157             (cond
6158              ;; "end if":
6159              ((looking-at "if\\b[^_]")
6160               (vector "else\\|elsif\\|if"
6161                       (vhdl-first-word pos)
6162                       "else\\|then\\|use" nil))
6163              ;; "end component":
6164              ((looking-at "component\\b[^_]")
6165               (vector (buffer-substring (match-beginning 1)
6166                                         (match-end 1))
6167                       (vhdl-first-word pos)
6168                       nil nil))
6169              ;; "end units", "end record", "end protected":
6170              ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
6171               (vector (buffer-substring (match-beginning 1)
6172                                         (match-end 1))
6173                       (vhdl-first-word pos)
6174                       nil t))
6175              ;; "end block", "end process", "end procedural":
6176              ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
6177               (vector "begin" (vhdl-first-word pos) nil nil))
6178              ;; "end case":
6179              ((looking-at "case\\b[^_]")
6180               (vector "case" (vhdl-first-word pos) "is" nil))
6181              ;; "end generate":
6182              ((looking-at "generate\\b[^_]")
6183               (vector "generate\\|for\\|if"
6184                       (vhdl-first-word pos)
6185                       "generate" nil))
6186              ;; "end loop":
6187              ((looking-at "loop\\b[^_]")
6188               (vector "loop\\|while\\|for"
6189                       (vhdl-first-word pos)
6190                       "loop" nil))
6191              ;; "end for" (inside configuration declaration):
6192              ((looking-at "for\\b[^_]")
6193               (vector "for" (vhdl-first-word pos) nil nil))
6194              ;; "end [id]":
6195              (t
6196               (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
6197                       (vhdl-first-word pos)
6198                       ;; return an alist of (statement . keyword) mappings
6199                       '(
6200                         ;; "begin ... end [id]":
6201                         ("begin"          . nil)
6202                         ;; "architecture ... is ... begin ... end [id]":
6203                         ("architecture"   . "is")
6204                         ;; "configuration ... is ... end [id]":
6205                         ("configuration"  . "is")
6206                         ;; "context ... is ... end [id]":
6207                         ("context"        . "is")
6208                         ;; "entity ... is ... end [id]":
6209                         ("entity"         . "is")
6210                         ;; "package ... is ... end [id]":
6211                         ("package"        . "is")
6212                         ;; "procedure ... is ... begin ... end [id]":
6213                         ("procedure"      . "is")
6214                         ;; "function ... is ... begin ... end [id]":
6215                         ("function"       . "is")
6216                         )
6217                       nil))
6218              ))) ; "end ..."
6219       )))
6220
6221 (defconst vhdl-leader-re
6222   "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
6223
6224 (defun vhdl-end-of-leader ()
6225   (save-excursion
6226     (cond ((looking-at "block\\|process\\|procedural")
6227            (if (save-excursion
6228                  (forward-sexp)
6229                  (skip-chars-forward " \t\n\r\f")
6230                  (= (following-char) ?\())
6231                (forward-sexp 2)
6232              (forward-sexp))
6233            (when (looking-at "[ \t\n\r\f]*is")
6234              (goto-char (match-end 0)))
6235            (point))
6236           ((looking-at "component")
6237            (forward-sexp 2)
6238            (when (looking-at "[ \t\n\r\f]*is")
6239              (goto-char (match-end 0)))
6240            (point))
6241           ((looking-at "for")
6242            (forward-sexp 2)
6243            (skip-chars-forward " \t\n\r\f")
6244            (while (looking-at "[,:(]")
6245              (forward-sexp)
6246              (skip-chars-forward " \t\n\r\f"))
6247            (point))
6248           (t nil)
6249           )))
6250
6251 (defconst vhdl-trailer-re
6252   "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
6253
6254 (defconst vhdl-statement-fwd-re
6255   "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
6256   "A regular expression for searching forward that matches all known
6257 \"statement\" keywords.")
6258
6259 (defconst vhdl-statement-bwd-re
6260   "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
6261   "A regular expression for searching backward that matches all known
6262 \"statement\" keywords.")
6263
6264 (defun vhdl-statement-p (&optional lim)
6265   "Return t if we are looking at a real \"statement\" keyword.
6266 Assumes that the caller will make sure that we are looking at
6267 vhdl-statement-fwd-re, and are not inside a literal, and that we are not
6268 in the middle of an identifier that just happens to contain a
6269 \"statement\" keyword."
6270   (cond
6271    ;; "for" ... "generate":
6272    ((and (looking-at "f")
6273          ;; Make sure it's the start of a parameter specification.
6274          (save-excursion
6275            (forward-sexp 2)
6276            (skip-chars-forward " \t\n\r\f")
6277            (looking-at "in\\b[^_]"))
6278          ;; Make sure it's not an "end for".
6279          (save-excursion
6280            (backward-sexp)
6281            (not (looking-at "end\\s-+\\w"))))
6282     t)
6283    ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
6284    ((and (looking-at "i")
6285          ;; Make sure it's not an "end if".
6286          (save-excursion
6287            (backward-sexp)
6288            (not (looking-at "end\\s-+\\w"))))
6289     t)
6290    ;; "while" ... "loop":
6291    ((looking-at "w")
6292     t)
6293    ))
6294
6295 (defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>"
6296   "Regexp describing a case statement alternative key.")
6297
6298 (defun vhdl-case-alternative-p (&optional lim)
6299   "Return t if we are looking at a real case alternative.
6300 Assumes that the caller will make sure that we are looking at
6301 vhdl-case-alternative-re, and are not inside a literal, and that
6302 we are not in the middle of an identifier that just happens to
6303 contain a \"when\" keyword."
6304   (save-excursion
6305     (let (foundp)
6306       (while (and (not foundp)
6307                   (re-search-backward ";\\|<=" lim 'move))
6308         (if (or (= (preceding-char) ?_)
6309                 (vhdl-in-literal))
6310             (backward-char)
6311           (setq foundp t)))
6312       (or (eq (following-char) ?\;)
6313           (eq (point) lim)))
6314     ))
6315
6316 ;; Core syntactic movement functions:
6317
6318 (defconst vhdl-b-t-b-re
6319   (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
6320
6321 (defun vhdl-backward-to-block (&optional lim)
6322   "Move backward to the previous \"begin\" or \"end\" keyword."
6323   (let (foundp)
6324     (while (and (not foundp)
6325                 (re-search-backward vhdl-b-t-b-re lim 'move))
6326       (if (or (= (preceding-char) ?_)
6327               (vhdl-in-literal))
6328           (backward-char)
6329         (cond
6330          ;; "begin" keyword:
6331          ((and (looking-at vhdl-begin-fwd-re)
6332                (or (not (looking-at "\\<use\\>"))
6333                    (save-excursion (back-to-indentation)
6334                                    (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6335                (/= (preceding-char) ?_)
6336                (vhdl-begin-p lim))
6337           (setq foundp 'begin))
6338          ;; "end" keyword:
6339          ((and (looking-at vhdl-end-fwd-re)
6340                (/= (preceding-char) ?_)
6341                (vhdl-end-p lim))
6342           (setq foundp 'end))
6343          ))
6344       )
6345     foundp
6346     ))
6347
6348 (defun vhdl-forward-sexp (&optional count lim)
6349   "Move forward across one balanced expression (sexp).
6350 With COUNT, do it that many times."
6351   (interactive "p")
6352   (let ((count (or count 1))
6353         (case-fold-search t)
6354         end-vec target)
6355     (save-excursion
6356       (while (> count 0)
6357         ;; skip whitespace
6358         (skip-chars-forward " \t\n\r\f")
6359         ;; Check for an unbalanced "end" keyword
6360         (if (and (looking-at vhdl-end-fwd-re)
6361                  (/= (preceding-char) ?_)
6362                  (not (vhdl-in-literal))
6363                  (vhdl-end-p lim)
6364                  (not (looking-at "else")))
6365             (error
6366              "ERROR:  Containing expression ends prematurely in vhdl-forward-sexp"))
6367         ;; If the current keyword is a "begin" keyword, then find the
6368         ;; corresponding "end" keyword.
6369         (if (setq end-vec (vhdl-corresponding-end lim))
6370             (let (
6371                   ;; end-re is the statement keyword to search for
6372                   (end-re
6373                    (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
6374                   ;; column is either the statement keyword target column
6375                   ;; or nil
6376                   (column (aref end-vec 1))
6377                   (eol (vhdl-point 'eol))
6378                   foundp literal placeholder)
6379               ;; Look for the statement keyword.
6380               (while (and (not foundp)
6381                           (re-search-forward end-re nil t)
6382                           (setq placeholder (match-end 1))
6383                           (goto-char (match-beginning 0)))
6384                 ;; If we are in a literal, or not in the right target
6385                 ;; column and not on the same line as the begin, then
6386                 ;; try again.
6387                 (if (or (and column
6388                              (/= (current-indentation) column)
6389                              (> (point) eol))
6390                         (= (preceding-char) ?_)
6391                         (setq literal (vhdl-in-literal)))
6392                     (if (eq literal 'comment)
6393                         (end-of-line)
6394                       (forward-char))
6395                   ;; An "else" keyword corresponds to both the opening brace
6396                   ;; of the following sexp and the closing brace of the
6397                   ;; previous sexp.
6398                   (if (not (looking-at "else"))
6399                       (goto-char placeholder))
6400                   (setq foundp t))
6401                 )
6402               (if (not foundp)
6403                   (error "ERROR:  Unbalanced keywords in vhdl-forward-sexp"))
6404               )
6405           ;; If the current keyword is not a "begin" keyword, then just
6406           ;; perform the normal forward-sexp.
6407           (forward-sexp)
6408           )
6409         (setq count (1- count))
6410         )
6411       (setq target (point)))
6412     (goto-char target)
6413     nil))
6414
6415 (defun vhdl-backward-sexp (&optional count lim)
6416   "Move backward across one balanced expression (sexp).
6417 With COUNT, do it that many times.  LIM bounds any required backward
6418 searches."
6419   (interactive "p")
6420   (let ((count (or count 1))
6421         (case-fold-search t)
6422         begin-vec target)
6423     (save-excursion
6424       (while (> count 0)
6425         ;; Perform the normal backward-sexp, unless we are looking at
6426         ;; "else" - an "else" keyword corresponds to both the opening brace
6427         ;; of the following sexp and the closing brace of the previous sexp.
6428         (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
6429                  (/= (preceding-char) ?_)
6430                  (not (vhdl-in-literal)))
6431             nil
6432           (backward-sexp)
6433           (if (and (looking-at vhdl-begin-fwd-re)
6434                    (or (not (looking-at "\\<use\\>"))
6435                        (save-excursion
6436                          (back-to-indentation)
6437                          (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6438                    (/= (preceding-char) ?_)
6439                    (not (vhdl-in-literal))
6440                    (vhdl-begin-p lim))
6441               (error "ERROR:  Containing expression ends prematurely in vhdl-backward-sexp")))
6442         ;; If the current keyword is an "end" keyword, then find the
6443         ;; corresponding "begin" keyword.
6444         (if (and (setq begin-vec (vhdl-corresponding-begin lim))
6445                  (/= (preceding-char) ?_))
6446             (let (
6447                   ;; begin-re is the statement keyword to search for
6448                   (begin-re
6449                    (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
6450                   ;; column is either the statement keyword target column
6451                   ;; or nil
6452                   (column (aref begin-vec 1))
6453                   ;; internal-p controls where the statement keyword can
6454                   ;; be found.
6455                   (internal-p (aref begin-vec 3))
6456                   (last-backward (point)) last-forward
6457                   foundp literal keyword)
6458               ;; Look for the statement keyword.
6459               (while (and (not foundp)
6460                           (re-search-backward begin-re lim t)
6461                           (setq keyword
6462                                 (buffer-substring (match-beginning 1)
6463                                                   (match-end 1))))
6464                 ;; If we are in a literal or in the wrong column,
6465                 ;; then try again.
6466                 (if (or (and column
6467                              (and (/= (current-indentation) column)
6468                                   ;; possibly accept current-column as
6469                                   ;; well as current-indentation.
6470                                   (or (not internal-p)
6471                                       (/= (current-column) column))))
6472                         (= (preceding-char) ?_)
6473                         (vhdl-in-literal))
6474                     (backward-char)
6475                   ;; If there is a supplementary keyword, then
6476                   ;; search forward for it.
6477                   (if (and (setq begin-re (aref begin-vec 2))
6478                            (or (not (listp begin-re))
6479                                ;; If begin-re is an alist, then find the
6480                                ;; element corresponding to the actual
6481                                ;; keyword that we found.
6482                                (progn
6483                                  (setq begin-re
6484                                        (assoc keyword begin-re))
6485                                  (and begin-re
6486                                       (setq begin-re (cdr begin-re))))))
6487                       (and
6488                        (setq begin-re
6489                              (concat "\\b\\(" begin-re "\\)\\b[^_]"))
6490                        (save-excursion
6491                          (setq last-forward (point))
6492                          ;; Look for the supplementary keyword
6493                          ;; (bounded by the backward search start
6494                          ;; point).
6495                          (while (and (not foundp)
6496                                      (re-search-forward begin-re
6497                                                         last-backward t)
6498                                      (goto-char (match-beginning 1)))
6499                            ;; If we are in a literal, then try again.
6500                            (if (or (= (preceding-char) ?_)
6501                                    (setq literal
6502                                          (vhdl-in-literal)))
6503                                (if (eq literal 'comment)
6504                                    (goto-char
6505                                     (min (vhdl-point 'eol) last-backward))
6506                                  (forward-char))
6507                              ;; We have found the supplementary keyword.
6508                              ;; Save the position of the keyword in foundp.
6509                              (setq foundp (point)))
6510                            )
6511                          foundp)
6512                        ;; If the supplementary keyword was found, then
6513                        ;; move point to the supplementary keyword.
6514                        (goto-char foundp))
6515                     ;; If there was no supplementary keyword, then
6516                     ;; point is already at the statement keyword.
6517                     (setq foundp t)))
6518                 ) ; end of the search for the statement keyword
6519               (if (not foundp)
6520                   (error "ERROR:  Unbalanced keywords in vhdl-backward-sexp"))
6521               ))
6522         (setq count (1- count))
6523         )
6524       (setq target (point)))
6525     (goto-char target)
6526     nil))
6527
6528 (defun vhdl-backward-up-list (&optional count limit)
6529   "Move backward out of one level of blocks.
6530 With argument, do this that many times."
6531   (interactive "p")
6532   (let ((count (or count 1))
6533         target)
6534     (save-excursion
6535       (while (> count 0)
6536         (if (looking-at vhdl-defun-re)
6537             (error "ERROR:  Unbalanced blocks"))
6538         (vhdl-backward-to-block limit)
6539         (setq count (1- count)))
6540       (setq target (point)))
6541     (goto-char target)))
6542
6543 (defun vhdl-end-of-defun (&optional count)
6544   "Move forward to the end of a VHDL defun."
6545   (interactive)
6546   (let ((case-fold-search t))
6547     (vhdl-beginning-of-defun)
6548     (if (not (looking-at "block\\|process\\|procedural"))
6549         (re-search-forward "\\bis\\b"))
6550     (vhdl-forward-sexp)))
6551
6552 (defun vhdl-mark-defun ()
6553   "Put mark at end of this \"defun\", point at beginning."
6554   (interactive)
6555   (let ((case-fold-search t))
6556     (push-mark)
6557     (vhdl-beginning-of-defun)
6558     (push-mark)
6559     (if (not (looking-at "block\\|process\\|procedural"))
6560         (re-search-forward "\\bis\\b"))
6561     (vhdl-forward-sexp)
6562     (exchange-point-and-mark)))
6563
6564 (defun vhdl-beginning-of-libunit ()
6565   "Move backward to the beginning of a VHDL library unit.
6566 Returns the location of the corresponding begin keyword, unless search
6567 stops due to beginning or end of buffer.
6568 Note that if point is between the \"libunit\" keyword and the
6569 corresponding \"begin\" keyword, then that libunit will not be
6570 recognized, and the search will continue backwards.  If point is
6571 at the \"begin\" keyword, then the defun will be recognized.  The
6572 returned point is at the first character of the \"libunit\" keyword."
6573   (let ((last-forward (point))
6574         (last-backward
6575          ;; Just in case we are actually sitting on the "begin"
6576          ;; keyword, allow for the keyword and an extra character,
6577          ;; as this will be used when looking forward for the
6578          ;; "begin" keyword.
6579          (save-excursion (forward-word 1) (1+ (point))))
6580         foundp literal placeholder)
6581     ;; Find the "libunit" keyword.
6582     (while (and (not foundp)
6583                 (re-search-backward vhdl-libunit-re nil 'move))
6584       ;; If we are in a literal, or not at a real libunit, then try again.
6585       (if (or (= (preceding-char) ?_)
6586               (vhdl-in-literal)
6587               (not (vhdl-libunit-p)))
6588           (backward-char)
6589         ;; Find the corresponding "begin" keyword.
6590         (setq last-forward (point))
6591         (while (and (not foundp)
6592                     (re-search-forward "\\bis\\b[^_]" last-backward t)
6593                     (setq placeholder (match-beginning 0)))
6594           (if (or (= (preceding-char) ?_)
6595                   (setq literal (vhdl-in-literal)))
6596               ;; It wasn't a real keyword, so keep searching.
6597               (if (eq literal 'comment)
6598                   (goto-char
6599                    (min (vhdl-point 'eol) last-backward))
6600                 (forward-char))
6601             ;; We have found the begin keyword, loop will exit.
6602             (setq foundp placeholder)))
6603         ;; Go back to the libunit keyword
6604         (goto-char last-forward)))
6605     foundp))
6606
6607 (defun vhdl-beginning-of-defun (&optional count)
6608   "Move backward to the beginning of a VHDL defun.
6609 With argument, do it that many times.
6610 Returns the location of the corresponding begin keyword, unless search
6611 stops due to beginning or end of buffer."
6612   ;; Note that if point is between the "defun" keyword and the
6613   ;; corresponding "begin" keyword, then that defun will not be
6614   ;; recognized, and the search will continue backwards.  If point is
6615   ;; at the "begin" keyword, then the defun will be recognized.  The
6616   ;; returned point is at the first character of the "defun" keyword.
6617   (interactive "p")
6618   (let ((count (or count 1))
6619         (case-fold-search t)
6620         (last-forward (point))
6621         foundp)
6622     (while (> count 0)
6623       (setq foundp nil)
6624       (goto-char last-forward)
6625       (let ((last-backward
6626              ;; Just in case we are actually sitting on the "begin"
6627              ;; keyword, allow for the keyword and an extra character,
6628              ;; as this will be used when looking forward for the
6629              ;; "begin" keyword.
6630              (save-excursion (forward-word 1) (1+ (point))))
6631             begin-string literal)
6632         (while (and (not foundp)
6633                     (re-search-backward vhdl-defun-re nil 'move))
6634           ;; If we are in a literal, then try again.
6635           (if (or (= (preceding-char) ?_)
6636                   (vhdl-in-literal))
6637               (backward-char)
6638             (if (setq begin-string (vhdl-corresponding-defun))
6639                 ;; This is a real defun keyword.
6640                 ;; Find the corresponding "begin" keyword.
6641                 ;; Look for the begin keyword.
6642                 (progn
6643                   ;; Save the search start point.
6644                   (setq last-forward (point))
6645                   (while (and (not foundp)
6646                               (search-forward begin-string last-backward t))
6647                     (if (or (= (preceding-char) ?_)
6648                             (save-match-data
6649                               (setq literal (vhdl-in-literal))))
6650                         ;; It wasn't a real keyword, so keep searching.
6651                         (if (eq literal 'comment)
6652                             (goto-char
6653                              (min (vhdl-point 'eol) last-backward))
6654                           (forward-char))
6655                       ;; We have found the begin keyword, loop will exit.
6656                       (setq foundp (match-beginning 0)))
6657                     )
6658                   ;; Go back to the defun keyword
6659                   (goto-char last-forward)) ; end search for begin keyword
6660               ))
6661           ) ; end of the search for the defun keyword
6662         )
6663       (setq count (1- count))
6664       )
6665     (vhdl-keep-region-active)
6666     foundp))
6667
6668 (defun vhdl-beginning-of-statement (&optional count lim interactive)
6669   "Go to the beginning of the innermost VHDL statement.
6670 With prefix arg, go back N - 1 statements.  If already at the
6671 beginning of a statement then go to the beginning of the preceding
6672 one.  If within a string or comment, or next to a comment (only
6673 whitespace between), move by sentences instead of statements.
6674
6675 When called from a program, this function takes 3 optional args: the
6676 prefix arg, a buffer position limit which is the farthest back to
6677 search, and an argument indicating an interactive call."
6678   (interactive "p\np")
6679   (let ((count (or count 1))
6680         (case-fold-search t)
6681         (lim (or lim (point-min)))
6682         (here (point))
6683         state)
6684     (save-excursion
6685       (goto-char lim)
6686       (setq state (parse-partial-sexp (point) here nil nil)))
6687     (if (and interactive
6688              (or (nth 3 state)
6689                  (nth 4 state)
6690                  (looking-at (concat "[ \t]*" comment-start-skip))))
6691         (forward-sentence (- count))
6692       (while (> count 0)
6693         (vhdl-beginning-of-statement-1 lim)
6694         (setq count (1- count))))
6695     ;; its possible we've been left up-buf of lim
6696     (goto-char (max (point) lim))
6697     )
6698   (vhdl-keep-region-active))
6699
6700 (defconst vhdl-e-o-s-re
6701   (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re))
6702
6703 (defun vhdl-end-of-statement ()
6704   "Very simple implementation."
6705   (interactive)
6706   (re-search-forward vhdl-e-o-s-re))
6707
6708 (defconst vhdl-b-o-s-re
6709   (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|"
6710           vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
6711
6712 (defun vhdl-beginning-of-statement-1 (&optional lim)
6713   "Move to the start of the current statement, or the previous
6714 statement if already at the beginning of one."
6715   (let ((lim (or lim (point-min)))
6716         (here (point))
6717         (pos (point))
6718         donep)
6719     ;; go backwards one balanced expression, but be careful of
6720     ;; unbalanced paren being reached
6721     (if (not (vhdl-safe (progn (backward-sexp) t)))
6722         (progn
6723           (backward-up-list 1)
6724           (forward-char)
6725           (vhdl-forward-syntactic-ws here)
6726           (setq donep t)))
6727     (while (and (not donep)
6728                 (not (bobp))
6729                 ;; look backwards for a statement boundary
6730                 (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move)))
6731       (if (or (= (preceding-char) ?_)
6732               (vhdl-in-literal))
6733           (backward-char)
6734         (cond
6735          ;; If we are looking at an open paren, then stop after it
6736          ((eq (following-char) ?\()
6737           (forward-char)
6738           (vhdl-forward-syntactic-ws here)
6739           (setq donep t))
6740          ;; If we are looking at a close paren, then skip it
6741          ((eq (following-char) ?\))
6742           (forward-char)
6743           (setq pos (point))
6744           (backward-sexp)
6745           (if (< (point) lim)
6746               (progn (goto-char pos)
6747                      (vhdl-forward-syntactic-ws here)
6748                      (setq donep t))))
6749          ;; If we are looking at a semicolon, then stop
6750          ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p)))
6751           (progn
6752             (forward-char)
6753             (vhdl-forward-syntactic-ws here)
6754             (setq donep t)))
6755          ;; If we are looking at a "begin", then stop
6756          ((and (looking-at vhdl-begin-fwd-re)
6757                (or (not (looking-at "\\<use\\>"))
6758                    (save-excursion
6759                      (back-to-indentation)
6760                      (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6761                (/= (preceding-char) ?_)
6762                (vhdl-begin-p nil))
6763           ;; If it's a leader "begin", then find the
6764           ;; right place
6765           (if (looking-at vhdl-leader-re)
6766               (save-excursion
6767                 ;; set a default stop point at the begin
6768                 (setq pos (point))
6769                 ;; is the start point inside the leader area ?
6770                 (goto-char (vhdl-end-of-leader))
6771                 (vhdl-forward-syntactic-ws here)
6772                 (if (< (point) here)
6773                     ;; start point was not inside leader area
6774                     ;; set stop point at word after leader
6775                     (setq pos (point))))
6776             (forward-word 1)
6777             (vhdl-forward-syntactic-ws here)
6778             (setq pos (point)))
6779           (goto-char pos)
6780           (setq donep t))
6781          ;; If we are looking at a "statement", then stop
6782          ((and (looking-at vhdl-statement-fwd-re)
6783                (/= (preceding-char) ?_)
6784                (vhdl-statement-p nil))
6785           (setq donep t))
6786          ;; If we are looking at a case alternative key, then stop
6787          ((and (looking-at vhdl-case-alternative-re)
6788                (vhdl-case-alternative-p lim))
6789           (save-excursion
6790             ;; set a default stop point at the when
6791             (setq pos (point))
6792             ;; is the start point inside the case alternative key ?
6793             (looking-at vhdl-case-alternative-re)
6794             (goto-char (match-end 0))
6795             (vhdl-forward-syntactic-ws here)
6796             (if (< (point) here)
6797                 ;; start point was not inside the case alternative key
6798                 ;; set stop point at word after case alternative keyleader
6799                 (setq pos (point))))
6800           (goto-char pos)
6801           (setq donep t))
6802          ;; Bogus find, continue
6803          (t
6804           (backward-char)))))
6805     ))
6806
6807 ;; Defuns for calculating the current syntactic state:
6808
6809 (defun vhdl-get-library-unit (bod placeholder)
6810   "If there is an enclosing library unit at BOD, with its \"begin\"
6811 keyword at PLACEHOLDER, then return the library unit type."
6812   (let ((here (vhdl-point 'bol)))
6813     (if (save-excursion
6814           (goto-char placeholder)
6815           (vhdl-safe (vhdl-forward-sexp 1 bod))
6816           (<= here (point)))
6817         (save-excursion
6818           (goto-char bod)
6819           (cond
6820            ((looking-at "e") 'entity)
6821            ((looking-at "a") 'architecture)
6822            ((looking-at "conf") 'configuration)
6823            ((looking-at "cont") 'context)
6824            ((looking-at "p")
6825             (save-excursion
6826               (goto-char bod)
6827               (forward-sexp)
6828               (vhdl-forward-syntactic-ws here)
6829               (if (looking-at "body\\b[^_]")
6830                   'package-body 'package))))))
6831     ))
6832
6833 (defun vhdl-get-block-state (&optional lim)
6834   "Finds and records all the closest opens.
6835 LIM is the furthest back we need to search (it should be the
6836 previous libunit keyword)."
6837   (let ((here (point))
6838         (lim (or lim (point-min)))
6839         keyword sexp-start sexp-mid sexp-end
6840         preceding-sexp containing-sexp
6841         containing-begin containing-mid containing-paren)
6842     (save-excursion
6843       ;; Find the containing-paren, and use that as the limit
6844       (if (setq containing-paren
6845                 (save-restriction
6846                   (narrow-to-region lim (point))
6847                   (vhdl-safe (scan-lists (point) -1 1))))
6848           (setq lim containing-paren))
6849       ;; Look backwards for "begin" and "end" keywords.
6850       (while (and (> (point) lim)
6851                   (not containing-sexp))
6852         (setq keyword (vhdl-backward-to-block lim))
6853         (cond
6854          ((eq keyword 'begin)
6855           ;; Found a "begin" keyword
6856           (setq sexp-start (point))
6857           (setq sexp-mid (vhdl-corresponding-mid lim))
6858           (setq sexp-end (vhdl-safe
6859                           (save-excursion
6860                             (vhdl-forward-sexp 1 lim) (point))))
6861           (if (and sexp-end (<= sexp-end here))
6862               ;; we want to record this sexp, but we only want to
6863               ;; record the last-most of any of them before here
6864               (or preceding-sexp
6865                   (setq preceding-sexp sexp-start))
6866             ;; we're contained in this sexp so put sexp-start on
6867             ;; front of list
6868             (setq containing-sexp sexp-start)
6869             (setq containing-mid sexp-mid)
6870             (setq containing-begin t)))
6871          ((eq keyword 'end)
6872           ;; Found an "end" keyword
6873           (forward-sexp)
6874           (setq sexp-end (point))
6875           (setq sexp-mid nil)
6876           (setq sexp-start
6877                 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
6878                     (progn (backward-sexp) (point))))
6879           ;; we want to record this sexp, but we only want to
6880           ;; record the last-most of any of them before here
6881           (or preceding-sexp
6882               (setq preceding-sexp sexp-start)))
6883          )))
6884     ;; Check if the containing-paren should be the containing-sexp
6885     (if (and containing-paren
6886              (or (null containing-sexp)
6887                  (< containing-sexp containing-paren)))
6888         (setq containing-sexp containing-paren
6889               preceding-sexp nil
6890               containing-begin nil
6891               containing-mid nil))
6892     (vector containing-sexp preceding-sexp containing-begin containing-mid)
6893     ))
6894
6895
6896 (defconst vhdl-s-c-a-re
6897   (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key))
6898
6899 (defun vhdl-skip-case-alternative (&optional lim)
6900   "Skip forward over case/when bodies, with optional maximal
6901 limit.  If no next case alternative is found, nil is returned and
6902 point is not moved."
6903   (let ((lim (or lim (point-max)))
6904         (here (point))
6905         donep foundp)
6906     (while (and (< (point) lim)
6907                 (not donep))
6908       (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
6909                (save-match-data
6910                  (not (vhdl-in-literal)))
6911                (/= (match-beginning 0) here))
6912           (progn
6913             (goto-char (match-beginning 0))
6914             (cond
6915              ((and (looking-at "case")
6916                    (re-search-forward "\\bis[^_]" lim t))
6917               (backward-sexp)
6918               (vhdl-forward-sexp))
6919              (t
6920               (setq donep t
6921                     foundp t))))))
6922     (if (not foundp)
6923         (goto-char here))
6924     foundp))
6925
6926 (defun vhdl-backward-skip-label (&optional lim)
6927   "Skip backward over a label, with optional maximal
6928 limit.  If label is not found, nil is returned and point
6929 is not moved."
6930   (let ((lim (or lim (point-min)))
6931         placeholder)
6932     (if (save-excursion
6933           (vhdl-backward-syntactic-ws lim)
6934           (and (eq (preceding-char) ?:)
6935                (progn
6936                  (backward-sexp)
6937                  (setq placeholder (point))
6938                  (looking-at vhdl-label-key))))
6939         (goto-char placeholder))
6940     ))
6941
6942 (defun vhdl-forward-skip-label (&optional lim)
6943   "Skip forward over a label, with optional maximal
6944 limit.  If label is not found, nil is returned and point
6945 is not moved."
6946   (let ((lim (or lim (point-max))))
6947     (if (looking-at vhdl-label-key)
6948         (progn
6949           (goto-char (match-end 0))
6950           (vhdl-forward-syntactic-ws lim)))
6951     ))
6952
6953 (defun vhdl-get-syntactic-context ()
6954   "Guess the syntactic description of the current line of VHDL code."
6955   (save-excursion
6956     (save-restriction
6957       (beginning-of-line)
6958       (let* ((indent-point (point))
6959              (case-fold-search t)
6960              vec literal containing-sexp preceding-sexp
6961              containing-begin containing-mid containing-leader
6962              char-before-ip char-after-ip begin-after-ip end-after-ip
6963              placeholder lim library-unit
6964             )
6965
6966         ;; Reset the syntactic context
6967         (setq vhdl-syntactic-context nil)
6968
6969         (save-excursion
6970           ;; Move to the start of the previous library unit, and
6971           ;; record the position of the "begin" keyword.
6972           (setq placeholder (vhdl-beginning-of-libunit))
6973           ;; The position of the "libunit" keyword gives us a gross
6974           ;; limit point.
6975           (setq lim (point))
6976           )
6977
6978         ;; If there is a previous library unit, and we are enclosed by
6979         ;; it, then set the syntax accordingly.
6980         (and placeholder
6981              (setq library-unit (vhdl-get-library-unit lim placeholder))
6982              (vhdl-add-syntax library-unit lim))
6983
6984         ;; Find the surrounding state.
6985         (if (setq vec (vhdl-get-block-state lim))
6986             (progn
6987               (setq containing-sexp (aref vec 0))
6988               (setq preceding-sexp (aref vec 1))
6989               (setq containing-begin (aref vec 2))
6990               (setq containing-mid (aref vec 3))
6991               ))
6992
6993         ;; set the limit on the farthest back we need to search
6994         (setq lim (if containing-sexp
6995                       (save-excursion
6996                         (goto-char containing-sexp)
6997                         ;; set containing-leader if required
6998                         (if (looking-at vhdl-leader-re)
6999                             (setq containing-leader (vhdl-end-of-leader)))
7000                         (vhdl-point 'bol))
7001                     (point-min)))
7002
7003         ;; cache char before and after indent point, and move point to
7004         ;; the most likely position to perform the majority of tests
7005         (goto-char indent-point)
7006         (skip-chars-forward " \t")
7007         (setq literal (vhdl-in-literal))
7008         (setq char-after-ip (following-char))
7009         (setq begin-after-ip (and
7010                               (not literal)
7011                               (looking-at vhdl-begin-fwd-re)
7012                               (or (not (looking-at "\\<use\\>"))
7013                                   (save-excursion
7014                                     (back-to-indentation)
7015                                     (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
7016                               (vhdl-begin-p)))
7017         (setq end-after-ip (and
7018                             (not literal)
7019                             (looking-at vhdl-end-fwd-re)
7020                             (vhdl-end-p)))
7021         (vhdl-backward-syntactic-ws lim)
7022         (setq char-before-ip (preceding-char))
7023         (goto-char indent-point)
7024         (skip-chars-forward " \t")
7025
7026         ;; now figure out syntactic qualities of the current line
7027         (cond
7028          ;; CASE 1: in a string or comment.
7029          ((memq literal '(string comment))
7030           (vhdl-add-syntax literal (vhdl-point 'bopl)))
7031          ;; CASE 2: Line is at top level.
7032          ((null containing-sexp)
7033           ;; Find the point to which indentation will be relative
7034           (save-excursion
7035             (if (null preceding-sexp)
7036                 ;; CASE 2X.1
7037                 ;; no preceding-sexp -> use the preceding statement
7038                 (vhdl-beginning-of-statement-1 lim)
7039               ;; CASE 2X.2
7040               ;; if there is a preceding-sexp then indent relative to it
7041               (goto-char preceding-sexp)
7042               ;; if not at boi, then the block-opening keyword is
7043               ;; probably following a label, so we need a different
7044               ;; relpos
7045               (if (/= (point) (vhdl-point 'boi))
7046                   ;; CASE 2X.3
7047                   (vhdl-beginning-of-statement-1 lim)))
7048             ;; v-b-o-s could have left us at point-min
7049             (and (bobp)
7050                  ;; CASE 2X.4
7051                  (vhdl-forward-syntactic-ws indent-point))
7052             (setq placeholder (point)))
7053           (cond
7054            ;; CASE 2A : we are looking at a block-open
7055            (begin-after-ip
7056             (vhdl-add-syntax 'block-open placeholder))
7057            ;; CASE 2B: we are looking at a block-close
7058            (end-after-ip
7059             (vhdl-add-syntax 'block-close placeholder))
7060            ;; CASE 2C: we are looking at a top-level statement
7061            ((progn
7062               (vhdl-backward-syntactic-ws lim)
7063               (or (bobp)
7064                   (and (= (preceding-char) ?\;)
7065                        (not (vhdl-in-quote-p)))))
7066             (vhdl-add-syntax 'statement placeholder))
7067            ;; CASE 2D: we are looking at a top-level statement-cont
7068            (t
7069             (vhdl-beginning-of-statement-1 lim)
7070             ;; v-b-o-s could have left us at point-min
7071             (and (bobp)
7072                  ;; CASE 2D.1
7073                  (vhdl-forward-syntactic-ws indent-point))
7074             (vhdl-add-syntax 'statement-cont (point)))
7075            )) ; end CASE 2
7076          ;; CASE 3: line is inside parentheses.  Most likely we are
7077          ;; either in a subprogram argument (interface) list, or a
7078          ;; continued expression containing parentheses.
7079          ((null containing-begin)
7080           (vhdl-backward-syntactic-ws containing-sexp)
7081           (cond
7082            ;; CASE 3A: we are looking at the arglist closing paren
7083            ((eq char-after-ip ?\))
7084             (goto-char containing-sexp)
7085             (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
7086            ;; CASE 3B: we are looking at the first argument in an empty
7087            ;; argument list.
7088            ((eq char-before-ip ?\()
7089             (goto-char containing-sexp)
7090             (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
7091            ;; CASE 3C: we are looking at an arglist continuation line,
7092            ;; but the preceding argument is on the same line as the
7093            ;; opening paren.  This case includes multi-line
7094            ;; expression paren groupings.
7095            ((and (save-excursion
7096                    (goto-char (1+ containing-sexp))
7097                    (skip-chars-forward " \t")
7098                    (not (eolp))
7099                    (not (looking-at "--\\|`")))
7100                  (save-excursion
7101                    (vhdl-beginning-of-statement-1 containing-sexp)
7102                    (skip-chars-backward " \t(")
7103                    (while (and (= (preceding-char) ?\;)
7104                                (not (vhdl-in-quote-p)))
7105                      (vhdl-beginning-of-statement-1 containing-sexp)
7106                      (skip-chars-backward " \t("))
7107                    (<= (point) containing-sexp)))
7108             (goto-char containing-sexp)
7109             (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
7110            ;; CASE 3D: we are looking at just a normal arglist
7111            ;; continuation line
7112            (t (vhdl-beginning-of-statement-1 containing-sexp)
7113               (vhdl-forward-syntactic-ws indent-point)
7114               (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
7115            ))
7116          ;; CASE 4: A block mid open
7117          ((and begin-after-ip
7118                (looking-at containing-mid))
7119           (goto-char containing-sexp)
7120           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7121           (if (looking-at vhdl-trailer-re)
7122               ;; CASE 4.1
7123               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7124           (vhdl-backward-skip-label (vhdl-point 'boi))
7125           (vhdl-add-syntax 'block-open (point)))
7126          ;; CASE 5: block close brace
7127          (end-after-ip
7128           (goto-char containing-sexp)
7129           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7130           (if (looking-at vhdl-trailer-re)
7131               ;; CASE 5.1
7132               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7133           (vhdl-backward-skip-label (vhdl-point 'boi))
7134           (vhdl-add-syntax 'block-close (point)))
7135          ;; CASE 6: A continued statement
7136          ((and (/= char-before-ip ?\;)
7137                ;; check it's not a trailer begin keyword, or a begin
7138                ;; keyword immediately following a label.
7139                (not (and begin-after-ip
7140                          (or (looking-at vhdl-trailer-re)
7141                              (save-excursion
7142                                (vhdl-backward-skip-label containing-sexp)))))
7143                ;; check it's not a statement keyword
7144                (not (and (looking-at vhdl-statement-fwd-re)
7145                          (vhdl-statement-p)))
7146                ;; see if the b-o-s is before the indent point
7147                (> indent-point
7148                   (save-excursion
7149                     (vhdl-beginning-of-statement-1 containing-sexp)
7150                     ;; If we ended up after a leader, then this will
7151                     ;; move us forward to the start of the first
7152                     ;; statement.  Note that a containing sexp here is
7153                     ;; always a keyword, not a paren, so this will
7154                     ;; have no effect if we hit the containing-sexp.
7155                     (vhdl-forward-syntactic-ws indent-point)
7156                     (setq placeholder (point))))
7157                ;; check it's not a block-intro
7158                (/= placeholder containing-sexp)
7159                ;; check it's not a case block-intro
7160                (save-excursion
7161                  (goto-char placeholder)
7162                  (or (not (looking-at vhdl-case-alternative-re))
7163                      (> (match-end 0) indent-point))))
7164           ;; Make placeholder skip a label, but only if it puts us
7165           ;; before the indent point at the start of a line.
7166           (let ((new placeholder))
7167             (if (and (> indent-point
7168                         (save-excursion
7169                           (goto-char placeholder)
7170                           (vhdl-forward-skip-label indent-point)
7171                           (setq new (point))))
7172                      (save-excursion
7173                        (goto-char new)
7174                        (eq new (progn (back-to-indentation) (point)))))
7175                 (setq placeholder new)))
7176           (vhdl-add-syntax 'statement-cont placeholder)
7177           (if begin-after-ip
7178               (vhdl-add-syntax 'block-open)))
7179          ;; Statement. But what kind?
7180          ;; CASE 7: A case alternative key
7181          ((and (looking-at vhdl-case-alternative-re)
7182                (vhdl-case-alternative-p containing-sexp))
7183           ;; for a case alternative key, we set relpos to the first
7184           ;; non-whitespace char on the line containing the "case"
7185           ;; keyword.
7186           (goto-char containing-sexp)
7187           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7188           (if (looking-at vhdl-trailer-re)
7189               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7190           (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
7191          ;; CASE 8: statement catchall
7192          (t
7193           ;; we know its a statement, but we need to find out if it is
7194           ;; the first statement in a block
7195           (if containing-leader
7196               (goto-char containing-leader)
7197             (goto-char containing-sexp)
7198             ;; Note that a containing sexp here is always a keyword,
7199             ;; not a paren, so skip over the keyword.
7200             (forward-sexp))
7201           ;; move to the start of the first statement
7202           (vhdl-forward-syntactic-ws indent-point)
7203           (setq placeholder (point))
7204           ;; we want to ignore case alternatives keys when skipping forward
7205           (let (incase-p)
7206             (while (looking-at vhdl-case-alternative-re)
7207               (setq incase-p (point))
7208               ;; we also want to skip over the body of the
7209               ;; case/when statement if that doesn't put us at
7210               ;; after the indent-point
7211               (while (vhdl-skip-case-alternative indent-point))
7212               ;; set up the match end
7213               (looking-at vhdl-case-alternative-re)
7214               (goto-char (match-end 0))
7215               ;; move to the start of the first case alternative statement
7216               (vhdl-forward-syntactic-ws indent-point)
7217               (setq placeholder (point)))
7218             (cond
7219              ;; CASE 8A: we saw a case/when statement so we must be
7220              ;; in a switch statement.  find out if we are at the
7221              ;; statement just after a case alternative key
7222              ((and incase-p
7223                    (= (point) indent-point))
7224               ;; relpos is the "when" keyword
7225               (vhdl-add-syntax 'statement-case-intro incase-p))
7226              ;; CASE 8B: any old statement
7227              ((< (point) indent-point)
7228               ;; relpos is the first statement of the block
7229               (vhdl-add-syntax 'statement placeholder)
7230               (if begin-after-ip
7231                   (vhdl-add-syntax 'block-open)))
7232              ;; CASE 8C: first statement in a block
7233              (t
7234               (goto-char containing-sexp)
7235               ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7236               (if (looking-at vhdl-trailer-re)
7237                   (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7238               (vhdl-backward-skip-label (vhdl-point 'boi))
7239               (vhdl-add-syntax 'statement-block-intro (point))
7240               (if begin-after-ip
7241                   (vhdl-add-syntax 'block-open)))
7242              )))
7243          )
7244
7245         ;; now we need to look at any modifiers
7246         (goto-char indent-point)
7247         (skip-chars-forward " \t")
7248         (if (or (looking-at "--") (looking-at "/\\*"))
7249             (vhdl-add-syntax 'comment))
7250         (if (looking-at "`")
7251             (vhdl-add-syntax 'directive))
7252         (if (eq literal 'pound)
7253             (vhdl-add-syntax 'cpp-macro))
7254         ;; return the syntax
7255         vhdl-syntactic-context))))
7256
7257 ;; Standard indentation line-ups:
7258
7259 (defun vhdl-lineup-arglist (langelem)
7260   "Lineup the current arglist line with the arglist appearing just
7261 after the containing paren which starts the arglist."
7262   (save-excursion
7263     (let* ((containing-sexp
7264             (save-excursion
7265               ;; arglist-cont-nonempty gives relpos ==
7266               ;; to boi of containing-sexp paren. This
7267               ;; is good when offset is +, but bad
7268               ;; when it is vhdl-lineup-arglist, so we
7269               ;; have to special case a kludge here.
7270               (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
7271                   (progn
7272                     (beginning-of-line)
7273                     (backward-up-list 1)
7274                     (skip-chars-forward " \t" (vhdl-point 'eol)))
7275                 (goto-char (cdr langelem)))
7276               (point)))
7277            (cs-curcol (save-excursion
7278                         (goto-char (cdr langelem))
7279                         (current-column))))
7280       (if (save-excursion
7281             (beginning-of-line)
7282             (looking-at "[ \t]*)"))
7283           (progn (goto-char (match-end 0))
7284                  (backward-sexp)
7285                  (forward-char)
7286                  (vhdl-forward-syntactic-ws)
7287                  (- (current-column) cs-curcol))
7288         (goto-char containing-sexp)
7289         (or (eolp)
7290             (let ((eol (vhdl-point 'eol))
7291                   (here (progn
7292                           (forward-char)
7293                           (skip-chars-forward " \t")
7294                           (point))))
7295               (vhdl-forward-syntactic-ws)
7296               (if (< (point) eol)
7297                   (goto-char here))))
7298         (- (current-column) cs-curcol)
7299         ))))
7300
7301 (defun vhdl-lineup-arglist-intro (langelem)
7302   "Lineup an arglist-intro line to just after the open paren."
7303   (save-excursion
7304     (let ((cs-curcol (save-excursion
7305                        (goto-char (cdr langelem))
7306                        (current-column)))
7307           (ce-curcol (save-excursion
7308                        (beginning-of-line)
7309                        (backward-up-list 1)
7310                        (skip-chars-forward " \t" (vhdl-point 'eol))
7311                        (current-column))))
7312       (- ce-curcol cs-curcol -1))))
7313
7314 (defun vhdl-lineup-comment (langelem)
7315   "Support old behavior for comment indentation.  We look at
7316 vhdl-comment-only-line-offset to decide how to indent comment
7317 only-lines."
7318   (save-excursion
7319     (back-to-indentation)
7320     ;; at or to the right of comment-column
7321     (if (>= (current-column) comment-column)
7322         (vhdl-comment-indent)
7323       ;; otherwise, indent as specified by vhdl-comment-only-line-offset
7324       (if (not (bolp))
7325           ;; inside multi-line comment
7326           (if (looking-at "\\*")
7327               1
7328             ;; otherwise
7329           (or (car-safe vhdl-comment-only-line-offset)
7330                 vhdl-comment-only-line-offset))
7331         (or (cdr-safe vhdl-comment-only-line-offset)
7332             (car-safe vhdl-comment-only-line-offset)
7333             -1000                       ;jam it against the left side
7334             )))))
7335
7336 (defun vhdl-lineup-statement-cont (langelem)
7337   "Line up statement-cont after the assignment operator."
7338   (save-excursion
7339     (let* ((relpos (cdr langelem))
7340            (assignp (save-excursion
7341                      (goto-char (vhdl-point 'boi))
7342                      (and (re-search-forward "\\(<\\|:\\|=\\)="
7343                                              (vhdl-point 'eol) t)
7344                           (- (point) (vhdl-point 'boi)))))
7345            (curcol (progn
7346                      (goto-char relpos)
7347                      (current-column)))
7348            foundp)
7349       (while (and (not foundp)
7350                   (< (point) (vhdl-point 'eol)))
7351         (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move)
7352         (if (vhdl-in-literal)
7353             (forward-char)
7354           (if (= (preceding-char) ?\()
7355               ;; skip over any parenthesized expressions
7356               (goto-char (min (vhdl-point 'eol)
7357                               (scan-lists (point) 1 1)))
7358             ;; found an assignment operator (not at eol)
7359             (setq foundp (not (looking-at "\\s-*$"))))))
7360       (if (not foundp)
7361           ;; there's no assignment operator on the line
7362           vhdl-basic-offset
7363         ;; calculate indentation column after assign and ws, unless
7364         ;; our line contains an assignment operator
7365         (if (not assignp)
7366             (progn
7367               (forward-char)
7368               (skip-chars-forward " \t")
7369               (setq assignp 0)))
7370         (- (current-column) assignp curcol))
7371       )))
7372
7373 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7374 ;; Progress reporting
7375
7376 (defvar vhdl-progress-info nil
7377   "Array variable for progress information: 0 begin, 1 end, 2 time.")
7378
7379 (defun vhdl-update-progress-info (string pos)
7380   "Update progress information."
7381   (when (and vhdl-progress-info (not noninteractive)
7382              (< vhdl-progress-interval
7383                 (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
7384     (let ((delta (- (aref vhdl-progress-info 1)
7385                     (aref vhdl-progress-info 0))))
7386       (message "%s... (%2d%%)" string
7387                (if (= 0 delta)
7388                    100
7389                  (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
7390                         delta))))
7391     (aset vhdl-progress-info 2 (nth 1 (current-time)))))
7392
7393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7394 ;; Indentation commands
7395
7396 (defun vhdl-electric-tab (&optional prefix-arg)
7397   "If preceding character is part of a word or a paren then hippie-expand,
7398 else if right of non whitespace on line then insert tab,
7399 else if last command was a tab or return then dedent one step or if a comment
7400 toggle between normal indent and inline comment indent,
7401 else indent `correctly'."
7402   (interactive "*P")
7403   (vhdl-prepare-search-2
7404    (cond
7405     ;; indent region if region is active
7406     ((and (not (featurep 'xemacs)) (use-region-p))
7407      (vhdl-indent-region (region-beginning) (region-end) nil))
7408     ;; expand word
7409     ((= (char-syntax (preceding-char)) ?w)
7410      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7411            (case-replace nil)
7412            (hippie-expand-only-buffers
7413             (or (and (boundp 'hippie-expand-only-buffers)
7414                      hippie-expand-only-buffers)
7415                 '(vhdl-mode))))
7416        (vhdl-expand-abbrev prefix-arg)))
7417     ;; expand parenthesis
7418     ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
7419      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7420            (case-replace nil))
7421        (vhdl-expand-paren prefix-arg)))
7422     ;; insert tab
7423     ((> (current-column) (current-indentation))
7424      (insert-tab))
7425     ;; toggle comment indent
7426     ((and (looking-at "--")
7427           (or (eq last-command 'vhdl-electric-tab)
7428               (eq last-command 'vhdl-electric-return)))
7429      (cond ((= (current-indentation) 0) ; no indent
7430             (indent-to 1)
7431             (indent-according-to-mode))
7432            ((< (current-indentation) comment-column) ; normal indent
7433             (indent-to comment-column)
7434             (indent-according-to-mode))
7435            (t                           ; inline comment indent
7436             (delete-region (line-beginning-position) (point)))))
7437     ;; dedent
7438     ((and (>= (current-indentation) vhdl-basic-offset)
7439           (or (eq last-command 'vhdl-electric-tab)
7440               (eq last-command 'vhdl-electric-return)))
7441      (backward-delete-char-untabify vhdl-basic-offset nil))
7442     ;; indent line
7443     (t (indent-according-to-mode)))
7444    (setq this-command 'vhdl-electric-tab)))
7445
7446 (defun vhdl-electric-return ()
7447   "newline-and-indent or indent-new-comment-line if in comment and preceding
7448 character is a space."
7449   (interactive)
7450   (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
7451       (indent-new-comment-line)
7452     (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)
7453                (not (vhdl-in-comment-p)))
7454       (vhdl-fix-case-word -1))
7455     (newline-and-indent)))
7456
7457 (defun vhdl-indent-line ()
7458   "Indent the current line as VHDL code.  Returns the amount of
7459 indentation change."
7460   (interactive)
7461   (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
7462          (pos (- (point-max) (point)))
7463          (is-comment nil)
7464          (indent
7465           (if syntax
7466               ;; indent syntax-based
7467               (if (and (eq (caar syntax) 'comment)
7468                        (>= (vhdl-get-offset (car syntax)) comment-column))
7469                   ;; special case: comments at or right of comment-column
7470                   (vhdl-get-offset (car syntax))
7471                 ;; align comments like following code line
7472                 (when vhdl-indent-comment-like-next-code-line
7473                   (save-excursion
7474                     (while (eq (caar syntax) 'comment)
7475                       (setq is-comment t)
7476                       (beginning-of-line 2)
7477                       (setq syntax (vhdl-get-syntactic-context)))))
7478                 (when is-comment
7479                   (push (cons 'comment nil) syntax))
7480                 (apply '+ (mapcar 'vhdl-get-offset syntax)))
7481             ;; indent like previous nonblank line
7482             (save-excursion (beginning-of-line)
7483                             (re-search-backward "^[^\n]" nil t)
7484                             (current-indentation))))
7485          (shift-amt  (- indent (current-indentation))))
7486     (and vhdl-echo-syntactic-information-p
7487          (message "syntax: %s, indent= %d" syntax indent))
7488     (let ((has-formfeed
7489            (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
7490       (when (or (not (zerop shift-amt)) has-formfeed)
7491         (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
7492         (beginning-of-line)
7493         (when has-formfeed (insert "\f"))
7494         (indent-to indent)))
7495     (if (< (point) (vhdl-point 'boi))
7496         (back-to-indentation)
7497       ;; If initial point was within line's indentation, position after
7498       ;; the indentation.  Else stay at same point in text.
7499       (when (> (- (point-max) pos) (point))
7500         (goto-char (- (point-max) pos))))
7501     (run-hooks 'vhdl-special-indent-hook)
7502     (vhdl-update-progress-info "Indenting" (vhdl-current-line))
7503     shift-amt))
7504
7505 (defun vhdl-indent-region (beg end &optional column)
7506   "Indent region as VHDL code.
7507 Adds progress reporting to `indent-region'."
7508   (interactive "r\nP")
7509   (when vhdl-progress-interval
7510     (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7511                                      (count-lines (point-min) end) 0)))
7512   (indent-region beg end column)
7513   (when vhdl-progress-interval (message "Indenting...done"))
7514   (setq vhdl-progress-info nil))
7515
7516 (defun vhdl-indent-buffer ()
7517   "Indent whole buffer as VHDL code.
7518 Calls `indent-region' for whole buffer and adds progress reporting."
7519   (interactive)
7520   (vhdl-indent-region (point-min) (point-max)))
7521
7522 (defun vhdl-indent-group ()
7523   "Indent group of lines between empty lines."
7524   (interactive)
7525   (let ((beg (save-excursion
7526                (if (re-search-backward vhdl-align-group-separate nil t)
7527                    (point-marker)
7528                  (point-min-marker))))
7529         (end (save-excursion
7530                (if (re-search-forward vhdl-align-group-separate nil t)
7531                    (point-marker)
7532                  (point-max-marker)))))
7533     (vhdl-indent-region beg end)))
7534
7535 (defun vhdl-indent-sexp (&optional endpos)
7536   "Indent each line of the list starting just after point.
7537 If optional arg ENDPOS is given, indent each line, stopping when
7538 ENDPOS is encountered."
7539   (interactive)
7540   (save-excursion
7541     (let ((beg (point))
7542           (end (progn (vhdl-forward-sexp nil endpos) (point))))
7543       (indent-region beg end nil))))
7544
7545 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7546 ;; Miscellaneous commands
7547
7548 (defun vhdl-show-syntactic-information ()
7549   "Show syntactic information for current line."
7550   (interactive)
7551   (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
7552   (vhdl-keep-region-active))
7553
7554 ;; Verification and regression functions:
7555
7556 (defun vhdl-regress-line (&optional arg)
7557   "Check syntactic information for current line."
7558   (interactive "P")
7559   (let ((expected (save-excursion
7560                     (end-of-line)
7561                     (when (search-backward " -- ((" (vhdl-point 'bol) t)
7562                       (forward-char 4)
7563                       (read (current-buffer)))))
7564         (actual (vhdl-get-syntactic-context))
7565         (expurgated))
7566     ;; remove the library unit symbols
7567     (mapc
7568      (function
7569       (lambda (elt)
7570         (if (memq (car elt) '(entity configuration context package
7571                                      package-body architecture))
7572             nil
7573           (setq expurgated (append expurgated (list elt))))))
7574      actual)
7575     (if (and (not arg) expected (listp expected))
7576         (if (not (equal expected expurgated))
7577             (error "ERROR:  Should be: %s, is: %s" expected expurgated))
7578       (save-excursion
7579         (beginning-of-line)
7580         (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
7581           (end-of-line)
7582           (if (search-backward " -- ((" (vhdl-point 'bol) t)
7583               (delete-region (point) (line-end-position)))
7584           (insert " -- ")
7585           (insert (format "%s" expurgated))))))
7586   (vhdl-keep-region-active))
7587
7588
7589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7590 ;;; Alignment, beautifying
7591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7592
7593 (defconst vhdl-align-alist
7594   '(
7595     ;; after some keywords
7596     (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
7597                "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
7598     ;; before ':'
7599     (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7600     ;; after direction specifications
7601     (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7602                ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7603     ;; before "==", ":=", "=>", and "<="
7604     (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
7605     (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7606     (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
7607     ;; before some keywords
7608     (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7609     (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7610     (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7611     (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
7612     (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
7613     ;; before "=>" since "when/else ... =>" can occur
7614     (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7615     )
7616   "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7617 It is searched in order.  If REGEXP is found anywhere in the first
7618 line of a region to be aligned, ALIGN-PATTERN will be used for that
7619 region.  ALIGN-PATTERN must include the whitespace to be expanded or
7620 contracted.  It may also provide regexps for the text surrounding the
7621 whitespace.  SUBEXP specifies which sub-expression of
7622 ALIGN-PATTERN matches the white space to be expanded/contracted.")
7623
7624 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7625 ;; Align code
7626
7627 (defvar vhdl-align-try-all-clauses t
7628   "If REGEXP is not found on the first line of the region that clause
7629 is ignored.  If this variable is non-nil, then the clause is tried anyway.")
7630
7631 (defun vhdl-do-group (function &optional spacing)
7632   "Apply FUNCTION on group of lines between empty lines."
7633   (let
7634       ;; search for group beginning
7635       ((beg (save-excursion
7636               (if (re-search-backward vhdl-align-group-separate nil t)
7637                   (progn (beginning-of-line 2) (back-to-indentation) (point))
7638                 (point-min))))
7639        ;; search for group end
7640        (end (save-excursion
7641               (if (re-search-forward vhdl-align-group-separate nil t)
7642                   (progn (beginning-of-line) (point))
7643                 (point-max)))))
7644     ;; run FUNCTION
7645     (funcall function beg end spacing)))
7646
7647 (defun vhdl-do-list (function &optional spacing)
7648   "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7649 parentheses."
7650   (let (beg end)
7651     (save-excursion
7652       ;; search for beginning of balanced group of parentheses
7653       (setq beg (vhdl-re-search-backward "[()]" nil t))
7654       (while (looking-at ")")
7655         (forward-char) (backward-sexp)
7656         (setq beg (vhdl-re-search-backward "[()]" nil t)))
7657       ;; search for end of balanced group of parentheses
7658       (when beg
7659         (forward-list)
7660         (setq end (point))
7661         (goto-char (1+ beg))
7662         (skip-chars-forward " \t\n\r\f")
7663         (setq beg (point))))
7664     ;; run FUNCTION
7665     (if beg
7666         (funcall function beg end spacing)
7667       (error "ERROR:  Not within a list enclosed by a pair of parentheses"))))
7668
7669 (defun vhdl-do-same-indent (function &optional spacing)
7670   "Apply FUNCTION to block of lines with same indent."
7671   (let ((indent (current-indentation))
7672         beg end)
7673     ;; search for first line with same indent
7674     (save-excursion
7675       (while (and (not (bobp))
7676                   (or (looking-at "^\\s-*\\(--.*\\)?$")
7677                       (= (current-indentation) indent)))
7678         (unless (looking-at "^\\s-*$")
7679           (back-to-indentation) (setq beg (point)))
7680         (beginning-of-line -0)))
7681     ;; search for last line with same indent
7682     (save-excursion
7683       (while (and (not (eobp))
7684                   (or (looking-at "^\\s-*\\(--.*\\)?$")
7685                       (= (current-indentation) indent)))
7686         (if (looking-at "^\\s-*$")
7687             (beginning-of-line 2)
7688           (beginning-of-line 2)
7689           (setq end (point)))))
7690     ;; run FUNCTION
7691     (funcall function beg end spacing)))
7692
7693 (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
7694   "Attempt to align a range of lines based on the content of the
7695 lines.  The definition of `alignment-list' determines the matching
7696 order and the manner in which the lines are aligned.  If ALIGNMENT-LIST
7697 is not specified `vhdl-align-alist' is used.  If INDENT is non-nil,
7698 indentation is done before aligning."
7699   (interactive "r\np")
7700   (setq alignment-list (or alignment-list vhdl-align-alist))
7701   (setq spacing (or spacing 1))
7702   (save-excursion
7703     (let (bol indent)
7704       (goto-char end)
7705       (setq end (point-marker))
7706       (goto-char begin)
7707       (setq bol (setq begin (progn (beginning-of-line) (point))))
7708       (when indent
7709         (indent-region bol end nil))))
7710   (let ((copy (copy-alist alignment-list)))
7711     (vhdl-prepare-search-2
7712      (while copy
7713        (save-excursion
7714          (goto-char begin)
7715          (let (element
7716                (eol (point-at-eol)))
7717            (setq element (nth 0 copy))
7718            (when (and (or (and (listp (car element))
7719                                (memq major-mode (car element)))
7720                           (eq major-mode (car element)))
7721                       (or vhdl-align-try-all-clauses
7722                           (re-search-forward (car (cdr element)) eol t)))
7723              (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7724                                   (car (cdr (cdr (cdr element)))) spacing))
7725            (setq copy (cdr copy))))))))
7726
7727 (defun vhdl-align-region-2 (begin end match &optional substr spacing)
7728   "Align a range of lines from BEGIN to END.  The regular expression
7729 MATCH must match exactly one field: the whitespace to be
7730 contracted/expanded.  The alignment column will equal the
7731 rightmost column of the widest whitespace block.  SPACING is
7732 the amount of extra spaces to add to the calculated maximum required.
7733 SPACING defaults to 1 so that at least one space is inserted after
7734 the token in MATCH."
7735   (setq spacing (or spacing 1))
7736   (setq substr (or substr 1))
7737   (save-excursion
7738     (let (distance (max 0) (lines 0) bol eol width)
7739       ;; Determine the greatest whitespace distance to the alignment
7740       ;; character
7741       (goto-char begin)
7742       (setq eol (point-at-eol)
7743             bol (setq begin (progn (beginning-of-line) (point))))
7744       (while (< bol end)
7745         (save-excursion
7746           (when (and (vhdl-re-search-forward match eol t)
7747                      (save-excursion
7748                        (goto-char (match-beginning 0))
7749                        (forward-char)
7750                        (and (not (vhdl-in-literal))
7751                             (not (vhdl-in-quote-p))
7752                             (not (vhdl-in-extended-identifier-p))))
7753                      (not (looking-at "\\s-*$")))
7754             (setq distance (- (match-beginning substr) bol))
7755             (when (> distance max)
7756               (setq max distance))))
7757         (forward-line)
7758         (setq bol (point)
7759               eol (point-at-eol))
7760         (setq lines (1+ lines)))
7761       ;; Now insert enough maxs to push each assignment operator to
7762       ;; the same column.  We need to use 'lines' as a counter, since
7763       ;; the location of the mark may change
7764       (goto-char (setq bol begin))
7765       (setq eol (point-at-eol))
7766       (while (> lines 0)
7767         (when (and (vhdl-re-search-forward match eol t)
7768                    (save-excursion
7769                      (goto-char (match-beginning 0))
7770                      (forward-char)
7771                      (and (not (vhdl-in-literal))
7772                           (not (vhdl-in-quote-p))
7773                           (not (vhdl-in-extended-identifier-p))))
7774                    (not (looking-at "\\s-*$"))
7775                    (> (match-beginning 0)  ; not if at boi
7776                       (save-excursion (back-to-indentation) (point))))
7777           (setq width (- (match-end substr) (match-beginning substr)))
7778           (setq distance (- (match-beginning substr) bol))
7779           (goto-char (match-beginning substr))
7780           (delete-char width)
7781           (insert-char ?  (+ (- max distance) spacing)))
7782         (beginning-of-line)
7783         (forward-line)
7784         (setq bol (point)
7785               eol (point-at-eol))
7786         (setq lines (1- lines))))))
7787
7788 (defun vhdl-align-region-groups (beg end &optional spacing
7789                                      no-message no-comments)
7790   "Align region, treat groups of lines separately."
7791   (interactive "r\nP")
7792   (save-excursion
7793     (let (orig pos)
7794       (goto-char beg)
7795       (beginning-of-line)
7796       (setq orig (point-marker))
7797       (setq beg (point))
7798       (goto-char end)
7799       (setq end (point-marker))
7800       (untabify beg end)
7801       (unless no-message
7802         (when vhdl-progress-interval
7803           (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7804                                            (count-lines (point-min) end) 0))))
7805       (when (nth 0 vhdl-beautify-options)
7806         (vhdl-fixup-whitespace-region beg end t))
7807       (goto-char beg)
7808       (if (not vhdl-align-groups)
7809           ;; align entire region
7810           (progn (vhdl-align-region-1 beg end spacing)
7811                  (unless no-comments
7812                    (vhdl-align-inline-comment-region-1 beg end)))
7813         ;; align groups
7814         (while (and (< beg end)
7815                     (re-search-forward vhdl-align-group-separate end t))
7816           (setq pos (point-marker))
7817           (vhdl-align-region-1 beg pos spacing)
7818           (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7819           (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7820           (setq beg (1+ pos))
7821           (goto-char beg))
7822         ;; align last group
7823         (when (< beg end)
7824           (vhdl-align-region-1 beg end spacing)
7825           (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7826           (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7827       (when vhdl-indent-tabs-mode
7828         (tabify orig end))
7829       (unless no-message
7830         (when vhdl-progress-interval (message "Aligning...done"))
7831         (setq vhdl-progress-info nil)))))
7832
7833 (defun vhdl-align-region (beg end &optional spacing)
7834   "Align region, treat blocks with same indent and argument lists separately."
7835   (interactive "r\nP")
7836   (if (not vhdl-align-same-indent)
7837       ;; align entire region
7838       (vhdl-align-region-groups beg end spacing)
7839     ;; align blocks with same indent and argument lists
7840     (save-excursion
7841       (let ((cur-beg beg)
7842             indent cur-end)
7843         (when vhdl-progress-interval
7844           (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7845                                            (count-lines (point-min) end) 0)))
7846         (goto-char end)
7847         (setq end (point-marker))
7848         (goto-char cur-beg)
7849         (while (< (point) end)
7850           ;; is argument list opening?
7851           (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7852                                                     (point) (vhdl-point 'eol)))))
7853               ;; determine region for argument list
7854               (progn (goto-char cur-beg)
7855                      (forward-sexp)
7856                      (setq cur-end (point))
7857                      (beginning-of-line 2))
7858             ;; determine region with same indent
7859             (setq indent (current-indentation))
7860             (setq cur-beg (point))
7861             (setq cur-end (vhdl-point 'bonl))
7862             (beginning-of-line 2)
7863             (while (and (< (point) end)
7864                         (or (looking-at "^\\s-*\\(--.*\\)?$")
7865                             (= (current-indentation) indent))
7866                         (<= (save-excursion
7867                               (nth 0 (parse-partial-sexp
7868                                       (point) (vhdl-point 'eol)))) 0))
7869               (unless (looking-at "^\\s-*$")
7870                 (setq cur-end (vhdl-point 'bonl)))
7871               (beginning-of-line 2)))
7872           ;; align region
7873           (vhdl-align-region-groups cur-beg cur-end spacing t t))
7874         (vhdl-align-inline-comment-region beg end spacing noninteractive)
7875         (when vhdl-progress-interval (message "Aligning...done"))
7876         (setq vhdl-progress-info nil)))))
7877
7878 (defun vhdl-align-group (&optional spacing)
7879   "Align group of lines between empty lines."
7880   (interactive)
7881   (vhdl-do-group 'vhdl-align-region spacing))
7882
7883 (defun vhdl-align-list (&optional spacing)
7884   "Align the lines of a list surrounded by a balanced group of parentheses."
7885   (interactive)
7886   (vhdl-do-list 'vhdl-align-region-groups spacing))
7887
7888 (defun vhdl-align-same-indent (&optional spacing)
7889   "Align block of lines with same indent."
7890   (interactive)
7891   (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7892
7893 (defun vhdl-align-declarations (&optional spacing)
7894   "Align the lines within the declarative part of a design unit."
7895   (interactive)
7896   (let (beg end)
7897     (vhdl-prepare-search-2
7898      (save-excursion
7899        ;; search for declarative part
7900        (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
7901                   (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7902          (setq beg (point))
7903          (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7904          (setq end (point)))))
7905     (if beg
7906         (vhdl-align-region-groups beg end spacing)
7907       (error "ERROR:  Not within the declarative part of a design unit"))))
7908
7909 (defun vhdl-align-buffer ()
7910   "Align buffer."
7911   (interactive)
7912   (vhdl-align-region (point-min) (point-max)))
7913
7914 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7915 ;; Align inline comments
7916
7917 (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7918   "Align inline comments in region."
7919   (save-excursion
7920     (let ((start-max comment-column)
7921           (length-max 0)
7922           comment-list start-list tmp-list start length
7923           cur-start prev-start no-code)
7924       (setq spacing (or spacing 2))
7925       (vhdl-prepare-search-2
7926        (goto-char beg)
7927        ;; search for comment start positions and lengths
7928        (while (< (point) end)
7929          (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7930                     (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
7931                     (not (save-excursion (goto-char (match-beginning 2))
7932                                          (vhdl-in-literal))))
7933            (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7934            (setq length (- (match-end 2) (match-beginning 2)))
7935            (setq start-max (max start start-max))
7936            (setq length-max (max length length-max))
7937            (push (cons start length) comment-list))
7938          (beginning-of-line 2))
7939        (setq comment-list
7940              (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
7941        ;; reduce start positions
7942        (setq start-list (list (caar comment-list)))
7943        (setq comment-list (cdr comment-list))
7944        (while comment-list
7945          (unless (or (= (caar comment-list) (car start-list))
7946                      (<= (+ (car start-list) (cdar comment-list))
7947                             end-comment-column))
7948            (push (caar comment-list) start-list))
7949          (setq comment-list (cdr comment-list)))
7950        ;; align lines as nicely as possible
7951        (goto-char beg)
7952        (while (< (point) end)
7953          (setq cur-start nil)
7954          (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7955                     (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7956                              (not (save-excursion
7957                                     (goto-char (match-beginning 3))
7958                                     (vhdl-in-literal))))
7959                         (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7960                              (>= (- (match-end 2) (match-beginning 2))
7961                                  comment-column))))
7962            (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7963            (setq length (- (match-end 3) (match-beginning 3)))
7964            (setq no-code (= (match-beginning 1) (match-end 1)))
7965            ;; insert minimum whitespace
7966            (goto-char (match-end 2))
7967            (delete-region (match-beginning 2) (match-end 2))
7968            (insert-char ?\  spacing)
7969            (setq tmp-list start-list)
7970            ;; insert additional whitespace to align
7971            (setq cur-start
7972                  (cond
7973                   ;; align comment-only line to inline comment of previous line
7974                   ((and no-code prev-start
7975                         (<= length (- end-comment-column prev-start)))
7976                    prev-start)
7977                   ;; align all comments at `start-max' if this is possible
7978                   ((<= (+ start-max length-max) end-comment-column)
7979                    start-max)
7980                   ;; align at `comment-column' if possible
7981                   ((and (<= start comment-column)
7982                         (<= length (- end-comment-column comment-column)))
7983                    comment-column)
7984                   ;; align at left-most possible start position otherwise
7985                   (t
7986                    (while (and tmp-list (< (car tmp-list) start))
7987                      (setq tmp-list (cdr tmp-list)))
7988                    (car tmp-list))))
7989            (indent-to cur-start))
7990          (setq prev-start cur-start)
7991          (beginning-of-line 2))))))
7992
7993 (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7994   "Align inline comments within a region.  Groups of code lines separated by
7995 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7996   (interactive "r\nP")
7997   (save-excursion
7998     (let (orig pos)
7999       (goto-char beg)
8000       (beginning-of-line)
8001       (setq orig (point-marker))
8002       (setq beg (point))
8003       (goto-char end)
8004       (setq end (point-marker))
8005       (untabify beg end)
8006       (unless no-message (message "Aligning inline comments..."))
8007       (goto-char beg)
8008       (if (not vhdl-align-groups)
8009           ;; align entire region
8010           (vhdl-align-inline-comment-region-1 beg end spacing)
8011         ;; align groups
8012         (while (and (< beg end)
8013                     (re-search-forward vhdl-align-group-separate end t))
8014           (setq pos (point-marker))
8015           (vhdl-align-inline-comment-region-1 beg pos spacing)
8016           (setq beg (1+ pos))
8017           (goto-char beg))
8018         ;; align last group
8019         (when (< beg end)
8020           (vhdl-align-inline-comment-region-1 beg end spacing)))
8021       (when vhdl-indent-tabs-mode
8022         (tabify orig end))
8023       (unless no-message (message "Aligning inline comments...done")))))
8024
8025 (defun vhdl-align-inline-comment-group (&optional spacing)
8026   "Align inline comments within a group of lines between empty lines."
8027   (interactive)
8028   (save-excursion
8029     (let ((start (point))
8030           beg end)
8031       (setq end (if (re-search-forward vhdl-align-group-separate nil t)
8032                     (point-marker) (point-max)))
8033       (goto-char start)
8034       (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
8035                     (point) (point-min)))
8036       (untabify beg end)
8037       (message "Aligning inline comments...")
8038       (vhdl-align-inline-comment-region-1 beg end)
8039       (when vhdl-indent-tabs-mode
8040         (tabify beg end))
8041       (message "Aligning inline comments...done"))))
8042
8043 (defun vhdl-align-inline-comment-buffer ()
8044   "Align inline comments within buffer.  Groups of code lines separated by
8045 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
8046   (interactive)
8047   (vhdl-align-inline-comment-region (point-min) (point-max)))
8048
8049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8050 ;; Fixup whitespace
8051
8052 (defun vhdl-fixup-whitespace-region (beg end &optional no-message)
8053   "Fixup whitespace in region.  Surround operator symbols by one space,
8054 eliminate multiple spaces (except at beginning of line), eliminate spaces at
8055 end of line, do nothing in comments and strings."
8056   (interactive "r")
8057   (unless no-message (message "Fixing up whitespace..."))
8058   (save-excursion
8059     (goto-char end)
8060     (setq end (point-marker))
8061     ;; have no space before and one space after `,' and ';'
8062     (goto-char beg)
8063     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
8064       (if (match-string 1)
8065           (goto-char (match-end 1))
8066         (replace-match "\\3 " nil nil nil 2)))
8067     ;; have no space after `('
8068     (goto-char beg)
8069     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
8070       (if (match-string 1)
8071           (goto-char (match-end 1))
8072         (replace-match "\\2")))
8073     ;; have no space before `)'
8074     (goto-char beg)
8075     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
8076       (if (match-string 1)
8077           (goto-char (match-end 1))
8078         (replace-match "\\2")))
8079     ;; surround operator symbols by one space
8080     (goto-char beg)
8081     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
8082       (if (or (match-string 1)
8083               (<= (match-beginning 0)  ; not if at boi
8084                  (save-excursion (back-to-indentation) (point))))
8085           (goto-char (match-end 0))
8086         (replace-match "\\3 \\4 \\5")
8087         (goto-char (match-end 2))))
8088     ;; eliminate multiple spaces and spaces at end of line
8089     (goto-char beg)
8090     (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
8091                (and (looking-at "--.*") (re-search-forward "--.*" end t))
8092                (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
8093                (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
8094                     (progn (replace-match "" nil nil) t))
8095                (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
8096                     (progn (replace-match ";" nil nil) t))
8097                (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
8098                (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
8099                     (progn (replace-match "  " nil nil) t))
8100                (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
8101                     (progn (replace-match " " nil nil) t))
8102                (and (looking-at "-") (re-search-forward "-" end t))
8103                (re-search-forward "[^ \t\"-]+" end t))))
8104   (unless no-message (message "Fixing up whitespace...done")))
8105
8106 (defun vhdl-fixup-whitespace-buffer ()
8107   "Fixup whitespace in buffer.  Surround operator symbols by one space,
8108 eliminate multiple spaces (except at beginning of line), eliminate spaces at
8109 end of line, do nothing in comments."
8110   (interactive)
8111   (vhdl-fixup-whitespace-region (point-min) (point-max)))
8112
8113 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8114 ;; Case fixing
8115
8116 (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
8117   "Convert all words matching WORD-REGEXP in region to lower or upper case,
8118 depending on parameter UPPER-CASE."
8119   (let ((case-replace nil)
8120         (last-update 0))
8121     (vhdl-prepare-search-2
8122      (save-excursion
8123        (goto-char end)
8124        (setq end (point-marker))
8125        (goto-char beg)
8126        (while (re-search-forward word-regexp end t)
8127          (or (vhdl-in-literal)
8128              (if upper-case
8129                  (upcase-word -1)
8130                (downcase-word -1)))
8131          (when (and count vhdl-progress-interval (not noninteractive)
8132                     (< vhdl-progress-interval
8133                        (- (nth 1 (current-time)) last-update)))
8134            (message "Fixing case... (%2d%s)"
8135                     (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
8136                     "%")
8137            (setq last-update (nth 1 (current-time)))))
8138        (goto-char end)))))
8139
8140 (defun vhdl-fix-case-region (beg end &optional arg)
8141   "Convert all VHDL words in region to lower or upper case, depending on
8142 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8143   (interactive "r\nP")
8144   (vhdl-fix-case-region-1
8145    beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
8146   (vhdl-fix-case-region-1
8147    beg end vhdl-upper-case-types vhdl-types-regexp 1)
8148   (vhdl-fix-case-region-1
8149    beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
8150   (vhdl-fix-case-region-1
8151    beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
8152   (vhdl-fix-case-region-1
8153    beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
8154   (when vhdl-progress-interval (message "Fixing case...done")))
8155
8156 (defun vhdl-fix-case-buffer ()
8157   "Convert all VHDL words in buffer to lower or upper case, depending on
8158 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8159   (interactive)
8160   (vhdl-fix-case-region (point-min) (point-max)))
8161
8162 (defun vhdl-fix-case-word (&optional arg)
8163   "Convert word after cursor to upper case if necessary."
8164   (interactive "p")
8165   (save-excursion
8166     (when arg (backward-word 1))
8167     (vhdl-prepare-search-1
8168      (when (and vhdl-upper-case-keywords
8169                 (looking-at vhdl-keywords-regexp))
8170        (upcase-word 1))
8171      (when (and vhdl-upper-case-types
8172                 (looking-at vhdl-types-regexp))
8173        (upcase-word 1))
8174      (when (and vhdl-upper-case-attributes
8175                 (looking-at vhdl-attributes-regexp))
8176        (upcase-word 1))
8177      (when (and vhdl-upper-case-enum-values
8178                 (looking-at vhdl-enum-values-regexp))
8179        (upcase-word 1))
8180      (when (and vhdl-upper-case-constants
8181                 (looking-at vhdl-constants-regexp))
8182        (upcase-word 1)))))
8183
8184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8185 ;; Fix statements
8186 ;; - force each statement to be on a separate line except when on same line
8187 ;;   with 'end' keyword
8188
8189 (defun vhdl-fix-statement-region (beg end &optional arg)
8190   "Force statements in region on separate line except when on same line
8191 with 'end' keyword (necessary for correct indentation).
8192 Currently supported keywords: 'begin', 'if'."
8193   (interactive "r\nP")
8194   (vhdl-prepare-search-2
8195    (let (point)
8196      (save-excursion
8197        (goto-char end)
8198        (setq end (point-marker))
8199        (goto-char beg)
8200        ;; `begin' keyword
8201        (while (re-search-forward
8202                "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t)
8203          (goto-char (match-end 0))
8204          (setq point (point-marker))
8205          (when (and (match-string 1)
8206                     (or (not (match-string 2))
8207                         (save-excursion (goto-char (match-end 2))
8208                                         (vhdl-in-literal)))
8209                     (not (save-excursion (goto-char (match-beginning 1))
8210                                          (vhdl-in-literal))))
8211            (goto-char (match-beginning 1))
8212            (insert "\n")
8213            (indent-according-to-mode))
8214          (goto-char point))
8215        (goto-char beg)
8216        ;; `for', `if' keywords
8217        (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
8218          (goto-char (match-end 1))
8219          (setq point (point-marker))
8220          ;; exception: in literal or preceded by `end', `wait' or label
8221          (when (and (not (save-excursion (goto-char (match-beginning 1))
8222                                          (vhdl-in-literal)))
8223                     (save-excursion
8224                       (beginning-of-line 1)
8225                       (save-match-data
8226                         (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
8227                                                 (match-beginning 1) t)
8228                              (not (string-match
8229                                    "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
8230                                    (match-string 1)))))))
8231            (goto-char (match-beginning 1))
8232            (insert "\n")
8233            (indent-according-to-mode))
8234          (goto-char point))))))
8235
8236 (defun vhdl-fix-statement-buffer ()
8237   "Force statements in buffer on separate line except when on same line
8238 with 'end' keyword (necessary for correct indentation)."
8239   (interactive)
8240   (vhdl-fix-statement-region (point-min) (point-max)))
8241
8242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8243 ;; Trailing spaces
8244
8245 (defun vhdl-remove-trailing-spaces-region (beg end &optional arg)
8246   "Remove trailing spaces in region."
8247   (interactive "r\nP")
8248   (save-excursion
8249     (goto-char end)
8250     (setq end (point-marker))
8251     (goto-char beg)
8252     (while (re-search-forward "[ \t]+$" end t)
8253       (unless (vhdl-in-literal)
8254         (replace-match "" nil nil)))))
8255
8256 (defun vhdl-remove-trailing-spaces ()
8257   "Remove trailing spaces in buffer."
8258   (interactive)
8259   (vhdl-remove-trailing-spaces-region (point-min) (point-max)))
8260
8261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8262 ;; Beautify
8263
8264 (defun vhdl-beautify-region (beg end)
8265   "Beautify region by applying indentation, whitespace fixup, alignment, and
8266 case fixing to a region.  Calls functions `vhdl-indent-buffer',
8267 `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
8268 `vhdl-fix-case-buffer'."
8269   (interactive "r")
8270   (setq end (save-excursion (goto-char end) (point-marker)))
8271   (save-excursion ; remove DOS EOL characters in UNIX file
8272     (goto-char beg)
8273     (while (search-forward "\r" nil t)
8274       (replace-match "" nil t)))
8275   (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
8276   (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
8277   (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
8278   (when (nth 3 vhdl-beautify-options)
8279     (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
8280   (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
8281   (when (nth 0 vhdl-beautify-options)
8282     (vhdl-remove-trailing-spaces-region beg end)
8283     (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
8284
8285 (defun vhdl-beautify-buffer ()
8286   "Beautify buffer by applying indentation, whitespace fixup, alignment, and
8287 case fixing to entire buffer.  Calls `vhdl-beautify-region' for the entire
8288 buffer."
8289   (interactive)
8290   (vhdl-beautify-region (point-min) (point-max))
8291   (when noninteractive (save-buffer)))
8292
8293 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8294 ;; Code filling
8295
8296 (defun vhdl-fill-region (beg end &optional arg)
8297   "Fill lines for a region of code."
8298   (interactive "r\np")
8299   (save-excursion
8300     (goto-char beg)
8301     (let ((margin (if arg (current-indentation) (current-column))))
8302       (goto-char end)
8303       (setq end (point-marker))
8304       ;; remove inline comments, newlines and whitespace
8305       (vhdl-comment-kill-region beg end)
8306       (vhdl-comment-kill-inline-region beg end)
8307       (subst-char-in-region beg (1- end) ?\n ?\ )
8308       (vhdl-fixup-whitespace-region beg end)
8309       ;; wrap and end-comment-column
8310       (goto-char beg)
8311       (while (re-search-forward "\\s-" end t)
8312         (when(> (current-column) vhdl-end-comment-column)
8313           (backward-char)
8314           (when (re-search-backward "\\s-" beg t)
8315             (replace-match "\n")
8316             (indent-to margin)))))))
8317
8318 (defun vhdl-fill-group ()
8319   "Fill group of lines between empty lines."
8320   (interactive)
8321   (vhdl-do-group 'vhdl-fill-region))
8322
8323 (defun vhdl-fill-list ()
8324   "Fill the lines of a list surrounded by a balanced group of parentheses."
8325   (interactive)
8326   (vhdl-do-list 'vhdl-fill-region))
8327
8328 (defun vhdl-fill-same-indent ()
8329   "Fill the lines of block of lines with same indent."
8330   (interactive)
8331   (vhdl-do-same-indent 'vhdl-fill-region))
8332
8333
8334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8335 ;;; Code updating/fixing
8336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8337
8338 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8339 ;; Sensitivity list update
8340
8341 ;; Strategy:
8342 ;; - no sensitivity list is generated for processes with wait statements
8343 ;; - otherwise, do the following:
8344 ;;   1. scan for all local signals (ports, signals declared in arch./blocks)
8345 ;;   2. scan for all signals already in the sensitivity list (in order to catch
8346 ;;      manually entered global signals)
8347 ;;   3. signals from 1. and 2. form the list of visible signals
8348 ;;   4. search for if/elsif conditions containing an event (sequential code)
8349 ;;   5. scan for strings that are within syntactical regions where signals are
8350 ;;      read but not within sequential code, and that correspond to visible
8351 ;;      signals
8352 ;;   6. replace sensitivity list by list of signals from 5.
8353
8354 (defun vhdl-update-sensitivity-list-process ()
8355   "Update sensitivity list of current process."
8356   (interactive)
8357   (save-excursion
8358     (vhdl-prepare-search-2
8359      (end-of-line)
8360      ;; look whether in process
8361      (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
8362                    (equal (upcase (match-string 2)) "PROCESS")
8363                    (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
8364          (error "ERROR:  Not within a process")
8365        (message "Updating sensitivity list...")
8366        (vhdl-update-sensitivity-list)
8367        (message "Updating sensitivity list...done")))))
8368
8369 (defun vhdl-update-sensitivity-list-buffer ()
8370   "Update sensitivity list of all processes in current buffer."
8371   (interactive)
8372   (save-excursion
8373     (vhdl-prepare-search-2
8374      (goto-char (point-min))
8375      (message "Updating sensitivity lists...")
8376      (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
8377        (goto-char (match-beginning 0))
8378        (condition-case nil (vhdl-update-sensitivity-list) (error "")))
8379      (message "Updating sensitivity lists...done")))
8380   (when noninteractive (save-buffer)))
8381
8382 (defun vhdl-update-sensitivity-list ()
8383   "Update sensitivity list."
8384     (let ((proc-beg (point))
8385           (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
8386           (proc-mid (vhdl-re-search-backward
8387                      "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t))
8388           seq-region-list)
8389       (cond
8390        ;; error if 'begin' keyword missing
8391        ((not (match-string 2))
8392         (error "ERROR:  No 'begin' keyword found"))
8393        ;; search for wait statement (no sensitivity list allowed)
8394        ((progn (goto-char proc-mid)
8395                (vhdl-re-search-forward "\\<wait\\>" proc-end t))
8396         (error "ERROR:  Process with wait statement, sensitivity list not generated"))
8397        ;; combinational process (update sensitivity list)
8398        (t
8399         (let
8400             ;; scan for visible signals
8401             ((visible-list (vhdl-get-visible-signals))
8402              ;; define syntactic regions where signals are read
8403              (scan-regions-list
8404               '(;; right-hand side of signal/variable assignment
8405                 ;; (special case: "<=" is relational operator in a condition)
8406                 ((vhdl-re-search-forward "[<:]=" proc-end t)
8407                  (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
8408                 ;; if condition
8409                 ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t)
8410                  (vhdl-re-search-forward "\\<then\\>" proc-end t))
8411                 ;; elsif condition
8412                 ((vhdl-re-search-forward "\\<elsif\\>" proc-end t)
8413                  (vhdl-re-search-forward "\\<then\\>" proc-end t))
8414                 ;; while loop condition
8415                 ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t)
8416                  (vhdl-re-search-forward "\\<loop\\>" proc-end t))
8417                 ;; exit/next condition
8418                 ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
8419                  (vhdl-re-search-forward ";" proc-end t))
8420                 ;; assert condition
8421                 ((vhdl-re-search-forward "\\<assert\\>" proc-end t)
8422                  (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
8423                 ;; case expression
8424                 ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t)
8425                  (vhdl-re-search-forward "\\<is\\>" proc-end t))
8426                 ;; parameter list of procedure call, array index
8427                 ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
8428                       (1- (point)))
8429                  (progn (backward-char) (forward-sexp)
8430                         (while (looking-at "(") (forward-sexp)) (point)))))
8431              name field read-list sens-list signal-list tmp-list
8432              sens-beg sens-end beg end margin)
8433           ;; scan for signals in old sensitivity list
8434           (goto-char proc-beg)
8435           (vhdl-re-search-forward "\\<process\\>" proc-mid t)
8436           (if (not (looking-at "[ \t\n\r\f]*("))
8437               (setq sens-beg (point))
8438             (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
8439             (goto-char (match-end 1))
8440             (forward-sexp)
8441             (setq sens-end (1- (point)))
8442             (goto-char sens-beg)
8443             (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t)
8444                         (setq sens-list
8445                               (cons (downcase (match-string 0)) sens-list))
8446                         (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t))))
8447           (setq signal-list (append visible-list sens-list))
8448           ;; search for sequential parts
8449           (goto-char proc-mid)
8450           (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
8451             (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t))
8452             (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
8453               (goto-char end)
8454               (backward-word 1)
8455               (vhdl-forward-sexp)
8456               (push (cons end (point)) seq-region-list)
8457               (beginning-of-line)))
8458           ;; scan for signals read in process
8459           (while scan-regions-list
8460             (goto-char proc-mid)
8461             (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
8462                         (setq end (eval (nth 1 (car scan-regions-list)))))
8463               (goto-char beg)
8464               (unless (or (vhdl-in-literal)
8465                           (and seq-region-list
8466                                (let ((tmp-list seq-region-list))
8467                                  (while (and tmp-list
8468                                              (< (point) (caar tmp-list)))
8469                                    (setq tmp-list (cdr tmp-list)))
8470                                  (and tmp-list (< (point) (cdar tmp-list))))))
8471                 (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
8472                   (setq name (match-string 1))
8473                   ;; get array index range
8474                   (when vhdl-array-index-record-field-in-sensitivity-list
8475                     (setq field (match-string 2))
8476                     ;; not use if it includes a variable name
8477                     (save-match-data
8478                       (setq tmp-list visible-list)
8479                       (while (and field tmp-list)
8480                         (when (string-match
8481                                (concat "\\<" (car tmp-list) "\\>") field)
8482                           (setq field nil))
8483                         (setq tmp-list (cdr tmp-list)))))
8484                   (when (and (not (match-string 6)) ; not when formal parameter
8485                              (not (and (match-string 5) ; not event attribute
8486                                        (not (member (downcase (match-string 5))
8487                                                     '("event" "last_event" "transaction")))))
8488                              (member (downcase name) signal-list))
8489                     ;; not add if name or name+field already exists
8490                     (unless
8491                         (or (member-ignore-case name read-list)
8492                             (member-ignore-case (concat name field) read-list))
8493                       (push (concat name field) read-list))
8494                     (setq tmp-list read-list)
8495                     ;; remove existing name+field if name is added
8496                     (save-match-data
8497                       (while tmp-list
8498                         (when (string-match (concat "^" name field "[(.]")
8499                                             (car tmp-list))
8500                           (setq read-list (delete (car tmp-list) read-list)))
8501                         (setq tmp-list (cdr tmp-list)))))
8502                   (goto-char (match-end 1)))))
8503             (setq scan-regions-list (cdr scan-regions-list)))
8504           ;; update sensitivity list
8505           (goto-char sens-beg)
8506           (if sens-end
8507               (delete-region sens-beg sens-end)
8508             (when read-list
8509               (insert " ()") (backward-char)))
8510           (setq read-list (sort read-list 'string<))
8511           (when read-list
8512             (setq margin (current-column))
8513             (insert (car read-list))
8514             (setq read-list (cdr read-list))
8515             (while read-list
8516               (insert ",")
8517               (if (<= (+ (current-column) (length (car read-list)) 2)
8518                       end-comment-column)
8519                   (insert " ")
8520                 (insert "\n") (indent-to margin))
8521               (insert (car read-list))
8522               (setq read-list (cdr read-list)))))))))
8523
8524 (defun vhdl-get-visible-signals ()
8525   "Get all signals visible in the current block."
8526   (let (beg end signal-list entity-name file-name)
8527     (vhdl-prepare-search-2
8528      ;; get entity name
8529      (save-excursion
8530        (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
8531                     (not (equal "END" (upcase (match-string 1))))
8532                     (setq entity-name (match-string 2)))
8533          (error "ERROR:  Not within an architecture")))
8534      ;; search for signals declared in entity port clause
8535      (save-excursion
8536        (goto-char (point-min))
8537        (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
8538          (setq file-name
8539                (concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
8540                        "." (file-name-extension (buffer-file-name)))))
8541        (vhdl-visit-file
8542         file-name t
8543         (vhdl-prepare-search-2
8544          (goto-char (point-min))
8545          (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
8546              (error "ERROR:  Entity \"%s\" not found:\n  --> see option `vhdl-entity-file-name'" entity-name)
8547            (when (setq beg (vhdl-re-search-forward
8548                             "\\<port[ \t\n\r\f]*("
8549                             (save-excursion
8550                               (re-search-forward "^end\\>" nil t)) t))
8551              (setq end (save-excursion
8552                          (backward-char) (forward-sexp) (point)))
8553              (vhdl-forward-syntactic-ws)
8554              (while (< (point) end)
8555                (when (looking-at "signal[ \t\n\r\f]+")
8556                  (goto-char (match-end 0)))
8557                (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+")
8558                  (setq signal-list
8559                        (cons (downcase (match-string 1)) signal-list))
8560                  (goto-char (match-end 0))
8561                  (vhdl-forward-syntactic-ws))
8562                (re-search-forward ";" end 1)
8563                (vhdl-forward-syntactic-ws)))))))
8564      ;; search for signals declared in architecture declarative part
8565      (save-excursion
8566        (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
8567                      (not (equal "END" (upcase (match-string 1))))
8568                      (setq end (re-search-forward "^begin\\>" nil t))))
8569            (error "ERROR:  No architecture declarative part found")
8570          ;; scan for all declared signal and alias names
8571          (goto-char beg)
8572          (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8573            (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8574              (if (match-string 2)
8575                  ;; scan signal name
8576                  (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)")
8577                    (setq signal-list
8578                          (cons (downcase (match-string 1)) signal-list))
8579                    (goto-char (match-end 0)))
8580                ;; scan alias name, check is alias of (declared) signal
8581                (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)")
8582                           (member (downcase (match-string 2)) signal-list))
8583                  (setq signal-list
8584                        (cons (downcase (match-string 1)) signal-list))
8585                  (goto-char (match-end 0))))
8586              (setq beg (point))))))
8587      ;; search for signals declared in surrounding block declarative parts
8588      (save-excursion
8589        (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
8590                                       (match-string 4))
8591                             (goto-char (match-end 4))
8592                             (vhdl-backward-sexp)
8593                             (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
8594                           beg)
8595                    (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
8596          ;; scan for all declared signal names
8597          (goto-char beg)
8598          (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8599            (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8600              (if (match-string 2)
8601                  ;; scan signal name
8602                  (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8603                    (setq signal-list
8604                          (cons (downcase (match-string 1)) signal-list))
8605                    (goto-char (match-end 0)))
8606                ;; scan alias name, check is alias of (declared) signal
8607                (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8608                           (member (downcase (match-string 2)) signal-list))
8609                  (setq signal-list
8610                        (cons (downcase (match-string 1)) signal-list))
8611                  (goto-char (match-end 0))))))
8612          (goto-char beg)))
8613      signal-list)))
8614
8615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8616 ;; Generic/port clause fixing
8617
8618 (defun vhdl-fix-clause-buffer ()
8619   "Fix all generic/port clauses in current buffer."
8620   (interactive)
8621   (save-excursion
8622     (vhdl-prepare-search-2
8623      (goto-char (point-min))
8624      (message "Fixing generic/port clauses...")
8625      (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)
8626        (goto-char (match-end 0))
8627        (condition-case nil (vhdl-fix-clause) (error "")))
8628      (message "Fixing generic/port clauses...done"))))
8629
8630 (defun vhdl-fix-clause ()
8631   "Fix closing parenthesis within generic/port clause."
8632   (interactive)
8633   (save-excursion
8634     (vhdl-prepare-search-2
8635      (let ((pos (point))
8636            beg end)
8637        (end-of-line)
8638        (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t))
8639            (error "ERROR:  Not within a generic/port clause")
8640          ;; search for end of clause
8641          (goto-char (match-end 0))
8642          (setq beg (1- (point)))
8643          (vhdl-forward-syntactic-ws)
8644          (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
8645            (goto-char (1- (match-end 0)))
8646            (setq end (point-marker))
8647            (forward-char)
8648            (vhdl-forward-syntactic-ws))
8649          (goto-char end)
8650          (when (> pos (point-at-eol))
8651            (error "ERROR:  Not within a generic/port clause"))
8652          ;; delete closing parenthesis on separate line (not supported style)
8653          (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
8654            (vhdl-line-kill)
8655            (vhdl-backward-syntactic-ws)
8656            (setq end (point-marker))
8657            (insert ";"))
8658          ;; delete superfluous parentheses
8659          (while (progn (goto-char beg)
8660                        (condition-case () (forward-sexp)
8661                          (error (goto-char (point-max))))
8662                        (< (point) end))
8663            (delete-char -1))
8664          ;; add closing parenthesis
8665          (when (> (point) end)
8666            (goto-char end)
8667            (insert ")")))))))
8668
8669
8670 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8671 ;;; Electrification
8672 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8673
8674 (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
8675   "Syntax of prompt inserted by template generators.")
8676
8677 (defvar vhdl-template-invoked-by-hook nil
8678   "Indicates whether a template has been invoked by a hook or by key or menu.
8679 Used for undoing after template abortion.")
8680
8681 ;; correct different behavior of function `unread-command-events' in XEmacs
8682 (defun vhdl-character-to-event (arg))
8683 (defalias 'vhdl-character-to-event
8684   (if (fboundp 'character-to-event) 'character-to-event 'identity))
8685
8686 (defun vhdl-work-library ()
8687   "Return the working library name of the current project or \"work\" if no
8688 project is defined."
8689   (vhdl-resolve-env-variable
8690    (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
8691        vhdl-default-library)))
8692
8693 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8694 ;;  Enabling/disabling
8695
8696 (define-minor-mode vhdl-electric-mode
8697   "Toggle VHDL electric mode.
8698 With a prefix argument ARG, enable the mode if ARG is positive,
8699 and disable it otherwise.  If called from Lisp, enable it if ARG
8700 is omitted or nil."
8701   :global t :group 'vhdl-mode)
8702
8703 (define-minor-mode vhdl-stutter-mode
8704   "Toggle VHDL stuttering mode.
8705 With a prefix argument ARG, enable the mode if ARG is positive,
8706 and disable it otherwise.  If called from Lisp, enable it if ARG
8707 is omitted or nil."
8708   :global t :group 'vhdl-mode)
8709
8710 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8711 ;; Stuttering
8712
8713 (defun vhdl-electric-dash (count)
8714   "-- starts a comment, --- draws a horizontal line,
8715 ---- starts a display comment."
8716   (interactive "p")
8717   (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
8718       (cond
8719        ((and abbrev-start-location (= abbrev-start-location (point)))
8720         (setq abbrev-start-location nil)
8721         (goto-char last-abbrev-location)
8722         (beginning-of-line nil)
8723         (vhdl-comment-display))
8724        ((/= (preceding-char) ?-)        ; standard dash (minus)
8725         (self-insert-command count))
8726        (t (self-insert-command count)
8727           (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment")
8728           (let ((next-input (read-char)))
8729             (if (= next-input ?-)       ; triple dash
8730                 (progn
8731                   (vhdl-comment-display-line)
8732                   (message
8733                    "Enter '-' for display comment, else continue coding")
8734                   (let ((next-input (read-char)))
8735                     (if (= next-input ?-) ; four dashes
8736                         (vhdl-comment-display t)
8737                       (setq unread-command-events ; pushback the char
8738                             (list (vhdl-character-to-event next-input))))))
8739               (setq unread-command-events ; pushback the char
8740                     (list (vhdl-character-to-event next-input)))
8741               (vhdl-comment-insert)))))
8742     (self-insert-command count)))
8743
8744 (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
8745   (interactive "p")
8746   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8747       (if (= (preceding-char) ?\()
8748           (progn (delete-char -1) (insert-char ?\[ 1))
8749         (insert-char ?\( 1))
8750     (self-insert-command count)))
8751
8752 (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
8753   (interactive "p")
8754   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8755       (progn
8756         (if (= (preceding-char) ?\))
8757             (progn (delete-char -1) (insert-char ?\] 1))
8758           (insert-char ?\) 1))
8759         (blink-matching-open))
8760     (self-insert-command count)))
8761
8762 (defun vhdl-electric-quote (count) "'' --> \""
8763   (interactive "p")
8764   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8765       (if (= (preceding-char) vhdl-last-input-event)
8766           (progn (delete-char -1) (insert-char ?\" 1))
8767         (insert-char ?\' 1))
8768     (self-insert-command count)))
8769
8770 (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
8771   (interactive "p")
8772   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8773       (cond ((= (preceding-char) vhdl-last-input-event)
8774              (progn (delete-char -1)
8775                     (unless (eq (preceding-char) ? ) (insert " "))
8776                     (insert ": ")
8777                     (setq this-command 'vhdl-electric-colon)))
8778             ((and
8779               (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? ))
8780              (progn (delete-char -1) (insert "= ")))
8781             (t (insert-char ?\; 1)))
8782     (self-insert-command count)))
8783
8784 (defun vhdl-electric-comma (count) "',,' --> ' <= '"
8785   (interactive "p")
8786   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8787       (cond ((= (preceding-char) vhdl-last-input-event)
8788              (progn (delete-char -1)
8789                     (unless (eq (preceding-char) ? ) (insert " "))
8790                     (insert "<= ")))
8791             (t (insert-char ?\, 1)))
8792     (self-insert-command count)))
8793
8794 (defun vhdl-electric-period (count) "'..' --> ' => '"
8795   (interactive "p")
8796   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8797       (cond ((= (preceding-char) vhdl-last-input-event)
8798              (progn (delete-char -1)
8799                     (unless (eq (preceding-char) ? ) (insert " "))
8800                     (insert "=> ")))
8801             (t (insert-char ?\. 1)))
8802     (self-insert-command count)))
8803
8804 (defun vhdl-electric-equal (count) "'==' --> ' == '"
8805   (interactive "p")
8806   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8807       (cond ((= (preceding-char) vhdl-last-input-event)
8808              (progn (delete-char -1)
8809                     (unless (eq (preceding-char) ? ) (insert " "))
8810                     (insert "== ")))
8811             (t (insert-char ?\= 1)))
8812     (self-insert-command count)))
8813
8814 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8815 ;;  VHDL templates
8816
8817 (defun vhdl-template-paired-parens ()
8818   "Insert a pair of round parentheses, placing point between them."
8819   (interactive)
8820   (insert "()")
8821   (backward-char))
8822
8823 (defun vhdl-template-alias ()
8824   "Insert alias declaration."
8825   (interactive)
8826   (let ((start (point)))
8827     (vhdl-insert-keyword "ALIAS ")
8828     (when (vhdl-template-field "name" nil t start (point))
8829       (insert " : ")
8830       (unless (vhdl-template-field
8831                (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8832                nil t)
8833         (delete-char -3))
8834       (vhdl-insert-keyword " IS ")
8835       (vhdl-template-field "name" ";")
8836       (vhdl-comment-insert-inline))))
8837
8838 (defun vhdl-template-architecture ()
8839   "Insert architecture."
8840   (interactive)
8841   (let ((margin (current-indentation))
8842         (start (point))
8843         arch-name)
8844     (vhdl-insert-keyword "ARCHITECTURE ")
8845     (when (setq arch-name
8846                 (vhdl-template-field "name" nil t start (point)))
8847       (vhdl-insert-keyword " OF ")
8848       (if (save-excursion
8849             (vhdl-prepare-search-1
8850              (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8851           (insert (match-string 1))
8852         (vhdl-template-field "entity name"))
8853       (vhdl-insert-keyword " IS\n")
8854       (vhdl-template-begin-end
8855        (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8856        (memq vhdl-insert-empty-lines '(unit all))))))
8857
8858 (defun vhdl-template-array (kind &optional secondary)
8859   "Insert array type definition."
8860   (interactive)
8861   (let ((start (point)))
8862     (vhdl-insert-keyword "ARRAY (")
8863     (when (or (vhdl-template-field "range" nil (not secondary) start (point))
8864               secondary)
8865       (vhdl-insert-keyword ") OF ")
8866       (vhdl-template-field (if (eq kind 'type) "type" "nature"))
8867       (vhdl-insert-keyword ";"))))
8868
8869 (defun vhdl-template-assert ()
8870   "Insert an assertion statement."
8871   (interactive)
8872   (let ((start (point)))
8873     (vhdl-insert-keyword "ASSERT ")
8874     (when vhdl-conditions-in-parenthesis (insert "("))
8875     (when (vhdl-template-field "condition (negated)" nil t start (point))
8876       (when vhdl-conditions-in-parenthesis (insert ")"))
8877       (setq start (point))
8878       (vhdl-insert-keyword " REPORT ")
8879       (unless (vhdl-template-field "string expression" nil nil nil nil t)
8880         (delete-region start (point)))
8881       (setq start (point))
8882       (vhdl-insert-keyword " SEVERITY ")
8883       (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
8884         (delete-region start (point)))
8885       (insert ";"))))
8886
8887 (defun vhdl-template-attribute ()
8888   "Insert an attribute declaration or specification."
8889   (interactive)
8890   (if (eq (vhdl-decision-query
8891            "attribute" "(d)eclaration or (s)pecification?" t) ?s)
8892       (vhdl-template-attribute-spec)
8893     (vhdl-template-attribute-decl)))
8894
8895 (defun vhdl-template-attribute-decl ()
8896   "Insert an attribute declaration."
8897   (interactive)
8898   (let ((start (point)))
8899     (vhdl-insert-keyword "ATTRIBUTE ")
8900     (when (vhdl-template-field "name" " : " t start (point))
8901       (vhdl-template-field "type" ";")
8902       (vhdl-comment-insert-inline))))
8903
8904 (defun vhdl-template-attribute-spec ()
8905   "Insert an attribute specification."
8906   (interactive)
8907   (let ((start (point)))
8908     (vhdl-insert-keyword "ATTRIBUTE ")
8909     (when (vhdl-template-field "name" nil t start (point))
8910       (vhdl-insert-keyword " OF ")
8911       (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8912       (vhdl-template-field "entity class")
8913       (vhdl-insert-keyword " IS ")
8914       (vhdl-template-field "expression" ";"))))
8915
8916 (defun vhdl-template-block ()
8917   "Insert a block."
8918   (interactive)
8919   (let ((margin (current-indentation))
8920         (start (point))
8921         label)
8922     (vhdl-insert-keyword ": BLOCK ")
8923     (goto-char start)
8924     (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
8925       (forward-word 1)
8926       (forward-char 1)
8927       (insert "(")
8928       (if (vhdl-template-field "[guard expression]" nil t)
8929           (insert ")")
8930         (delete-char -2))
8931       (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8932       (insert "\n")
8933       (vhdl-template-begin-end "BLOCK" label margin)
8934       (vhdl-comment-block))))
8935
8936 (defun vhdl-template-block-configuration ()
8937   "Insert a block configuration statement."
8938   (interactive)
8939   (let ((margin (current-indentation))
8940         (start (point)))
8941     (vhdl-insert-keyword "FOR ")
8942     (when (vhdl-template-field "block name" nil t start (point))
8943       (vhdl-insert-keyword "\n\n")
8944       (indent-to margin)
8945       (vhdl-insert-keyword "END FOR;")
8946       (end-of-line 0)
8947       (indent-to (+ margin vhdl-basic-offset)))))
8948
8949 (defun vhdl-template-break ()
8950   "Insert a break statement."
8951   (interactive)
8952   (let (position)
8953     (vhdl-insert-keyword "BREAK")
8954     (setq position (point))
8955     (insert " ")
8956     (while (or
8957             (progn (vhdl-insert-keyword "FOR ")
8958                    (if (vhdl-template-field "[quantity name]" " USE " t)
8959                        (progn (vhdl-template-field "quantity name" " => ") t)
8960                      (delete-region (point)
8961                                     (progn (forward-word -1) (point)))
8962                      nil))
8963             (vhdl-template-field "[quantity name]" " => " t))
8964       (vhdl-template-field "expression")
8965       (setq position (point))
8966       (insert ", "))
8967     (delete-region position (point))
8968     (unless (vhdl-sequential-statement-p)
8969       (vhdl-insert-keyword " ON ")
8970       (if (vhdl-template-field "[sensitivity list]" nil t)
8971           (setq position (point))
8972         (delete-region position (point))))
8973     (vhdl-insert-keyword " WHEN ")
8974     (when vhdl-conditions-in-parenthesis (insert "("))
8975     (if (vhdl-template-field "[condition]" nil t)
8976         (when vhdl-conditions-in-parenthesis (insert ")"))
8977       (delete-region position (point)))
8978     (insert ";")))
8979
8980 (defun vhdl-template-case (&optional kind)
8981   "Insert a case statement."
8982   (interactive)
8983   (let ((margin (current-indentation))
8984         (start (point))
8985         label)
8986     (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
8987                                     (not (vhdl-standard-p 'ams))) 'is 'use)))
8988     (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8989         (vhdl-insert-keyword "CASE ")
8990       (vhdl-insert-keyword ": CASE ")
8991       (goto-char start)
8992       (setq label (vhdl-template-field "[label]" nil t))
8993       (unless label (delete-char 2))
8994       (forward-word 1)
8995       (forward-char 1))
8996     (when (vhdl-template-field "expression" nil t start (point))
8997       (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
8998       (indent-to margin)
8999       (vhdl-insert-keyword "END CASE")
9000       (when label (insert " " label))
9001       (insert ";")
9002       (forward-line -1)
9003       (indent-to (+ margin vhdl-basic-offset))
9004       (vhdl-insert-keyword "WHEN ")
9005       (let ((position (point)))
9006         (insert " => ;\n")
9007         (indent-to (+ margin vhdl-basic-offset))
9008         (vhdl-insert-keyword "WHEN OTHERS => null;")
9009         (goto-char position)))))
9010
9011 (defun vhdl-template-case-is ()
9012   "Insert a sequential case statement."
9013   (interactive)
9014   (vhdl-template-case 'is))
9015
9016 (defun vhdl-template-case-use ()
9017   "Insert a simultaneous case statement."
9018   (interactive)
9019   (vhdl-template-case 'use))
9020
9021 (defun vhdl-template-component ()
9022   "Insert a component declaration."
9023   (interactive)
9024   (vhdl-template-component-decl))
9025
9026 (defun vhdl-template-component-conf ()
9027   "Insert a component configuration (uses `vhdl-template-configuration-spec'
9028 since these are almost equivalent)."
9029   (interactive)
9030   (let ((margin (current-indentation))
9031         (result (vhdl-template-configuration-spec t)))
9032     (when result
9033       (insert "\n")
9034       (indent-to margin)
9035       (vhdl-insert-keyword "END FOR;")
9036       (when (eq result 'no-use)
9037         (end-of-line -0)))))
9038
9039 (defun vhdl-template-component-decl ()
9040   "Insert a component declaration."
9041   (interactive)
9042   (let ((margin (current-indentation))
9043         (start (point))
9044         name end-column)
9045     (vhdl-insert-keyword "COMPONENT ")
9046     (when (setq name (vhdl-template-field "name" nil t start (point)))
9047       (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9048       (insert "\n\n")
9049       (indent-to margin)
9050       (vhdl-insert-keyword "END COMPONENT")
9051       (unless (vhdl-standard-p '87) (insert " " name))
9052       (insert ";")
9053       (setq end-column (current-column))
9054       (end-of-line -0)
9055       (indent-to (+ margin vhdl-basic-offset))
9056       (vhdl-template-generic-list t t)
9057       (insert "\n")
9058       (indent-to (+ margin vhdl-basic-offset))
9059       (vhdl-template-port-list t)
9060       (beginning-of-line 2)
9061       (forward-char end-column))))
9062
9063 (defun vhdl-template-component-inst ()
9064   "Insert a component instantiation statement."
9065   (interactive)
9066   (let ((margin (current-indentation))
9067         (start (point))
9068         unit position)
9069     (when (vhdl-template-field "instance label" nil t start (point))
9070       (insert ": ")
9071       (if (not (vhdl-use-direct-instantiation))
9072           (vhdl-template-field "component name")
9073         ;; direct instantiation
9074         (setq unit (vhdl-template-field
9075                     "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
9076         (setq unit (upcase (or unit "")))
9077         (cond ((equal unit "ENTITY")
9078                (let ((begin (point)))
9079                  (vhdl-template-field "library name" "." t begin (point) nil
9080                                     (vhdl-work-library))
9081                (vhdl-template-field "entity name" "(")
9082                (if (vhdl-template-field "[architecture name]" nil t)
9083                    (insert ")")
9084                    (delete-char -1))))
9085               ((equal unit "CONFIGURATION")
9086                (vhdl-template-field "library name" "." nil nil nil nil
9087                                     (vhdl-work-library))
9088                (vhdl-template-field "configuration name"))
9089               (t (vhdl-template-field "component name"))))
9090       (insert "\n")
9091       (indent-to (+ margin vhdl-basic-offset))
9092       (setq position (point))
9093       (vhdl-insert-keyword "GENERIC ")
9094       (when (vhdl-template-map position t t)
9095         (insert "\n")
9096         (indent-to (+ margin vhdl-basic-offset)))
9097       (setq position (point))
9098       (vhdl-insert-keyword "PORT ")
9099       (unless (vhdl-template-map position t t)
9100         (delete-region (line-beginning-position) (point))
9101         (delete-char -1))
9102       (insert ";"))))
9103
9104 (defun vhdl-template-conditional-signal-asst ()
9105   "Insert a conditional signal assignment."
9106   (interactive)
9107   (when (vhdl-template-field "target signal")
9108     (insert " <= ")
9109     (let ((margin (current-column))
9110           (start (point))
9111           position)
9112       (vhdl-template-field "waveform")
9113       (setq position (point))
9114       (vhdl-insert-keyword " WHEN ")
9115       (when vhdl-conditions-in-parenthesis (insert "("))
9116       (while (and (vhdl-template-field "[condition]" nil t)
9117                   (progn
9118                     (when vhdl-conditions-in-parenthesis (insert ")"))
9119                     (setq position (point))
9120                     (vhdl-insert-keyword " ELSE")
9121                     (insert "\n")
9122                     (indent-to margin)
9123                     (vhdl-template-field "[waveform]" nil t)))
9124         (setq position (point))
9125         (vhdl-insert-keyword " WHEN ")
9126         (when vhdl-conditions-in-parenthesis (insert "(")))
9127       (delete-region position (point))
9128       (insert ";")
9129       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9130
9131 (defun vhdl-template-configuration ()
9132   "Insert a configuration specification if within an architecture,
9133 a block or component configuration if within a configuration declaration,
9134 a configuration declaration if not within a design unit."
9135   (interactive)
9136   (vhdl-prepare-search-1
9137    (cond
9138     ((and (save-excursion               ; architecture body
9139             (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
9140           (equal "ARCHITECTURE" (upcase (match-string 1))))
9141      (vhdl-template-configuration-spec))
9142     ((and (save-excursion               ; configuration declaration
9143             (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9144           (equal "CONFIGURATION" (upcase (match-string 1))))
9145      (if (eq (vhdl-decision-query
9146               "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
9147          (vhdl-template-component-conf)
9148        (vhdl-template-block-configuration)))
9149     (t (vhdl-template-configuration-decl))))) ; otherwise
9150
9151 (defun vhdl-template-configuration-spec (&optional optional-use)
9152   "Insert a configuration specification."
9153   (interactive)
9154   (let ((margin (current-indentation))
9155         (start (point))
9156         aspect position)
9157     (vhdl-insert-keyword "FOR ")
9158     (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
9159                                t start (point))
9160       (vhdl-template-field "component name" "\n")
9161       (indent-to (+ margin vhdl-basic-offset))
9162       (setq start (point))
9163       (vhdl-insert-keyword "USE ")
9164       (if (and optional-use
9165                (not (setq aspect (vhdl-template-field
9166                                   "[ENTITY | CONFIGURATION | OPEN]" " " t))))
9167           (progn (delete-region start (point)) 'no-use)
9168         (unless optional-use
9169           (setq aspect (vhdl-template-field
9170                         "ENTITY | CONFIGURATION | OPEN" " ")))
9171         (setq aspect (upcase (or aspect "")))
9172         (cond ((equal aspect "ENTITY")
9173                (vhdl-template-field "library name" "." nil nil nil nil
9174                                     (vhdl-work-library))
9175                (vhdl-template-field "entity name" "(")
9176                (if (vhdl-template-field "[architecture name]" nil t)
9177                    (insert ")")
9178                  (delete-char -1))
9179                (insert "\n")
9180                (indent-to (+ margin (* 2 vhdl-basic-offset)))
9181                (setq position (point))
9182                (vhdl-insert-keyword "GENERIC ")
9183                (when (vhdl-template-map position t t)
9184                  (insert "\n")
9185                  (indent-to (+ margin (* 2 vhdl-basic-offset))))
9186                (setq position (point))
9187                (vhdl-insert-keyword "PORT ")
9188                (unless (vhdl-template-map position t t)
9189                  (delete-region (line-beginning-position) (point))
9190                  (delete-char -1))
9191                (insert ";")
9192                t)
9193               ((equal aspect "CONFIGURATION")
9194                (vhdl-template-field "library name" "." nil nil nil nil
9195                                     (vhdl-work-library))
9196                (vhdl-template-field "configuration name" ";"))
9197               (t (delete-char -1) (insert ";") t))))))
9198
9199
9200 (defun vhdl-template-configuration-decl ()
9201   "Insert a configuration declaration."
9202   (interactive)
9203   (let ((margin (current-indentation))
9204         (start (point))
9205         entity-exists string name position)
9206     (vhdl-insert-keyword "CONFIGURATION ")
9207     (when (setq name (vhdl-template-field "name" nil t start (point)))
9208       (vhdl-insert-keyword " OF ")
9209       (save-excursion
9210         (vhdl-prepare-search-1
9211          (setq entity-exists (vhdl-re-search-backward
9212                               "\\<entity \\(\\w*\\) is\\>" nil t))
9213          (setq string (match-string 1))))
9214       (if (and entity-exists (not (equal string "")))
9215           (insert string)
9216         (vhdl-template-field "entity name"))
9217       (vhdl-insert-keyword " IS\n")
9218       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9219       (indent-to (+ margin vhdl-basic-offset))
9220       (setq position (point))
9221       (insert "\n")
9222       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9223       (indent-to margin)
9224       (vhdl-insert-keyword "END ")
9225       (unless (vhdl-standard-p '87)
9226         (vhdl-insert-keyword "CONFIGURATION "))
9227       (insert name ";")
9228       (goto-char position))))
9229
9230 (defun vhdl-template-constant ()
9231   "Insert a constant declaration."
9232   (interactive)
9233   (let ((start (point))
9234         (in-arglist (vhdl-in-argument-list-p)))
9235     (vhdl-insert-keyword "CONSTANT ")
9236     (when (vhdl-template-field "name" nil t start (point))
9237       (insert " : ")
9238       (when in-arglist (vhdl-insert-keyword "IN "))
9239       (vhdl-template-field "type")
9240       (if in-arglist
9241           (progn (insert ";")
9242                  (vhdl-comment-insert-inline))
9243         (let ((position (point)))
9244           (insert " := ")
9245           (unless (vhdl-template-field "[initialization]" nil t)
9246             (delete-region position (point)))
9247           (insert ";")
9248           (vhdl-comment-insert-inline))))))
9249
9250 (defun vhdl-template-context ()
9251   "Insert a context declaration."
9252   (interactive)
9253   (let ((margin (current-indentation))
9254         (start (point))
9255         entity-exists string name position)
9256     (vhdl-insert-keyword "CONTEXT ")
9257     (when (setq name (vhdl-template-field "name" nil t start (point)))
9258       (vhdl-insert-keyword " IS\n")
9259       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9260       (indent-to (+ margin vhdl-basic-offset))
9261       (setq position (point))
9262       (insert "\n")
9263       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9264       (indent-to margin)
9265       (vhdl-insert-keyword "END ")
9266       (unless (vhdl-standard-p '87)
9267         (vhdl-insert-keyword "CONTEXT "))
9268       (insert name ";")
9269       (goto-char position))))
9270
9271 (defun vhdl-template-default ()
9272   "Insert nothing."
9273   (interactive)
9274   (insert " ")
9275   (unexpand-abbrev)
9276   (backward-word 1)
9277   (vhdl-case-word 1)
9278   (forward-char 1))
9279
9280 (defun vhdl-template-default-indent ()
9281   "Insert nothing and indent."
9282   (interactive)
9283   (insert " ")
9284   (unexpand-abbrev)
9285   (backward-word 1)
9286   (vhdl-case-word 1)
9287   (forward-char 1)
9288   (indent-according-to-mode))
9289
9290 (defun vhdl-template-disconnect ()
9291   "Insert a disconnect statement."
9292   (interactive)
9293   (let ((start (point)))
9294     (vhdl-insert-keyword "DISCONNECT ")
9295     (when (vhdl-template-field "signal names | OTHERS | ALL"
9296                                " : " t start (point))
9297       (vhdl-template-field "type")
9298       (vhdl-insert-keyword " AFTER ")
9299       (vhdl-template-field "time expression" ";"))))
9300
9301 (defun vhdl-template-else ()
9302   "Insert an else statement."
9303   (interactive)
9304   (let (margin)
9305     (vhdl-prepare-search-1
9306      (vhdl-insert-keyword "ELSE")
9307      (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
9308               (equal "WHEN" (upcase (match-string 1))))
9309          (insert " ")
9310        (indent-according-to-mode)
9311        (setq margin (current-indentation))
9312        (insert "\n")
9313        (indent-to (+ margin vhdl-basic-offset))))))
9314
9315 (defun vhdl-template-elsif ()
9316   "Insert an elsif statement."
9317   (interactive)
9318   (let ((start (point))
9319         margin)
9320     (vhdl-insert-keyword "ELSIF ")
9321     (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
9322       (when vhdl-conditions-in-parenthesis (insert "("))
9323       (when (vhdl-template-field "condition" nil t start (point))
9324         (when vhdl-conditions-in-parenthesis (insert ")"))
9325         (indent-according-to-mode)
9326         (setq margin (current-indentation))
9327         (vhdl-insert-keyword
9328          (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
9329         (indent-to (+ margin vhdl-basic-offset))))))
9330
9331 (defun vhdl-template-entity ()
9332   "Insert an entity."
9333   (interactive)
9334   (let ((margin (current-indentation))
9335         (start (point))
9336         name end-column)
9337     (vhdl-insert-keyword "ENTITY ")
9338     (when (setq name (vhdl-template-field "name" nil t start (point)))
9339       (vhdl-insert-keyword " IS\n\n")
9340       (indent-to margin)
9341       (vhdl-insert-keyword "END ")
9342       (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
9343       (insert name ";")
9344       (setq end-column (current-column))
9345       (end-of-line -0)
9346       (indent-to (+ margin vhdl-basic-offset))
9347       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9348       (indent-to (+ margin vhdl-basic-offset))
9349       (when (vhdl-template-generic-list t)
9350         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9351       (insert "\n")
9352       (indent-to (+ margin vhdl-basic-offset))
9353       (when (vhdl-template-port-list t)
9354         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9355       (beginning-of-line 2)
9356       (forward-char end-column))))
9357
9358 (defun vhdl-template-exit ()
9359   "Insert an exit statement."
9360   (interactive)
9361   (let ((start (point)))
9362     (vhdl-insert-keyword "EXIT ")
9363     (if (vhdl-template-field "[loop label]" nil t start (point))
9364         (let ((position (point)))
9365           (vhdl-insert-keyword " WHEN ")
9366           (when vhdl-conditions-in-parenthesis (insert "("))
9367           (if (vhdl-template-field "[condition]" nil t)
9368               (when vhdl-conditions-in-parenthesis (insert ")"))
9369             (delete-region position (point))))
9370       (delete-char -1))
9371     (insert ";")))
9372
9373 (defun vhdl-template-file ()
9374   "Insert a file declaration."
9375   (interactive)
9376   (let ((start (point)))
9377     (vhdl-insert-keyword "FILE ")
9378     (when (vhdl-template-field "name" nil t start (point))
9379       (insert " : ")
9380       (vhdl-template-field "type")
9381       (unless (vhdl-standard-p '87)
9382         (vhdl-insert-keyword " OPEN ")
9383         (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
9384                                      nil t)
9385           (delete-char -6)))
9386       (vhdl-insert-keyword " IS ")
9387       (when (vhdl-standard-p '87)
9388         (vhdl-template-field "[IN | OUT]" " " t))
9389       (vhdl-template-field "filename-string" nil nil nil nil t)
9390       (insert ";")
9391       (vhdl-comment-insert-inline))))
9392
9393 (defun vhdl-template-for ()
9394   "Insert a block or component configuration if within a configuration
9395 declaration, a configuration specification if within an architecture
9396 declarative part (and not within a subprogram), a for-loop if within a
9397 sequential statement part (subprogram or process), and a for-generate
9398 otherwise."
9399   (interactive)
9400   (vhdl-prepare-search-1
9401    (cond
9402     ((vhdl-sequential-statement-p)      ; sequential statement
9403      (vhdl-template-for-loop))
9404     ((and (save-excursion               ; configuration declaration
9405             (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9406           (equal "CONFIGURATION" (upcase (match-string 1))))
9407      (if (eq (vhdl-decision-query
9408               "for" "(b)lock or (c)omponent configuration?" t) ?c)
9409          (vhdl-template-component-conf)
9410        (vhdl-template-block-configuration)))
9411     ((and (save-excursion
9412             (re-search-backward         ; architecture declarative part
9413              "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
9414           (equal "ARCHITECTURE" (upcase (match-string 1))))
9415      (vhdl-template-configuration-spec))
9416     (t (vhdl-template-for-generate))))) ; concurrent statement
9417
9418 (defun vhdl-template-for-generate ()
9419   "Insert a for-generate."
9420   (interactive)
9421   (let ((margin (current-indentation))
9422         (start (point))
9423         label position)
9424     (vhdl-insert-keyword ": FOR ")
9425     (setq position (point-marker))
9426     (goto-char start)
9427     (when (setq label (vhdl-template-field "label" nil t start position))
9428       (goto-char position)
9429       (vhdl-template-field "loop variable")
9430       (vhdl-insert-keyword " IN ")
9431       (vhdl-template-field "range")
9432       (vhdl-template-generate-body margin label))))
9433
9434 (defun vhdl-template-for-loop ()
9435   "Insert a for loop."
9436   (interactive)
9437   (let ((margin (current-indentation))
9438         (start (point))
9439         label index)
9440     (if (not (eq vhdl-optional-labels 'all))
9441         (vhdl-insert-keyword "FOR ")
9442       (vhdl-insert-keyword ": FOR ")
9443       (goto-char start)
9444       (setq label (vhdl-template-field "[label]" nil t))
9445       (unless label (delete-char 2))
9446       (forward-word 1)
9447       (forward-char 1))
9448     (when (setq index (vhdl-template-field "loop variable"
9449                                            nil t start (point)))
9450       (vhdl-insert-keyword " IN ")
9451       (vhdl-template-field "range")
9452       (vhdl-insert-keyword " LOOP\n\n")
9453       (indent-to margin)
9454       (vhdl-insert-keyword "END LOOP")
9455       (if label
9456           (insert " " label ";")
9457         (insert ";")
9458         (when vhdl-self-insert-comments (insert "  -- " index)))
9459       (forward-line -1)
9460       (indent-to (+ margin vhdl-basic-offset)))))
9461
9462 (defun vhdl-template-function (&optional kind)
9463   "Insert a function declaration or body."
9464   (interactive)
9465   (let ((margin (current-indentation))
9466         (start (point))
9467         name)
9468     (vhdl-insert-keyword "FUNCTION ")
9469     (when (setq name (vhdl-template-field "name" nil t start (point)))
9470       (vhdl-template-argument-list t)
9471       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9472       (end-of-line)
9473       (insert "\n")
9474       (indent-to (+ margin vhdl-basic-offset))
9475       (vhdl-insert-keyword "RETURN ")
9476       (vhdl-template-field "type")
9477       (if (if kind (eq kind 'body)
9478             (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9479           (progn (vhdl-insert-keyword " IS\n")
9480                  (vhdl-template-begin-end
9481                   (unless (vhdl-standard-p '87) "FUNCTION") name margin)
9482                  (vhdl-comment-block))
9483         (insert ";")))))
9484
9485 (defun vhdl-template-function-decl ()
9486   "Insert a function declaration."
9487   (interactive)
9488   (vhdl-template-function 'decl))
9489
9490 (defun vhdl-template-function-body ()
9491   "Insert a function declaration."
9492   (interactive)
9493   (vhdl-template-function 'body))
9494
9495 (defun vhdl-template-generate ()
9496   "Insert a generation scheme."
9497   (interactive)
9498   (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i)
9499       (vhdl-template-if-generate)
9500     (vhdl-template-for-generate)))
9501
9502 (defun vhdl-template-generic ()
9503   "Insert generic declaration, or generic map in instantiation statements."
9504   (interactive)
9505   (let ((start (point)))
9506     (vhdl-prepare-search-1
9507      (cond
9508       ((and (save-excursion             ; entity declaration
9509               (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9510             (equal "ENTITY" (upcase (match-string 1))))
9511        (vhdl-template-generic-list nil))
9512       ((or (save-excursion
9513              (or (beginning-of-line)
9514                  (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9515            (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9516        (vhdl-insert-keyword "GENERIC ")
9517        (vhdl-template-map start))
9518       (t (vhdl-template-generic-list nil t))))))
9519
9520 (defun vhdl-template-group ()
9521   "Insert group or group template declaration."
9522   (interactive)
9523   (let ((start (point)))
9524     (if (eq (vhdl-decision-query
9525              "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
9526         (vhdl-template-group-template)
9527       (vhdl-template-group-decl))))
9528
9529 (defun vhdl-template-group-decl ()
9530   "Insert group declaration."
9531   (interactive)
9532   (let ((start (point)))
9533     (vhdl-insert-keyword "GROUP ")
9534     (when (vhdl-template-field "name" " : " t start (point))
9535       (vhdl-template-field "template name" " (")
9536       (vhdl-template-field "constituent list" ");")
9537       (vhdl-comment-insert-inline))))
9538
9539 (defun vhdl-template-group-template ()
9540   "Insert group template declaration."
9541   (interactive)
9542   (let ((start (point)))
9543     (vhdl-insert-keyword "GROUP ")
9544     (when (vhdl-template-field "template name" nil t start (point))
9545       (vhdl-insert-keyword " IS (")
9546       (vhdl-template-field "entity class list" ");")
9547       (vhdl-comment-insert-inline))))
9548
9549 (defun vhdl-template-if ()
9550   "Insert a sequential if statement or an if-generate statement."
9551   (interactive)
9552   (if (vhdl-sequential-statement-p)
9553       (vhdl-template-if-then)
9554     (if (and (vhdl-standard-p 'ams)
9555              (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u))
9556         (vhdl-template-if-use)
9557       (vhdl-template-if-generate))))
9558
9559 (defun vhdl-template-if-generate ()
9560   "Insert an if-generate."
9561   (interactive)
9562   (let ((margin (current-indentation))
9563         (start (point))
9564         label position)
9565     (vhdl-insert-keyword ": IF ")
9566     (setq position (point-marker))
9567     (goto-char start)
9568     (when (setq label (vhdl-template-field "label" nil t start position))
9569       (goto-char position)
9570       (when vhdl-conditions-in-parenthesis (insert "("))
9571       (vhdl-template-field "condition")
9572       (when vhdl-conditions-in-parenthesis (insert ")"))
9573       (vhdl-template-generate-body margin label))))
9574
9575 (defun vhdl-template-if-then-use (kind)
9576   "Insert a sequential if statement."
9577   (interactive)
9578   (let ((margin (current-indentation))
9579         (start (point))
9580         label)
9581     (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
9582         (vhdl-insert-keyword "IF ")
9583       (vhdl-insert-keyword ": IF ")
9584       (goto-char start)
9585       (setq label (vhdl-template-field "[label]" nil t))
9586       (unless label (delete-char 2))
9587       (forward-word 1)
9588       (forward-char 1))
9589     (when vhdl-conditions-in-parenthesis (insert "("))
9590     (when (vhdl-template-field "condition" nil t start (point))
9591       (when vhdl-conditions-in-parenthesis (insert ")"))
9592       (vhdl-insert-keyword
9593        (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
9594       (indent-to margin)
9595       (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
9596       (when label (insert " " label))
9597       (insert ";")
9598       (forward-line -1)
9599       (indent-to (+ margin vhdl-basic-offset)))))
9600
9601 (defun vhdl-template-if-then ()
9602   "Insert a sequential if statement."
9603   (interactive)
9604   (vhdl-template-if-then-use 'then))
9605
9606 (defun vhdl-template-if-use ()
9607   "Insert a simultaneous if statement."
9608   (interactive)
9609   (vhdl-template-if-then-use 'use))
9610
9611 (defun vhdl-template-instance ()
9612   "Insert a component instantiation statement."
9613   (interactive)
9614   (vhdl-template-component-inst))
9615
9616 (defun vhdl-template-library ()
9617   "Insert a library specification."
9618   (interactive)
9619   (let ((margin (current-indentation))
9620         (start (point))
9621         name end-pos)
9622     (vhdl-insert-keyword "LIBRARY ")
9623     (when (setq name (vhdl-template-field "names" nil t start (point)))
9624       (insert ";")
9625       (unless (string-match "," name)
9626         (setq end-pos (point))
9627         (insert "\n")
9628         (indent-to margin)
9629         (vhdl-insert-keyword "USE ")
9630         (insert name)
9631         (vhdl-insert-keyword "..ALL;")
9632         (backward-char 5)
9633         (if (vhdl-template-field "package name")
9634             (forward-char 5)
9635           (delete-region end-pos (+ (point) 5)))))))
9636
9637 (defun vhdl-template-limit ()
9638   "Insert a limit."
9639   (interactive)
9640   (let ((start (point)))
9641     (vhdl-insert-keyword "LIMIT ")
9642     (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
9643                                t start (point))
9644       (vhdl-template-field "type")
9645       (vhdl-insert-keyword " WITH ")
9646       (vhdl-template-field "real expression" ";"))))
9647
9648 (defun vhdl-template-loop ()
9649   "Insert a loop."
9650   (interactive)
9651   (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t)))
9652     (cond ((eq char ?w)
9653            (vhdl-template-while-loop))
9654           ((eq char ?f)
9655            (vhdl-template-for-loop))
9656           (t (vhdl-template-bare-loop)))))
9657
9658 (defun vhdl-template-bare-loop ()
9659   "Insert a loop."
9660   (interactive)
9661   (let ((margin (current-indentation))
9662         (start (point))
9663         label)
9664     (if (not (eq vhdl-optional-labels 'all))
9665         (vhdl-insert-keyword "LOOP ")
9666       (vhdl-insert-keyword ": LOOP ")
9667       (goto-char start)
9668       (setq label (vhdl-template-field "[label]" nil t))
9669       (unless label (delete-char 2))
9670       (forward-word 1)
9671       (delete-char 1))
9672     (insert "\n\n")
9673     (indent-to margin)
9674     (vhdl-insert-keyword "END LOOP")
9675     (insert (if label (concat " " label ";") ";"))
9676     (forward-line -1)
9677     (indent-to (+ margin vhdl-basic-offset))))
9678
9679 (defun vhdl-template-map (&optional start optional secondary)
9680   "Insert a map specification with association list."
9681   (interactive)
9682   (let ((start (or start (point)))
9683         margin end-pos)
9684     (vhdl-insert-keyword "MAP (")
9685     (if (not vhdl-association-list-with-formals)
9686         (if (vhdl-template-field
9687              (concat (and optional "[") "association list" (and optional "]"))
9688              ")" (or (not secondary) optional)
9689              (and (not secondary) start) (point))
9690             t
9691           (if (and optional secondary) (delete-region start (point)))
9692           nil)
9693       (if vhdl-argument-list-indent
9694           (setq margin (current-column))
9695         (setq margin (+ (current-indentation) vhdl-basic-offset))
9696         (insert "\n")
9697         (indent-to margin))
9698       (if (vhdl-template-field
9699            (concat (and optional "[") "formal" (and optional "]"))
9700            " => " (or (not secondary) optional)
9701            (and (not secondary) start) (point))
9702           (progn
9703             (vhdl-template-field "actual" ",")
9704             (setq end-pos (point))
9705             (insert "\n")
9706             (indent-to margin)
9707             (while (vhdl-template-field "[formal]" " => " t)
9708               (vhdl-template-field "actual" ",")
9709               (setq end-pos (point))
9710               (insert "\n")
9711               (indent-to margin))
9712             (delete-region end-pos (point))
9713             (delete-char -1)
9714             (insert ")")
9715             (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9716             t)
9717         (when (and optional secondary) (delete-region start (point)))
9718         nil))))
9719
9720 (defun vhdl-template-modify (&optional noerror)
9721   "Actualize modification date."
9722   (interactive)
9723   (vhdl-prepare-search-2
9724    (save-excursion
9725      (goto-char (point-min))
9726      (if (re-search-forward vhdl-modify-date-prefix-string nil t)
9727          (progn (delete-region (point) (progn (end-of-line) (point)))
9728                 (vhdl-template-insert-date))
9729        (unless noerror
9730          (error "ERROR:  Modification date prefix string \"%s\" not found"
9731                         vhdl-modify-date-prefix-string))))))
9732
9733
9734 (defun vhdl-template-modify-noerror ()
9735   "Call `vhdl-template-modify' with NOERROR non-nil."
9736   (vhdl-template-modify t))
9737
9738 (defun vhdl-template-nature ()
9739   "Insert a nature declaration."
9740   (interactive)
9741   (let ((start (point))
9742         name mid-pos end-pos)
9743     (vhdl-insert-keyword "NATURE ")
9744     (when (setq name (vhdl-template-field "name" nil t start (point)))
9745       (vhdl-insert-keyword " IS ")
9746       (let ((definition
9747               (upcase
9748                (or (vhdl-template-field
9749                     "across type | ARRAY | RECORD")
9750                    ""))))
9751         (cond ((equal definition "")
9752                (insert ";"))
9753               ((equal definition "ARRAY")
9754                (delete-region (point) (progn (forward-word -1) (point)))
9755                (vhdl-template-array 'nature t))
9756               ((equal definition "RECORD")
9757                (setq mid-pos (point-marker))
9758                (delete-region (point) (progn (forward-word -1) (point)))
9759                (vhdl-template-record 'nature name t))
9760               (t
9761                (vhdl-insert-keyword " ACROSS ")
9762                (vhdl-template-field "through type")
9763                (vhdl-insert-keyword " THROUGH ")
9764                (vhdl-template-field "reference name")
9765                (vhdl-insert-keyword " REFERENCE;")))
9766         (when mid-pos
9767           (setq end-pos (point-marker))
9768           (goto-char mid-pos)
9769           (end-of-line))
9770         (vhdl-comment-insert-inline)
9771         (when end-pos (goto-char end-pos))))))
9772
9773 (defun vhdl-template-next ()
9774   "Insert a next statement."
9775   (interactive)
9776   (let ((start (point)))
9777     (vhdl-insert-keyword "NEXT ")
9778     (if (vhdl-template-field "[loop label]" nil t start (point))
9779         (let ((position (point)))
9780           (vhdl-insert-keyword " WHEN ")
9781           (when vhdl-conditions-in-parenthesis (insert "("))
9782           (if (vhdl-template-field "[condition]" nil t)
9783               (when vhdl-conditions-in-parenthesis (insert ")"))
9784             (delete-region position (point))))
9785       (delete-char -1))
9786     (insert ";")))
9787
9788 (defun vhdl-template-others ()
9789   "Insert an others aggregate."
9790   (interactive)
9791   (let ((start (point)))
9792     (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
9793         (progn (unless vhdl-template-invoked-by-hook (insert "("))
9794                (vhdl-insert-keyword "OTHERS => '")
9795                (when (vhdl-template-field "value" nil t start (point))
9796                  (insert "')")))
9797       (vhdl-insert-keyword "OTHERS "))))
9798
9799 (defun vhdl-template-package (&optional kind)
9800   "Insert a package specification or body."
9801   (interactive)
9802   (let ((margin (current-indentation))
9803         (start (point))
9804         name body position)
9805     (vhdl-insert-keyword "PACKAGE ")
9806     (setq body (if kind (eq kind 'body)
9807                  (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
9808     (when body
9809       (vhdl-insert-keyword "BODY ")
9810       (when (save-excursion
9811               (vhdl-prepare-search-1
9812                (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
9813         (insert (setq name (match-string 1)))))
9814     (when (or name
9815               (setq name (vhdl-template-field "name" nil t start (point))))
9816       (vhdl-insert-keyword " IS\n")
9817       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9818       (indent-to (+ margin vhdl-basic-offset))
9819       (setq position (point))
9820       (insert "\n")
9821       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9822       (indent-to margin)
9823       (vhdl-insert-keyword "END ")
9824       (unless (vhdl-standard-p '87)
9825         (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY "))))
9826       (insert (or name "") ";")
9827       (goto-char position))))
9828
9829 (defun vhdl-template-package-decl ()
9830   "Insert a package specification."
9831   (interactive)
9832   (vhdl-template-package 'decl))
9833
9834 (defun vhdl-template-package-body ()
9835   "Insert a package body."
9836   (interactive)
9837   (vhdl-template-package 'body))
9838
9839 (defun vhdl-template-port ()
9840   "Insert a port declaration, or port map in instantiation statements."
9841   (interactive)
9842   (let ((start (point)))
9843     (vhdl-prepare-search-1
9844      (cond
9845       ((and (save-excursion             ; entity declaration
9846               (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9847             (equal "ENTITY" (upcase (match-string 1))))
9848        (vhdl-template-port-list nil))
9849       ((or (save-excursion
9850              (or (beginning-of-line)
9851                  (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9852            (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9853        (vhdl-insert-keyword "PORT ")
9854        (vhdl-template-map start))
9855       (t (vhdl-template-port-list nil))))))
9856
9857 (defun vhdl-template-procedural ()
9858   "Insert a procedural."
9859   (interactive)
9860   (let ((margin (current-indentation))
9861         (start (point))
9862         (case-fold-search t)
9863         label)
9864     (vhdl-insert-keyword "PROCEDURAL ")
9865     (when (memq vhdl-optional-labels '(process all))
9866       (goto-char start)
9867       (insert ": ")
9868       (goto-char start)
9869       (setq label (vhdl-template-field "[label]" nil t))
9870       (unless label (delete-char 2))
9871       (forward-word 1)
9872       (forward-char 1))
9873     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9874     (insert "\n")
9875     (vhdl-template-begin-end "PROCEDURAL" label margin)
9876     (vhdl-comment-block)))
9877
9878 (defun vhdl-template-procedure (&optional kind)
9879   "Insert a procedure declaration or body."
9880   (interactive)
9881   (let ((margin (current-indentation))
9882         (start (point))
9883         name)
9884     (vhdl-insert-keyword "PROCEDURE ")
9885     (when (setq name (vhdl-template-field "name" nil t start (point)))
9886       (vhdl-template-argument-list)
9887       (if (if kind (eq kind 'body)
9888             (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9889           (progn (vhdl-insert-keyword " IS")
9890                  (when vhdl-auto-align
9891                    (vhdl-align-region-groups start (point) 1))
9892                  (end-of-line) (insert "\n")
9893                  (vhdl-template-begin-end
9894                   (unless (vhdl-standard-p '87) "PROCEDURE")
9895                   name margin)
9896                  (vhdl-comment-block))
9897         (insert ";")
9898         (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9899         (end-of-line)))))
9900
9901 (defun vhdl-template-procedure-decl ()
9902   "Insert a procedure declaration."
9903   (interactive)
9904   (vhdl-template-procedure 'decl))
9905
9906 (defun vhdl-template-procedure-body ()
9907   "Insert a procedure body."
9908   (interactive)
9909   (vhdl-template-procedure 'body))
9910
9911 (defun vhdl-template-process (&optional kind)
9912   "Insert a process."
9913   (interactive)
9914   (let ((margin (current-indentation))
9915         (start (point))
9916         (reset-kind vhdl-reset-kind)
9917         label seq input-signals clock reset final-pos)
9918     (setq seq (if kind (eq kind 'seq)
9919                 (eq (vhdl-decision-query
9920                      "process" "(c)ombinational or (s)equential?" t) ?s)))
9921     (vhdl-insert-keyword "PROCESS ")
9922     (when (memq vhdl-optional-labels '(process all))
9923       (goto-char start)
9924       (insert ": ")
9925       (goto-char start)
9926       (setq label (vhdl-template-field "[label]" nil t))
9927       (unless label (delete-char 2))
9928       (forward-word 1)
9929       (forward-char 1))
9930     (insert "(")
9931     (if (not seq)
9932         (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
9933                          (progn (insert "all)") (setq input-signals "all")))
9934                     (setq input-signals
9935                           (vhdl-template-field "[sensitivity list]" ")" t)))
9936           (setq input-signals "")
9937           (delete-char -2))
9938       (setq clock (or (and (not (equal "" vhdl-clock-name))
9939                            (progn (insert vhdl-clock-name) vhdl-clock-name))
9940                       (vhdl-template-field "clock name") "<clock>"))
9941       (when (eq reset-kind 'query)
9942         (setq reset-kind
9943               (if (eq (vhdl-decision-query
9944                        "" "(a)synchronous or (s)ynchronous reset?" t) ?a)
9945                   'async
9946                 'sync)))
9947       (when (eq reset-kind 'async)
9948         (insert ", ")
9949         (setq reset (or (and (not (equal "" vhdl-reset-name))
9950                              (progn (insert vhdl-reset-name) vhdl-reset-name))
9951                         (vhdl-template-field "reset name") "<reset>")))
9952       (insert ")"))
9953     (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9954     (insert "\n")
9955     (vhdl-template-begin-end "PROCESS" label margin)
9956     (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind)))
9957     (when vhdl-prompt-for-comments
9958       (setq final-pos (point-marker))
9959       (vhdl-prepare-search-2
9960        (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9961                   (vhdl-re-search-backward "\\<process\\>" nil t))
9962          (end-of-line -0)
9963          (if (bobp)
9964              (progn (insert "\n") (forward-line -1))
9965            (insert "\n"))
9966          (indent-to margin)
9967          (insert "-- purpose: ")
9968          (if (not (vhdl-template-field "[description]" nil t))
9969              (vhdl-line-kill-entire)
9970            (insert "\n")
9971            (indent-to margin)
9972            (insert "-- type   : ")
9973            (insert (if seq "sequential" "combinational") "\n")
9974            (indent-to margin)
9975            (insert "-- inputs : ")
9976            (if (not seq)
9977                (insert input-signals)
9978              (insert clock ", ")
9979              (when reset (insert reset ", "))
9980              (unless (vhdl-template-field "[signal names]" nil t)
9981                (delete-char -2)))
9982            (insert "\n")
9983            (indent-to margin)
9984            (insert "-- outputs: ")
9985            (vhdl-template-field "[signal names]" nil t))))
9986       (goto-char final-pos))))
9987
9988 (defun vhdl-template-process-comb ()
9989   "Insert a combinational process."
9990   (interactive)
9991   (vhdl-template-process 'comb))
9992
9993 (defun vhdl-template-process-seq ()
9994   "Insert a sequential process."
9995   (interactive)
9996   (vhdl-template-process 'seq))
9997
9998 (defun vhdl-template-quantity ()
9999   "Insert a quantity declaration."
10000   (interactive)
10001   (if (vhdl-in-argument-list-p)
10002       (let ((start (point)))
10003         (vhdl-insert-keyword "QUANTITY ")
10004         (when (vhdl-template-field "names" nil t start (point))
10005           (insert " : ")
10006           (vhdl-template-field "[IN | OUT]" " " t)
10007           (vhdl-template-field "type")
10008           (insert ";")
10009           (vhdl-comment-insert-inline)))
10010     (let ((char (vhdl-decision-query
10011                  "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
10012       (cond ((eq char ?f) (vhdl-template-quantity-free))
10013             ((eq char ?b) (vhdl-template-quantity-branch))
10014             ((eq char ?s) (vhdl-template-quantity-source))
10015             (t (vhdl-template-undo (point) (point)))))))
10016
10017 (defun vhdl-template-quantity-free ()
10018   "Insert a free quantity declaration."
10019   (interactive)
10020   (vhdl-insert-keyword "QUANTITY ")
10021   (vhdl-template-field "names")
10022   (insert " : ")
10023   (vhdl-template-field "type")
10024   (let ((position (point)))
10025     (insert " := ")
10026     (unless (vhdl-template-field "[initialization]" nil t)
10027       (delete-region position (point)))
10028     (insert ";")
10029     (vhdl-comment-insert-inline)))
10030
10031 (defun vhdl-template-quantity-branch ()
10032   "Insert a branch quantity declaration."
10033   (interactive)
10034   (let (position)
10035     (vhdl-insert-keyword "QUANTITY ")
10036     (when (vhdl-template-field "[across names]" " " t)
10037       (vhdl-insert-keyword "ACROSS "))
10038     (when (vhdl-template-field "[through names]" " " t)
10039       (vhdl-insert-keyword "THROUGH "))
10040     (vhdl-template-field "plus terminal name")
10041     (setq position (point))
10042     (vhdl-insert-keyword " TO ")
10043     (unless (vhdl-template-field "[minus terminal name]" nil t)
10044       (delete-region position (point)))
10045     (insert ";")
10046     (vhdl-comment-insert-inline)))
10047
10048 (defun vhdl-template-quantity-source ()
10049   "Insert a source quantity declaration."
10050   (interactive)
10051   (vhdl-insert-keyword "QUANTITY ")
10052   (vhdl-template-field "names")
10053   (insert " : ")
10054   (vhdl-template-field "type" " ")
10055   (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n)
10056       (progn (vhdl-insert-keyword "NOISE ")
10057              (vhdl-template-field "power expression"))
10058     (vhdl-insert-keyword "SPECTRUM ")
10059     (vhdl-template-field "magnitude expression" ", ")
10060     (vhdl-template-field "phase expression"))
10061   (insert ";")
10062   (vhdl-comment-insert-inline))
10063
10064 (defun vhdl-template-record (kind &optional name secondary)
10065   "Insert a record type declaration."
10066   (interactive)
10067   (let ((margin (current-indentation))
10068         (start (point))
10069         (first t))
10070     (vhdl-insert-keyword "RECORD\n")
10071     (indent-to (+ margin vhdl-basic-offset))
10072     (when (or (vhdl-template-field "element names"
10073                                    nil (not secondary) start (point))
10074               secondary)
10075       (while (or first (vhdl-template-field "[element names]" nil t))
10076         (insert " : ")
10077         (vhdl-template-field (if (eq kind 'type) "type" "nature") ";")
10078         (vhdl-comment-insert-inline)
10079         (insert "\n")
10080         (indent-to (+ margin vhdl-basic-offset))
10081         (setq first nil))
10082       (delete-region (line-beginning-position) (point))
10083       (indent-to margin)
10084       (vhdl-insert-keyword "END RECORD")
10085       (unless (vhdl-standard-p '87) (and name (insert " " name)))
10086       (insert ";")
10087       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10088
10089 (defun vhdl-template-report ()
10090   "Insert a report statement."
10091   (interactive)
10092   (let ((start (point)))
10093     (vhdl-insert-keyword "REPORT ")
10094     (if (equal "\"\"" (vhdl-template-field
10095                        "string expression" nil t start (point) t))
10096         (delete-char -2)
10097       (setq start (point))
10098       (vhdl-insert-keyword " SEVERITY ")
10099       (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
10100         (delete-region start (point)))
10101       (insert ";"))))
10102
10103 (defun vhdl-template-return ()
10104   "Insert a return statement."
10105   (interactive)
10106   (let ((start (point)))
10107     (vhdl-insert-keyword "RETURN ")
10108     (unless (vhdl-template-field "[expression]" nil t start (point))
10109       (delete-char -1))
10110     (insert ";")))
10111
10112 (defun vhdl-template-selected-signal-asst ()
10113   "Insert a selected signal assignment."
10114   (interactive)
10115   (let ((margin (current-indentation))
10116         (start (point))
10117         (choices t))
10118     (let ((position (point)))
10119       (vhdl-insert-keyword " SELECT ")
10120       (goto-char position))
10121     (vhdl-insert-keyword "WITH ")
10122     (when (vhdl-template-field "selector expression"
10123                                nil t start (+ (point) 7))
10124       (forward-word 1)
10125       (delete-char 1)
10126       (insert "\n")
10127       (indent-to (+ margin vhdl-basic-offset))
10128       (vhdl-template-field "target signal" " <= ")
10129       (insert "\n")
10130       (indent-to (+ margin vhdl-basic-offset))
10131       (vhdl-template-field "waveform")
10132       (vhdl-insert-keyword " WHEN ")
10133       (vhdl-template-field "choices" ",")
10134       (insert "\n")
10135       (indent-to (+ margin vhdl-basic-offset))
10136       (while (and choices (vhdl-template-field "[waveform]" nil t))
10137         (vhdl-insert-keyword " WHEN ")
10138         (if (setq choices (vhdl-template-field "[choices]" "," t))
10139             (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10140           (vhdl-insert-keyword "OTHERS")))
10141       (when choices
10142         (fixup-whitespace)
10143         (delete-char -2))
10144       (insert ";")
10145       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10146
10147 (defun vhdl-template-signal ()
10148   "Insert a signal declaration."
10149   (interactive)
10150   (let ((start (point))
10151         (in-arglist (vhdl-in-argument-list-p)))
10152     (vhdl-insert-keyword "SIGNAL ")
10153     (when (vhdl-template-field "names" nil t start (point))
10154       (insert " : ")
10155       (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10156       (vhdl-template-field "type")
10157       (if in-arglist
10158           (progn (insert ";")
10159                  (vhdl-comment-insert-inline))
10160         (let ((position (point)))
10161           (insert " := ")
10162           (unless (vhdl-template-field "[initialization]" nil t)
10163             (delete-region position (point)))
10164           (insert ";")
10165           (vhdl-comment-insert-inline))))))
10166
10167 (defun vhdl-template-subnature ()
10168   "Insert a subnature declaration."
10169   (interactive)
10170   (let ((start (point))
10171         position)
10172     (vhdl-insert-keyword "SUBNATURE ")
10173     (when (vhdl-template-field "name" nil t start (point))
10174       (vhdl-insert-keyword " IS ")
10175       (vhdl-template-field "nature" " (")
10176       (if (vhdl-template-field "[index range]" nil t)
10177           (insert ")")
10178         (delete-char -2))
10179       (setq position (point))
10180       (vhdl-insert-keyword " TOLERANCE ")
10181       (if (equal "\"\"" (vhdl-template-field "[string expression]"
10182                                              nil t nil nil t))
10183           (delete-region position (point))
10184         (vhdl-insert-keyword " ACROSS ")
10185         (vhdl-template-field "string expression" nil nil nil nil t)
10186         (vhdl-insert-keyword " THROUGH"))
10187       (insert ";")
10188       (vhdl-comment-insert-inline))))
10189
10190 (defun vhdl-template-subprogram-body ()
10191   "Insert a subprogram body."
10192   (interactive)
10193   (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10194       (vhdl-template-function-body)
10195     (vhdl-template-procedure-body)))
10196
10197 (defun vhdl-template-subprogram-decl ()
10198   "Insert a subprogram declaration."
10199   (interactive)
10200   (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10201       (vhdl-template-function-decl)
10202     (vhdl-template-procedure-decl)))
10203
10204 (defun vhdl-template-subtype ()
10205   "Insert a subtype declaration."
10206   (interactive)
10207   (let ((start (point)))
10208     (vhdl-insert-keyword "SUBTYPE ")
10209     (when (vhdl-template-field "name" nil t start (point))
10210       (vhdl-insert-keyword " IS ")
10211       (vhdl-template-field "type" " ")
10212       (unless
10213           (vhdl-template-field "[RANGE value range | ( index range )]" nil t)
10214         (delete-char -1))
10215       (insert ";")
10216       (vhdl-comment-insert-inline))))
10217
10218 (defun vhdl-template-terminal ()
10219   "Insert a terminal declaration."
10220   (interactive)
10221   (let ((start (point)))
10222     (vhdl-insert-keyword "TERMINAL ")
10223     (when (vhdl-template-field "names" nil t start (point))
10224       (insert " : ")
10225       (vhdl-template-field "nature")
10226       (insert ";")
10227       (vhdl-comment-insert-inline))))
10228
10229 (defun vhdl-template-type ()
10230   "Insert a type declaration."
10231   (interactive)
10232   (let ((start (point))
10233         name mid-pos end-pos)
10234     (vhdl-insert-keyword "TYPE ")
10235     (when (setq name (vhdl-template-field "name" nil t start (point)))
10236       (vhdl-insert-keyword " IS ")
10237       (let ((definition
10238               (upcase
10239                (or (vhdl-template-field
10240                     "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t)
10241                    ""))))
10242         (cond ((equal definition "")
10243                (delete-char -4)
10244                (insert ";"))
10245               ((equal definition "ARRAY")
10246                (delete-region (point) (progn (forward-word -1) (point)))
10247                (vhdl-template-array 'type t))
10248               ((equal definition "RECORD")
10249                (setq mid-pos (point-marker))
10250                (delete-region (point) (progn (forward-word -1) (point)))
10251                (vhdl-template-record 'type name t))
10252               ((equal definition "ACCESS")
10253                (insert " ")
10254                (vhdl-template-field "type" ";"))
10255               ((equal definition "FILE")
10256                (vhdl-insert-keyword " OF ")
10257                (vhdl-template-field "type" ";"))
10258               ((equal definition "ENUM")
10259                (kill-word -1)
10260                (insert "(")
10261                (setq end-pos (point-marker))
10262                (insert ");"))
10263               (t (insert ";")))
10264         (when mid-pos
10265           (setq end-pos (point-marker))
10266           (goto-char mid-pos)
10267           (end-of-line))
10268         (vhdl-comment-insert-inline)
10269         (when end-pos (goto-char end-pos))))))
10270
10271 (defun vhdl-template-use ()
10272   "Insert a use clause."
10273   (interactive)
10274   (let ((start (point)))
10275     (vhdl-prepare-search-1
10276      (vhdl-insert-keyword "USE ")
10277      (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
10278        (vhdl-insert-keyword "..ALL;")
10279        (backward-char 6)
10280        (when (vhdl-template-field "library name" nil t start (+ (point) 6))
10281          (forward-char 1)
10282          (vhdl-template-field "package name")
10283          (forward-char 5))))))
10284
10285 (defun vhdl-template-variable ()
10286   "Insert a variable declaration."
10287   (interactive)
10288   (let ((start (point))
10289         (in-arglist (vhdl-in-argument-list-p)))
10290     (vhdl-prepare-search-2
10291      (if (or (save-excursion
10292                (progn (vhdl-beginning-of-block)
10293                       (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
10294              (save-excursion (backward-word 1) (looking-at "\\<shared\\>")))
10295          (vhdl-insert-keyword "VARIABLE ")
10296        (if (vhdl-standard-p '87)
10297            (error "ERROR:  Not within sequential block")
10298          (vhdl-insert-keyword "SHARED VARIABLE "))))
10299     (when (vhdl-template-field "names" nil t start (point))
10300       (insert " : ")
10301       (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10302       (vhdl-template-field "type")
10303       (if in-arglist
10304           (progn (insert ";")
10305                  (vhdl-comment-insert-inline))
10306         (let ((position (point)))
10307           (insert " := ")
10308           (unless (vhdl-template-field "[initialization]" nil t)
10309             (delete-region position (point)))
10310           (insert ";")
10311           (vhdl-comment-insert-inline))))))
10312
10313 (defun vhdl-template-wait ()
10314   "Insert a wait statement."
10315   (interactive)
10316   (vhdl-insert-keyword "WAIT ")
10317   (unless (vhdl-template-field
10318            "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
10319            nil t)
10320     (delete-char -1))
10321   (insert ";"))
10322
10323 (defun vhdl-template-when ()
10324   "Indent correctly if within a case statement."
10325   (interactive)
10326   (let ((position (point))
10327         margin)
10328     (vhdl-prepare-search-2
10329      (if (and (= (current-column) (current-indentation))
10330               (vhdl-re-search-forward "\\<end\\>" nil t)
10331               (looking-at "\\s-*\\<case\\>"))
10332          (progn
10333            (setq margin (current-indentation))
10334            (goto-char position)
10335            (delete-horizontal-space)
10336            (indent-to (+ margin vhdl-basic-offset)))
10337        (goto-char position)))
10338     (vhdl-insert-keyword "WHEN ")))
10339
10340 (defun vhdl-template-while-loop ()
10341   "Insert a while loop."
10342   (interactive)
10343   (let* ((margin (current-indentation))
10344          (start (point))
10345          label)
10346     (if (not (eq vhdl-optional-labels 'all))
10347         (vhdl-insert-keyword "WHILE ")
10348       (vhdl-insert-keyword ": WHILE ")
10349       (goto-char start)
10350       (setq label (vhdl-template-field "[label]" nil t))
10351       (unless label (delete-char 2))
10352       (forward-word 1)
10353       (forward-char 1))
10354     (when vhdl-conditions-in-parenthesis (insert "("))
10355     (when (vhdl-template-field "condition" nil t start (point))
10356       (when vhdl-conditions-in-parenthesis (insert ")"))
10357       (vhdl-insert-keyword " LOOP\n\n")
10358       (indent-to margin)
10359       (vhdl-insert-keyword "END LOOP")
10360       (insert (if label (concat " " label ";") ";"))
10361       (forward-line -1)
10362       (indent-to (+ margin vhdl-basic-offset)))))
10363
10364 (defun vhdl-template-with ()
10365   "Insert a with statement (i.e. selected signal assignment)."
10366   (interactive)
10367   (vhdl-prepare-search-1
10368    (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
10369             (equal ";" (match-string 1)))
10370        (vhdl-template-selected-signal-asst)
10371      (vhdl-insert-keyword "WITH "))))
10372
10373 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10374 ;; Special templates
10375
10376 (defun vhdl-template-clocked-wait ()
10377   "Insert a wait statement for rising/falling clock edge."
10378   (interactive)
10379   (let ((start (point))
10380         clock)
10381     (vhdl-insert-keyword "WAIT UNTIL ")
10382     (when (setq clock
10383                 (or (and (not (equal "" vhdl-clock-name))
10384                          (progn (insert vhdl-clock-name) vhdl-clock-name))
10385                     (vhdl-template-field "clock name" nil t start (point))))
10386       (insert "'event")
10387       (vhdl-insert-keyword " AND ")
10388       (insert clock)
10389       (insert
10390        " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";")
10391       (vhdl-comment-insert-inline
10392        (concat (if vhdl-clock-rising-edge "rising" "falling")
10393                " clock edge")))))
10394
10395 (defun vhdl-template-seq-process (clock reset reset-kind)
10396   "Insert a template for the body of a sequential process."
10397   (let ((margin (current-indentation))
10398         position)
10399     (vhdl-insert-keyword "IF ")
10400     (when vhdl-conditions-in-parenthesis (insert "("))
10401     (when (eq reset-kind 'async)
10402       (insert reset " = "
10403               (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10404       (when vhdl-conditions-in-parenthesis (insert ")"))
10405       (vhdl-insert-keyword " THEN")
10406       (vhdl-comment-insert-inline
10407        (concat "asynchronous reset (active "
10408                (if vhdl-reset-active-high "high" "low") ")"))
10409       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10410       (setq position (point))
10411       (insert "\n") (indent-to margin)
10412       (vhdl-insert-keyword "ELSIF ")
10413       (when vhdl-conditions-in-parenthesis (insert "(")))
10414     (if (eq vhdl-clock-edge-condition 'function)
10415         (insert (if vhdl-clock-rising-edge "rising" "falling")
10416                 "_edge(" clock ")")
10417       (insert clock "'event")
10418       (vhdl-insert-keyword " AND ")
10419       (insert clock " = "
10420               (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
10421     (when vhdl-conditions-in-parenthesis (insert ")"))
10422     (vhdl-insert-keyword " THEN")
10423     (vhdl-comment-insert-inline
10424      (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
10425     (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10426     (when (eq reset-kind 'sync)
10427       (vhdl-insert-keyword "IF ")
10428       (when vhdl-conditions-in-parenthesis (insert "("))
10429       (setq reset (or (and (not (equal "" vhdl-reset-name))
10430                            (progn (insert vhdl-reset-name) vhdl-reset-name))
10431                       (vhdl-template-field "reset name") "<reset>"))
10432       (insert " = "
10433               (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10434       (when vhdl-conditions-in-parenthesis (insert ")"))
10435       (vhdl-insert-keyword " THEN")
10436       (vhdl-comment-insert-inline
10437        (concat "synchronous reset (active "
10438                (if vhdl-reset-active-high "high" "low") ")"))
10439       (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10440       (setq position (point))
10441       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10442       (vhdl-insert-keyword "ELSE")
10443       (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10444       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10445       (vhdl-insert-keyword "END IF;"))
10446     (when (eq reset-kind 'none)
10447       (setq position (point)))
10448     (insert "\n") (indent-to margin)
10449     (vhdl-insert-keyword "END IF;")
10450     (goto-char position)
10451     reset))
10452
10453 (defun vhdl-template-standard-package (library package)
10454   "Insert specification of a standard package.  Include a library
10455 specification, if not already there."
10456   (let ((margin (current-indentation)))
10457     (unless (equal library "std")
10458       (unless (or (save-excursion
10459                     (vhdl-prepare-search-1
10460                      (and (not (bobp))
10461                           (re-search-backward
10462                            (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
10463                                    library "\\|end\\)\\>") nil t)
10464                           (match-string 2))))
10465                   (equal (downcase library) "work"))
10466         (vhdl-insert-keyword "LIBRARY ")
10467         (insert library ";")
10468         (when package
10469           (insert "\n")
10470           (indent-to margin))))
10471     (when package
10472       (vhdl-insert-keyword "USE ")
10473       (insert library "." package)
10474       (vhdl-insert-keyword ".ALL;"))))
10475
10476 (defun vhdl-template-package-numeric-bit ()
10477   "Insert specification of `numeric_bit' package."
10478   (interactive)
10479   (vhdl-template-standard-package "ieee" "numeric_bit"))
10480
10481 (defun vhdl-template-package-numeric-std ()
10482   "Insert specification of `numeric_std' package."
10483   (interactive)
10484   (vhdl-template-standard-package "ieee" "numeric_std"))
10485
10486 (defun vhdl-template-package-std-logic-1164 ()
10487   "Insert specification of `std_logic_1164' package."
10488   (interactive)
10489   (vhdl-template-standard-package "ieee" "std_logic_1164"))
10490
10491 (defun vhdl-template-package-std-logic-arith ()
10492   "Insert specification of `std_logic_arith' package."
10493   (interactive)
10494   (vhdl-template-standard-package "ieee" "std_logic_arith"))
10495
10496 (defun vhdl-template-package-std-logic-misc ()
10497   "Insert specification of `std_logic_misc' package."
10498   (interactive)
10499   (vhdl-template-standard-package "ieee" "std_logic_misc"))
10500
10501 (defun vhdl-template-package-std-logic-signed ()
10502   "Insert specification of `std_logic_signed' package."
10503   (interactive)
10504   (vhdl-template-standard-package "ieee" "std_logic_signed"))
10505
10506 (defun vhdl-template-package-std-logic-textio ()
10507   "Insert specification of `std_logic_textio' package."
10508   (interactive)
10509   (vhdl-template-standard-package "ieee" "std_logic_textio"))
10510
10511 (defun vhdl-template-package-std-logic-unsigned ()
10512   "Insert specification of `std_logic_unsigned' package."
10513   (interactive)
10514   (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
10515
10516 (defun vhdl-template-package-textio ()
10517   "Insert specification of `textio' package."
10518   (interactive)
10519   (vhdl-template-standard-package "std" "textio"))
10520
10521 (defun vhdl-template-package-fundamental-constants ()
10522   "Insert specification of `fundamental_constants' package."
10523   (interactive)
10524   (vhdl-template-standard-package "ieee" "fundamental_constants"))
10525
10526 (defun vhdl-template-package-material-constants ()
10527   "Insert specification of `material_constants' package."
10528   (interactive)
10529   (vhdl-template-standard-package "ieee" "material_constants"))
10530
10531 (defun vhdl-template-package-energy-systems ()
10532   "Insert specification of `energy_systems' package."
10533   (interactive)
10534   (vhdl-template-standard-package "ieee" "energy_systems"))
10535
10536 (defun vhdl-template-package-electrical-systems ()
10537   "Insert specification of `electrical_systems' package."
10538   (interactive)
10539   (vhdl-template-standard-package "ieee" "electrical_systems"))
10540
10541 (defun vhdl-template-package-mechanical-systems ()
10542   "Insert specification of `mechanical_systems' package."
10543   (interactive)
10544   (vhdl-template-standard-package "ieee" "mechanical_systems"))
10545
10546 (defun vhdl-template-package-radiant-systems ()
10547   "Insert specification of `radiant_systems' package."
10548   (interactive)
10549   (vhdl-template-standard-package "ieee" "radiant_systems"))
10550
10551 (defun vhdl-template-package-thermal-systems ()
10552   "Insert specification of `thermal_systems' package."
10553   (interactive)
10554   (vhdl-template-standard-package "ieee" "thermal_systems"))
10555
10556 (defun vhdl-template-package-fluidic-systems ()
10557   "Insert specification of `fluidic_systems' package."
10558   (interactive)
10559   (vhdl-template-standard-package "ieee" "fluidic_systems"))
10560
10561 (defun vhdl-template-package-math-complex ()
10562   "Insert specification of `math_complex' package."
10563   (interactive)
10564   (vhdl-template-standard-package "ieee" "math_complex"))
10565
10566 (defun vhdl-template-package-math-real ()
10567   "Insert specification of `math_real' package."
10568   (interactive)
10569   (vhdl-template-standard-package "ieee" "math_real"))
10570
10571 (defun vhdl-template-directive (directive)
10572   "Insert directive."
10573   (unless (= (current-indentation) (current-column))
10574     (delete-horizontal-space)
10575     (insert "  "))
10576   (insert "-- pragma " directive))
10577
10578 (defun vhdl-template-directive-translate-on ()
10579   "Insert directive 'translate_on'."
10580   (interactive)
10581   (vhdl-template-directive "translate_on"))
10582
10583 (defun vhdl-template-directive-translate-off ()
10584   "Insert directive 'translate_off'."
10585   (interactive)
10586   (vhdl-template-directive "translate_off"))
10587
10588 (defun vhdl-template-directive-synthesis-on ()
10589   "Insert directive 'synthesis_on'."
10590   (interactive)
10591   (vhdl-template-directive "synthesis_on"))
10592
10593 (defun vhdl-template-directive-synthesis-off ()
10594   "Insert directive 'synthesis_off'."
10595   (interactive)
10596   (vhdl-template-directive "synthesis_off"))
10597
10598 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10599 ;; Header and footer templates
10600
10601 (defun vhdl-template-header (&optional file-title)
10602   "Insert a VHDL file header."
10603   (interactive)
10604   (unless (equal vhdl-file-header "")
10605     (let (pos)
10606       (save-excursion
10607         (goto-char (point-min))
10608         (vhdl-insert-string-or-file vhdl-file-header)
10609         (setq pos (point-marker)))
10610       (vhdl-template-replace-header-keywords
10611        (point-min-marker) pos file-title))))
10612
10613 (defun vhdl-template-footer ()
10614   "Insert a VHDL file footer."
10615   (interactive)
10616   (unless (equal vhdl-file-footer "")
10617     (let (pos)
10618       (save-excursion
10619         (goto-char (point-max))
10620         (setq pos (point-marker))
10621         (vhdl-insert-string-or-file vhdl-file-footer)
10622         (unless (= (preceding-char) ?\n)
10623           (insert "\n")))
10624       (vhdl-template-replace-header-keywords pos (point-max-marker)))))
10625
10626 (defun vhdl-template-replace-header-keywords (beg end &optional file-title
10627                                                   is-model)
10628   "Replace keywords in header and footer."
10629   (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
10630                            ""))
10631         (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
10632                           ""))
10633         pos)
10634     (vhdl-prepare-search-2
10635      (save-excursion
10636        (goto-char beg)
10637        (while (search-forward "<projectdesc>" end t)
10638          (replace-match project-desc t t))
10639        (goto-char beg)
10640        (while (search-forward "<filename>" end t)
10641          (replace-match (buffer-name) t t))
10642        (goto-char beg)
10643        (while (search-forward "<copyright>" end t)
10644          (replace-match vhdl-copyright-string t t))
10645        (goto-char beg)
10646        (while (search-forward "<author>" end t)
10647          (replace-match "" t t)
10648          (insert (user-full-name))
10649          (when user-mail-address (insert "  <" user-mail-address ">")))
10650        (goto-char beg)
10651        (while (search-forward "<authorfull>" end t)
10652          (replace-match (user-full-name) t t))
10653        (goto-char beg)
10654        (while (search-forward "<login>" end t)
10655          (replace-match (user-login-name) t t))
10656        (goto-char beg)
10657        (while (search-forward "<project>" end t)
10658          (replace-match project-title t t))
10659        (goto-char beg)
10660        (while (search-forward "<company>" end t)
10661          (replace-match vhdl-company-name t t))
10662        (goto-char beg)
10663        (while (search-forward "<platform>" end t)
10664          (replace-match vhdl-platform-spec t t))
10665        (goto-char beg)
10666        (while (search-forward "<standard>" end t)
10667          (replace-match
10668           (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
10669                                ((vhdl-standard-p '93) "'93/02")
10670                                ((vhdl-standard-p '08) "'08"))
10671                   (when (vhdl-standard-p 'ams) ", VHDL-AMS")
10672                   (when (vhdl-standard-p 'math) ", Math Packages")) t t))
10673        (goto-char beg)
10674        ;; Replace <RCS> with $, so that RCS for the source is
10675        ;; not over-enthusiastic with replacements
10676        (while (search-forward "<RCS>" end t)
10677          (replace-match "$" nil t))
10678        (goto-char beg)
10679        (while (search-forward "<date>" end t)
10680          (replace-match "" t t)
10681          (vhdl-template-insert-date))
10682        (goto-char beg)
10683        (while (search-forward "<year>" end t)
10684          (replace-match (format-time-string "%Y" nil) t t))
10685        (goto-char beg)
10686        (when file-title
10687          (while (search-forward "<title string>" end t)
10688            (replace-match file-title t t))
10689          (goto-char beg))
10690        (let (string)
10691          (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
10692            (save-match-data
10693              (setq string (read-string (concat (match-string 1) ": "))))
10694            (replace-match string t t)))
10695        (goto-char beg)
10696        (when (and (not is-model) (search-forward "<cursor>" end t))
10697          (replace-match "" t t)
10698          (setq pos (point))))
10699      (when pos (goto-char pos))
10700      (unless is-model
10701        (when (or (not project-title) (equal project-title ""))
10702          (message "You can specify a project title in user option `vhdl-project-alist'"))
10703        (when (or (not project-desc) (equal project-desc ""))
10704          (message "You can specify a project description in user option `vhdl-project-alist'"))
10705        (when (equal vhdl-platform-spec "")
10706          (message "You can specify a platform in user option `vhdl-platform-spec'"))
10707        (when (equal vhdl-company-name "")
10708          (message "You can specify a company name in user option `vhdl-company-name'"))))))
10709
10710 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10711 ;; Comment templates and functions
10712
10713 (defun vhdl-comment-indent ()
10714   "Indent comments."
10715   (let* ((position (point))
10716          (col
10717           (progn
10718             (forward-line -1)
10719             (if (re-search-forward "--" position t)
10720                 (- (current-column) 2)  ; existing comment at bol stays there
10721               (goto-char position)
10722               (skip-chars-backward " \t")
10723               (max comment-column       ; else indent to comment column
10724                    (1+ (current-column))))))) ; except leave at least one space
10725     (goto-char position)
10726     col))
10727
10728 (defun vhdl-comment-insert ()
10729   "Start a comment at the end of the line.
10730 If on line with code, indent at least `comment-column'.
10731 If starting after end-comment-column, start a new line."
10732   (interactive)
10733   (when (> (current-column) end-comment-column) (newline-and-indent))
10734   (if (or (looking-at "\\s-*$") ; end of line
10735           (and (not unread-command-events) ; called with key binding or menu
10736                (not (end-of-line))))
10737       (let (margin)
10738         (while (= (preceding-char) ?-) (delete-char -1))
10739         (setq margin (current-column))
10740         (delete-horizontal-space)
10741         (if (bolp)
10742             (progn (indent-to margin) (insert "--"))
10743           (insert "  ")
10744           (indent-to comment-column)
10745           (insert "--"))
10746         (if (not unread-command-events) (insert " ")))
10747     ;; else code following current point implies commenting out code
10748     (let (next-input code)
10749       (while (= (preceding-char) ?-) (delete-char -2))
10750       (while (= (setq next-input (read-char)) 13) ; CR
10751         (insert "--") ; or have a space after it?
10752         (forward-char -2)
10753         (forward-line 1)
10754         (message "Enter CR if commenting out a line of code.")
10755         (setq code t))
10756       (unless code
10757         (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
10758       (setq unread-command-events
10759             (list (vhdl-character-to-event next-input)))))) ; pushback the char
10760
10761 (defun vhdl-comment-display (&optional line-exists)
10762   "Add 2 comment lines at the current indent, making a display comment."
10763   (interactive)
10764   (let ((margin (current-indentation)))
10765     (unless line-exists (vhdl-comment-display-line))
10766     (insert "\n") (indent-to margin)
10767     (insert "\n") (indent-to margin)
10768     (vhdl-comment-display-line)
10769     (end-of-line -0)
10770     (insert "-- ")))
10771
10772 (defun vhdl-comment-display-line ()
10773   "Displays one line of dashes."
10774   (interactive)
10775   (while (= (preceding-char) ?-) (delete-char -2))
10776   (insert "--")
10777   (let* ((col (current-column))
10778          (len (- end-comment-column col)))
10779     (insert-char vhdl-comment-display-line-char len)))
10780
10781 (defun vhdl-comment-append-inline ()
10782   "Append empty inline comment to current line."
10783   (interactive)
10784   (end-of-line)
10785   (delete-horizontal-space)
10786   (insert "  ")
10787   (indent-to comment-column)
10788   (insert "-- "))
10789
10790 (defun vhdl-comment-insert-inline (&optional string always-insert)
10791   "Insert inline comment."
10792   (when (or (and string (or vhdl-self-insert-comments always-insert))
10793             (and (not string) vhdl-prompt-for-comments))
10794     (let ((position (point)))
10795       (insert "  ")
10796       (indent-to comment-column)
10797       (insert "-- ")
10798       (if (not (or (and string (progn (insert string) t))
10799                    (vhdl-template-field "[comment]" nil t)))
10800           (delete-region position (point))
10801         (while (= (preceding-char) ?\ ) (delete-char -1))))))
10802
10803 (defun vhdl-comment-block ()
10804   "Insert comment for code block."
10805   (when vhdl-prompt-for-comments
10806     (let ((final-pos (point-marker)))
10807       (vhdl-prepare-search-2
10808        (when (and (re-search-backward "^\\s-*begin\\>" nil t)
10809                   (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
10810          (let (margin)
10811            (back-to-indentation)
10812            (setq margin (current-column))
10813            (end-of-line -0)
10814            (if (bobp)
10815                (progn (insert "\n") (forward-line -1))
10816              (insert "\n"))
10817            (indent-to margin)
10818            (insert "-- purpose: ")
10819            (unless (vhdl-template-field "[description]" nil t)
10820              (vhdl-line-kill-entire)))))
10821       (goto-char final-pos))))
10822
10823 (defun vhdl-comment-uncomment-region (beg end &optional arg)
10824   "Comment out region if not commented out, uncomment otherwise."
10825   (interactive "r\nP")
10826   (save-excursion
10827     (goto-char (1- end))
10828     (end-of-line)
10829     (setq end (point-marker))
10830     (goto-char beg)
10831     (beginning-of-line)
10832     (setq beg (point))
10833     (if (looking-at (concat "\\s-*" comment-start))
10834         (comment-region beg end '(4))
10835       (comment-region beg end))))
10836
10837 (defun vhdl-comment-uncomment-line (&optional arg)
10838   "Comment out line if not commented out, uncomment otherwise."
10839   (interactive "p")
10840   (save-excursion
10841     (beginning-of-line)
10842     (let ((position (point)))
10843       (forward-line (or arg 1))
10844       (vhdl-comment-uncomment-region position (point)))))
10845
10846 (defun vhdl-comment-kill-region (beg end)
10847   "Kill comments in region."
10848   (interactive "r")
10849   (save-excursion
10850     (goto-char end)
10851     (setq end (point-marker))
10852     (goto-char beg)
10853     (beginning-of-line)
10854     (while (< (point) end)
10855       (if (looking-at "^\\(\\s-*--.*\n\\)")
10856           (progn (delete-region (match-beginning 1) (match-end 1)))
10857         (beginning-of-line 2)))))
10858
10859 (defun vhdl-comment-kill-inline-region (beg end)
10860   "Kill inline comments in region."
10861   (interactive "r")
10862   (save-excursion
10863     (goto-char end)
10864     (setq end (point-marker))
10865     (goto-char beg)
10866     (beginning-of-line)
10867     (while (< (point) end)
10868       (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
10869         (delete-region (match-beginning 1) (match-end 1)))
10870       (beginning-of-line 2))))
10871
10872 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10873 ;; Subtemplates
10874
10875 (defun vhdl-template-begin-end (construct name margin &optional empty-lines)
10876   "Insert a begin ... end pair with optional name after the end.
10877 Point is left between them."
10878   (let (position)
10879     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10880     (indent-to margin)
10881     (vhdl-insert-keyword "BEGIN")
10882     (when (and (or construct name) vhdl-self-insert-comments)
10883       (insert "  --")
10884       (when construct (insert " ") (vhdl-insert-keyword construct))
10885       (when name (insert " " name)))
10886     (insert "\n")
10887     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10888     (indent-to (+ margin vhdl-basic-offset))
10889     (setq position (point))
10890     (insert "\n")
10891     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10892     (indent-to margin)
10893     (vhdl-insert-keyword "END")
10894     (when construct (insert " ") (vhdl-insert-keyword construct))
10895     (insert (if name (concat " " name) "") ";")
10896     (goto-char position)))
10897
10898 (defun vhdl-template-argument-list (&optional is-function)
10899   "Read from user a procedure or function argument list."
10900   (insert " (")
10901   (let ((margin (current-column))
10902         (start (point))
10903         (end-pos (point))
10904         not-empty interface semicolon-pos)
10905     (unless vhdl-argument-list-indent
10906       (setq margin (+ (current-indentation) vhdl-basic-offset))
10907       (insert "\n")
10908       (indent-to margin))
10909     (setq interface (vhdl-template-field
10910                      (concat "[CONSTANT | SIGNAL"
10911                              (unless is-function " | VARIABLE") "]") " " t))
10912     (while (vhdl-template-field "[names]" nil t)
10913       (setq not-empty t)
10914       (insert " : ")
10915       (unless is-function
10916         (if (and interface (equal (upcase interface) "CONSTANT"))
10917             (vhdl-insert-keyword "IN ")
10918           (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
10919       (vhdl-template-field "type")
10920       (setq semicolon-pos (point))
10921       (insert ";")
10922       (vhdl-comment-insert-inline)
10923       (setq end-pos (point))
10924       (insert "\n")
10925       (indent-to margin)
10926       (setq interface (vhdl-template-field
10927                        (concat "[CONSTANT | SIGNAL"
10928                                (unless is-function " | VARIABLE") "]") " " t)))
10929     (delete-region end-pos (point))
10930     (when semicolon-pos (goto-char semicolon-pos))
10931     (if not-empty
10932         (progn (delete-char 1) (insert ")"))
10933       (delete-char -2))))
10934
10935 (defun vhdl-template-generic-list (optional &optional no-value)
10936   "Read from user a generic spec argument list."
10937   (let (margin
10938         (start (point)))
10939     (vhdl-insert-keyword "GENERIC (")
10940     (setq margin (current-column))
10941     (unless vhdl-argument-list-indent
10942       (let ((position (point)))
10943         (back-to-indentation)
10944         (setq margin (+ (current-column) vhdl-basic-offset))
10945         (goto-char position)
10946         (insert "\n")
10947         (indent-to margin)))
10948     (let ((vhdl-generics (vhdl-template-field
10949                           (concat (and optional "[") "name"
10950                                   (and no-value "s") (and optional "]"))
10951                           nil optional)))
10952       (if (not vhdl-generics)
10953           (if optional
10954               (progn (vhdl-line-kill-entire) (end-of-line -0)
10955                      (unless vhdl-argument-list-indent
10956                        (vhdl-line-kill-entire) (end-of-line -0)))
10957             (vhdl-template-undo start (point))
10958             nil )
10959         (insert " : ")
10960         (let (semicolon-pos end-pos)
10961           (while vhdl-generics
10962             (vhdl-template-field "type")
10963             (if no-value
10964                 (progn (setq semicolon-pos (point))
10965                        (insert ";"))
10966               (insert " := ")
10967               (unless (vhdl-template-field "[value]" nil t)
10968                 (delete-char -4))
10969               (setq semicolon-pos (point))
10970               (insert ";"))
10971             (vhdl-comment-insert-inline)
10972             (setq end-pos (point))
10973             (insert "\n")
10974             (indent-to margin)
10975             (setq vhdl-generics (vhdl-template-field
10976                                  (concat "[name" (and no-value "s") "]")
10977                                  " : " t)))
10978           (delete-region end-pos (point))
10979           (goto-char semicolon-pos)
10980           (insert ")")
10981           (end-of-line)
10982           (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10983           t)))))
10984
10985 (defun vhdl-template-port-list (optional)
10986   "Read from user a port spec argument list."
10987   (let ((start (point))
10988         margin vhdl-ports object)
10989     (vhdl-insert-keyword "PORT (")
10990     (setq margin (current-column))
10991     (unless vhdl-argument-list-indent
10992       (let ((position (point)))
10993         (back-to-indentation)
10994         (setq margin (+ (current-column) vhdl-basic-offset))
10995         (goto-char position)
10996         (insert "\n")
10997         (indent-to margin)))
10998     (when (vhdl-standard-p 'ams)
10999       (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11000                                         " " t)))
11001     (setq vhdl-ports (vhdl-template-field
11002                       (concat (and optional "[") "names" (and optional "]"))
11003                       nil optional))
11004     (if (not vhdl-ports)
11005         (if optional
11006             (progn (vhdl-line-kill-entire) (end-of-line -0)
11007                    (unless vhdl-argument-list-indent
11008                      (vhdl-line-kill-entire) (end-of-line -0)))
11009           (vhdl-template-undo start (point))
11010           nil)
11011       (insert " : ")
11012       (let (semicolon-pos end-pos)
11013         (while vhdl-ports
11014           (cond ((or (null object) (equal "SIGNAL" (upcase object)))
11015                  (vhdl-template-field "IN | OUT | INOUT" " "))
11016                 ((equal "QUANTITY" (upcase object))
11017                  (vhdl-template-field "[IN | OUT]" " " t)))
11018           (vhdl-template-field
11019            (if (and object (equal "TERMINAL" (upcase object)))
11020                     "nature" "type"))
11021           (setq semicolon-pos (point))
11022           (insert ";")
11023           (vhdl-comment-insert-inline)
11024           (setq end-pos (point))
11025           (insert "\n")
11026           (indent-to margin)
11027           (when (vhdl-standard-p 'ams)
11028             (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11029                                               " " t)))
11030           (setq vhdl-ports (vhdl-template-field "[names]" " : " t)))
11031         (delete-region end-pos (point))
11032         (goto-char semicolon-pos)
11033         (insert ")")
11034         (end-of-line)
11035         (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
11036         t))))
11037
11038 (defun vhdl-template-generate-body (margin label)
11039   "Insert body for generate template."
11040   (vhdl-insert-keyword " GENERATE")
11041   (insert "\n\n")
11042   (indent-to margin)
11043   (vhdl-insert-keyword "END GENERATE ")
11044   (insert label ";")
11045   (end-of-line 0)
11046   (indent-to (+ margin vhdl-basic-offset)))
11047
11048 (defun vhdl-template-insert-date ()
11049   "Insert date in appropriate format."
11050   (interactive)
11051   (insert
11052    (cond
11053     ;; 'american, 'european, 'scientific kept for backward compatibility
11054     ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
11055     ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
11056     ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
11057     (t (format-time-string vhdl-date-format nil)))))
11058
11059 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11060 ;; Help functions
11061
11062 (defun vhdl-electric-space (count)
11063   "Expand abbreviations and self-insert space(s), do indent-new-comment-line
11064 if in comment and past end-comment-column."
11065   (interactive "p")
11066   (cond ((vhdl-in-comment-p)
11067          (self-insert-command count)
11068          (cond ((>= (current-column) (+ 2 end-comment-column))
11069                 (backward-char 1)
11070                 (skip-chars-backward "^ \t\n\r\f")
11071                 (indent-new-comment-line)
11072                 (skip-chars-forward "^ \t\n\r\f")
11073                 (forward-char 1))
11074                ((>= (current-column) end-comment-column)
11075                 (indent-new-comment-line))
11076                (t nil)))
11077         ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
11078              (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
11079          (vhdl-prepare-search-1
11080           (or (expand-abbrev) (vhdl-fix-case-word -1)))
11081          (self-insert-command count))
11082         (t (self-insert-command count))))
11083
11084 (defun vhdl-template-field (prompt &optional follow-string optional
11085                                    begin end is-string default)
11086   "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
11087 If OPTIONAL is nil, the prompt is left if an empty string is inserted.  If
11088 an empty string is inserted, return nil and call `vhdl-template-undo' for
11089 the region between BEGIN and END.  IS-STRING indicates whether a string
11090 with double-quotes is to be inserted.  DEFAULT specifies a default string."
11091   (let ((position (point))
11092         string)
11093     (insert "<" prompt ">")
11094     (setq string
11095           (condition-case ()
11096               (read-from-minibuffer (concat prompt ": ")
11097                                     (or (and is-string '("\"\"" . 2)) default)
11098                                     vhdl-minibuffer-local-map)
11099             (quit (if (and optional begin end)
11100                       (progn (beep) "")
11101                     (keyboard-quit)))))
11102     (when (or (not (equal string "")) optional)
11103       (delete-region position (point)))
11104     (when (and (equal string "") optional begin end)
11105       (vhdl-template-undo begin end)
11106       (message "Template aborted"))
11107     (unless (equal string "")
11108       (insert string)
11109       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
11110                               vhdl-keywords-regexp)
11111       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
11112                               vhdl-types-regexp)
11113       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
11114                               (concat "'" vhdl-attributes-regexp))
11115       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
11116                               vhdl-enum-values-regexp)
11117       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants
11118                               vhdl-constants-regexp))
11119     (when (or (not (equal string "")) (not optional))
11120       (insert (or follow-string "")))
11121     (if (equal string "") nil string)))
11122
11123 (defun vhdl-decision-query (string prompt &optional optional)
11124   "Query a decision from the user."
11125   (let ((start (point)))
11126     (when string (vhdl-insert-keyword (concat string " ")))
11127     (message "%s" (or prompt ""))
11128     (let ((char (read-char)))
11129       (delete-region start (point))
11130       (if (and optional (eq char ?\r))
11131           (progn (insert " ")
11132                  (unexpand-abbrev)
11133                  (throw 'abort "ERROR:  Template aborted"))
11134         char))))
11135
11136 (defun vhdl-insert-keyword (keyword)
11137   "Insert KEYWORD and adjust case."
11138   (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))))
11139
11140 (defun vhdl-case-keyword (keyword)
11141   "Adjust case of KEYWORD."
11142   (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
11143
11144 (defun vhdl-case-word (num)
11145   "Adjust case of following NUM words."
11146   (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
11147
11148 (defun vhdl-minibuffer-tab (&optional prefix-arg)
11149   "If preceding character is part of a word or a paren then hippie-expand,
11150 else insert tab (used for word completion in VHDL minibuffer)."
11151   (interactive "P")
11152   (cond
11153    ;; expand word
11154    ((= (char-syntax (preceding-char)) ?w)
11155     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11156           (case-replace nil)
11157           (hippie-expand-only-buffers
11158            (or (and (boundp 'hippie-expand-only-buffers)
11159                     hippie-expand-only-buffers)
11160                '(vhdl-mode))))
11161       (vhdl-expand-abbrev prefix-arg)))
11162    ;; expand parenthesis
11163    ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
11164     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11165           (case-replace nil))
11166       (vhdl-expand-paren prefix-arg)))
11167    ;; insert tab
11168    (t (insert-tab))))
11169
11170 (defun vhdl-template-search-prompt ()
11171   "Search for left out template prompts and query again."
11172   (interactive)
11173   (vhdl-prepare-search-2
11174    (when (or (re-search-forward
11175               (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
11176              (re-search-backward
11177               (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
11178      (let ((string (match-string 1)))
11179        (replace-match "")
11180        (vhdl-template-field string)))))
11181
11182 (defun vhdl-template-undo (begin end)
11183   "Undo aborted template by deleting region and unexpanding the keyword."
11184   (cond (vhdl-template-invoked-by-hook
11185          (goto-char end)
11186          (insert " ")
11187          (delete-region begin end)
11188          (unexpand-abbrev))
11189         (t (delete-region begin end))))
11190
11191 (defun vhdl-insert-string-or-file (string)
11192   "Insert STRING or file contents if STRING is an existing file name."
11193   (unless (equal string "")
11194     (let ((file-name
11195            (progn (string-match "^\\([^\n]+\\)" string)
11196                   (vhdl-resolve-env-variable (match-string 1 string)))))
11197       (if (file-exists-p file-name)
11198            (forward-char (cadr (insert-file-contents file-name)))
11199         (insert string)))))
11200
11201 (defun vhdl-beginning-of-block ()
11202   "Move cursor to the beginning of the enclosing block."
11203   (let (pos)
11204     (vhdl-prepare-search-2
11205      (save-excursion
11206        (beginning-of-line)
11207        ;; search backward for block beginning or end
11208        (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
11209                               ;; not consider subprogram declarations
11210                               (or (and (match-string 5)
11211                                        (save-match-data
11212                                          (save-excursion
11213                                            (goto-char (match-end 5))
11214                                            (forward-word 1)
11215                                            (vhdl-forward-syntactic-ws)
11216                                            (when (looking-at "(")
11217                                              (forward-sexp))
11218                                            (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11219                                          (match-string 1)))
11220                                   ;; not consider configuration specifications
11221                                   (and (match-string 6)
11222                                        (save-match-data
11223                                          (save-excursion
11224                                            (vhdl-end-of-block)
11225                                            (beginning-of-line)
11226                                            (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11227                   (match-string 2))
11228          ;; skip subblock if block end found
11229          (vhdl-beginning-of-block))))
11230     (when pos (goto-char pos))))
11231
11232 (defun vhdl-end-of-block ()
11233   "Move cursor to the end of the enclosing block."
11234   (let (pos)
11235     (vhdl-prepare-search-2
11236      (save-excursion
11237        (end-of-line)
11238        ;; search forward for block beginning or end
11239        (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t))
11240                               ;; not consider subprogram declarations
11241                               (or (and (match-string 5)
11242                                        (save-match-data
11243                                          (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11244                                          (match-string 1)))
11245                                   ;; not consider configuration specifications
11246                                   (and (match-string 6)
11247                                        (save-match-data
11248                                          (save-excursion
11249                                            (vhdl-end-of-block)
11250                                            (beginning-of-line)
11251                                            (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11252                   (not (match-string 2)))
11253          ;; skip subblock if block beginning found
11254          (vhdl-end-of-block))))
11255     (when pos (goto-char pos))))
11256
11257 (defun vhdl-sequential-statement-p ()
11258   "Check if point is within sequential statement part."
11259   (let ((start (point)))
11260     (save-excursion
11261       (vhdl-prepare-search-2
11262        ;; is sequential statement if ...
11263        (and (re-search-backward "^\\s-*begin\\>" nil t)
11264             ;; ... point is between "begin" and "end" of ...
11265             (progn (vhdl-end-of-block)
11266                    (< start (point)))
11267             ;; ... a sequential block
11268             (progn (vhdl-beginning-of-block)
11269                    (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
11270
11271 (defun vhdl-in-argument-list-p ()
11272   "Check if within an argument list."
11273   (save-excursion
11274     (vhdl-prepare-search-2
11275      (or (string-match "arglist"
11276                        (format "%s" (caar (vhdl-get-syntactic-context))))
11277          (progn (beginning-of-line)
11278                 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
11279
11280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11281 ;; Abbrev hooks
11282
11283 (defun vhdl-hooked-abbrev (func)
11284   "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
11285 but not if inside a comment or quote."
11286   (if (or (vhdl-in-literal)
11287           (save-excursion
11288             (forward-word -1)
11289             (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
11290       (progn
11291         (insert " ")
11292         (unexpand-abbrev)
11293         (backward-word 1)
11294         (vhdl-case-word 1)
11295         (delete-char 1))
11296     (if (not vhdl-electric-mode)
11297         (progn
11298           (insert " ")
11299           (unexpand-abbrev)
11300           (backward-word 1)
11301           (vhdl-case-word 1)
11302           (delete-char 1))
11303       (let ((invoke-char vhdl-last-input-event)
11304             (abbrev-mode -1)
11305             (vhdl-template-invoked-by-hook t))
11306         (let ((caught (catch 'abort
11307                         (funcall func))))
11308           (when (stringp caught) (message "%s" caught)))
11309         (when (= invoke-char ?-) (setq abbrev-start-location (point)))
11310         ;; delete CR which is still in event queue
11311         (if (fboundp 'enqueue-eval-event)
11312             (enqueue-eval-event 'delete-char -1)
11313           (setq unread-command-events   ; push back a delete char
11314                 (list (vhdl-character-to-event ?\177))))))))
11315
11316 (defun vhdl-template-alias-hook ()
11317   (vhdl-hooked-abbrev 'vhdl-template-alias))
11318 (defun vhdl-template-architecture-hook ()
11319   (vhdl-hooked-abbrev 'vhdl-template-architecture))
11320 (defun vhdl-template-assert-hook ()
11321   (vhdl-hooked-abbrev 'vhdl-template-assert))
11322 (defun vhdl-template-attribute-hook ()
11323   (vhdl-hooked-abbrev 'vhdl-template-attribute))
11324 (defun vhdl-template-block-hook ()
11325   (vhdl-hooked-abbrev 'vhdl-template-block))
11326 (defun vhdl-template-break-hook ()
11327   (vhdl-hooked-abbrev 'vhdl-template-break))
11328 (defun vhdl-template-case-hook ()
11329   (vhdl-hooked-abbrev 'vhdl-template-case))
11330 (defun vhdl-template-component-hook ()
11331   (vhdl-hooked-abbrev 'vhdl-template-component))
11332 (defun vhdl-template-instance-hook ()
11333   (vhdl-hooked-abbrev 'vhdl-template-instance))
11334 (defun vhdl-template-conditional-signal-asst-hook ()
11335   (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
11336 (defun vhdl-template-configuration-hook ()
11337   (vhdl-hooked-abbrev 'vhdl-template-configuration))
11338 (defun vhdl-template-constant-hook ()
11339   (vhdl-hooked-abbrev 'vhdl-template-constant))
11340 (defun vhdl-template-context-hook ()
11341   (vhdl-hooked-abbrev 'vhdl-template-context))
11342 (defun vhdl-template-disconnect-hook ()
11343   (vhdl-hooked-abbrev 'vhdl-template-disconnect))
11344 (defun vhdl-template-display-comment-hook ()
11345   (vhdl-hooked-abbrev 'vhdl-comment-display))
11346 (defun vhdl-template-else-hook ()
11347   (vhdl-hooked-abbrev 'vhdl-template-else))
11348 (defun vhdl-template-elsif-hook ()
11349   (vhdl-hooked-abbrev 'vhdl-template-elsif))
11350 (defun vhdl-template-entity-hook ()
11351   (vhdl-hooked-abbrev 'vhdl-template-entity))
11352 (defun vhdl-template-exit-hook ()
11353   (vhdl-hooked-abbrev 'vhdl-template-exit))
11354 (defun vhdl-template-file-hook ()
11355   (vhdl-hooked-abbrev 'vhdl-template-file))
11356 (defun vhdl-template-for-hook ()
11357   (vhdl-hooked-abbrev 'vhdl-template-for))
11358 (defun vhdl-template-function-hook ()
11359   (vhdl-hooked-abbrev 'vhdl-template-function))
11360 (defun vhdl-template-generic-hook ()
11361   (vhdl-hooked-abbrev 'vhdl-template-generic))
11362 (defun vhdl-template-group-hook ()
11363   (vhdl-hooked-abbrev 'vhdl-template-group))
11364 (defun vhdl-template-library-hook ()
11365   (vhdl-hooked-abbrev 'vhdl-template-library))
11366 (defun vhdl-template-limit-hook ()
11367   (vhdl-hooked-abbrev 'vhdl-template-limit))
11368 (defun vhdl-template-if-hook ()
11369   (vhdl-hooked-abbrev 'vhdl-template-if))
11370 (defun vhdl-template-bare-loop-hook ()
11371   (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
11372 (defun vhdl-template-map-hook ()
11373   (vhdl-hooked-abbrev 'vhdl-template-map))
11374 (defun vhdl-template-nature-hook ()
11375   (vhdl-hooked-abbrev 'vhdl-template-nature))
11376 (defun vhdl-template-next-hook ()
11377   (vhdl-hooked-abbrev 'vhdl-template-next))
11378 (defun vhdl-template-others-hook ()
11379   (vhdl-hooked-abbrev 'vhdl-template-others))
11380 (defun vhdl-template-package-hook ()
11381   (vhdl-hooked-abbrev 'vhdl-template-package))
11382 (defun vhdl-template-port-hook ()
11383   (vhdl-hooked-abbrev 'vhdl-template-port))
11384 (defun vhdl-template-procedural-hook ()
11385   (vhdl-hooked-abbrev 'vhdl-template-procedural))
11386 (defun vhdl-template-procedure-hook ()
11387   (vhdl-hooked-abbrev 'vhdl-template-procedure))
11388 (defun vhdl-template-process-hook ()
11389   (vhdl-hooked-abbrev 'vhdl-template-process))
11390 (defun vhdl-template-quantity-hook ()
11391   (vhdl-hooked-abbrev 'vhdl-template-quantity))
11392 (defun vhdl-template-report-hook ()
11393   (vhdl-hooked-abbrev 'vhdl-template-report))
11394 (defun vhdl-template-return-hook ()
11395   (vhdl-hooked-abbrev 'vhdl-template-return))
11396 (defun vhdl-template-selected-signal-asst-hook ()
11397   (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
11398 (defun vhdl-template-signal-hook ()
11399   (vhdl-hooked-abbrev 'vhdl-template-signal))
11400 (defun vhdl-template-subnature-hook ()
11401   (vhdl-hooked-abbrev 'vhdl-template-subnature))
11402 (defun vhdl-template-subtype-hook ()
11403   (vhdl-hooked-abbrev 'vhdl-template-subtype))
11404 (defun vhdl-template-terminal-hook ()
11405   (vhdl-hooked-abbrev 'vhdl-template-terminal))
11406 (defun vhdl-template-type-hook ()
11407   (vhdl-hooked-abbrev 'vhdl-template-type))
11408 (defun vhdl-template-use-hook ()
11409   (vhdl-hooked-abbrev 'vhdl-template-use))
11410 (defun vhdl-template-variable-hook ()
11411   (vhdl-hooked-abbrev 'vhdl-template-variable))
11412 (defun vhdl-template-wait-hook ()
11413   (vhdl-hooked-abbrev 'vhdl-template-wait))
11414 (defun vhdl-template-when-hook ()
11415   (vhdl-hooked-abbrev 'vhdl-template-when))
11416 (defun vhdl-template-while-loop-hook ()
11417   (vhdl-hooked-abbrev 'vhdl-template-while-loop))
11418 (defun vhdl-template-with-hook ()
11419   (vhdl-hooked-abbrev 'vhdl-template-with))
11420 (defun vhdl-template-and-hook ()
11421   (vhdl-hooked-abbrev 'vhdl-template-and))
11422 (defun vhdl-template-or-hook ()
11423   (vhdl-hooked-abbrev 'vhdl-template-or))
11424 (defun vhdl-template-nand-hook ()
11425   (vhdl-hooked-abbrev 'vhdl-template-nand))
11426 (defun vhdl-template-nor-hook ()
11427   (vhdl-hooked-abbrev 'vhdl-template-nor))
11428 (defun vhdl-template-xor-hook ()
11429   (vhdl-hooked-abbrev 'vhdl-template-xor))
11430 (defun vhdl-template-xnor-hook ()
11431   (vhdl-hooked-abbrev 'vhdl-template-xnor))
11432 (defun vhdl-template-not-hook ()
11433   (vhdl-hooked-abbrev 'vhdl-template-not))
11434
11435 (defun vhdl-template-default-hook ()
11436   (vhdl-hooked-abbrev 'vhdl-template-default))
11437 (defun vhdl-template-default-indent-hook ()
11438   (vhdl-hooked-abbrev 'vhdl-template-default-indent))
11439
11440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11441 ;; Template insertion from completion list
11442
11443 (defun vhdl-template-insert-construct (name)
11444   "Insert the built-in construct template with NAME."
11445   (interactive
11446    (list (let ((completion-ignore-case t))
11447            (completing-read "Construct name: "
11448                             vhdl-template-construct-alist nil t))))
11449   (vhdl-template-insert-fun
11450    (cadr (assoc name vhdl-template-construct-alist))))
11451
11452 (defun vhdl-template-insert-package (name)
11453   "Insert the built-in package template with NAME."
11454   (interactive
11455    (list (let ((completion-ignore-case t))
11456            (completing-read "Package name: "
11457                             vhdl-template-package-alist nil t))))
11458   (vhdl-template-insert-fun
11459    (cadr (assoc name vhdl-template-package-alist))))
11460
11461 (defun vhdl-template-insert-directive (name)
11462   "Insert the built-in directive template with NAME."
11463   (interactive
11464    (list (let ((completion-ignore-case t))
11465            (completing-read "Directive name: "
11466                             vhdl-template-directive-alist nil t))))
11467   (vhdl-template-insert-fun
11468    (cadr (assoc name vhdl-template-directive-alist))))
11469
11470 (defun vhdl-template-insert-fun (fun)
11471   "Call FUN to insert a built-in template."
11472   (let ((caught (catch 'abort (when fun (funcall fun)))))
11473     (when (stringp caught) (message "%s" caught))))
11474
11475
11476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11477 ;;; Models
11478 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11479
11480 (defun vhdl-model-insert (model-name)
11481   "Insert the user model with name MODEL-NAME."
11482   (interactive
11483    (let ((completion-ignore-case t))
11484      (list (completing-read "Model name: " vhdl-model-alist))))
11485   (indent-according-to-mode)
11486   (let ((start (point-marker))
11487         (margin (current-indentation))
11488         model position prompt string end)
11489     (vhdl-prepare-search-2
11490      (when (setq model (assoc model-name vhdl-model-alist))
11491        ;; insert model
11492        (beginning-of-line)
11493        (delete-horizontal-space)
11494        (goto-char start)
11495        (vhdl-insert-string-or-file (nth 1 model))
11496        (setq end (point-marker))
11497        ;; indent code
11498        (goto-char start)
11499        (beginning-of-line)
11500        (while (< (point) end)
11501          (unless (looking-at "^$")
11502            (insert-char ?  margin))
11503          (beginning-of-line 2))
11504        (goto-char start)
11505        ;; insert clock
11506        (unless (equal "" vhdl-clock-name)
11507          (while (re-search-forward "<clock>" end t)
11508            (replace-match vhdl-clock-name)))
11509        (goto-char start)
11510        ;; insert reset
11511        (unless (equal "" vhdl-reset-name)
11512          (while (re-search-forward "<reset>" end t)
11513            (replace-match vhdl-reset-name)))
11514        ;; replace header prompts
11515        (vhdl-template-replace-header-keywords start end nil t)
11516        (goto-char start)
11517        ;; query other prompts
11518        (while (re-search-forward
11519                (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
11520          (unless (equal "cursor" (match-string 1))
11521            (setq position (match-beginning 1))
11522            (setq prompt (match-string 1))
11523            (replace-match "")
11524            (setq string (vhdl-template-field prompt nil t))
11525            ;; replace occurrences of same prompt
11526            (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
11527              (replace-match (or string "")))
11528            (goto-char position)))
11529        (goto-char start)
11530        ;; goto final position
11531        (if (re-search-forward "<cursor>" end t)
11532            (replace-match "")
11533          (goto-char end))))))
11534
11535 (defun vhdl-model-defun ()
11536   "Define help and hook functions for user models."
11537   (let ((model-alist vhdl-model-alist)
11538         model-name model-keyword)
11539     (while model-alist
11540       ;; define functions for user models that can be invoked from menu and key
11541       ;; bindings and which themselves call `vhdl-model-insert' with the model
11542       ;; name as argument
11543       (setq model-name (nth 0 (car model-alist)))
11544       (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
11545                ,(concat "Insert model for \"" model-name "\".")
11546                (interactive)
11547                (vhdl-model-insert ,model-name)))
11548       ;; define hooks for user models that are invoked from keyword abbrevs
11549       (setq model-keyword (nth 3 (car model-alist)))
11550       (unless (equal model-keyword "")
11551         (eval `(defun
11552                  ,(vhdl-function-name
11553                    "vhdl-model" model-name "hook") ()
11554                  (vhdl-hooked-abbrev
11555                   ',(vhdl-function-name "vhdl-model" model-name)))))
11556       (setq model-alist (cdr model-alist)))))
11557
11558 (vhdl-model-defun)
11559
11560
11561 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11562 ;;; Port translation
11563 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11564
11565 (defvar vhdl-port-list nil
11566   "Variable to hold last port map parsed.")
11567 ;; structure: (parenthesized expression means list of such entries)
11568 ;; (ent-name
11569 ;;  ((generic-names) generic-type generic-init generic-comment group-comment)
11570 ;;  ((port-names) port-object port-direct port-type port-comment group-comment)
11571 ;;  (lib-name pack-key))
11572
11573 (defun vhdl-parse-string (string &optional optional)
11574   "Check that the text following point matches the regexp in STRING."
11575   (if (looking-at string)
11576       (progn (goto-char (match-end 0))
11577              (when (vhdl-in-literal)
11578                (end-of-line))
11579              (point))
11580     (unless optional
11581       (throw 'parse (format "ERROR:  Syntax error near line %s, expecting \"%s\""
11582                             (vhdl-current-line) string)))
11583     nil))
11584
11585 (defun vhdl-replace-string (regexp-cons string &optional adjust-case)
11586   "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
11587   (vhdl-prepare-search-1
11588    (if (string-match (car regexp-cons) string)
11589        (if adjust-case
11590            (funcall vhdl-file-name-case
11591                     (replace-match (cdr regexp-cons) t nil string))
11592          (replace-match (cdr regexp-cons) t nil string))
11593      string)))
11594
11595 (defun vhdl-parse-group-comment ()
11596   "Parse comment and empty lines between groups of lines."
11597   (let ((start (point))
11598         string)
11599     (vhdl-forward-comment (point-max))
11600     (setq string (buffer-substring-no-properties start (point)))
11601     (vhdl-forward-syntactic-ws)
11602     ;; strip off leading blanks and first newline
11603     (while (string-match "^\\(\\s-+\\)" string)
11604       (setq string (concat (substring string 0 (match-beginning 1))
11605                            (substring string (match-end 1)))))
11606     (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
11607         (substring string 1)
11608       string)))
11609
11610 (defun vhdl-paste-group-comment (string indent)
11611   "Paste comment and empty lines from STRING between groups of lines
11612 with INDENT."
11613   (let ((pos (point-marker)))
11614     (when (> indent 0)
11615       (while (string-match "^\\(--\\)" string)
11616         (setq string (concat (substring string 0 (match-beginning 1))
11617                              (make-string indent ? )
11618                              (substring string (match-beginning 1))))))
11619     (beginning-of-line)
11620     (insert string)
11621     (goto-char pos)))
11622
11623 (defvar vhdl-port-flattened nil
11624   "Indicates whether a port has been flattened.")
11625
11626 (defun vhdl-port-flatten (&optional as-alist)
11627   "Flatten port list so that only one generic/port exists per line.
11628 This operation is performed on an internally stored port and is only
11629 reflected in a subsequent paste operation."
11630   (interactive)
11631   (if (not vhdl-port-list)
11632       (error "ERROR:  No port has been read")
11633     (message "Flattening port for next paste...")
11634     (let ((new-vhdl-port-list (list (car vhdl-port-list)))
11635           (old-vhdl-port-list (cdr vhdl-port-list))
11636           old-port-list new-port-list old-port new-port names)
11637       ;; traverse port list and flatten entries
11638       (while (cdr old-vhdl-port-list)
11639         (setq old-port-list (car old-vhdl-port-list))
11640         (setq new-port-list nil)
11641         (while old-port-list
11642           (setq old-port (car old-port-list))
11643           (setq names (car old-port))
11644           (while names
11645             (setq new-port (cons (if as-alist (car names) (list (car names)))
11646                                  (cdr old-port)))
11647             (setq new-port-list (append new-port-list (list new-port)))
11648             (setq names (cdr names)))
11649           (setq old-port-list (cdr old-port-list)))
11650         (setq old-vhdl-port-list (cdr old-vhdl-port-list))
11651         (setq new-vhdl-port-list (append new-vhdl-port-list
11652                                          (list new-port-list))))
11653       (setq vhdl-port-list
11654             (append new-vhdl-port-list (list old-vhdl-port-list))
11655             vhdl-port-flattened t)
11656       (message "Flattening port for next paste...done"))))
11657
11658 (defvar vhdl-port-reversed-direction nil
11659   "Indicates whether port directions are reversed.")
11660
11661 (defun vhdl-port-reverse-direction ()
11662   "Reverse direction for all ports (useful in testbenches).
11663 This operation is performed on an internally stored port and is only
11664 reflected in a subsequent paste operation."
11665   (interactive)
11666   (if (not vhdl-port-list)
11667       (error "ERROR:  No port has been read")
11668     (message "Reversing port directions for next paste...")
11669     (let ((port-list (nth 2 vhdl-port-list))
11670           port-dir-car port-dir)
11671       ;; traverse port list and reverse directions
11672       (while port-list
11673         (setq port-dir-car (cddr (car port-list))
11674               port-dir (car port-dir-car))
11675         (setcar port-dir-car
11676                 (cond ((equal port-dir "in") "out")
11677                       ((equal port-dir "IN") "OUT")
11678                       ((equal port-dir "out") "in")
11679                       ((equal port-dir "OUT") "IN")
11680                       (t port-dir)))
11681         (setq port-list (cdr port-list)))
11682       (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
11683       (message "Reversing port directions for next paste...done"))))
11684
11685 (defun vhdl-port-copy ()
11686   "Get generic and port information from an entity or component declaration."
11687   (interactive)
11688   (save-excursion
11689     (let (parse-error end-of-list
11690           decl-type name generic-list port-list context-clause
11691           object names direct type init comment group-comment)
11692       (vhdl-prepare-search-2
11693        (setq
11694         parse-error
11695         (catch 'parse
11696           ;; check if within entity or component declaration
11697           (end-of-line)
11698           (when (or (not (re-search-backward
11699                           "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
11700                     (equal "END" (upcase (match-string 1))))
11701             (throw 'parse "ERROR:  Not within an entity or component declaration"))
11702           (setq decl-type (downcase (match-string-no-properties 1)))
11703           (forward-word 1)
11704           (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
11705           (setq name (match-string-no-properties 1))
11706           (message "Reading port of %s \"%s\"..." decl-type name)
11707           (vhdl-forward-syntactic-ws)
11708           ;; parse generic clause
11709           (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t)
11710             ;; parse group comment and spacing
11711             (setq group-comment (vhdl-parse-group-comment))
11712             (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11713             (while (not end-of-list)
11714               ;; parse names (accept extended identifiers)
11715               (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11716               (setq names (list (match-string-no-properties 1)))
11717               (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11718                 (setq names
11719                       (append names (list (match-string-no-properties 1)))))
11720               ;; parse type
11721               (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
11722               (setq type (match-string-no-properties 1))
11723               (when (vhdl-in-comment-p) ; if stuck in comment
11724                 (setq type (concat type (and (vhdl-parse-string ".*")
11725                                              (match-string-no-properties 0)))))
11726               (setq comment nil)
11727               (while (looking-at "(")
11728                 (setq type
11729                       (concat type
11730                               (buffer-substring-no-properties
11731                                (point) (progn (forward-sexp) (point)))
11732                               (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11733                                    (match-string-no-properties 1)))))
11734               ;; special case: closing parenthesis is on separate line
11735               (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11736                 (setq comment (substring type (match-beginning 2)))
11737                 (setq type (substring type 0 (match-beginning 1))))
11738               ;; strip of trailing group-comment
11739               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11740               (setq type (substring type 0 (match-end 1)))
11741               ;; parse initialization expression
11742               (setq init nil)
11743               (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
11744                 (vhdl-parse-string "\\([^();\n]*\\)")
11745                 (setq init (match-string-no-properties 1))
11746                 (while (looking-at "(")
11747                   (setq init
11748                         (concat init
11749                                 (buffer-substring-no-properties
11750                                  (point) (progn (forward-sexp) (point)))
11751                                 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11752                                      (match-string-no-properties 1))))))
11753               ;; special case: closing parenthesis is on separate line
11754               (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11755                 (setq comment (substring init (match-beginning 2)))
11756                 (setq init (substring init 0 (match-beginning 1)))
11757                 (vhdl-forward-syntactic-ws))
11758               (skip-chars-forward " \t")
11759               ;; parse inline comment, special case: as above, no initial.
11760               (unless comment
11761                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11762                                    (match-string-no-properties 1))))
11763               (vhdl-forward-syntactic-ws)
11764               (setq end-of-list (vhdl-parse-string ")" t))
11765               (vhdl-parse-string "\\s-*;\\s-*")
11766               ;; parse inline comment
11767               (unless comment
11768                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11769                                    (match-string-no-properties 1))))
11770               ;; save everything in list
11771               (setq generic-list (append generic-list
11772                                          (list (list names type init
11773                                                      comment group-comment))))
11774               ;; parse group comment and spacing
11775               (setq group-comment (vhdl-parse-group-comment))))
11776           ;; parse port clause
11777           (when (vhdl-parse-string "port[ \t\n\r\f]*(" t)
11778             ;; parse group comment and spacing
11779             (setq group-comment (vhdl-parse-group-comment))
11780             (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11781             (while (not end-of-list)
11782               ;; parse object
11783               (setq object
11784                     (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t)
11785                          (match-string-no-properties 1)))
11786               ;; parse names (accept extended identifiers)
11787               (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11788               (setq names (list (match-string-no-properties 1)))
11789               (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11790                 (setq names (append names (list (match-string-no-properties 1)))))
11791               ;; parse direction
11792               (vhdl-parse-string ":[ \t\n\r\f]*")
11793               (setq direct
11794                     (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t)
11795                          (match-string-no-properties 1)))
11796               ;; parse type
11797               (vhdl-parse-string "\\([^();\n]+\\)")
11798               (setq type (match-string-no-properties 1))
11799               (when (vhdl-in-comment-p) ; if stuck in comment
11800                 (setq type (concat type (and (vhdl-parse-string ".*")
11801                                              (match-string-no-properties 0)))))
11802               (setq comment nil)
11803               (while (looking-at "(")
11804                 (setq type (concat type
11805                                    (buffer-substring-no-properties
11806                                     (point) (progn (forward-sexp) (point)))
11807                                    (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11808                                         (match-string-no-properties 1)))))
11809               ;; special case: closing parenthesis is on separate line
11810               (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11811                 (setq comment (substring type (match-beginning 2)))
11812                 (setq type (substring type 0 (match-beginning 1))))
11813               ;; strip of trailing group-comment
11814               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11815               (setq type (substring type 0 (match-end 1)))
11816               (vhdl-forward-syntactic-ws)
11817               (setq end-of-list (vhdl-parse-string ")" t))
11818               (vhdl-parse-string "\\s-*;\\s-*")
11819               ;; parse inline comment
11820               (unless comment
11821                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11822                                    (match-string-no-properties 1))))
11823               ;; save everything in list
11824               (setq port-list (append port-list
11825                                       (list (list names object direct type
11826                                                   comment group-comment))))
11827               ;; parse group comment and spacing
11828               (setq group-comment (vhdl-parse-group-comment))))
11829           ;; parse context clause
11830           (setq context-clause (vhdl-scan-context-clause))
11831 ;         ;; add surrounding package to context clause
11832 ;         (when (and (equal decl-type "component")
11833 ;                    (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
11834 ;           (setq context-clause
11835 ;                 (append context-clause
11836 ;                         (list (cons (vhdl-work-library)
11837 ;                                     (match-string-no-properties 1))))))
11838           (message "Reading port of %s \"%s\"...done" decl-type name)
11839           nil)))
11840       ;; finish parsing
11841       (if parse-error
11842           (error parse-error)
11843         (setq vhdl-port-list (list name generic-list port-list context-clause)
11844               vhdl-port-reversed-direction nil
11845               vhdl-port-flattened nil)))))
11846
11847 (defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
11848   "Paste a context clause."
11849   (let ((margin (current-indentation))
11850         (clause-list (nth 3 vhdl-port-list))
11851         clause)
11852     (while clause-list
11853       (setq clause (car clause-list))
11854       (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
11855                                                 (downcase exclude-pack-name)))
11856                   (save-excursion
11857                     (re-search-backward
11858                      (concat "^\\s-*use\\s-+" (car clause)
11859                              "\." (cdr clause) "\\>") nil t)))
11860         (vhdl-template-standard-package (car clause) (cdr clause))
11861         (insert "\n"))
11862       (setq clause-list (cdr clause-list)))))
11863
11864 (defun vhdl-port-paste-generic (&optional no-init)
11865   "Paste a generic clause."
11866   (let ((margin (current-indentation))
11867         (generic-list (nth 1 vhdl-port-list))
11868         list-margin start names generic)
11869     ;; paste generic clause
11870     (when generic-list
11871       (setq start (point))
11872       (vhdl-insert-keyword "GENERIC (")
11873       (unless vhdl-argument-list-indent
11874         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11875       (setq list-margin (current-column))
11876       (while generic-list
11877         (setq generic (car generic-list))
11878         ;; paste group comment and spacing
11879         (when (memq vhdl-include-group-comments '(decl always))
11880           (vhdl-paste-group-comment (nth 4 generic) list-margin))
11881         ;; paste names
11882         (setq names (nth 0 generic))
11883         (while names
11884           (insert (car names))
11885           (setq names (cdr names))
11886           (when names (insert ", ")))
11887         ;; paste type
11888         (insert " : " (nth 1 generic))
11889         ;; paste initialization
11890         (when (and (not no-init) (nth 2 generic))
11891           (insert " := " (nth 2 generic)))
11892         (unless (cdr generic-list) (insert ")"))
11893         (insert ";")
11894         ;; paste comment
11895         (when (and vhdl-include-port-comments (nth 3 generic))
11896           (vhdl-comment-insert-inline (nth 3 generic) t))
11897         (setq generic-list (cdr generic-list))
11898         (when generic-list (insert "\n") (indent-to list-margin)))
11899       ;; align generic clause
11900       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
11901
11902 (defun vhdl-port-paste-port ()
11903   "Paste a port clause."
11904   (let ((margin (current-indentation))
11905         (port-list (nth 2 vhdl-port-list))
11906         list-margin start names port)
11907     ;; paste port clause
11908     (when port-list
11909       (setq start (point))
11910       (vhdl-insert-keyword "PORT (")
11911       (unless vhdl-argument-list-indent
11912         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11913       (setq list-margin (current-column))
11914       (while port-list
11915         (setq port (car port-list))
11916         ;; paste group comment and spacing
11917         (when (memq vhdl-include-group-comments '(decl always))
11918           (vhdl-paste-group-comment (nth 5 port) list-margin))
11919         ;; paste object
11920         (when (nth 1 port) (insert (nth 1 port) " "))
11921         ;; paste names
11922         (setq names (nth 0 port))
11923         (while names
11924           (insert (car names))
11925           (setq names (cdr names))
11926           (when names (insert ", ")))
11927         ;; paste direction
11928         (insert " : ")
11929         (when (nth 2 port) (insert (nth 2 port) " "))
11930         ;; paste type
11931         (insert (nth 3 port))
11932         (unless (cdr port-list) (insert ")"))
11933         (insert ";")
11934         ;; paste comment
11935         (when (and vhdl-include-port-comments (nth 4 port))
11936           (vhdl-comment-insert-inline (nth 4 port) t))
11937         (setq port-list (cdr port-list))
11938         (when port-list (insert "\n") (indent-to list-margin)))
11939       ;; align port clause
11940       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11941
11942 (defun vhdl-port-paste-declaration (kind &optional no-indent)
11943   "Paste as an entity or component declaration."
11944   (unless no-indent (indent-according-to-mode))
11945   (let ((margin (current-indentation))
11946         (name (nth 0 vhdl-port-list)))
11947     (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11948     (insert name)
11949     (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11950         (vhdl-insert-keyword " IS"))
11951     ;; paste generic and port clause
11952     (when (nth 1 vhdl-port-list)
11953       (insert "\n")
11954       (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11955         (insert "\n"))
11956       (indent-to (+ margin vhdl-basic-offset))
11957       (vhdl-port-paste-generic (eq kind 'component)))
11958     (when (nth 2 vhdl-port-list)
11959       (insert "\n")
11960       (when (and (memq vhdl-insert-empty-lines '(unit all))
11961                  (eq kind 'entity))
11962         (insert "\n"))
11963       (indent-to (+ margin vhdl-basic-offset)))
11964     (vhdl-port-paste-port)
11965     (insert "\n")
11966     (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11967       (insert "\n"))
11968     (indent-to margin)
11969     (vhdl-insert-keyword "END")
11970     (if (eq kind 'entity)
11971         (progn
11972           (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11973           (insert " " name))
11974       (vhdl-insert-keyword " COMPONENT")
11975       (unless (vhdl-standard-p '87) (insert " " name)))
11976     (insert ";")))
11977
11978 (defun vhdl-port-paste-entity (&optional no-indent)
11979   "Paste as an entity declaration."
11980   (interactive)
11981   (if (not vhdl-port-list)
11982       (error "ERROR:  No port read")
11983     (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11984     (vhdl-port-paste-declaration 'entity no-indent)
11985     (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11986
11987 (defun vhdl-port-paste-component (&optional no-indent)
11988   "Paste as a component declaration."
11989   (interactive)
11990   (if (not vhdl-port-list)
11991       (error "ERROR:  No port read")
11992     (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
11993     (vhdl-port-paste-declaration 'component no-indent)
11994     (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
11995
11996 (defun vhdl-port-paste-generic-map (&optional secondary no-constants)
11997   "Paste as a generic map."
11998   (interactive)
11999   (unless secondary (indent-according-to-mode))
12000   (let ((margin (current-indentation))
12001         list-margin start generic
12002         (generic-list (nth 1 vhdl-port-list)))
12003     (when generic-list
12004       (setq start (point))
12005       (vhdl-insert-keyword "GENERIC MAP (")
12006       (if (not vhdl-association-list-with-formals)
12007           ;; paste list of actual generics
12008           (while generic-list
12009             (insert (if no-constants
12010                       (car (nth 0 (car generic-list)))
12011                     (or (nth 2 (car generic-list)) " ")))
12012             (setq generic-list (cdr generic-list))
12013             (insert (if generic-list ", " ")"))
12014             (when (and (not generic-list) secondary
12015                        (null (nth 2 vhdl-port-list)))
12016               (insert ";")))
12017         (unless vhdl-argument-list-indent
12018           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12019         (setq list-margin (current-column))
12020         (while generic-list
12021           (setq generic (car generic-list))
12022           ;; paste group comment and spacing
12023           (when (eq vhdl-include-group-comments 'always)
12024             (vhdl-paste-group-comment (nth 4 generic) list-margin))
12025           ;; paste formal and actual generic
12026           (insert (car (nth 0 generic)) " => "
12027                   (if no-constants
12028                       (vhdl-replace-string vhdl-actual-generic-name
12029                                            (car (nth 0 generic)))
12030                     (or (nth 2 generic) "")))
12031           (setq generic-list (cdr generic-list))
12032           (insert (if generic-list "," ")"))
12033           (when (and (not generic-list) secondary
12034                      (null (nth 2 vhdl-port-list)))
12035             (insert ";"))
12036           ;; paste comment
12037           (when (or vhdl-include-type-comments
12038                     (and vhdl-include-port-comments (nth 3 generic)))
12039             (vhdl-comment-insert-inline
12040              (concat
12041               (when vhdl-include-type-comments
12042                 (concat "[" (nth 1 generic) "] "))
12043               (when vhdl-include-port-comments (nth 3 generic))) t))
12044           (when generic-list (insert "\n") (indent-to list-margin)))
12045         ;; align generic map
12046         (when vhdl-auto-align
12047           (vhdl-align-region-groups start (point) 1 t))))))
12048
12049 (defun vhdl-port-paste-port-map ()
12050   "Paste as a port map."
12051   (let ((margin (current-indentation))
12052         list-margin start port
12053         (port-list (nth 2 vhdl-port-list)))
12054     (when port-list
12055       (setq start (point))
12056       (vhdl-insert-keyword "PORT MAP (")
12057       (if (not vhdl-association-list-with-formals)
12058           ;; paste list of actual ports
12059           (while port-list
12060             (insert (vhdl-replace-string vhdl-actual-port-name
12061                                          (car (nth 0 (car port-list)))))
12062             (setq port-list (cdr port-list))
12063             (insert (if port-list ", " ")")))
12064         (unless vhdl-argument-list-indent
12065           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12066         (setq list-margin (current-column))
12067         (while port-list
12068           (setq port (car port-list))
12069           ;; paste group comment and spacing
12070           (when (eq vhdl-include-group-comments 'always)
12071             (vhdl-paste-group-comment (nth 5 port) list-margin))
12072           ;; paste formal and actual port
12073           (insert (car (nth 0 port)) " => ")
12074           (insert (vhdl-replace-string vhdl-actual-port-name
12075                                        (car (nth 0 port))))
12076           (setq port-list (cdr port-list))
12077           (insert (if port-list "," ");"))
12078           ;; paste comment
12079           (when (or (and vhdl-include-direction-comments (nth 2 port))
12080                     vhdl-include-type-comments
12081                     (and vhdl-include-port-comments (nth 4 port)))
12082             (vhdl-comment-insert-inline
12083              (concat
12084               (cond ((and vhdl-include-direction-comments
12085                           vhdl-include-type-comments)
12086                      (concat "[" (format "%-4s" (concat (nth 2 port) " "))
12087                              (nth 3 port) "] "))
12088                     ((and vhdl-include-direction-comments (nth 2 port))
12089                      (format "%-6s" (concat "[" (nth 2 port) "] ")))
12090                     (vhdl-include-direction-comments "      ")
12091                     (vhdl-include-type-comments
12092                      (concat "[" (nth 3 port) "] ")))
12093               (when vhdl-include-port-comments (nth 4 port))) t))
12094           (when port-list (insert "\n") (indent-to list-margin)))
12095         ;; align port clause
12096         (when vhdl-auto-align
12097           (vhdl-align-region-groups start (point) 1))))))
12098
12099 (defun vhdl-port-paste-instance (&optional name no-indent title)
12100   "Paste as an instantiation."
12101   (interactive)
12102   (if (not vhdl-port-list)
12103       (error "ERROR:  No port read")
12104     (let ((orig-vhdl-port-list vhdl-port-list))
12105       ;; flatten local copy of port list (must be flat for port mapping)
12106       (vhdl-port-flatten)
12107       (unless no-indent (indent-according-to-mode))
12108       (let ((margin (current-indentation)))
12109         ;; paste instantiation
12110         (cond (name
12111                (insert name))
12112               ((equal (cdr vhdl-instance-name) "")
12113                (setq name (vhdl-template-field "instance name")))
12114               ((string-match "\%d" (cdr vhdl-instance-name))
12115                (let ((n 1))
12116                  (while (save-excursion
12117                           (setq name (format (vhdl-replace-string
12118                                               vhdl-instance-name
12119                                               (nth 0 vhdl-port-list)) n))
12120                           (goto-char (point-min))
12121                           (vhdl-re-search-forward name nil t))
12122                    (setq n (1+ n)))
12123                  (insert name)))
12124               (t (insert (vhdl-replace-string vhdl-instance-name
12125                                               (nth 0 vhdl-port-list)))))
12126         (message "Pasting port as instantiation \"%s\"..." name)
12127         (insert ": ")
12128         (when title
12129           (save-excursion
12130             (beginning-of-line)
12131             (indent-to vhdl-basic-offset)
12132             (insert "-- instance \"" name "\"\n")))
12133         (if (not (vhdl-use-direct-instantiation))
12134             (insert (nth 0 vhdl-port-list))
12135           (vhdl-insert-keyword "ENTITY ")
12136           (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
12137         (when (nth 1 vhdl-port-list)
12138           (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12139           (vhdl-port-paste-generic-map t t))
12140         (when (nth 2 vhdl-port-list)
12141           (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12142           (vhdl-port-paste-port-map))
12143         (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list))
12144           (insert ";"))
12145         (message "Pasting port as instantiation \"%s\"...done" name))
12146       (setq vhdl-port-list orig-vhdl-port-list))))
12147
12148 (defun vhdl-port-paste-constants (&optional no-indent)
12149   "Paste generics as constants."
12150   (interactive)
12151   (if (not vhdl-port-list)
12152       (error "ERROR:  No port read")
12153     (let ((orig-vhdl-port-list vhdl-port-list))
12154       (message "Pasting port as constants...")
12155       ;; flatten local copy of port list (must be flat for constant initial.)
12156       (vhdl-port-flatten)
12157       (unless no-indent (indent-according-to-mode))
12158       (let ((margin (current-indentation))
12159             start generic name
12160             (generic-list (nth 1 vhdl-port-list)))
12161         (when generic-list
12162           (setq start (point))
12163           (while generic-list
12164             (setq generic (car generic-list))
12165             ;; paste group comment and spacing
12166             (when (memq vhdl-include-group-comments '(decl always))
12167               (vhdl-paste-group-comment (nth 4 generic) margin))
12168             (vhdl-insert-keyword "CONSTANT ")
12169             ;; paste generic constants
12170             (setq name (nth 0 generic))
12171             (when name
12172               (insert (vhdl-replace-string vhdl-actual-generic-name (car name)))
12173               ;; paste type
12174               (insert " : " (nth 1 generic))
12175               ;; paste initialization
12176               (when (nth 2 generic)
12177                 (insert " := " (nth 2 generic)))
12178               (insert ";")
12179               ;; paste comment
12180               (when (and vhdl-include-port-comments (nth 3 generic))
12181                 (vhdl-comment-insert-inline (nth 3 generic) t))
12182               (setq generic-list (cdr generic-list))
12183               (when generic-list (insert "\n") (indent-to margin))))
12184             ;; align signal list
12185           (when vhdl-auto-align
12186             (vhdl-align-region-groups start (point) 1))))
12187       (message "Pasting port as constants...done")
12188       (setq vhdl-port-list orig-vhdl-port-list))))
12189
12190 (defun vhdl-port-paste-signals (&optional initialize no-indent)
12191   "Paste ports as internal signals."
12192   (interactive)
12193   (if (not vhdl-port-list)
12194       (error "ERROR:  No port read")
12195     (message "Pasting port as signals...")
12196     (unless no-indent (indent-according-to-mode))
12197     (let ((margin (current-indentation))
12198           start port names type generic-list port-name constant-name pos
12199           (port-list (nth 2 vhdl-port-list)))
12200       (when port-list
12201         (setq start (point))
12202         (while port-list
12203           (setq port (car port-list))
12204           ;; paste group comment and spacing
12205           (when (memq vhdl-include-group-comments '(decl always))
12206             (vhdl-paste-group-comment (nth 5 port) margin))
12207           ;; paste object
12208           (if (nth 1 port)
12209               (insert (nth 1 port) " ")
12210             (vhdl-insert-keyword "SIGNAL "))
12211           ;; paste actual port signals
12212           (setq names (nth 0 port))
12213           (while names
12214             (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
12215             (setq names (cdr names))
12216             (when names (insert ", ")))
12217           ;; paste type
12218           (setq type (nth 3 port))
12219           (setq generic-list (nth 1 vhdl-port-list))
12220           (vhdl-prepare-search-1
12221            (setq pos 0)
12222            ;; replace formal by actual generics
12223            (while generic-list
12224              (setq port-name (car (nth 0 (car generic-list))))
12225              (while (string-match (concat "\\<" port-name "\\>") type pos)
12226                (setq constant-name
12227                      (save-match-data (vhdl-replace-string
12228                                        vhdl-actual-generic-name port-name)))
12229                (setq type (replace-match constant-name t nil type))
12230                (setq pos (match-end 0)))
12231              (setq generic-list (cdr generic-list))))
12232           (insert " : " type)
12233           ;; paste initialization (inputs only)
12234           (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
12235             (insert " := "
12236                     (cond ((string-match "integer" (nth 3 port)) "0")
12237                           ((string-match "natural" (nth 3 port)) "0")
12238                           ((string-match "positive" (nth 3 port)) "0")
12239                           ((string-match "real" (nth 3 port)) "0.0")
12240                           ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12241                           (t "'0'"))))
12242           (insert ";")
12243           ;; paste comment
12244           (when (or (and vhdl-include-direction-comments (nth 2 port))
12245                     (and vhdl-include-port-comments (nth 4 port)))
12246             (vhdl-comment-insert-inline
12247              (concat
12248               (cond ((and vhdl-include-direction-comments (nth 2 port))
12249                      (format "%-6s" (concat "[" (nth 2 port) "] ")))
12250                     (vhdl-include-direction-comments "      "))
12251               (when vhdl-include-port-comments (nth 4 port))) t))
12252           (setq port-list (cdr port-list))
12253           (when port-list (insert "\n") (indent-to margin)))
12254         ;; align signal list
12255         (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12256     (message "Pasting port as signals...done")))
12257
12258 (defun vhdl-port-paste-initializations (&optional no-indent)
12259   "Paste ports as signal initializations."
12260   (interactive)
12261   (if (not vhdl-port-list)
12262       (error "ERROR:  No port read")
12263     (let ((orig-vhdl-port-list vhdl-port-list))
12264       (message "Pasting port as initializations...")
12265       ;; flatten local copy of port list (must be flat for signal initial.)
12266       (vhdl-port-flatten)
12267       (unless no-indent (indent-according-to-mode))
12268       (let ((margin (current-indentation))
12269             start port name
12270             (port-list (nth 2 vhdl-port-list)))
12271         (when port-list
12272           (setq start (point))
12273           (while port-list
12274             (setq port (car port-list))
12275             ;; paste actual port signal (inputs only)
12276             (when (equal "IN" (upcase (nth 2 port)))
12277               (setq name (car (nth 0 port)))
12278               (insert (vhdl-replace-string vhdl-actual-port-name name))
12279               ;; paste initialization
12280               (insert " <= "
12281                       (cond ((string-match "integer" (nth 3 port)) "0")
12282                             ((string-match "natural" (nth 3 port)) "0")
12283                             ((string-match "positive" (nth 3 port)) "0")
12284                             ((string-match "real" (nth 3 port)) "0.0")
12285                             ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12286                             (t "'0'"))
12287                       ";"))
12288             (setq port-list (cdr port-list))
12289             (when (and port-list
12290                        (equal "IN" (upcase (nth 2 (car port-list)))))
12291               (insert "\n") (indent-to margin)))
12292           ;; align signal list
12293           (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12294       (message "Pasting port as initializations...done")
12295       (setq vhdl-port-list orig-vhdl-port-list))))
12296
12297 (defun vhdl-port-paste-testbench ()
12298   "Paste as a bare-bones testbench."
12299   (interactive)
12300   (if (not vhdl-port-list)
12301       (error "ERROR:  No port read")
12302     (let ((case-fold-search t)
12303           (ent-name (vhdl-replace-string vhdl-testbench-entity-name
12304                                          (nth 0 vhdl-port-list)))
12305           (source-buffer (current-buffer))
12306           arch-name config-name ent-file-name arch-file-name
12307           ent-buffer arch-buffer position)
12308       ;; open entity file
12309       (unless (eq vhdl-testbench-create-files 'none)
12310         (setq ent-file-name
12311               (concat (vhdl-replace-string vhdl-testbench-entity-file-name
12312                                            ent-name t)
12313                       "." (file-name-extension (buffer-file-name))))
12314         (if (file-exists-p ent-file-name)
12315             (if (y-or-n-p
12316                  (concat "File \"" ent-file-name "\" exists; overwrite? "))
12317                 (progn (find-file ent-file-name)
12318                        (erase-buffer)
12319                        (set-buffer-modified-p nil))
12320               (if (eq vhdl-testbench-create-files 'separate)
12321                   (setq ent-file-name nil)
12322                 (error "ERROR:  Pasting port as testbench...aborted")))
12323           (find-file ent-file-name)))
12324       (unless (and (eq vhdl-testbench-create-files 'separate)
12325                    (null ent-file-name))
12326         ;; paste entity header
12327         (if vhdl-testbench-include-header
12328             (progn (vhdl-template-header
12329                     (concat "Testbench for design \""
12330                             (nth 0 vhdl-port-list) "\""))
12331                    (goto-char (point-max)))
12332           (vhdl-comment-display-line) (insert "\n\n"))
12333         ;; paste std_logic_1164 package
12334         (when vhdl-testbench-include-library
12335           (vhdl-template-package-std-logic-1164)
12336           (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
12337         ;; paste entity declaration
12338         (vhdl-insert-keyword "ENTITY ")
12339         (insert ent-name)
12340         (vhdl-insert-keyword " IS")
12341         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
12342         (insert "\n")
12343         (vhdl-insert-keyword "END ")
12344         (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
12345         (insert ent-name ";")
12346         (insert "\n\n")
12347         (vhdl-comment-display-line) (insert "\n"))
12348       ;; get architecture name
12349       (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
12350                           (read-from-minibuffer "architecture name: "
12351                                                 nil vhdl-minibuffer-local-map)
12352                         (vhdl-replace-string vhdl-testbench-architecture-name
12353                                              (nth 0 vhdl-port-list))))
12354       (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
12355       ;; open architecture file
12356       (if (not (eq vhdl-testbench-create-files 'separate))
12357           (insert "\n")
12358         (setq ent-buffer (current-buffer))
12359         (setq arch-file-name
12360               (concat (vhdl-replace-string vhdl-testbench-architecture-file-name
12361                                            (concat ent-name " " arch-name) t)
12362                       "." (file-name-extension (buffer-file-name))))
12363         (when (and (file-exists-p arch-file-name)
12364                    (not (y-or-n-p (concat "File \"" arch-file-name
12365                                           "\" exists; overwrite? "))))
12366           (error "ERROR:  Pasting port as testbench...aborted"))
12367         (find-file arch-file-name)
12368         (erase-buffer)
12369         (set-buffer-modified-p nil)
12370         ;; paste architecture header
12371         (if vhdl-testbench-include-header
12372             (progn (vhdl-template-header
12373                     (concat "Testbench architecture for design \""
12374                             (nth 0 vhdl-port-list) "\""))
12375                    (goto-char (point-max)))
12376           (vhdl-comment-display-line) (insert "\n\n")))
12377       ;; paste architecture body
12378       (vhdl-insert-keyword "ARCHITECTURE ")
12379       (insert arch-name)
12380       (vhdl-insert-keyword " OF ")
12381       (insert ent-name)
12382       (vhdl-insert-keyword " IS")
12383       (insert "\n\n") (indent-to vhdl-basic-offset)
12384       ;; paste component declaration
12385       (unless (vhdl-use-direct-instantiation)
12386         (vhdl-port-paste-component t)
12387         (insert "\n\n") (indent-to vhdl-basic-offset))
12388       ;; paste constants
12389       (when (nth 1 vhdl-port-list)
12390         (insert "-- component generics\n") (indent-to vhdl-basic-offset)
12391         (vhdl-port-paste-constants t)
12392         (insert "\n\n") (indent-to vhdl-basic-offset))
12393       ;; paste internal signals
12394       (insert "-- component ports\n") (indent-to vhdl-basic-offset)
12395       (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
12396       (insert "\n")
12397       ;; paste custom declarations
12398       (unless (equal "" vhdl-testbench-declarations)
12399         (insert "\n")
12400         (setq position (point))
12401         (vhdl-insert-string-or-file vhdl-testbench-declarations)
12402         (vhdl-indent-region position (point)))
12403       (setq position (point))
12404       (insert "\n\n")
12405       (vhdl-comment-display-line) (insert "\n")
12406       (when vhdl-testbench-include-configuration
12407         (setq config-name (vhdl-replace-string
12408                            vhdl-testbench-configuration-name
12409                            (concat ent-name " " arch-name)))
12410         (insert "\n")
12411         (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
12412         (vhdl-insert-keyword " OF ") (insert ent-name)
12413         (vhdl-insert-keyword " IS\n")
12414         (indent-to vhdl-basic-offset)
12415         (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
12416         (indent-to vhdl-basic-offset)
12417         (vhdl-insert-keyword "END FOR;\n")
12418         (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
12419         (vhdl-comment-display-line) (insert "\n"))
12420       (goto-char position)
12421       (vhdl-template-begin-end
12422        (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
12423       ;; paste instantiation
12424       (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
12425       (vhdl-port-paste-instance
12426        (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
12427       (insert "\n")
12428       ;; paste custom statements
12429       (unless (equal "" vhdl-testbench-statements)
12430         (insert "\n")
12431         (setq position (point))
12432         (vhdl-insert-string-or-file vhdl-testbench-statements)
12433         (vhdl-indent-region position (point)))
12434       (insert "\n")
12435       (indent-to vhdl-basic-offset)
12436       (unless (eq vhdl-testbench-create-files 'none)
12437         (setq arch-buffer (current-buffer))
12438         (when ent-buffer (set-buffer ent-buffer) (save-buffer))
12439         (set-buffer arch-buffer) (save-buffer))
12440       (message "%s"
12441        (concat (format "Pasting port as testbench \"%s(%s)\"...done"
12442                        ent-name arch-name)
12443                (and ent-file-name
12444                     (format "\n  File created: \"%s\"" ent-file-name))
12445                (and arch-file-name
12446                     (format "\n  File created: \"%s\"" arch-file-name)))))))
12447
12448
12449 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12450 ;;; Subprogram interface translation
12451 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12452
12453 (defvar vhdl-subprog-list nil
12454   "Variable to hold last subprogram interface parsed.")
12455 ;; structure: (parenthesized expression means list of such entries)
12456 ;; (subprog-name kind
12457 ;;  ((names) object direct type init comment group-comment)
12458 ;;  return-type return-comment group-comment)
12459
12460 (defvar vhdl-subprog-flattened nil
12461   "Indicates whether an subprogram interface has been flattened.")
12462
12463 (defun vhdl-subprog-flatten ()
12464   "Flatten interface list so that only one parameter exists per line."
12465   (interactive)
12466   (if (not vhdl-subprog-list)
12467       (error "ERROR:  No subprogram interface has been read")
12468     (message "Flattening subprogram interface...")
12469     (let ((old-subprog-list (nth 2 vhdl-subprog-list))
12470           new-subprog-list old-subprog new-subprog names)
12471       ;; traverse parameter list and flatten entries
12472       (while old-subprog-list
12473         (setq old-subprog (car old-subprog-list))
12474         (setq names (car old-subprog))
12475         (while names
12476           (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
12477           (setq new-subprog-list (append new-subprog-list (list new-subprog)))
12478           (setq names (cdr names)))
12479         (setq old-subprog-list (cdr old-subprog-list)))
12480       (setq vhdl-subprog-list
12481             (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
12482                   new-subprog-list (nth 3 vhdl-subprog-list)
12483                   (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
12484             vhdl-subprog-flattened t)
12485     (message "Flattening subprogram interface...done"))))
12486
12487 (defun vhdl-subprog-copy ()
12488   "Get interface information from a subprogram specification."
12489   (interactive)
12490   (save-excursion
12491     (let (parse-error pos end-of-list
12492           name kind param-list object names direct type init
12493           comment group-comment
12494           return-type return-comment return-group-comment)
12495       (vhdl-prepare-search-2
12496        (setq
12497         parse-error
12498         (catch 'parse
12499           ;; check if within function declaration
12500           (setq pos (point))
12501           (end-of-line)
12502           (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
12503           (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
12504                        (goto-char (match-end 0))
12505                        (save-excursion (backward-char)
12506                                     (forward-sexp)
12507                                     (<= pos (point))))
12508             (throw 'parse "ERROR:  Not within a subprogram specification"))
12509           (setq name (match-string-no-properties 5))
12510           (setq kind (if (match-string 2) 'procedure 'function))
12511           (setq end-of-list (not (match-string 7)))
12512           (message "Reading interface of subprogram \"%s\"..." name)
12513           ;; parse parameter list
12514           (setq group-comment (vhdl-parse-group-comment))
12515           (setq end-of-list (or end-of-list
12516                                 (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
12517           (while (not end-of-list)
12518             ;; parse object
12519             (setq object
12520                   (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
12521                          (match-string-no-properties 1)))
12522             ;; parse names (accept extended identifiers)
12523             (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
12524             (setq names (list (match-string-no-properties 1)))
12525             (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
12526               (setq names (append names (list (match-string-no-properties 1)))))
12527             ;; parse direction
12528             (vhdl-parse-string ":[ \t\n\r\f]*")
12529             (setq direct
12530                   (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t)
12531                        (match-string-no-properties 1)))
12532             ;; parse type
12533             (vhdl-parse-string "\\([^():;\n]+\\)")
12534             (setq type (match-string-no-properties 1))
12535             (setq comment nil)
12536             (while (looking-at "(")
12537               (setq type
12538                     (concat type
12539                             (buffer-substring-no-properties
12540                              (point) (progn (forward-sexp) (point)))
12541                             (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
12542                                  (match-string-no-properties 1)))))
12543             ;; special case: closing parenthesis is on separate line
12544             (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
12545               (setq comment (substring type (match-beginning 2)))
12546               (setq type (substring type 0 (match-beginning 1))))
12547             ;; strip off trailing group-comment
12548             (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
12549             (setq type (substring type 0 (match-end 1)))
12550             ;; parse initialization expression
12551             (setq init nil)
12552             (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
12553               (vhdl-parse-string "\\([^();\n]*\\)")
12554               (setq init (match-string-no-properties 1))
12555               (while (looking-at "(")
12556                 (setq init
12557                       (concat init
12558                               (buffer-substring-no-properties
12559                                (point) (progn (forward-sexp) (point)))
12560                               (and (vhdl-parse-string "\\([^();\n]*\\)" t)
12561                                    (match-string-no-properties 1))))))
12562             ;; special case: closing parenthesis is on separate line
12563             (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
12564               (setq comment (substring init (match-beginning 2)))
12565               (setq init (substring init 0 (match-beginning 1)))
12566               (vhdl-forward-syntactic-ws))
12567             (skip-chars-forward " \t")
12568             ;; parse inline comment, special case: as above, no initial.
12569             (unless comment
12570               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12571                                  (match-string-no-properties 1))))
12572             (vhdl-forward-syntactic-ws)
12573             (setq end-of-list (vhdl-parse-string ")\\s-*" t))
12574             ;; parse inline comment
12575             (unless comment
12576               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12577                                  (match-string-no-properties 1))))
12578             (setq return-group-comment (vhdl-parse-group-comment))
12579             (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
12580             ;; parse return type
12581             (when (match-string 3)
12582               (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
12583               (setq return-type (match-string-no-properties 1))
12584               (when (and return-type
12585                          (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
12586                 (setq return-comment (substring return-type (match-beginning 2)))
12587                 (setq return-type (substring return-type 0 (match-beginning 1))))
12588               ;; strip of trailing group-comment
12589               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
12590               (setq return-type (substring return-type 0 (match-end 1)))
12591               ;; parse return comment
12592               (unless return-comment
12593                 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12594                                           (match-string-no-properties 1)))))
12595             ;; parse inline comment
12596             (unless comment
12597               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12598                                  (match-string-no-properties 1))))
12599             ;; save everything in list
12600             (setq param-list (append param-list
12601                                      (list (list names object direct type init
12602                                                  comment group-comment))))
12603             ;; parse group comment and spacing
12604             (setq group-comment (vhdl-parse-group-comment)))
12605           (message "Reading interface of subprogram \"%s\"...done" name)
12606           nil)))
12607       ;; finish parsing
12608       (if parse-error
12609           (error parse-error)
12610         (setq vhdl-subprog-list
12611               (list name kind param-list return-type return-comment
12612                     return-group-comment)
12613               vhdl-subprog-flattened nil)))))
12614
12615 (defun vhdl-subprog-paste-specification (kind)
12616   "Paste as a subprogram specification."
12617   (indent-according-to-mode)
12618   (let ((margin (current-column))
12619         (param-list (nth 2 vhdl-subprog-list))
12620         list-margin start names param)
12621     ;; paste keyword and name
12622     (vhdl-insert-keyword
12623      (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
12624     (insert (nth 0 vhdl-subprog-list))
12625     (if (not param-list)
12626         (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12627       (setq start (point))
12628       ;; paste parameter list
12629       (insert " (")
12630       (unless vhdl-argument-list-indent
12631         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12632       (setq list-margin (current-column))
12633       (while param-list
12634         (setq param (car param-list))
12635         ;; paste group comment and spacing
12636         (when (memq vhdl-include-group-comments (list kind 'always))
12637           (vhdl-paste-group-comment (nth 6 param) list-margin))
12638         ;; paste object
12639         (when (nth 1 param) (insert (nth 1 param) " "))
12640         ;; paste names
12641         (setq names (nth 0 param))
12642         (while names
12643           (insert (car names))
12644           (setq names (cdr names))
12645           (when names (insert ", ")))
12646         ;; paste direction
12647         (insert " : ")
12648         (when (nth 2 param) (insert (nth 2 param) " "))
12649         ;; paste type
12650         (insert (nth 3 param))
12651         ;; paste initialization
12652         (when (nth 4 param) (insert " := " (nth 4 param)))
12653         ;; terminate line
12654         (if (cdr param-list)
12655             (insert ";")
12656           (insert ")")
12657           (when (null (nth 3 vhdl-subprog-list))
12658             (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
12659         ;; paste comment
12660         (when (and vhdl-include-port-comments (nth 5 param))
12661           (vhdl-comment-insert-inline (nth 5 param) t))
12662         (setq param-list (cdr param-list))
12663         (when param-list (insert "\n") (indent-to list-margin)))
12664       (when (nth 3 vhdl-subprog-list)
12665         (insert "\n") (indent-to list-margin)
12666         ;; paste group comment and spacing
12667         (when (memq vhdl-include-group-comments (list kind 'always))
12668           (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
12669         ;; paste return type
12670         (insert "return " (nth 3 vhdl-subprog-list))
12671         (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12672         (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
12673           (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
12674       ;; align parameter list
12675       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
12676     ;; paste body
12677     (when (eq kind 'body)
12678       (insert "\n")
12679       (vhdl-template-begin-end
12680        (unless (vhdl-standard-p '87)
12681          (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
12682        (nth 0 vhdl-subprog-list) margin))))
12683
12684 (defun vhdl-subprog-paste-declaration ()
12685   "Paste as a subprogram declaration."
12686   (interactive)
12687   (if (not vhdl-subprog-list)
12688       (error "ERROR:  No subprogram interface read")
12689     (message "Pasting interface as subprogram declaration \"%s\"..."
12690              (car vhdl-subprog-list))
12691     ;; paste specification
12692     (vhdl-subprog-paste-specification 'decl)
12693     (message "Pasting interface as subprogram declaration \"%s\"...done"
12694              (car vhdl-subprog-list))))
12695
12696 (defun vhdl-subprog-paste-body ()
12697   "Paste as a subprogram body."
12698   (interactive)
12699   (if (not vhdl-subprog-list)
12700       (error "ERROR:  No subprogram interface read")
12701     (message "Pasting interface as subprogram body \"%s\"..."
12702              (car vhdl-subprog-list))
12703     ;; paste specification and body
12704     (vhdl-subprog-paste-specification 'body)
12705     (message "Pasting interface as subprogram body \"%s\"...done"
12706              (car vhdl-subprog-list))))
12707
12708 (defun vhdl-subprog-paste-call ()
12709   "Paste as a subprogram call."
12710   (interactive)
12711   (if (not vhdl-subprog-list)
12712       (error "ERROR:  No subprogram interface read")
12713     (let ((orig-vhdl-subprog-list vhdl-subprog-list)
12714           param-list margin list-margin param start)
12715       ;; flatten local copy of interface list (must be flat for parameter mapping)
12716       (vhdl-subprog-flatten)
12717       (setq param-list (nth 2 vhdl-subprog-list))
12718       (indent-according-to-mode)
12719       (setq margin (current-indentation))
12720       (message "Pasting interface as subprogram call \"%s\"..."
12721                (car vhdl-subprog-list))
12722       ;; paste name
12723       (insert (nth 0 vhdl-subprog-list))
12724       (if (not param-list)
12725           (insert ";")
12726         (setq start (point))
12727         ;; paste parameter list
12728         (insert " (")
12729         (unless vhdl-argument-list-indent
12730           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12731         (setq list-margin (current-column))
12732         (while param-list
12733           (setq param (car param-list))
12734           ;; paste group comment and spacing
12735           (when (eq vhdl-include-group-comments 'always)
12736             (vhdl-paste-group-comment (nth 6 param) list-margin))
12737           ;; paste formal port
12738           (insert (car (nth 0 param)) " => ")
12739           (setq param-list (cdr param-list))
12740           (insert (if param-list "," ");"))
12741           ;; paste comment
12742           (when (and vhdl-include-port-comments (nth 5 param))
12743             (vhdl-comment-insert-inline (nth 5 param)))
12744           (when param-list (insert "\n") (indent-to list-margin)))
12745         ;; align parameter list
12746         (when vhdl-auto-align
12747           (vhdl-align-region-groups start (point) 1)))
12748       (message "Pasting interface as subprogram call \"%s\"...done"
12749                (car vhdl-subprog-list))
12750       (setq vhdl-subprog-list orig-vhdl-subprog-list))))
12751
12752
12753 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12754 ;;; Miscellaneous
12755 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12756
12757 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12758 ;; Hippie expand customization
12759
12760 (defvar vhdl-expand-upper-case nil)
12761
12762 (defun vhdl-try-expand-abbrev (old)
12763   "Try expanding abbreviations from `vhdl-abbrev-list'."
12764   (unless old
12765     (he-init-string (he-dabbrev-beg) (point))
12766     (setq he-expand-list
12767           (let ((abbrev-list vhdl-abbrev-list)
12768                 (sel-abbrev-list '()))
12769             (while abbrev-list
12770               (when (or (not (stringp (car abbrev-list)))
12771                         (string-match
12772                          (concat "^" he-search-string) (car abbrev-list)))
12773                 (setq sel-abbrev-list
12774                       (cons (car abbrev-list) sel-abbrev-list)))
12775               (setq abbrev-list (cdr abbrev-list)))
12776             (nreverse sel-abbrev-list))))
12777   (while (and he-expand-list
12778               (or (not (stringp (car he-expand-list)))
12779                   (he-string-member (car he-expand-list) he-tried-table t)))
12780     (unless (stringp (car he-expand-list))
12781       (setq vhdl-expand-upper-case (car he-expand-list)))
12782     (setq he-expand-list (cdr he-expand-list)))
12783   (if (null he-expand-list)
12784       (progn (when old (he-reset-string))
12785              nil)
12786     (he-substitute-string
12787      (if vhdl-expand-upper-case
12788          (upcase (car he-expand-list))
12789        (car he-expand-list))
12790      t)
12791     (setq he-expand-list (cdr he-expand-list))
12792     t))
12793
12794 (defun vhdl-he-list-beg ()
12795   "Also looks at the word before `(' in order to better match parenthesized
12796 expressions (e.g. for index ranges of types and signals)."
12797   (save-excursion
12798     (condition-case ()
12799         (progn (backward-up-list 1)
12800                (skip-syntax-backward "w_")) ; crashes in `viper-mode'
12801       (error ()))
12802     (point)))
12803
12804 ;; override `he-list-beg' from `hippie-exp'
12805 (unless (and (boundp 'viper-mode) viper-mode)
12806  (defalias 'he-list-beg 'vhdl-he-list-beg))
12807
12808 ;; function for expanding abbrevs and dabbrevs
12809 (defalias 'vhdl-expand-abbrev (make-hippie-expand-function
12810                                '(try-expand-dabbrev
12811                                  try-expand-dabbrev-all-buffers
12812                                  vhdl-try-expand-abbrev)))
12813
12814 ;; function for expanding parenthesis
12815 (defalias 'vhdl-expand-paren (make-hippie-expand-function
12816                               '(try-expand-list
12817                                 try-expand-list-all-buffers)))
12818
12819 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12820 ;; Line handling functions
12821
12822 (defun vhdl-current-line ()
12823   "Return the line number of the line containing point."
12824   (save-restriction
12825     (widen)
12826     (1+ (count-lines (point-min) (point-at-bol)))))
12827
12828 (defun vhdl-line-kill-entire (&optional arg)
12829   "Delete entire line."
12830   (interactive "p")
12831   (beginning-of-line)
12832   (kill-line (or arg 1)))
12833
12834 (defun vhdl-line-kill (&optional arg)
12835   "Kill current line."
12836   (interactive "p")
12837   (vhdl-line-kill-entire arg))
12838
12839 (defun vhdl-line-copy (&optional arg)
12840   "Copy current line."
12841   (interactive "p")
12842   (save-excursion
12843     (let ((position (point-at-bol)))
12844       (forward-line (or arg 1))
12845       (copy-region-as-kill position (point)))))
12846
12847 (defun vhdl-line-yank ()
12848   "Yank entire line."
12849   (interactive)
12850   (beginning-of-line)
12851   (yank))
12852
12853 (defun vhdl-line-expand (&optional prefix-arg)
12854   "Hippie-expand current line."
12855   (interactive "P")
12856   (require 'hippie-exp)
12857   (let ((case-fold-search t) (case-replace nil)
12858         (hippie-expand-try-functions-list
12859          '(try-expand-line try-expand-line-all-buffers)))
12860     (hippie-expand prefix-arg)))
12861
12862 (defun vhdl-line-transpose-next (&optional arg)
12863   "Interchange this line with next line."
12864   (interactive "p")
12865   (forward-line 1)
12866   (transpose-lines (or arg 1))
12867   (forward-line -1))
12868
12869 (defun vhdl-line-transpose-previous (&optional arg)
12870   "Interchange this line with previous line."
12871   (interactive "p")
12872   (forward-line 1)
12873   (transpose-lines (- 0 (or arg 0)))
12874   (forward-line -1))
12875
12876 (defun vhdl-line-open ()
12877   "Open a new line and indent."
12878   (interactive)
12879   (end-of-line -0)
12880   (newline-and-indent))
12881
12882 (defun vhdl-delete-indentation ()
12883   "Join lines.  That is, call `delete-indentation' with `fill-prefix' so that
12884 it works within comments too."
12885   (interactive)
12886   (let ((fill-prefix "-- "))
12887     (delete-indentation)))
12888
12889 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12890 ;; Move functions
12891
12892 (defun vhdl-forward-same-indent ()
12893   "Move forward to next line with same indent."
12894   (interactive)
12895   (let ((pos (point))
12896         (indent (current-indentation)))
12897     (beginning-of-line 2)
12898     (while (and (not (eobp))
12899                 (or (looking-at "^\\s-*\\(--.*\\)?$")
12900                     (> (current-indentation) indent)))
12901       (beginning-of-line 2))
12902     (if (= (current-indentation) indent)
12903         (back-to-indentation)
12904       (message "No following line with same indent found in this block")
12905       (goto-char pos)
12906       nil)))
12907
12908 (defun vhdl-backward-same-indent ()
12909   "Move backward to previous line with same indent."
12910   (interactive)
12911   (let ((pos (point))
12912         (indent (current-indentation)))
12913     (beginning-of-line -0)
12914     (while (and (not (bobp))
12915                 (or (looking-at "^\\s-*\\(--.*\\)?$")
12916                     (> (current-indentation) indent)))
12917       (beginning-of-line -0))
12918     (if (= (current-indentation) indent)
12919         (back-to-indentation)
12920       (message "No preceding line with same indent found in this block")
12921       (goto-char pos)
12922       nil)))
12923
12924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12925 ;; Statistics
12926
12927 (defun vhdl-statistics-buffer ()
12928   "Get some file statistics."
12929   (interactive)
12930   (let ((no-stats 0)
12931         (no-code-lines 0)
12932         (no-empty-lines 0)
12933         (no-comm-lines 0)
12934         (no-comments 0)
12935         (no-lines (count-lines (point-min) (point-max))))
12936     (save-excursion
12937       ;; count statements
12938       (goto-char (point-min))
12939       (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12940         (if (match-string 1)
12941             (goto-char (match-end 1))
12942           (setq no-stats (1+ no-stats))))
12943       ;; count code lines
12944       (goto-char (point-min))
12945       (while (not (eobp))
12946         (unless (looking-at "^\\s-*\\(--.*\\)?$")
12947           (setq no-code-lines (1+ no-code-lines)))
12948         (beginning-of-line 2))
12949       ;; count empty lines
12950       (goto-char (point-min))
12951       (while (and (re-search-forward "^\\s-*$" nil t)
12952                   (not (eq (point) (point-max))))
12953         (if (match-string 1)
12954             (goto-char (match-end 1))
12955           (setq no-empty-lines (1+ no-empty-lines))
12956           (unless (eq (point) (point-max))
12957             (forward-char))))
12958       ;; count comment-only lines
12959       (goto-char (point-min))
12960       (while (re-search-forward "^\\s-*--.*" nil t)
12961         (if (match-string 1)
12962             (goto-char (match-end 1))
12963           (setq no-comm-lines (1+ no-comm-lines))))
12964       ;; count comments
12965       (goto-char (point-min))
12966       (while (re-search-forward "--.*" nil t)
12967         (if (match-string 1)
12968             (goto-char (match-end 1))
12969           (setq no-comments (1+ no-comments)))))
12970     ;; print results
12971     (message "\n\
12972 File statistics: \"%s\"\n\
12973 -----------------------\n\
12974 # statements    : %5d\n\
12975 # code lines    : %5d\n\
12976 # empty lines   : %5d\n\
12977 # comment lines : %5d\n\
12978 # comments      : %5d\n\
12979 # total lines   : %5d\n\ "
12980              (buffer-file-name) no-stats no-code-lines no-empty-lines
12981              no-comm-lines no-comments no-lines)
12982     (unless vhdl-emacs-21 (vhdl-show-messages))))
12983
12984 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12985 ;; Help functions
12986
12987 (defun vhdl-re-search-forward (regexp &optional bound noerror count)
12988   "Like `re-search-forward', but does not match within literals."
12989   (let (pos)
12990     (save-excursion
12991       (while (and (setq pos (re-search-forward regexp bound noerror count))
12992                   (vhdl-in-literal))))
12993     (when pos (goto-char pos))
12994     pos))
12995
12996 (defun vhdl-re-search-backward (regexp &optional bound noerror count)
12997   "Like `re-search-backward', but does not match within literals."
12998   (let (pos)
12999     (save-excursion
13000       (while (and (setq pos (re-search-backward regexp bound noerror count))
13001                   (vhdl-in-literal))))
13002     (when pos (goto-char pos))
13003     pos))
13004
13005
13006 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13007 ;;; Project
13008 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13009
13010 (defun vhdl-set-project (name)
13011   "Set current project to NAME."
13012   (interactive
13013    (list (let ((completion-ignore-case t))
13014            (completing-read "Project name: " vhdl-project-alist nil t))))
13015   (cond ((equal name "")
13016          (setq vhdl-project nil)
13017          (message "Current VHDL project: None"))
13018         ((assoc name vhdl-project-alist)
13019          (setq vhdl-project name)
13020          (message "Current VHDL project: \"%s\"" name))
13021         (t
13022          (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
13023   (vhdl-speedbar-update-current-project))
13024
13025 (defun vhdl-set-default-project ()
13026   "Set current project as default on startup."
13027   (interactive)
13028   (customize-set-variable 'vhdl-project vhdl-project)
13029   (customize-save-customized))
13030
13031 (defun vhdl-toggle-project (name token indent)
13032   "Set current project to NAME or unset if NAME is current project."
13033   (vhdl-set-project (if (equal name vhdl-project) "" name)))
13034
13035 (defun vhdl-export-project (file-name)
13036   "Write project setup for current project."
13037   (interactive
13038    (let ((name (vhdl-resolve-env-variable
13039                 (vhdl-replace-string
13040                  (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13041                  (concat (subst-char-in-string
13042                           ?  ?_ (or (vhdl-project-p)
13043                                     (error "ERROR:  No current project")))
13044                          " " (user-login-name))))))
13045      (list (read-file-name
13046             "Write project file: "
13047             (when (file-name-absolute-p name) "") nil nil name))))
13048   (setq file-name (abbreviate-file-name file-name))
13049   (let ((orig-buffer (current-buffer)))
13050     (unless (file-exists-p (file-name-directory file-name))
13051       (make-directory (file-name-directory file-name) t))
13052     (if (not (file-writable-p file-name))
13053         (error "ERROR:  File not writable: \"%s\"" file-name)
13054       (set-buffer (find-file-noselect file-name t t))
13055       (erase-buffer)
13056       (insert ";; -*- Emacs-Lisp -*-\n\n"
13057               ";;; " (file-name-nondirectory file-name)
13058               " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
13059               ";; Project : " vhdl-project "\n"
13060               ";; Saved   : " (format-time-string "%Y-%m-%d %T ")
13061               (user-login-name) "\n\n\n"
13062               ";; project name\n"
13063               "(setq vhdl-project \"" vhdl-project "\")\n\n"
13064               ";; project setup\n"
13065               "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
13066       (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
13067       (insert ")\n")
13068       (save-buffer)
13069       (kill-buffer (current-buffer))
13070       (set-buffer orig-buffer))))
13071
13072 (defun vhdl-import-project (file-name &optional auto not-make-current)
13073   "Read project setup and set current project."
13074   (interactive
13075    (let ((name (vhdl-resolve-env-variable
13076                 (vhdl-replace-string
13077                  (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13078                  (concat "" " " (user-login-name))))))
13079      (list (read-file-name
13080             "Read project file: " (when (file-name-absolute-p name) "") nil t
13081             (file-name-directory name)))))
13082   (when (file-exists-p file-name)
13083     (condition-case ()
13084         (let ((current-project vhdl-project))
13085           (load-file file-name)
13086           (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10)
13087             (vhdl-adelete 'vhdl-project-alist vhdl-project)
13088             (error ""))
13089           (if not-make-current
13090               (setq vhdl-project current-project)
13091             (setq vhdl-compiler
13092                   (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project)))))
13093           (vhdl-update-mode-menu)
13094           (vhdl-speedbar-refresh)
13095           (unless not-make-current
13096             (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s"
13097                      vhdl-project vhdl-compiler (if auto " (auto-loaded)" ""))))
13098       (error (vhdl-warning
13099               (format "ERROR:  Invalid project setup file: \"%s\"" file-name))))))
13100
13101 (defun vhdl-duplicate-project ()
13102   "Duplicate setup of current project."
13103   (interactive)
13104   (let ((new-name (read-from-minibuffer "New project name: "))
13105         (project-entry (vhdl-aget vhdl-project-alist vhdl-project)))
13106     (setq vhdl-project-alist
13107           (append vhdl-project-alist
13108                   (list (cons new-name project-entry))))
13109     (vhdl-update-mode-menu)))
13110
13111 (defun vhdl-auto-load-project ()
13112   "Automatically load project setup at startup."
13113   (let ((file-name-list vhdl-project-file-name)
13114         file-list list-length)
13115     (while file-name-list
13116       (setq file-list
13117             (append file-list
13118                     (file-expand-wildcards
13119                      (vhdl-resolve-env-variable
13120                       (vhdl-replace-string
13121                        (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
13122                        (concat "\*" " " (user-login-name)))))))
13123       (setq list-length (or list-length (length file-list)))
13124       (setq file-name-list (cdr file-name-list)))
13125     (while file-list
13126       (vhdl-import-project (expand-file-name (car file-list)) t
13127                            (not (> list-length 0)))
13128       (setq list-length (1- list-length))
13129       (setq file-list (cdr file-list)))))
13130
13131 ;; automatically load project setup when idle after startup
13132 (when (memq 'startup vhdl-project-auto-load)
13133   (if noninteractive
13134       (vhdl-auto-load-project)
13135     (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project)))
13136
13137
13138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13139 ;;; Hideshow
13140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13141 ;; (using `hideshow.el')
13142
13143 (defconst vhdl-hs-start-regexp
13144   (concat
13145    "\\(^\\)\\s-*\\("
13146    ;; generic/port clause
13147    "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
13148    ;; component
13149    "component\\>\\|"
13150    ;; component instantiation
13151    "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
13152    "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13153    "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
13154    "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
13155    ;; subprogram
13156    "\\(function\\|procedure\\)\\>\\|"
13157    ;; process, block
13158    "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
13159    ;; configuration declaration
13160    "configuration\\>"
13161    "\\)")
13162   "Regexp to match start of construct to hide.")
13163
13164 (defun vhdl-hs-forward-sexp-func (count)
13165   "Find end of construct to hide (for hideshow).  Only searches forward."
13166   (let ((pos (point)))
13167     (vhdl-prepare-search-2
13168      (beginning-of-line)
13169      (cond
13170       ;; generic/port clause
13171       ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
13172        (goto-char (match-end 0))
13173        (backward-char)
13174        (forward-sexp))
13175       ;; component declaration
13176       ((looking-at "^\\s-*component\\>")
13177        (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
13178       ;; component instantiation
13179       ((looking-at
13180         (concat
13181          "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
13182          "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13183          "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
13184          "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
13185        (goto-char (match-end 0))
13186        (backward-char)
13187        (forward-sexp)
13188        (setq pos (point))
13189        (vhdl-forward-syntactic-ws)
13190        (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
13191          (goto-char (match-end 0))
13192          (backward-char)
13193          (forward-sexp)
13194          (setq pos (point)))
13195        (goto-char pos))
13196       ;; subprogram declaration/body
13197       ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
13198        (goto-char (match-end 0))
13199        (vhdl-forward-syntactic-ws)
13200        (when (looking-at "(")
13201          (forward-sexp))
13202        (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
13203                    (vhdl-in-literal)))
13204        ;; subprogram body
13205        (when (match-string 2)
13206          (re-search-forward "^\\s-*\\<begin\\>" nil t)
13207          (backward-word 1)
13208          (vhdl-forward-sexp)))
13209       ;; block (recursive)
13210       ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
13211        (goto-char (match-end 0))
13212        (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
13213                    (match-beginning 2))
13214          (vhdl-hs-forward-sexp-func count)))
13215       ;; process
13216       ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
13217        (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
13218       ;; configuration declaration
13219       ((looking-at "^\\s-*configuration\\>")
13220        (forward-word 4)
13221        (vhdl-forward-sexp))
13222       (t (goto-char pos))))))
13223
13224 (defun vhdl-hideshow-init ()
13225   "Initialize `hideshow'."
13226   (when vhdl-hideshow-menu
13227     (vhdl-hs-minor-mode 1)))
13228
13229 (defun vhdl-hs-minor-mode (&optional arg)
13230   "Toggle hideshow minor mode and update menu bar."
13231   (interactive "P")
13232   (require 'hideshow)
13233   ;; check for hideshow version 5.x
13234   (if (not (boundp 'hs-block-start-mdata-select))
13235       (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
13236     ;; initialize hideshow
13237     (unless (assoc 'vhdl-mode hs-special-modes-alist)
13238       (setq hs-special-modes-alist
13239             (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
13240                         'vhdl-hs-forward-sexp-func nil)
13241                   hs-special-modes-alist)))
13242     (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
13243     (if vhdl-hide-all-init
13244         (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t)
13245       (remove-hook 'hs-minor-mode-hook 'hs-hide-all t))
13246     (hs-minor-mode arg)
13247     (force-mode-line-update)))          ; hack to update menu bar
13248
13249
13250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13251 ;;; Font locking
13252 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13253 ;; (using `font-lock.el')
13254
13255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13256 ;; Help functions
13257
13258 (defun vhdl-within-translate-off ()
13259   "Return point if within translate-off region, else nil."
13260   (and (save-excursion
13261          (re-search-backward
13262           "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t))
13263        (equal "off" (match-string 1))
13264        (point)))
13265
13266 (defun vhdl-start-translate-off (limit)
13267   "Return point before translate-off pragma if before LIMIT, else nil."
13268   (when (re-search-forward
13269          "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t)
13270     (match-beginning 0)))
13271
13272 (defun vhdl-end-translate-off (limit)
13273   "Return point after translate-on pragma if before LIMIT, else nil."
13274   (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t))
13275
13276 (defun vhdl-match-translate-off (limit)
13277   "Match a translate-off block, setting match-data and returning t, else nil."
13278   (when (< (point) limit)
13279     (let ((start (or (vhdl-within-translate-off)
13280                      (vhdl-start-translate-off limit)))
13281           (case-fold-search t))
13282       (when start
13283         (let ((end (or (vhdl-end-translate-off limit) limit)))
13284           (set-match-data (list start end))
13285           (goto-char end))))))
13286
13287 (defun vhdl-font-lock-match-item (limit)
13288   "Match, and move over, any declaration item after point.  Adapted from
13289 `font-lock-match-c-style-declaration-item-and-skip-to-next'."
13290   (condition-case nil
13291       (save-restriction
13292         (narrow-to-region (point-min) limit)
13293         ;; match item
13294         (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
13295           (save-match-data
13296             (goto-char (match-end 1))
13297             ;; move to next item
13298             (if (looking-at "\\(\\s-*,\\)")
13299                 (goto-char (match-end 1))
13300               (end-of-line) t))))
13301     (error t)))
13302
13303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13304 ;; Syntax definitions
13305
13306 (defconst vhdl-font-lock-syntactic-keywords
13307   '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
13308   "Mark single quotes as having string quote syntax in 'c' instances.")
13309
13310 (defvar vhdl-font-lock-keywords nil
13311   "Regular expressions to highlight in VHDL Mode.")
13312
13313 (defvar vhdl-font-lock-keywords-0
13314   ;; set in `vhdl-font-lock-init' because dependent on user options
13315   "For consideration as a value of `vhdl-font-lock-keywords'.
13316 This does highlighting of template prompts and directives (pragmas).")
13317
13318 (defvar vhdl-font-lock-keywords-1 nil
13319   ;; set in `vhdl-font-lock-init' because dependent on user options
13320   "For consideration as a value of `vhdl-font-lock-keywords'.
13321 This does highlighting of keywords and standard identifiers.")
13322
13323 (defconst vhdl-font-lock-keywords-2
13324   (list
13325    ;; highlight names of units, subprograms, and components when declared
13326    (list
13327     (concat
13328      "^\\s-*\\("
13329      "architecture\\|configuration\\|context\\|entity\\|package"
13330      "\\(\\s-+body\\)?\\|"
13331      "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
13332      "\\)\\s-+\\(\\w+\\)")
13333     5 'font-lock-function-name-face)
13334
13335    ;; highlight entity names of architectures and configurations
13336    (list
13337     "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
13338     2 'font-lock-function-name-face)
13339
13340    ;; highlight labels of common constructs
13341    (list
13342     (concat
13343      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
13344      "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
13345      "postponed\\|process\\|"
13346      (when (vhdl-standard-p 'ams) "procedural\\|")
13347      "with\\|while"
13348      "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)")
13349     1 'font-lock-function-name-face)
13350
13351    ;; highlight label and component name of component instantiations
13352    (list
13353     (concat
13354      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
13355      "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
13356     '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
13357
13358    ;; highlight label and instantiated unit of component instantiations
13359    (list
13360     (concat
13361      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
13362      "\\(component\\|configuration\\|entity\\)\\s-+"
13363      "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
13364     '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
13365     '(5 font-lock-function-name-face nil t)
13366     '(7 font-lock-function-name-face nil t))
13367
13368    ;; highlight names and labels at end of constructs
13369    (list
13370     (concat
13371      "^\\s-*end\\s-+\\(\\("
13372      "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
13373      "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
13374      "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
13375      (when (vhdl-standard-p 'ams) "procedural\\|")
13376      "units"
13377      "\\)\\s-+\\)?\\(\\w*\\)")
13378     5 'font-lock-function-name-face)
13379
13380    ;; highlight labels in exit and next statements
13381    (list
13382     (concat
13383      "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
13384     3 'font-lock-function-name-face)
13385
13386    ;; highlight entity name in attribute specifications
13387    (list
13388     (concat
13389      "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
13390     1 'font-lock-function-name-face)
13391
13392    ;; highlight labels in block and component specifications
13393    (list
13394     (concat
13395      "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
13396      "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
13397     '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
13398
13399    ;; highlight names in library clauses
13400    (list "^\\s-*library\\>"
13401          '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
13402
13403    ;; highlight names in use clauses
13404    (list
13405     (concat
13406      "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
13407      "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
13408     '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
13409     '(8 font-lock-function-name-face nil t))
13410
13411    ;; highlight attribute name in attribute declarations/specifications
13412    (list
13413     (concat
13414      "^\\s-*attribute\\s-+\\(\\w+\\)")
13415     1 'vhdl-font-lock-attribute-face)
13416
13417    ;; highlight type/nature name in (sub)type/(sub)nature declarations
13418    (list
13419     (concat
13420      "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
13421     5 'font-lock-type-face)
13422
13423    ;; highlight signal/variable/constant declaration names
13424    (list "\\(:[^=]\\)"
13425          '(vhdl-font-lock-match-item
13426            (progn (goto-char (match-beginning 1))
13427                   (skip-syntax-backward " ")
13428                   (skip-syntax-backward "w_")
13429                   (skip-syntax-backward " ")
13430                   (while (= (preceding-char) ?,)
13431                     (backward-char 1)
13432                     (skip-syntax-backward " ")
13433                     (skip-syntax-backward "w_")
13434                     (skip-syntax-backward " ")))
13435            (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13436
13437    ;; highlight formal parameters in component instantiations and subprogram
13438    ;; calls
13439    (list "\\(=>\\)"
13440          '(vhdl-font-lock-match-item
13441            (progn (goto-char (match-beginning 1))
13442                   (skip-syntax-backward " ")
13443                   (while (= (preceding-char) ?\)) (backward-sexp))
13444                   (skip-syntax-backward "w_")
13445                   (skip-syntax-backward " ")
13446                   (when (memq (preceding-char) '(?n ?N ?|))
13447                     (goto-char (point-max))))
13448            (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13449
13450    ;; highlight alias/group/quantity declaration names and for-loop/-generate
13451    ;; variables
13452    (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
13453          '(vhdl-font-lock-match-item
13454            (progn (goto-char (match-end 1)) (match-beginning 2))
13455            nil (1 font-lock-variable-name-face)))
13456
13457    ;; highlight tool directives
13458    (list
13459     (concat
13460      "^\\s-*\\(`\\w+\\)")
13461     1 'font-lock-preprocessor-face)
13462    )
13463   "For consideration as a value of `vhdl-font-lock-keywords'.
13464 This does context sensitive highlighting of names and labels.")
13465
13466 (defvar vhdl-font-lock-keywords-3 nil
13467   ;; set in `vhdl-font-lock-init' because dependent on user options
13468   "For consideration as a value of `vhdl-font-lock-keywords'.
13469 This does highlighting of words with special syntax.")
13470
13471 (defvar vhdl-font-lock-keywords-4 nil
13472   ;; set in `vhdl-font-lock-init' because dependent on user options
13473   "For consideration as a value of `vhdl-font-lock-keywords'.
13474 This does highlighting of additional reserved words.")
13475
13476 (defconst vhdl-font-lock-keywords-5
13477   ;; background highlight translate-off regions
13478   '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append)))
13479   "For consideration as a value of `vhdl-font-lock-keywords'.
13480 This does background highlighting of translate-off regions.")
13481
13482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13483 ;; Font and color definitions
13484
13485 (defvar vhdl-font-lock-prompt-face         'vhdl-font-lock-prompt-face
13486   "Face name to use for prompts.")
13487
13488 (defvar vhdl-font-lock-attribute-face      'vhdl-font-lock-attribute-face
13489   "Face name to use for standardized attributes.")
13490
13491 (defvar vhdl-font-lock-enumvalue-face      'vhdl-font-lock-enumvalue-face
13492   "Face name to use for standardized enumeration values.")
13493
13494 (defvar vhdl-font-lock-function-face       'vhdl-font-lock-function-face
13495   "Face name to use for standardized functions and packages.")
13496
13497 (defvar vhdl-font-lock-directive-face      'vhdl-font-lock-directive-face
13498   "Face name to use for directives.")
13499
13500 (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face
13501   "Face name to use for additional reserved words.")
13502
13503 (defvar vhdl-font-lock-translate-off-face  'vhdl-font-lock-translate-off-face
13504   "Face name to use for translate-off regions.")
13505
13506 ;; face names to use for words with special syntax.
13507 (let ((syntax-alist vhdl-special-syntax-alist)
13508       name)
13509   (while syntax-alist
13510     (setq name (vhdl-function-name
13511                 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
13512     (eval `(defvar ,name ',name
13513              ,(concat "Face name to use for "
13514                       (nth 0 (car syntax-alist)) ".")))
13515     (setq syntax-alist (cdr syntax-alist))))
13516
13517 (defgroup vhdl-highlight-faces nil
13518   "Faces for highlighting."
13519   :group 'vhdl-highlight)
13520
13521 ;; add faces used from `font-lock'
13522 (custom-add-to-group
13523  'vhdl-highlight-faces 'font-lock-comment-face 'custom-face)
13524 (custom-add-to-group
13525  'vhdl-highlight-faces 'font-lock-string-face 'custom-face)
13526 (custom-add-to-group
13527  'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face)
13528 (custom-add-to-group
13529  'vhdl-highlight-faces 'font-lock-type-face 'custom-face)
13530 (custom-add-to-group
13531  'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face)
13532 (custom-add-to-group
13533  'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
13534
13535 (defface vhdl-font-lock-prompt-face
13536   '((((min-colors 88) (class color) (background light))
13537      (:foreground "Red1" :bold t))
13538     (((class color) (background light)) (:foreground "Red" :bold t))
13539     (((class color) (background dark)) (:foreground "Pink" :bold t))
13540     (t (:inverse-video t)))
13541   "Font lock mode face used to highlight prompts."
13542   :group 'vhdl-highlight-faces)
13543
13544 (defface vhdl-font-lock-attribute-face
13545   '((((class color) (background light)) (:foreground "Orchid"))
13546     (((class color) (background dark)) (:foreground "LightSteelBlue"))
13547     (t (:italic t :bold t)))
13548   "Font lock mode face used to highlight standardized attributes."
13549   :group 'vhdl-highlight-faces)
13550
13551 (defface vhdl-font-lock-enumvalue-face
13552   '((((class color) (background light)) (:foreground "SaddleBrown"))
13553     (((class color) (background dark)) (:foreground "BurlyWood"))
13554     (t (:italic t :bold t)))
13555   "Font lock mode face used to highlight standardized enumeration values."
13556   :group 'vhdl-highlight-faces)
13557
13558 (defface vhdl-font-lock-function-face
13559   '((((class color) (background light)) (:foreground "Cyan4"))
13560     (((class color) (background dark)) (:foreground "Orchid1"))
13561     (t (:italic t :bold t)))
13562   "Font lock mode face used to highlight standardized functions and packages."
13563   :group 'vhdl-highlight-faces)
13564
13565 (defface vhdl-font-lock-directive-face
13566   '((((class color) (background light)) (:foreground "CadetBlue"))
13567     (((class color) (background dark)) (:foreground "Aquamarine"))
13568     (t (:italic t :bold t)))
13569   "Font lock mode face used to highlight directives."
13570   :group 'vhdl-highlight-faces)
13571
13572 (defface vhdl-font-lock-reserved-words-face
13573   '((((class color) (background light)) (:foreground "Orange" :bold t))
13574     (((min-colors 88) (class color) (background dark))
13575      (:foreground "Yellow1" :bold t))
13576     (((class color) (background dark)) (:foreground "Yellow" :bold t))
13577     (t ()))
13578   "Font lock mode face used to highlight additional reserved words."
13579   :group 'vhdl-highlight-faces)
13580
13581 (defface vhdl-font-lock-translate-off-face
13582   '((((class color) (background light)) (:background "LightGray"))
13583     (((class color) (background dark)) (:background "DimGray"))
13584     (t ()))
13585   "Font lock mode face used to background highlight translate-off regions."
13586   :group 'vhdl-highlight-faces)
13587
13588 ;; font lock mode faces used to highlight words with special syntax.
13589 (let ((syntax-alist vhdl-special-syntax-alist))
13590   (while syntax-alist
13591     (eval `(defface ,(vhdl-function-name
13592                       "vhdl-font-lock" (caar syntax-alist) "face")
13593              '((((class color) (background light))
13594                 (:foreground ,(nth 2 (car syntax-alist))))
13595                (((class color) (background dark))
13596                 (:foreground ,(nth 3 (car syntax-alist))))
13597                (t ()))
13598              ,(concat "Font lock mode face used to highlight "
13599                       (nth 0 (car syntax-alist)) ".")
13600              :group 'vhdl-highlight-faces))
13601     (setq syntax-alist (cdr syntax-alist))))
13602
13603 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13604 ;; Font lock initialization
13605
13606 (defun vhdl-font-lock-init ()
13607   "Initialize fontification."
13608   ;; highlight template prompts and directives
13609   (setq vhdl-font-lock-keywords-0
13610         (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
13611                             vhdl-template-prompt-syntax ">\\)")
13612                     2 'vhdl-font-lock-prompt-face t)
13613               (list (concat "--\\s-*"
13614                             vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
13615                     2 'vhdl-font-lock-directive-face t)
13616               ;; highlight c-preprocessor directives
13617               (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
13618                     '(1 font-lock-builtin-face)
13619                     '(3 font-lock-variable-name-face nil t))))
13620   ;; highlight keywords and standardized types, attributes, enumeration
13621   ;; values, and subprograms
13622   (setq vhdl-font-lock-keywords-1
13623         (list
13624          (list (concat "'" vhdl-attributes-regexp)
13625                1 'vhdl-font-lock-attribute-face)
13626          (list vhdl-types-regexp       1 'font-lock-type-face)
13627          (list vhdl-functions-regexp   1 'vhdl-font-lock-function-face)
13628          (list vhdl-packages-regexp    1 'vhdl-font-lock-function-face)
13629          (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
13630          (list vhdl-constants-regexp   1 'font-lock-constant-face)
13631          (list vhdl-keywords-regexp    1 'font-lock-keyword-face)))
13632   ;; highlight words with special syntax.
13633   (setq vhdl-font-lock-keywords-3
13634         (let ((syntax-alist vhdl-special-syntax-alist)
13635               keywords)
13636           (while syntax-alist
13637             (setq keywords
13638                   (cons
13639                    (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1
13640                          (vhdl-function-name
13641                           "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")
13642                          (nth 4 (car syntax-alist)))
13643                    keywords))
13644             (setq syntax-alist (cdr syntax-alist)))
13645           keywords))
13646   ;; highlight additional reserved words
13647   (setq vhdl-font-lock-keywords-4
13648         (list (list vhdl-reserved-words-regexp 1
13649                     'vhdl-font-lock-reserved-words-face)))
13650   ;; highlight everything together
13651   (setq vhdl-font-lock-keywords
13652         (append
13653          vhdl-font-lock-keywords-0
13654          (when vhdl-highlight-keywords vhdl-font-lock-keywords-1)
13655          (when (or vhdl-highlight-forbidden-words
13656                    vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4)
13657          (when vhdl-highlight-special-words vhdl-font-lock-keywords-3)
13658          (when vhdl-highlight-names vhdl-font-lock-keywords-2)
13659          (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5))))
13660
13661 ;; initialize fontification for VHDL Mode
13662 (vhdl-font-lock-init)
13663
13664 (defun vhdl-fontify-buffer ()
13665   "Re-initialize fontification and fontify buffer."
13666   (interactive)
13667   (setq font-lock-defaults
13668         `(vhdl-font-lock-keywords
13669           nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
13670           beginning-of-line))
13671   (when (fboundp 'font-lock-unset-defaults)
13672     (font-lock-unset-defaults))         ; not implemented in XEmacs
13673   (font-lock-set-defaults)
13674   (font-lock-mode nil)
13675   (font-lock-mode t))
13676
13677 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13678 ;; Initialization for PostScript printing
13679
13680 (defun vhdl-ps-print-settings ()
13681   "Initialize custom face and page settings for PostScript printing."
13682   ;; define custom face settings
13683   (unless (or (not vhdl-print-customize-faces)
13684               ps-print-color-p)
13685     (set (make-local-variable 'ps-bold-faces)
13686          '(font-lock-keyword-face
13687            font-lock-type-face
13688            vhdl-font-lock-attribute-face
13689            vhdl-font-lock-enumvalue-face
13690            vhdl-font-lock-directive-face))
13691     (set (make-local-variable 'ps-italic-faces)
13692          '(font-lock-comment-face
13693            font-lock-function-name-face
13694            font-lock-type-face
13695            vhdl-font-lock-attribute-face
13696            vhdl-font-lock-enumvalue-face
13697            vhdl-font-lock-directive-face))
13698     (set (make-local-variable 'ps-underlined-faces)
13699          '(font-lock-string-face))
13700     (setq ps-always-build-face-reference t))
13701   ;; define page settings, so that a line containing 79 characters (default)
13702   ;; fits into one column
13703   (when vhdl-print-two-column
13704     (set (make-local-variable 'ps-landscape-mode) t)
13705     (set (make-local-variable 'ps-number-of-columns) 2)
13706     (set (make-local-variable 'ps-font-size) 7.0)
13707     (set (make-local-variable 'ps-header-title-font-size) 10.0)
13708     (set (make-local-variable 'ps-header-font-size) 9.0)
13709     (set (make-local-variable 'ps-header-offset) 12.0)
13710     (when (eq ps-paper-type 'letter)
13711       (set (make-local-variable 'ps-inter-column) 40.0)
13712       (set (make-local-variable 'ps-left-margin) 40.0)
13713       (set (make-local-variable 'ps-right-margin) 40.0))))
13714
13715 (defun vhdl-ps-print-init ()
13716   "Initialize PostScript printing."
13717   (if (featurep 'xemacs)
13718       (when (boundp 'ps-print-color-p)
13719         (vhdl-ps-print-settings))
13720     (if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
13721     (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t)))
13722
13723
13724 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13725 ;;; Hierarchy browser (using `speedbar.el')
13726 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13727 ;; Allows displaying the hierarchy of all VHDL design units contained in a
13728 ;; directory by using the speedbar.
13729
13730 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13731 ;; Variables
13732
13733 (defvar vhdl-entity-alist nil
13734   "Cache with entities and corresponding architectures for each
13735 project/directory.")
13736 ;; structure: (parenthesized expression means list of such entries)
13737 ;; (cache-key
13738 ;;   (ent-key ent-name ent-file ent-line
13739 ;;     (arch-key arch-name arch-file arch-line
13740 ;;       (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
13741 ;;                 inst-arch-key inst-conf-key inst-lib-key inst-path)
13742 ;;       (lib-name pack-key))
13743 ;;     mra-key (lib-name pack-key))
13744
13745 (defvar vhdl-config-alist nil
13746   "Cache with configurations for each project/directory.")
13747 ;; structure: (parenthesized expression means list of such entries)
13748 ;; (cache-key
13749 ;;   (conf-key conf-name conf-file conf-line ent-key arch-key
13750 ;;     (inst-key inst-comp-name inst-ent-key inst-arch-key
13751 ;;               inst-conf-key inst-lib-key)
13752 ;;     (lib-name pack-key)))
13753
13754 (defvar vhdl-package-alist nil
13755   "Cache with packages for each project/directory.")
13756 ;; structure: (parenthesized expression means list of such entries)
13757 ;; (cache-key
13758 ;;   (pack-key pack-name pack-file pack-line
13759 ;;     (comp-key comp-name comp-file comp-line)
13760 ;;     (func-key func-name func-file func-line)
13761 ;;     (lib-name pack-key)
13762 ;;     pack-body-file pack-body-line
13763 ;;     (func-key func-name func-body-file func-body-line)
13764 ;;     (lib-name pack-key)))
13765
13766 (defvar vhdl-ent-inst-alist nil
13767   "Cache with instantiated entities for each project/directory.")
13768 ;; structure: (parenthesized expression means list of such entries)
13769 ;; (cache-key (inst-ent-key))
13770
13771 (defvar vhdl-file-alist nil
13772   "Cache with design units in each file for each project/directory.")
13773 ;; structure: (parenthesized expression means list of such entries)
13774 ;; (cache-key
13775 ;;   (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
13776 ;;              (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
13777
13778 (defvar vhdl-directory-alist nil
13779   "Cache with source directories for each project.")
13780 ;; structure: (parenthesized expression means list of such entries)
13781 ;; (cache-key (directory))
13782
13783 (defvar vhdl-speedbar-shown-unit-alist nil
13784   "Alist of design units simultaneously open in the current speedbar for each
13785 directory and project.")
13786
13787 (defvar vhdl-speedbar-shown-project-list nil
13788   "List of projects simultaneously open in the current speedbar.")
13789
13790 (defvar vhdl-updated-project-list nil
13791   "List of projects and directories with updated files.")
13792
13793 (defvar vhdl-modified-file-list nil
13794   "List of modified files to be rescanned for hierarchy updating.")
13795
13796 (defvar vhdl-speedbar-hierarchy-depth 0
13797   "Depth of instantiation hierarchy to display.")
13798
13799 (defvar vhdl-speedbar-show-projects nil
13800   "Non-nil means project hierarchy is displayed in speedbar, directory
13801 hierarchy otherwise.")
13802
13803 (defun vhdl-get-end-of-unit ()
13804   "Return position of end of current unit."
13805   (let ((pos (point)))
13806     (save-excursion
13807       (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
13808                   (save-excursion
13809                     (goto-char (match-beginning 0))
13810                     (vhdl-backward-syntactic-ws)
13811                     (and (/= (preceding-char) ?\;) (not (bobp))))))
13812       (re-search-backward "^[ \t]*end\\>" pos 1)
13813       (point))))
13814
13815 (defun vhdl-match-string-downcase (num &optional string)
13816   "Like `match-string-no-properties' with down-casing."
13817   (let ((match (match-string-no-properties num string)))
13818     (and match (downcase match))))
13819
13820
13821 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13822 ;; Scan functions
13823
13824 (defun vhdl-scan-context-clause ()
13825   "Scan the context clause that precedes a design unit."
13826   (let (lib-alist)
13827     (save-excursion
13828       (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t)
13829         (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
13830                     (equal "USE" (upcase (match-string 1))))
13831           (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
13832             (push (cons (match-string-no-properties 1)
13833                                         (vhdl-match-string-downcase 2))
13834                   lib-alist)))))
13835     lib-alist))
13836
13837 (defun vhdl-scan-directory-contents (name &optional project update num-string
13838                                           non-final)
13839   "Scan contents of VHDL files in directory or file pattern NAME."
13840   (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
13841   (let* ((dir-name (match-string 1 name))
13842          (file-pattern (match-string 2 name))
13843          (is-directory (= 0 (length file-pattern)))
13844          (file-list
13845           (if update
13846               (list name)
13847             (if is-directory
13848                 (vhdl-get-source-files t dir-name)
13849               (vhdl-directory-files
13850                dir-name t (wildcard-to-regexp file-pattern)))))
13851          (key (or project dir-name))
13852          (file-exclude-regexp
13853           (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
13854          (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
13855          (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
13856          (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
13857          ent-alist conf-alist pack-alist ent-inst-list file-alist
13858          tmp-list tmp-entry no-files files-exist big-files)
13859     (when (or project update)
13860       (setq ent-alist (vhdl-aget vhdl-entity-alist key)
13861             conf-alist (vhdl-aget vhdl-config-alist key)
13862             pack-alist (vhdl-aget vhdl-package-alist key)
13863             ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key))
13864             file-alist (vhdl-aget vhdl-file-alist key)))
13865     (when (and (not is-directory) (null file-list))
13866       (message "No such file: \"%s\"" name))
13867     (setq files-exist file-list)
13868     (when file-list
13869       (setq no-files (length file-list))
13870       (message "Scanning %s %s\"%s\"..."
13871                (if is-directory "directory" "files") (or num-string "") name)
13872       ;; exclude files
13873       (unless (equal file-exclude-regexp "")
13874         (let ((case-fold-search nil)
13875               file-tmp-list)
13876           (while file-list
13877             (unless (string-match file-exclude-regexp (car file-list))
13878               (push (car file-list) file-tmp-list))
13879             (setq file-list (cdr file-list)))
13880           (setq file-list (nreverse file-tmp-list))))
13881       ;; do for all files
13882       (while file-list
13883         (unless noninteractive
13884           (message "Scanning %s %s\"%s\"... (%2d%%)"
13885                    (if is-directory "directory" "files")
13886                    (or num-string "") name
13887                    (floor (* 100.0 (- no-files (length file-list))) no-files)))
13888         (let ((file-name (abbreviate-file-name (car file-list)))
13889               ent-list arch-list arch-ent-list conf-list
13890               pack-list pack-body-list inst-list inst-ent-list)
13891           ;; scan file
13892           (vhdl-visit-file
13893            file-name nil
13894            (vhdl-prepare-search-2
13895             (save-excursion
13896               ;; scan for design units
13897               (if (and limit-design-file-size
13898                        (< limit-design-file-size (buffer-size)))
13899                   (progn (message "WARNING:  Scan limit (design units: file size) reached in file:\n  \"%s\"" file-name)
13900                          (setq big-files t))
13901                 ;; scan for entities
13902                 (goto-char (point-min))
13903                 (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13904                   (let* ((ent-name (match-string-no-properties 1))
13905                          (ent-key (downcase ent-name))
13906                          (ent-entry (vhdl-aget ent-alist ent-key))
13907                          (lib-alist (vhdl-scan-context-clause)))
13908                     (if (nth 1 ent-entry)
13909                         (vhdl-warning-when-idle
13910                          "Entity declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13911                          ent-name  (nth 1 ent-entry) (nth 2 ent-entry)
13912                          file-name (vhdl-current-line))
13913                       (push ent-key ent-list)
13914                       (vhdl-aput 'ent-alist ent-key
13915                                  (list ent-name file-name (vhdl-current-line)
13916                                        (nth 3 ent-entry) (nth 4 ent-entry)
13917                                        lib-alist)))))
13918                 ;; scan for architectures
13919                 (goto-char (point-min))
13920                 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13921                   (let* ((arch-name (match-string-no-properties 1))
13922                          (arch-key (downcase arch-name))
13923                          (ent-name (match-string-no-properties 2))
13924                          (ent-key (downcase ent-name))
13925                          (ent-entry (vhdl-aget ent-alist ent-key))
13926                          (arch-alist (nth 3 ent-entry))
13927                          (arch-entry (vhdl-aget arch-alist arch-key))
13928                          (lib-arch-alist (vhdl-scan-context-clause)))
13929                     (if arch-entry
13930                         (vhdl-warning-when-idle
13931                          "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13932                          arch-name ent-name (nth 1 arch-entry)
13933                          (nth 2 arch-entry) file-name (vhdl-current-line))
13934                       (setq arch-list (cons arch-key arch-list)
13935                             arch-ent-list (cons ent-key arch-ent-list))
13936                       (vhdl-aput 'arch-alist arch-key
13937                                  (list arch-name file-name (vhdl-current-line)
13938                                        nil lib-arch-alist))
13939                       (vhdl-aput 'ent-alist ent-key
13940                                  (list (or (nth 0 ent-entry) ent-name)
13941                                        (nth 1 ent-entry) (nth 2 ent-entry)
13942                                        (vhdl-sort-alist arch-alist)
13943                                        arch-key (nth 5 ent-entry))))))
13944                 ;; scan for configurations
13945                 (goto-char (point-min))
13946                 (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13947                   (let* ((conf-name (match-string-no-properties 1))
13948                          (conf-key (downcase conf-name))
13949                          (conf-entry (vhdl-aget conf-alist conf-key))
13950                          (ent-name (match-string-no-properties 2))
13951                          (ent-key (downcase ent-name))
13952                          (lib-alist (vhdl-scan-context-clause))
13953                          (conf-line (vhdl-current-line))
13954                          (end-of-unit (vhdl-get-end-of-unit))
13955                          arch-key comp-conf-list inst-key-list
13956                          inst-comp-key inst-ent-key inst-arch-key
13957                          inst-conf-key inst-lib-key)
13958                     (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
13959                       (setq arch-key (vhdl-match-string-downcase 1)))
13960                     (if conf-entry
13961                         (vhdl-warning-when-idle
13962                          "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13963                          conf-name ent-name (nth 1 conf-entry)
13964                          (nth 2 conf-entry) file-name conf-line)
13965                       (push conf-key conf-list)
13966                       ;; scan for subconfigurations and subentities
13967                       (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t)
13968                         (setq inst-comp-key (vhdl-match-string-downcase 3)
13969                               inst-key-list (split-string
13970                                              (vhdl-match-string-downcase 1)
13971                                              "[ \t\n\r\f]*,[ \t\n\r\f]*"))
13972                         (vhdl-forward-syntactic-ws)
13973                         (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
13974                           (setq
13975                            inst-lib-key (vhdl-match-string-downcase 3)
13976                            inst-ent-key (and (match-string 2)
13977                                              (vhdl-match-string-downcase 4))
13978                            inst-arch-key (and (match-string 2)
13979                                               (vhdl-match-string-downcase 6))
13980                            inst-conf-key (and (not (match-string 2))
13981                                               (vhdl-match-string-downcase 4)))
13982                           (while inst-key-list
13983                             (setq comp-conf-list
13984                                   (cons (list (car inst-key-list)
13985                                               inst-comp-key inst-ent-key
13986                                               inst-arch-key inst-conf-key
13987                                               inst-lib-key)
13988                                         comp-conf-list))
13989                             (setq inst-key-list (cdr inst-key-list)))))
13990                       (vhdl-aput 'conf-alist conf-key
13991                                  (list conf-name file-name conf-line ent-key
13992                                        arch-key comp-conf-list lib-alist)))))
13993                 ;; scan for packages
13994                 (goto-char (point-min))
13995                 (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13996                   (let* ((pack-name (match-string-no-properties 2))
13997                          (pack-key (downcase pack-name))
13998                          (is-body (match-string-no-properties 1))
13999                          (pack-entry (vhdl-aget pack-alist pack-key))
14000                          (pack-line (vhdl-current-line))
14001                          (end-of-unit (vhdl-get-end-of-unit))
14002                          comp-name func-name comp-alist func-alist lib-alist)
14003                     (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14004                         (vhdl-warning-when-idle
14005                          "Package%s declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
14006                          (if is-body " body" "") pack-name
14007                          (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14008                          (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
14009                          file-name (vhdl-current-line))
14010                       ;; scan for context clauses
14011                       (setq lib-alist (vhdl-scan-context-clause))
14012                       ;; scan for component and subprogram declarations/bodies
14013                       (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
14014                         (if (equal (upcase (match-string 1)) "COMPONENT")
14015                             (setq comp-name (match-string-no-properties 2)
14016                                   comp-alist
14017                                   (cons (list (downcase comp-name) comp-name
14018                                               file-name (vhdl-current-line))
14019                                         comp-alist))
14020                           (setq func-name (match-string-no-properties 2)
14021                                 func-alist
14022                                 (cons (list (downcase func-name) func-name
14023                                             file-name (vhdl-current-line))
14024                                       func-alist))))
14025                       (setq func-alist (nreverse func-alist))
14026                       (setq comp-alist (nreverse comp-alist))
14027                       (if is-body
14028                           (push pack-key pack-body-list)
14029                         (push pack-key pack-list))
14030                       (vhdl-aput
14031                        'pack-alist pack-key
14032                        (if is-body
14033                            (list (or (nth 0 pack-entry) pack-name)
14034                                  (nth 1 pack-entry) (nth 2 pack-entry)
14035                                  (nth 3 pack-entry) (nth 4 pack-entry)
14036                                  (nth 5 pack-entry)
14037                                  file-name pack-line func-alist lib-alist)
14038                          (list pack-name file-name pack-line
14039                                comp-alist func-alist lib-alist
14040                                (nth 6 pack-entry) (nth 7 pack-entry)
14041                                (nth 8 pack-entry) (nth 9 pack-entry))))))))
14042               ;; scan for hierarchy
14043               (if (and limit-hier-file-size
14044                        (< limit-hier-file-size (buffer-size)))
14045                   (progn (message "WARNING:  Scan limit (hierarchy: file size) reached in file:\n  \"%s\"" file-name)
14046                          (setq big-files t))
14047                 ;; scan for architectures
14048                 (goto-char (point-min))
14049                 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
14050                   (let* ((ent-name (match-string-no-properties 2))
14051                          (ent-key (downcase ent-name))
14052                          (arch-name (match-string-no-properties 1))
14053                          (arch-key (downcase arch-name))
14054                          (ent-entry (vhdl-aget ent-alist ent-key))
14055                          (arch-alist (nth 3 ent-entry))
14056                          (arch-entry (vhdl-aget arch-alist arch-key))
14057                          (beg-of-unit (point))
14058                          (end-of-unit (vhdl-get-end-of-unit))
14059                          (inst-no 0)
14060                          inst-alist inst-path)
14061                     ;; scan for contained instantiations
14062                     (while (and (re-search-forward
14063                                  (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
14064                                          "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
14065                                          "component[ \t\n\r\f]+\\(\\w+\\)\\|"
14066                                          "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
14067                                          "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
14068                                          "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
14069                                 (or (not limit-hier-inst-no)
14070                                     (<= (if (or (match-string 14)
14071                                                 (match-string 16))
14072                                             inst-no
14073                                           (setq inst-no (1+ inst-no)))
14074                                         limit-hier-inst-no)))
14075                       (cond
14076                        ;; block/generate beginning found
14077                        ((match-string 14)
14078                         (setq inst-path
14079                               (cons (match-string-no-properties 1) inst-path)))
14080                        ;; block/generate end found
14081                        ((match-string 16)
14082                         (setq inst-path (cdr inst-path)))
14083                        ;; instantiation found
14084                        (t
14085                         (let* ((inst-name (match-string-no-properties 1))
14086                                (inst-key (downcase inst-name))
14087                                (inst-comp-name
14088                                 (or (match-string-no-properties 3)
14089                                     (match-string-no-properties 6)))
14090                                (inst-ent-key
14091                                 (or (and (match-string 8)
14092                                          (vhdl-match-string-downcase 11))
14093                                     (and inst-comp-name
14094                                          (downcase inst-comp-name))))
14095                                (inst-arch-key (vhdl-match-string-downcase 13))
14096                                (inst-conf-key
14097                                 (and (not (match-string 8))
14098                                      (vhdl-match-string-downcase 11)))
14099                                (inst-lib-key (vhdl-match-string-downcase 10)))
14100                           (goto-char (match-end 1))
14101                           (setq inst-list (cons inst-key inst-list)
14102                                 inst-ent-list
14103                                 (cons inst-ent-key inst-ent-list))
14104                           (setq inst-alist
14105                                 (append
14106                                  inst-alist
14107                                  (list (list inst-key inst-name file-name
14108                                              (vhdl-current-line) inst-comp-name
14109                                              inst-ent-key inst-arch-key
14110                                              inst-conf-key inst-lib-key
14111                                              (reverse inst-path)))))))))
14112                     ;; scan for contained configuration specifications
14113                     (goto-char beg-of-unit)
14114                     (while (re-search-forward
14115                             (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*"
14116                                     "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t)
14117                       (let* ((inst-comp-name (match-string-no-properties 3))
14118                              (inst-ent-key
14119                               (and (match-string 6)
14120                                    (vhdl-match-string-downcase 9)))
14121                              (inst-arch-key (vhdl-match-string-downcase 11))
14122                              (inst-conf-key
14123                               (and (not (match-string 6))
14124                                    (vhdl-match-string-downcase 9)))
14125                              (inst-lib-key (vhdl-match-string-downcase 8))
14126                              (inst-key-list
14127                               (split-string (vhdl-match-string-downcase 1)
14128                                             "[ \t\n\r\f]*,[ \t\n\r\f]*"))
14129                              (tmp-inst-alist inst-alist)
14130                              inst-entry)
14131                         (while tmp-inst-alist
14132                           (when (and (or (equal "all" (car inst-key-list))
14133                                          (member (nth 0 (car tmp-inst-alist))
14134                                                  inst-key-list))
14135                                      (equal
14136                                       (downcase
14137                                        (or (nth 4 (car tmp-inst-alist)) ""))
14138                                       (downcase inst-comp-name)))
14139                             (setq inst-entry (car tmp-inst-alist))
14140                             (setq inst-ent-list
14141                                   (cons (or inst-ent-key (nth 5 inst-entry))
14142                                         (vhdl-delete
14143                                          (nth 5 inst-entry) inst-ent-list)))
14144                             (setq inst-entry
14145                                   (list (nth 0 inst-entry) (nth 1 inst-entry)
14146                                         (nth 2 inst-entry) (nth 3 inst-entry)
14147                                         (nth 4 inst-entry)
14148                                         (or inst-ent-key (nth 5 inst-entry))
14149                                         (or inst-arch-key (nth 6 inst-entry))
14150                                         inst-conf-key inst-lib-key))
14151                             (setcar tmp-inst-alist inst-entry))
14152                           (setq tmp-inst-alist (cdr tmp-inst-alist)))))
14153                     ;; save in cache
14154                     (vhdl-aput 'arch-alist arch-key
14155                                (list (nth 0 arch-entry) (nth 1 arch-entry)
14156                                      (nth 2 arch-entry) inst-alist
14157                                      (nth 4 arch-entry)))
14158                     (vhdl-aput 'ent-alist ent-key
14159                                (list (nth 0 ent-entry) (nth 1 ent-entry)
14160                                      (nth 2 ent-entry)
14161                                      (vhdl-sort-alist arch-alist)
14162                                      (nth 4 ent-entry) (nth 5 ent-entry)))
14163                     (when (and limit-hier-inst-no
14164                                (> inst-no limit-hier-inst-no))
14165                       (message "WARNING:  Scan limit (hierarchy: instances per architecture) reached in file:\n  \"%s\"" file-name)
14166                       (setq big-files t))
14167                     (goto-char end-of-unit))))
14168               ;; remember design units for this file
14169               (vhdl-aput 'file-alist file-name
14170                          (list ent-list arch-list arch-ent-list conf-list
14171                                pack-list pack-body-list
14172                                inst-list inst-ent-list))
14173               (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
14174         (setq file-list (cdr file-list))))
14175     (when (or (and (not project) files-exist)
14176               (and project (not non-final)))
14177       ;; consistency checks:
14178       ;; check whether each architecture has a corresponding entity
14179       (setq tmp-list ent-alist)
14180       (while tmp-list
14181         (when (null (nth 2 (car tmp-list)))
14182           (setq tmp-entry (car (nth 4 (car tmp-list))))
14183           (vhdl-warning-when-idle
14184            "Architecture of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14185            (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
14186            (nth 3 tmp-entry)))
14187         (setq tmp-list (cdr tmp-list)))
14188       ;; check whether configuration has a corresponding entity/architecture
14189       (setq tmp-list conf-alist)
14190       (while tmp-list
14191         (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list))))
14192             (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)))
14193               (setq tmp-entry (car tmp-list))
14194               (vhdl-warning-when-idle
14195                "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n  in \"%s\" (line %d)"
14196                (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
14197                (nth 2 tmp-entry) (nth 3 tmp-entry)))
14198           (setq tmp-entry (car tmp-list))
14199           (vhdl-warning-when-idle
14200            "Configuration of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14201            (nth 1 tmp-entry) (nth 4 tmp-entry)
14202            (nth 2 tmp-entry) (nth 3 tmp-entry)))
14203         (setq tmp-list (cdr tmp-list)))
14204       ;; check whether each package body has a package declaration
14205       (setq tmp-list pack-alist)
14206       (while tmp-list
14207         (when (null (nth 2 (car tmp-list)))
14208           (setq tmp-entry (car tmp-list))
14209           (vhdl-warning-when-idle
14210            "Package body of non-existing package: \"%s\"\n  in \"%s\" (line %d)"
14211            (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
14212         (setq tmp-list (cdr tmp-list)))
14213       ;; sort lists
14214       (setq ent-alist (vhdl-sort-alist ent-alist))
14215       (setq conf-alist (vhdl-sort-alist conf-alist))
14216       (setq pack-alist (vhdl-sort-alist pack-alist))
14217       ;; remember updated directory/project
14218       (add-to-list 'vhdl-updated-project-list (or project dir-name)))
14219     ;; clear directory alists
14220     (unless project
14221       (vhdl-adelete 'vhdl-entity-alist key)
14222       (vhdl-adelete 'vhdl-config-alist key)
14223       (vhdl-adelete 'vhdl-package-alist key)
14224       (vhdl-adelete 'vhdl-ent-inst-alist key)
14225       (vhdl-adelete 'vhdl-file-alist key))
14226     ;; put directory contents into cache
14227     (vhdl-aput 'vhdl-entity-alist key ent-alist)
14228     (vhdl-aput 'vhdl-config-alist key conf-alist)
14229     (vhdl-aput 'vhdl-package-alist key pack-alist)
14230     (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
14231     (vhdl-aput 'vhdl-file-alist key file-alist)
14232     ;; final messages
14233     (message "Scanning %s %s\"%s\"...done"
14234              (if is-directory "directory" "files") (or num-string "") name)
14235     (unless project (message "Scanning directory...done"))
14236     (when big-files
14237       (vhdl-warning-when-idle "Scanning is incomplete.\n  --> see user option `vhdl-speedbar-scan-limit'"))
14238     ;; save cache when scanned non-interactively
14239     (when (or (not project) (not non-final))
14240       (when (and noninteractive vhdl-speedbar-save-cache)
14241         (vhdl-save-cache key)))
14242     t))
14243
14244 (defun vhdl-scan-project-contents (project)
14245   "Scan the contents of all VHDL files found in the directories and files
14246 of PROJECT."
14247   (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
14248         (default-dir (vhdl-resolve-env-variable
14249                       (nth 1 (vhdl-aget vhdl-project-alist project))))
14250         (file-exclude-regexp
14251          (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
14252         dir-list-tmp dir dir-name num-dir act-dir recursive)
14253     ;; clear project alists
14254     (vhdl-adelete 'vhdl-entity-alist project)
14255     (vhdl-adelete 'vhdl-config-alist project)
14256     (vhdl-adelete 'vhdl-package-alist project)
14257     (vhdl-adelete 'vhdl-ent-inst-alist project)
14258     (vhdl-adelete 'vhdl-file-alist project)
14259     ;; expand directory names by default-directory
14260     (message "Collecting source files...")
14261     (while dir-list
14262       (setq dir (vhdl-resolve-env-variable (car dir-list)))
14263       (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
14264       (setq recursive (match-string 1 dir)
14265             dir-name (match-string 3 dir))
14266       (setq dir-list-tmp
14267             (cons (concat recursive
14268                           (if (file-name-absolute-p dir-name) "" default-dir)
14269                           dir-name)
14270                   dir-list-tmp))
14271       (setq dir-list (cdr dir-list)))
14272     ;; resolve path wildcards
14273     (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
14274     ;; expand directories
14275     (while dir-list-tmp
14276       (setq dir (car dir-list-tmp))
14277       ;; get subdirectories
14278       (if (string-match "-r \\(.*[/\\]\\)" dir)
14279           (setq dir-list (append dir-list (vhdl-get-subdirs
14280                                            (match-string 1 dir))))
14281         (setq dir-list (append dir-list (list dir))))
14282       (setq dir-list-tmp (cdr dir-list-tmp)))
14283     ;; exclude files
14284     (unless (equal file-exclude-regexp "")
14285       (let ((case-fold-search nil))
14286         (while dir-list
14287           (unless (string-match file-exclude-regexp (car dir-list))
14288             (push (car dir-list) dir-list-tmp))
14289           (setq dir-list (cdr dir-list)))
14290         (setq dir-list (nreverse dir-list-tmp))))
14291     (message "Collecting source files...done")
14292     ;; scan for design units for each directory in DIR-LIST
14293     (setq dir-list-tmp nil
14294           num-dir (length dir-list)
14295           act-dir 1)
14296     (while dir-list
14297       (setq dir-name (abbreviate-file-name
14298                       (expand-file-name (car dir-list))))
14299       (vhdl-scan-directory-contents dir-name project nil
14300                                     (format "(%s/%s) " act-dir num-dir)
14301                                     (cdr dir-list))
14302       (add-to-list 'dir-list-tmp (file-name-directory dir-name))
14303       (setq dir-list (cdr dir-list)
14304             act-dir (1+ act-dir)))
14305     (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
14306     (message "Scanning project \"%s\"...done" project)))
14307
14308 (defun vhdl-update-file-contents (file-name)
14309   "Update hierarchy information by contents of current buffer."
14310   (setq file-name (abbreviate-file-name file-name))
14311   (let* ((dir-name (file-name-directory file-name))
14312          (directory-alist vhdl-directory-alist)
14313          updated)
14314     (while directory-alist
14315       (when (member dir-name (nth 1 (car directory-alist)))
14316         (let* ((vhdl-project (nth 0 (car directory-alist)))
14317                (project (vhdl-project-p))
14318                (ent-alist (vhdl-aget vhdl-entity-alist
14319                                      (or project dir-name)))
14320                (conf-alist (vhdl-aget vhdl-config-alist
14321                                       (or project dir-name)))
14322                (pack-alist (vhdl-aget vhdl-package-alist
14323                                       (or project dir-name)))
14324                (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
14325                                          (or project dir-name))))
14326                (file-alist (vhdl-aget vhdl-file-alist (or project dir-name)))
14327                (file-entry (vhdl-aget file-alist file-name))
14328                (ent-list (nth 0 file-entry))
14329                (arch-list (nth 1 file-entry))
14330                (arch-ent-list (nth 2 file-entry))
14331                (conf-list (nth 3 file-entry))
14332                (pack-list (nth 4 file-entry))
14333                (pack-body-list (nth 5 file-entry))
14334                (inst-ent-list (nth 7 file-entry))
14335                (cache-key (or project dir-name))
14336                arch-alist key ent-key entry)
14337           ;; delete design units previously contained in this file:
14338           ;; entities
14339           (while ent-list
14340             (setq key (car ent-list)
14341                   entry (vhdl-aget ent-alist key))
14342             (when (equal file-name (nth 1 entry))
14343               (if (nth 3 entry)
14344                   (vhdl-aput 'ent-alist key
14345                              (list (nth 0 entry) nil nil (nth 3 entry) nil))
14346                 (vhdl-adelete 'ent-alist key)))
14347             (setq ent-list (cdr ent-list)))
14348           ;; architectures
14349           (while arch-list
14350             (setq key (car arch-list)
14351                   ent-key (car arch-ent-list)
14352                   entry (vhdl-aget ent-alist ent-key)
14353                   arch-alist (nth 3 entry))
14354             (when (equal file-name (nth 1 (vhdl-aget arch-alist key)))
14355               (vhdl-adelete 'arch-alist key)
14356               (if (or (nth 1 entry) arch-alist)
14357                   (vhdl-aput 'ent-alist ent-key
14358                              (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14359                                    arch-alist (nth 4 entry) (nth 5 entry)))
14360                 (vhdl-adelete 'ent-alist ent-key)))
14361             (setq arch-list (cdr arch-list)
14362                   arch-ent-list (cdr arch-ent-list)))
14363           ;; configurations
14364           (while conf-list
14365             (setq key (car conf-list))
14366             (when (equal file-name (nth 1 (vhdl-aget conf-alist key)))
14367               (vhdl-adelete 'conf-alist key))
14368             (setq conf-list (cdr conf-list)))
14369           ;; package declarations
14370           (while pack-list
14371             (setq key (car pack-list)
14372                   entry (vhdl-aget pack-alist key))
14373             (when (equal file-name (nth 1 entry))
14374               (if (nth 6 entry)
14375                   (vhdl-aput 'pack-alist key
14376                              (list (nth 0 entry) nil nil nil nil nil
14377                                    (nth 6 entry) (nth 7 entry) (nth 8 entry)
14378                                    (nth 9 entry)))
14379                 (vhdl-adelete 'pack-alist key)))
14380             (setq pack-list (cdr pack-list)))
14381           ;; package bodies
14382           (while pack-body-list
14383             (setq key (car pack-body-list)
14384                   entry (vhdl-aget pack-alist key))
14385             (when (equal file-name (nth 6 entry))
14386               (if (nth 1 entry)
14387                   (vhdl-aput 'pack-alist key
14388                              (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14389                                    (nth 3 entry) (nth 4 entry) (nth 5 entry)
14390                                    nil nil nil nil))
14391                 (vhdl-adelete 'pack-alist key)))
14392             (setq pack-body-list (cdr pack-body-list)))
14393           ;; instantiated entities
14394           (while inst-ent-list
14395             (setq ent-inst-list
14396                   (vhdl-delete (car inst-ent-list) ent-inst-list))
14397             (setq inst-ent-list (cdr inst-ent-list)))
14398           ;; update caches
14399           (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
14400           (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
14401           (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
14402           (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
14403           ;; scan file
14404           (vhdl-scan-directory-contents file-name project t)
14405           (when (or (and vhdl-speedbar-show-projects project)
14406                     (and (not vhdl-speedbar-show-projects) (not project)))
14407             (vhdl-speedbar-refresh project))
14408           (setq updated t)))
14409       (setq directory-alist (cdr directory-alist)))
14410     updated))
14411
14412 (defun vhdl-update-hierarchy ()
14413   "Update directory and hierarchy information in speedbar."
14414   (let ((file-list (reverse vhdl-modified-file-list))
14415         updated)
14416     (when (and vhdl-speedbar-update-on-saving file-list)
14417       (while file-list
14418         (setq updated
14419               (or (vhdl-update-file-contents (car file-list))
14420                   updated))
14421         (setq file-list (cdr file-list)))
14422       (setq vhdl-modified-file-list nil)
14423       (vhdl-speedbar-update-current-unit)
14424       (when updated (message "Updating hierarchy...done")))))
14425
14426 ;; structure (parenthesized expression means list of such entries)
14427 ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
14428 ;;  comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
14429 ;;  comp-lib-name level)
14430 (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
14431                                      conf-inst-alist level indent
14432                                      &optional include-top ent-hier)
14433   "Get instantiation hierarchy beginning in architecture ARCH-KEY of
14434 entity ENT-KEY."
14435   (let* ((ent-entry (vhdl-aget ent-alist ent-key))
14436          (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
14437                        (cdar (last (nth 3 ent-entry)))))
14438          (inst-alist (nth 3 arch-entry))
14439          inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
14440          hier-list subcomp-list tmp-list inst-key inst-comp-name
14441          inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
14442     (when (= level 0) (message "Extract design hierarchy..."))
14443     (when include-top
14444       (setq level (1+ level)))
14445     (when (member ent-key ent-hier)
14446       (error "ERROR:  Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
14447     ;; process all instances
14448     (while inst-alist
14449       (setq inst-entry (car inst-alist)
14450             inst-key (nth 0 inst-entry)
14451             inst-comp-name (nth 4 inst-entry)
14452             inst-conf-key (nth 7 inst-entry))
14453       ;; search entry in configuration's instantiations list
14454       (setq tmp-list conf-inst-alist)
14455       (while (and tmp-list
14456                   (not (and (member (nth 0 (car tmp-list))
14457                                     (list "all" inst-key))
14458                             (equal (nth 1 (car tmp-list))
14459                                    (downcase (or inst-comp-name ""))))))
14460         (setq tmp-list (cdr tmp-list)))
14461       (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
14462       (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key))
14463       (when (and inst-conf-key (not inst-conf-entry))
14464         (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
14465       ;; determine entity
14466       (setq inst-ent-key
14467             (or (nth 2 (car tmp-list))  ; from configuration
14468                 (nth 3 inst-conf-entry) ; from subconfiguration
14469                 (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry)))
14470                                         ; from configuration spec.
14471                 (nth 5 inst-entry)))    ; from direct instantiation
14472       (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key))
14473       ;; determine architecture
14474       (setq inst-arch-key
14475             (or (nth 3 (car tmp-list))          ; from configuration
14476                 (nth 4 inst-conf-entry)         ; from subconfiguration
14477                 (nth 6 inst-entry)              ; from direct instantiation
14478                 (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
14479                                                 ; from configuration spec.
14480                 (nth 4 inst-ent-entry)          ; MRA
14481                 (caar (nth 3 inst-ent-entry)))) ; first alphabetically
14482       (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key))
14483       ;; set library
14484       (setq inst-lib-key
14485             (or (nth 5 (car tmp-list))          ; from configuration
14486                 (nth 8 inst-entry)))            ; from direct instantiation
14487       ;; gather information for this instance
14488       (setq comp-entry
14489             (list (nth 1 inst-entry)
14490                   (cons (nth 2 inst-entry) (nth 3 inst-entry))
14491                   (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
14492                   (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
14493                   (or (nth 0 inst-arch-entry) inst-arch-key)
14494                   (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
14495                   (or (nth 0 inst-conf-entry) inst-conf-key)
14496                   (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
14497                   inst-lib-key level))
14498       ;; get subcomponent hierarchy
14499       (setq subcomp-list (vhdl-get-hierarchy
14500                           ent-alist conf-alist
14501                           inst-ent-key inst-arch-key inst-conf-key
14502                           (nth 5 inst-conf-entry)
14503                           (1+ level) indent nil (cons ent-key ent-hier)))
14504       ;; add to list
14505       (setq hier-list (append hier-list (list comp-entry) subcomp-list))
14506       (setq inst-alist (cdr inst-alist)))
14507     (when include-top
14508       (setq hier-list
14509             (cons (list nil nil (nth 0 ent-entry)
14510                         (cons (nth 1 ent-entry) (nth 2 ent-entry))
14511                         (nth 0 arch-entry)
14512                         (cons (nth 1 arch-entry) (nth 2 arch-entry))
14513                         nil nil
14514                         nil (1- level))
14515                   hier-list)))
14516     (when (or (= level 0) (and include-top (= level 1))) (message ""))
14517     hier-list))
14518
14519 (defun vhdl-get-instantiations (ent-key indent)
14520   "Get all instantiations of entity ENT-KEY."
14521   (let ((ent-alist (vhdl-aget vhdl-entity-alist
14522                               (vhdl-speedbar-line-key indent)))
14523         arch-alist inst-alist ent-inst-list
14524         ent-entry arch-entry inst-entry)
14525     (while ent-alist
14526       (setq ent-entry (car ent-alist))
14527       (setq arch-alist (nth 4 ent-entry))
14528       (while arch-alist
14529         (setq arch-entry (car arch-alist))
14530         (setq inst-alist (nth 4 arch-entry))
14531         (while inst-alist
14532           (setq inst-entry (car inst-alist))
14533           (when (equal ent-key (nth 5 inst-entry))
14534             (setq ent-inst-list
14535                   (cons (list (nth 1 inst-entry)
14536                               (cons (nth 2 inst-entry) (nth 3 inst-entry))
14537                               (nth 1 ent-entry)
14538                               (cons (nth 2 ent-entry) (nth 3 ent-entry))
14539                               (nth 1 arch-entry)
14540                               (cons (nth 2 arch-entry) (nth 3 arch-entry)))
14541                         ent-inst-list)))
14542           (setq inst-alist (cdr inst-alist)))
14543         (setq arch-alist (cdr arch-alist)))
14544       (setq ent-alist (cdr ent-alist)))
14545     (nreverse ent-inst-list)))
14546
14547 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14548 ;; Caching in file
14549
14550 (defun vhdl-save-caches ()
14551   "Save all updated hierarchy caches to file."
14552   (interactive)
14553   (condition-case nil
14554       (when vhdl-speedbar-save-cache
14555         ;; update hierarchy
14556         (vhdl-update-hierarchy)
14557         (let ((project-list vhdl-updated-project-list))
14558           (message "Saving hierarchy caches...")
14559           ;; write updated project caches
14560           (while project-list
14561             (vhdl-save-cache (car project-list))
14562             (setq project-list (cdr project-list)))
14563           (message "Saving hierarchy caches...done")))
14564     (error (progn (vhdl-warning "ERROR:  An error occurred while saving the hierarchy caches")
14565                   (sit-for 2)))))
14566
14567 (defun vhdl-save-cache (key)
14568   "Save current hierarchy cache to file."
14569   (let* ((orig-buffer (current-buffer))
14570          (vhdl-project key)
14571          (project (vhdl-project-p))
14572          (default-directory key)
14573          (directory (abbreviate-file-name (vhdl-default-directory)))
14574          (file-name (vhdl-resolve-env-variable
14575                      (vhdl-replace-string
14576                       (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14577                       (concat
14578                        (subst-char-in-string ?  ?_ (or project "dir"))
14579                        " " (user-login-name)))))
14580          (file-dir-name (expand-file-name file-name directory))
14581          (cache-key (or project directory))
14582          (key (if project "project" "directory")))
14583     (unless (file-exists-p (file-name-directory file-dir-name))
14584       (make-directory (file-name-directory file-dir-name) t))
14585     (if (not (file-writable-p file-dir-name))
14586         (progn (vhdl-warning (format "File not writable: \"%s\""
14587                                      (abbreviate-file-name file-dir-name)))
14588                (sit-for 2))
14589       (message "Saving cache: \"%s\"" file-dir-name)
14590       (set-buffer (find-file-noselect file-dir-name t t))
14591       (erase-buffer)
14592       (insert ";; -*- Emacs-Lisp -*-\n\n"
14593               ";;; " (file-name-nondirectory file-name)
14594               " - design hierarchy cache file for Emacs VHDL Mode "
14595               vhdl-version "\n")
14596       (insert "\n;; " (if project "Project  " "Directory") " : ")
14597       (if project (insert project) (prin1 directory (current-buffer)))
14598       (insert "\n;; Saved     : " (format-time-string "%Y-%m-%d %T ")
14599               (user-login-name) "\n\n"
14600               "\n;; version number\n"
14601               "(setq vhdl-cache-version \"" vhdl-version "\")\n"
14602               "\n;; " (if project "project" "directory") " name"
14603               "\n(setq " key " ")
14604       (prin1 (or project directory) (current-buffer))
14605       (insert ")\n")
14606       (when (member 'hierarchy vhdl-speedbar-save-cache)
14607         (insert "\n;; entity and architecture cache\n"
14608                 "(vhdl-aput 'vhdl-entity-alist " key " '")
14609         (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
14610         (insert ")\n\n;; configuration cache\n"
14611                 "(vhdl-aput 'vhdl-config-alist " key " '")
14612         (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
14613         (insert ")\n\n;; package cache\n"
14614                 "(vhdl-aput 'vhdl-package-alist " key " '")
14615         (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
14616         (insert ")\n\n;; instantiated entities cache\n"
14617                 "(vhdl-aput 'vhdl-ent-inst-alist " key " '")
14618         (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
14619         (insert ")\n\n;; design units per file cache\n"
14620                 "(vhdl-aput 'vhdl-file-alist " key " '")
14621         (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
14622         (when project
14623           (insert ")\n\n;; source directories in project cache\n"
14624                   "(vhdl-aput 'vhdl-directory-alist " key " '")
14625           (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
14626         (insert ")\n"))
14627       (when (member 'display vhdl-speedbar-save-cache)
14628         (insert "\n;; shown design units cache\n"
14629                 "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
14630         (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
14631                (current-buffer))
14632         (insert ")\n"))
14633       (setq vhdl-updated-project-list
14634             (delete cache-key vhdl-updated-project-list))
14635       (save-buffer)
14636       (kill-buffer (current-buffer))
14637       (set-buffer orig-buffer))))
14638
14639 (defun vhdl-load-cache (key)
14640   "Load hierarchy cache information from file."
14641   (let* ((vhdl-project key)
14642          (default-directory key)
14643          (directory (vhdl-default-directory))
14644          (file-name (vhdl-resolve-env-variable
14645                      (vhdl-replace-string
14646                       (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14647                       (concat
14648                        (subst-char-in-string ?  ?_ (or (vhdl-project-p) "dir"))
14649                        " " (user-login-name)))))
14650          (file-dir-name (expand-file-name file-name directory))
14651          vhdl-cache-version)
14652     (unless (memq 'vhdl-save-caches kill-emacs-hook)
14653       (add-hook 'kill-emacs-hook 'vhdl-save-caches))
14654     (when (file-exists-p file-dir-name)
14655       (condition-case ()
14656           (progn (load-file file-dir-name)
14657                  (string< (mapconcat
14658                            (lambda (a) (format "%3d" (string-to-number a)))
14659                            (split-string "3.33" "\\.") "")
14660                           (mapconcat
14661                            (lambda (a) (format "%3d" (string-to-number a)))
14662                            (split-string vhdl-cache-version "\\.") "")))
14663         (error (progn (vhdl-warning (format "ERROR:  Corrupted cache file: \"%s\"" file-dir-name))
14664                       nil))))))
14665
14666 (defun vhdl-require-hierarchy-info ()
14667   "Make sure that hierarchy information is available.  Load cache or scan files
14668 if required."
14669   (if (vhdl-project-p)
14670       (unless (or (assoc vhdl-project vhdl-file-alist)
14671                   (vhdl-load-cache vhdl-project))
14672         (vhdl-scan-project-contents vhdl-project))
14673     (let ((directory (abbreviate-file-name default-directory)))
14674       (unless (or (assoc directory vhdl-file-alist)
14675                   (vhdl-load-cache directory))
14676         (vhdl-scan-directory-contents directory)))))
14677
14678 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14679 ;; Add hierarchy browser functionality to speedbar
14680
14681 (defvar vhdl-speedbar-mode-map nil
14682   "Keymap used when in the VHDL hierarchy browser mode.")
14683
14684 (defvar vhdl-speedbar-menu-items nil
14685   "Additional menu-items to add to speedbar frame.")
14686
14687 (declare-function speedbar-add-supported-extension "speedbar" (extension))
14688 (declare-function speedbar-add-mode-functions-list "speedbar" (new-list))
14689 (declare-function speedbar-make-specialized-keymap "speedbar" ())
14690 (declare-function speedbar-change-initial-expansion-list "speedbar"
14691                   (new-default))
14692 (declare-function speedbar-add-expansion-list "speedbar" (new-list))
14693
14694 (defun vhdl-speedbar-initialize ()
14695   "Initialize speedbar."
14696   ;; general settings
14697   ;; VHDL file extensions (extracted from `auto-mode-alist')
14698   (let ((mode-alist auto-mode-alist))
14699     (while mode-alist
14700       (when (eq (cdar mode-alist) 'vhdl-mode)
14701         (speedbar-add-supported-extension (caar mode-alist)))
14702       (setq mode-alist (cdr mode-alist))))
14703   ;; hierarchy browser settings
14704   (when (boundp 'speedbar-mode-functions-list)
14705     ;; special functions
14706     (speedbar-add-mode-functions-list
14707      '("vhdl directory"
14708        (speedbar-item-info . vhdl-speedbar-item-info)
14709        (speedbar-line-directory . speedbar-files-line-path)))
14710     (speedbar-add-mode-functions-list
14711      '("vhdl project"
14712        (speedbar-item-info . vhdl-speedbar-item-info)
14713        (speedbar-line-directory . vhdl-speedbar-line-project)))
14714     ;; keymap
14715     (unless vhdl-speedbar-mode-map
14716       (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
14717       (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line)
14718       (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line)
14719       (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line)
14720       (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line)
14721       (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level)
14722       (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all)
14723       (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy)
14724       (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component)
14725       (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration)
14726       (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra)
14727       (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design)
14728       (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy)
14729       (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches)
14730       (let ((key 0))
14731         (while (<= key 9)
14732           (define-key vhdl-speedbar-mode-map (int-to-string key)
14733             `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
14734           (setq key (1+ key)))))
14735     (define-key speedbar-mode-map "h"
14736       (lambda () (interactive)
14737         (speedbar-change-initial-expansion-list "vhdl directory")))
14738     (define-key speedbar-mode-map "H"
14739       (lambda () (interactive)
14740         (speedbar-change-initial-expansion-list "vhdl project")))
14741     ;; menu
14742     (unless vhdl-speedbar-menu-items
14743       (setq
14744        vhdl-speedbar-menu-items
14745        `(["Edit" speedbar-edit-line t]
14746          ["Expand" speedbar-expand-line
14747           (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
14748          ["Contract" vhdl-speedbar-contract-level t]
14749          ["Expand All" vhdl-speedbar-expand-all t]
14750          ["Contract All" vhdl-speedbar-contract-all t]
14751          ,(let ((key 0) (menu-list '("Hierarchy Depth")))
14752             (while (<= key 9)
14753               (setq menu-list
14754                     (cons `[,(if (= key 0) "All" (int-to-string key))
14755                             (vhdl-speedbar-set-depth ,key)
14756                             :style radio
14757                             :selected (= vhdl-speedbar-hierarchy-depth ,key)
14758                             :keys ,(int-to-string key)]
14759                           menu-list))
14760               (setq key (1+ key)))
14761             (nreverse menu-list))
14762          "--"
14763          ["Copy Port/Subprogram" vhdl-speedbar-port-copy
14764           (or (vhdl-speedbar-check-unit 'entity)
14765               (vhdl-speedbar-check-unit 'subprogram))]
14766          ["Place Component" vhdl-speedbar-place-component
14767           (vhdl-speedbar-check-unit 'entity)]
14768          ["Generate Configuration" vhdl-speedbar-configuration
14769           (vhdl-speedbar-check-unit 'architecture)]
14770          ["Select as MRA" vhdl-speedbar-select-mra
14771           (vhdl-speedbar-check-unit 'architecture)]
14772          ["Make" vhdl-speedbar-make-design
14773           (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
14774          ["Generate Makefile" vhdl-speedbar-generate-makefile
14775           (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
14776          ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
14777           :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14778           ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)]
14779          ["Rescan Project" vhdl-speedbar-rescan-hierarchy
14780           :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14781           ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects]
14782          ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
14783     ;; hook-ups
14784     (speedbar-add-expansion-list
14785      '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14786        vhdl-speedbar-display-directory))
14787     (speedbar-add-expansion-list
14788      '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14789        vhdl-speedbar-display-projects))
14790     (setq speedbar-stealthy-function-list
14791           (append
14792            '(("vhdl directory" vhdl-speedbar-update-current-unit)
14793              ("vhdl project" vhdl-speedbar-update-current-project
14794               vhdl-speedbar-update-current-unit))
14795            speedbar-stealthy-function-list))
14796     (when (eq vhdl-speedbar-display-mode 'directory)
14797       (setq speedbar-initial-expansion-list-name "vhdl directory"))
14798     (when (eq vhdl-speedbar-display-mode 'project)
14799       (setq speedbar-initial-expansion-list-name "vhdl project"))
14800     (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
14801
14802 (defun vhdl-speedbar (&optional arg)
14803   "Open/close speedbar."
14804   (interactive)
14805   (if (not (fboundp 'speedbar))
14806       (error "WARNING:  Speedbar is not available or not installed")
14807     (condition-case ()
14808         (speedbar-frame-mode arg)
14809       (error (error "WARNING:  An error occurred while opening speedbar")))))
14810
14811 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14812 ;; Display functions
14813
14814 (defvar vhdl-speedbar-last-selected-project nil
14815   "Name of last selected project.")
14816
14817 ;; macros must be defined in the file they are used (copied from `speedbar.el')
14818 ;;; (defmacro speedbar-with-writable (&rest forms)
14819 ;;;   "Allow the buffer to be writable and evaluate FORMS."
14820 ;;;   (list 'let '((inhibit-read-only t))
14821 ;;;     (cons 'progn forms)))
14822 ;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
14823
14824 (declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
14825 (declare-function speedbar-directory-buttons "speedbar" (directory _index))
14826 (declare-function speedbar-file-lists "speedbar" (directory))
14827
14828 (defun vhdl-speedbar-display-directory (directory depth &optional rescan)
14829   "Display directory and hierarchy information in speedbar."
14830   (setq vhdl-speedbar-show-projects nil)
14831   (setq speedbar-ignored-directory-regexp
14832         (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))
14833   (setq directory (abbreviate-file-name (file-name-as-directory directory)))
14834   (setq speedbar-last-selected-file nil)
14835   (speedbar-with-writable
14836     (condition-case nil
14837         (progn
14838           ;; insert directory path
14839           (speedbar-directory-buttons directory depth)
14840           ;; insert subdirectories
14841           (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
14842           ;; scan and insert hierarchy of current directory
14843           (vhdl-speedbar-insert-dir-hierarchy directory depth
14844                                               speedbar-power-click)
14845           ;; expand subdirectories
14846           (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
14847       (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly")))))
14848
14849 (defun vhdl-speedbar-display-projects (project depth &optional rescan)
14850   "Display projects and hierarchy information in speedbar."
14851   (setq vhdl-speedbar-show-projects t)
14852   (setq speedbar-ignored-directory-regexp ".")
14853   (setq speedbar-last-selected-file nil)
14854   (setq vhdl-speedbar-last-selected-project nil)
14855   (speedbar-with-writable
14856     (condition-case nil
14857         ;; insert projects
14858         (vhdl-speedbar-insert-projects)
14859       (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly"))))
14860   (setq speedbar-full-text-cache nil)) ; prevent caching
14861
14862 (declare-function speedbar-make-tag-line "speedbar"
14863                   (type char func data tag tfunc tdata tface depth))
14864
14865 (defun vhdl-speedbar-insert-projects ()
14866   "Insert all projects in speedbar."
14867   (vhdl-speedbar-make-title-line "Projects:")
14868   (let ((project-alist (if vhdl-project-sort
14869                            (vhdl-sort-alist (copy-alist vhdl-project-alist))
14870                          vhdl-project-alist))
14871         (vhdl-speedbar-update-current-unit nil))
14872     ;; insert projects
14873     (while project-alist
14874       (speedbar-make-tag-line
14875        'angle ?+ 'vhdl-speedbar-expand-project
14876        (caar project-alist) (caar project-alist)
14877        'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
14878       (setq project-alist (cdr project-alist)))
14879     (setq project-alist vhdl-project-alist)
14880     ;; expand projects
14881     (while project-alist
14882       (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
14883         (goto-char (point-min))
14884         (when (re-search-forward
14885                (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
14886           (goto-char (match-end 1))
14887           (speedbar-do-function-pointer)))
14888       (setq project-alist (cdr project-alist)))))
14889
14890 (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
14891   "Insert hierarchy of PROJECT.  Rescan directories if RESCAN is non-nil,
14892 otherwise use cached data."
14893   (when (or rescan (and (not (assoc project vhdl-file-alist))
14894                         (not (vhdl-load-cache project))))
14895     (vhdl-scan-project-contents project))
14896   ;; insert design hierarchy
14897   (vhdl-speedbar-insert-hierarchy
14898    (vhdl-aget vhdl-entity-alist project)
14899    (vhdl-aget vhdl-config-alist project)
14900    (vhdl-aget vhdl-package-alist project)
14901    (car (vhdl-aget vhdl-ent-inst-alist project)) indent)
14902   (insert (int-to-string indent) ":\n")
14903   (put-text-property (- (point) 3) (1- (point)) 'invisible t)
14904   (put-text-property (1- (point)) (point) 'invisible nil)
14905   ;; expand design units
14906   (vhdl-speedbar-expand-units project))
14907
14908 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
14909   "Insert hierarchy of DIRECTORY.  Rescan directory if RESCAN is non-nil,
14910 otherwise use cached data."
14911   (when (or rescan (and (not (assoc directory vhdl-file-alist))
14912                         (not (vhdl-load-cache directory))))
14913     (vhdl-scan-directory-contents directory))
14914   ;; insert design hierarchy
14915   (vhdl-speedbar-insert-hierarchy
14916    (vhdl-aget vhdl-entity-alist directory)
14917    (vhdl-aget vhdl-config-alist directory)
14918    (vhdl-aget vhdl-package-alist directory)
14919    (car (vhdl-aget vhdl-ent-inst-alist directory)) depth)
14920   ;; expand design units
14921   (vhdl-speedbar-expand-units directory)
14922   (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
14923
14924 (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
14925                                                  ent-inst-list depth)
14926   "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14927   (if (not (or ent-alist conf-alist pack-alist))
14928       (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
14929     (let (ent-entry conf-entry pack-entry)
14930       ;; insert entities
14931       (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
14932       (while ent-alist
14933         (setq ent-entry (car ent-alist))
14934         (speedbar-make-tag-line
14935          'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
14936          (nth 1 ent-entry) 'vhdl-speedbar-find-file
14937          (cons (nth 2 ent-entry) (nth 3 ent-entry))
14938          'vhdl-speedbar-entity-face depth)
14939         (unless (nth 2 ent-entry)
14940           (end-of-line 0) (insert "!") (forward-char 1))
14941         (unless (member (nth 0 ent-entry) ent-inst-list)
14942           (end-of-line 0) (insert " (top)") (forward-char 1))
14943         (setq ent-alist (cdr ent-alist)))
14944       ;; insert configurations
14945       (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
14946       (while conf-alist
14947         (setq conf-entry (car conf-alist))
14948         (speedbar-make-tag-line
14949          'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
14950          (nth 1 conf-entry) 'vhdl-speedbar-find-file
14951          (cons (nth 2 conf-entry) (nth 3 conf-entry))
14952          'vhdl-speedbar-configuration-face depth)
14953         (setq conf-alist (cdr conf-alist)))
14954       ;; insert packages
14955       (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
14956       (while pack-alist
14957         (setq pack-entry (car pack-alist))
14958         (vhdl-speedbar-make-pack-line
14959          (nth 0 pack-entry) (nth 1 pack-entry)
14960          (cons (nth 2 pack-entry) (nth 3 pack-entry))
14961          (cons (nth 7 pack-entry) (nth 8 pack-entry))
14962          depth)
14963         (setq pack-alist (cdr pack-alist))))))
14964
14965 (declare-function speedbar-line-directory "speedbar" (&optional depth))
14966
14967 (defun vhdl-speedbar-rescan-hierarchy ()
14968   "Rescan hierarchy for the directory or project under the cursor."
14969   (interactive)
14970   (let (key path)
14971     (cond
14972      ;; current project
14973      (vhdl-speedbar-show-projects
14974       (setq key (vhdl-speedbar-line-project))
14975       (vhdl-scan-project-contents key))
14976      ;; top-level directory
14977      ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14978       (re-search-forward "[0-9]+:" nil t)
14979       (vhdl-scan-directory-contents
14980        (abbreviate-file-name (speedbar-line-directory))))
14981      ;; current directory
14982      (t (setq path (speedbar-line-directory))
14983         (string-match "^\\(.+[/\\]\\)" path)
14984         (vhdl-scan-directory-contents
14985          (abbreviate-file-name (match-string 1 path)))))
14986     (vhdl-speedbar-refresh key)))
14987
14988 (declare-function speedbar-goto-this-file "speedbar" (file))
14989
14990 (defun vhdl-speedbar-expand-dirs (directory)
14991   "Expand subdirectories in DIRECTORY according to
14992  `speedbar-shown-directories'."
14993   ;; (nicked from `speedbar-default-directory-list')
14994   (let ((sf (cdr (reverse speedbar-shown-directories)))
14995         (vhdl-speedbar-update-current-unit nil))
14996     (setq speedbar-shown-directories
14997           (list (expand-file-name default-directory)))
14998     (while sf
14999       (when (speedbar-goto-this-file (car sf))
15000         (beginning-of-line)
15001         (when (looking-at "[0-9]+:\\s-*<")
15002           (goto-char (match-end 0))
15003           (speedbar-do-function-pointer)))
15004       (setq sf (cdr sf))))
15005   (vhdl-speedbar-update-current-unit nil t))
15006
15007 (defun vhdl-speedbar-expand-units (key)
15008   "Expand design units in directory/project KEY according to
15009 `vhdl-speedbar-shown-unit-alist'."
15010   (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15011         (vhdl-speedbar-update-current-unit nil)
15012         vhdl-updated-project-list)
15013     (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15014     (vhdl-prepare-search-1
15015      (while unit-alist                  ; expand units
15016        (vhdl-speedbar-goto-this-unit key (caar unit-alist))
15017        (beginning-of-line)
15018        (let ((arch-alist (nth 1 (car unit-alist)))
15019              position)
15020          (when (looking-at "^[0-9]+:\\s-*\\[")
15021            (goto-char (match-end 0))
15022            (setq position (point))
15023            (speedbar-do-function-pointer)
15024            (select-frame speedbar-frame)
15025            (while arch-alist            ; expand architectures
15026              (goto-char position)
15027              (when (re-search-forward
15028                     (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
15029                             (car arch-alist) "\\>\\)") nil t)
15030                (beginning-of-line)
15031                (when (looking-at "^[0-9]+:\\s-*{")
15032                  (goto-char (match-end 0))
15033                  (speedbar-do-function-pointer)
15034                  (select-frame speedbar-frame)))
15035              (setq arch-alist (cdr arch-alist))))
15036          (setq unit-alist (cdr unit-alist))))))
15037   (vhdl-speedbar-update-current-unit nil t))
15038
15039 (declare-function speedbar-center-buffer-smartly "speedbar" ())
15040
15041 (defun vhdl-speedbar-contract-level ()
15042   "Contract current level in current directory/project."
15043   (interactive)
15044   (when (or (save-excursion
15045               (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
15046             (and (save-excursion
15047                    (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
15048                  (re-search-backward
15049                   (format "^[0-%d]:\\s-*[[{<]-"
15050                           (max (1- (string-to-number (match-string 1))) 0)) nil t)))
15051     (goto-char (match-end 0))
15052     (speedbar-do-function-pointer)
15053     (speedbar-center-buffer-smartly)))
15054
15055 (defun vhdl-speedbar-contract-all ()
15056   "Contract all expanded design units in current directory/project."
15057   (interactive)
15058   (if (and vhdl-speedbar-show-projects
15059            (save-excursion (beginning-of-line) (looking-at "^0:")))
15060       (progn (setq vhdl-speedbar-shown-project-list nil)
15061              (vhdl-speedbar-refresh))
15062     (let ((key (vhdl-speedbar-line-key)))
15063       (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15064       (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
15065       (when (memq 'display vhdl-speedbar-save-cache)
15066         (add-to-list 'vhdl-updated-project-list key)))))
15067
15068 (defun vhdl-speedbar-expand-all ()
15069   "Expand all design units in current directory/project."
15070   (interactive)
15071   (let* ((key (vhdl-speedbar-line-key))
15072          (ent-alist (vhdl-aget vhdl-entity-alist key))
15073          (conf-alist (vhdl-aget vhdl-config-alist key))
15074          (pack-alist (vhdl-aget vhdl-package-alist key))
15075          arch-alist unit-alist subunit-alist)
15076     (add-to-list 'vhdl-speedbar-shown-project-list key)
15077     (while ent-alist
15078       (setq arch-alist (nth 4 (car ent-alist)))
15079       (setq subunit-alist nil)
15080       (while arch-alist
15081         (push (caar arch-alist) subunit-alist)
15082         (setq arch-alist (cdr arch-alist)))
15083       (push (list (caar ent-alist) subunit-alist) unit-alist)
15084       (setq ent-alist (cdr ent-alist)))
15085     (while conf-alist
15086       (push (list (caar conf-alist)) unit-alist)
15087       (setq conf-alist (cdr conf-alist)))
15088     (while pack-alist
15089       (push (list (caar pack-alist)) unit-alist)
15090       (setq pack-alist (cdr pack-alist)))
15091     (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15092     (vhdl-speedbar-refresh)
15093     (when (memq 'display vhdl-speedbar-save-cache)
15094       (add-to-list 'vhdl-updated-project-list key))))
15095
15096 (declare-function speedbar-change-expand-button-char "speedbar" (char))
15097 (declare-function speedbar-delete-subblock "speedbar" (indent))
15098
15099 (defun vhdl-speedbar-expand-project (text token indent)
15100   "Expand/contract the project under the cursor."
15101   (cond
15102    ((string-match "+" text)             ; expand project
15103     (speedbar-change-expand-button-char ?-)
15104     (unless (member token vhdl-speedbar-shown-project-list)
15105       (setq vhdl-speedbar-shown-project-list
15106             (cons token vhdl-speedbar-shown-project-list)))
15107     (speedbar-with-writable
15108       (save-excursion
15109         (end-of-line) (forward-char 1)
15110         (vhdl-speedbar-insert-project-hierarchy token (1+ indent)
15111                                                 speedbar-power-click))))
15112    ((string-match "-" text)             ; contract project
15113     (speedbar-change-expand-button-char ?+)
15114     (setq vhdl-speedbar-shown-project-list
15115           (delete token vhdl-speedbar-shown-project-list))
15116     (speedbar-delete-subblock indent))
15117    (t (error "Nothing to display")))
15118   (when (equal (selected-frame) speedbar-frame)
15119     (speedbar-center-buffer-smartly)))
15120
15121 (defun vhdl-speedbar-expand-entity (text token indent)
15122   "Expand/contract the entity under the cursor."
15123   (cond
15124    ((string-match "+" text)             ; expand entity
15125     (let* ((key (vhdl-speedbar-line-key indent))
15126            (ent-alist (vhdl-aget vhdl-entity-alist key))
15127            (ent-entry (vhdl-aget ent-alist token))
15128            (arch-alist (nth 3 ent-entry))
15129            (inst-alist (vhdl-get-instantiations token indent))
15130            (subpack-alist (nth 5 ent-entry))
15131            (multiple-arch (> (length arch-alist) 1))
15132            arch-entry inst-entry)
15133       (if (not (or arch-alist inst-alist subpack-alist))
15134           (speedbar-change-expand-button-char ??)
15135         (speedbar-change-expand-button-char ?-)
15136         ;; add entity to `vhdl-speedbar-shown-unit-alist'
15137         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15138           (vhdl-aput 'unit-alist token nil)
15139           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15140         (speedbar-with-writable
15141          (save-excursion
15142            (end-of-line) (forward-char 1)
15143            ;; insert architectures
15144            (when arch-alist
15145              (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
15146            (while arch-alist
15147              (setq arch-entry (car arch-alist))
15148              (speedbar-make-tag-line
15149               'curly ?+ 'vhdl-speedbar-expand-architecture
15150               (cons token (nth 0 arch-entry))
15151               (nth 1 arch-entry) 'vhdl-speedbar-find-file
15152               (cons (nth 2 arch-entry) (nth 3 arch-entry))
15153               'vhdl-speedbar-architecture-face (1+ indent))
15154              (when (and multiple-arch
15155                         (equal (nth 0 arch-entry) (nth 4 ent-entry)))
15156                (end-of-line 0) (insert " (mra)") (forward-char 1))
15157              (setq arch-alist (cdr arch-alist)))
15158            ;; insert instantiations
15159            (when inst-alist
15160              (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
15161            (while inst-alist
15162              (setq inst-entry (car inst-alist))
15163              (vhdl-speedbar-make-inst-line
15164               (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
15165               (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
15166               nil nil nil (1+ indent) 0 " in ")
15167              (setq inst-alist (cdr inst-alist)))
15168            ;; insert required packages
15169            (vhdl-speedbar-insert-subpackages
15170             subpack-alist (1+ indent) indent)))
15171         (when (memq 'display vhdl-speedbar-save-cache)
15172           (add-to-list 'vhdl-updated-project-list key))
15173         (vhdl-speedbar-update-current-unit t t))))
15174    ((string-match "-" text)             ; contract entity
15175     (speedbar-change-expand-button-char ?+)
15176     ;; remove entity from `vhdl-speedbar-shown-unit-alist'
15177     (let* ((key (vhdl-speedbar-line-key indent))
15178            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15179       (vhdl-adelete 'unit-alist token)
15180       (if unit-alist
15181           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15182         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15183       (speedbar-delete-subblock indent)
15184       (when (memq 'display vhdl-speedbar-save-cache)
15185         (add-to-list 'vhdl-updated-project-list key))))
15186    (t (error "Nothing to display")))
15187   (when (equal (selected-frame) speedbar-frame)
15188     (speedbar-center-buffer-smartly)))
15189
15190 (defun vhdl-speedbar-expand-architecture (text token indent)
15191   "Expand/contract the architecture under the cursor."
15192   (cond
15193    ((string-match "+" text)             ; expand architecture
15194     (let* ((key (vhdl-speedbar-line-key (1- indent)))
15195            (ent-alist (vhdl-aget vhdl-entity-alist key))
15196            (conf-alist (vhdl-aget vhdl-config-alist key))
15197            (hier-alist (vhdl-get-hierarchy
15198                         ent-alist conf-alist (car token) (cdr token) nil nil
15199                         0 (1- indent)))
15200            (ent-entry (vhdl-aget ent-alist (car token)))
15201            (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token)))
15202            (subpack-alist (nth 4 arch-entry))
15203            entry)
15204       (if (not (or hier-alist subpack-alist))
15205           (speedbar-change-expand-button-char ??)
15206         (speedbar-change-expand-button-char ?-)
15207         ;; add architecture to `vhdl-speedbar-shown-unit-alist'
15208         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15209                (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15210           (vhdl-aput 'unit-alist (car token)
15211                      (list (cons (cdr token) arch-alist)))
15212           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15213         (speedbar-with-writable
15214           (save-excursion
15215             (end-of-line) (forward-char 1)
15216             ;; insert instance hierarchy
15217             (when hier-alist
15218               (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
15219                                              (1+ indent)))
15220             (while hier-alist
15221               (setq entry (car hier-alist))
15222               (when (or (= vhdl-speedbar-hierarchy-depth 0)
15223                         (< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15224                 (vhdl-speedbar-make-inst-line
15225                  (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15226                  (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15227                  (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
15228               (setq hier-alist (cdr hier-alist)))
15229             ;; insert required packages
15230             (vhdl-speedbar-insert-subpackages
15231              subpack-alist (1+ indent) (1- indent))))
15232         (when (memq 'display vhdl-speedbar-save-cache)
15233           (add-to-list 'vhdl-updated-project-list key))
15234         (vhdl-speedbar-update-current-unit t t))))
15235    ((string-match "-" text)             ; contract architecture
15236     (speedbar-change-expand-button-char ?+)
15237     ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
15238     (let* ((key (vhdl-speedbar-line-key (1- indent)))
15239            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15240            (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15241       (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
15242       (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15243       (speedbar-delete-subblock indent)
15244       (when (memq 'display vhdl-speedbar-save-cache)
15245         (add-to-list 'vhdl-updated-project-list key))))
15246    (t (error "Nothing to display")))
15247   (when (equal (selected-frame) speedbar-frame)
15248     (speedbar-center-buffer-smartly)))
15249
15250 (defun vhdl-speedbar-expand-config (text token indent)
15251   "Expand/contract the configuration under the cursor."
15252   (cond
15253    ((string-match "+" text)             ; expand configuration
15254     (let* ((key (vhdl-speedbar-line-key indent))
15255            (conf-alist (vhdl-aget vhdl-config-alist key))
15256            (conf-entry (vhdl-aget conf-alist token))
15257            (ent-alist (vhdl-aget vhdl-entity-alist key))
15258            (hier-alist (vhdl-get-hierarchy
15259                         ent-alist conf-alist (nth 3 conf-entry)
15260                         (nth 4 conf-entry) token (nth 5 conf-entry)
15261                         0 indent t))
15262            (subpack-alist (nth 6 conf-entry))
15263            entry)
15264       (if (not (or hier-alist subpack-alist))
15265           (speedbar-change-expand-button-char ??)
15266         (speedbar-change-expand-button-char ?-)
15267         ;; add configuration to `vhdl-speedbar-shown-unit-alist'
15268         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15269           (vhdl-aput 'unit-alist token nil)
15270           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15271         (speedbar-with-writable
15272          (save-excursion
15273            (end-of-line) (forward-char 1)
15274            ;; insert instance hierarchy
15275            (when hier-alist
15276              (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
15277            (while hier-alist
15278              (setq entry (car hier-alist))
15279              (when (or (= vhdl-speedbar-hierarchy-depth 0)
15280                        (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15281                (vhdl-speedbar-make-inst-line
15282                 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15283                 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15284                 (nth 8 entry) (1+ indent) (nth 9 entry) ": "))
15285              (setq hier-alist (cdr hier-alist)))
15286            ;; insert required packages
15287            (vhdl-speedbar-insert-subpackages
15288             subpack-alist (1+ indent) indent)))
15289         (when (memq 'display vhdl-speedbar-save-cache)
15290           (add-to-list 'vhdl-updated-project-list key))
15291         (vhdl-speedbar-update-current-unit t t))))
15292    ((string-match "-" text)             ; contract configuration
15293     (speedbar-change-expand-button-char ?+)
15294     ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
15295     (let* ((key (vhdl-speedbar-line-key indent))
15296            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15297       (vhdl-adelete 'unit-alist token)
15298       (if unit-alist
15299           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15300         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15301       (speedbar-delete-subblock indent)
15302       (when (memq 'display vhdl-speedbar-save-cache)
15303         (add-to-list 'vhdl-updated-project-list key))))
15304    (t (error "Nothing to display")))
15305   (when (equal (selected-frame) speedbar-frame)
15306     (speedbar-center-buffer-smartly)))
15307
15308 (defun vhdl-speedbar-expand-package (text token indent)
15309   "Expand/contract the package under the cursor."
15310   (cond
15311    ((string-match "+" text)             ; expand package
15312     (let* ((key (vhdl-speedbar-line-key indent))
15313            (pack-alist (vhdl-aget vhdl-package-alist key))
15314            (pack-entry (vhdl-aget pack-alist token))
15315            (comp-alist (nth 3 pack-entry))
15316            (func-alist (nth 4 pack-entry))
15317            (func-body-alist (nth 8 pack-entry))
15318            (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
15319            comp-entry func-entry func-body-entry)
15320       (if (not (or comp-alist func-alist subpack-alist))
15321           (speedbar-change-expand-button-char ??)
15322         (speedbar-change-expand-button-char ?-)
15323         ;; add package to `vhdl-speedbar-shown-unit-alist'
15324         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15325           (vhdl-aput 'unit-alist token nil)
15326           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15327         (speedbar-with-writable
15328           (save-excursion
15329             (end-of-line) (forward-char 1)
15330             ;; insert components
15331             (when comp-alist
15332               (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
15333             (while comp-alist
15334               (setq comp-entry (car comp-alist))
15335               (speedbar-make-tag-line
15336                nil nil nil
15337                (cons token (nth 0 comp-entry))
15338                (nth 1 comp-entry) 'vhdl-speedbar-find-file
15339                (cons (nth 2 comp-entry) (nth 3 comp-entry))
15340                'vhdl-speedbar-entity-face (1+ indent))
15341               (setq comp-alist (cdr comp-alist)))
15342             ;; insert subprograms
15343             (when func-alist
15344               (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
15345             (while func-alist
15346               (setq func-entry (car func-alist)
15347                     func-body-entry (vhdl-aget func-body-alist
15348                                                (car func-entry)))
15349               (when (nth 2 func-entry)
15350                 (vhdl-speedbar-make-subprogram-line
15351                  (nth 1 func-entry)
15352                  (cons (nth 2 func-entry) (nth 3 func-entry))
15353                  (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
15354                  (1+ indent)))
15355               (setq func-alist (cdr func-alist)))
15356            ;; insert required packages
15357            (vhdl-speedbar-insert-subpackages
15358             subpack-alist (1+ indent) indent)))
15359         (when (memq 'display vhdl-speedbar-save-cache)
15360           (add-to-list 'vhdl-updated-project-list key))
15361         (vhdl-speedbar-update-current-unit t t))))
15362    ((string-match "-" text)             ; contract package
15363     (speedbar-change-expand-button-char ?+)
15364     ;; remove package from `vhdl-speedbar-shown-unit-alist'
15365     (let* ((key (vhdl-speedbar-line-key indent))
15366            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15367       (vhdl-adelete 'unit-alist token)
15368       (if unit-alist
15369           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15370         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15371       (speedbar-delete-subblock indent)
15372       (when (memq 'display vhdl-speedbar-save-cache)
15373         (add-to-list 'vhdl-updated-project-list key))))
15374    (t (error "Nothing to display")))
15375   (when (equal (selected-frame) speedbar-frame)
15376     (speedbar-center-buffer-smartly)))
15377
15378 (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
15379   "Insert required packages."
15380   (let* ((pack-alist (vhdl-aget vhdl-package-alist
15381                                 (vhdl-speedbar-line-key dir-indent)))
15382          pack-key lib-name pack-entry)
15383     (when subpack-alist
15384       (vhdl-speedbar-make-title-line "Packages Used:" indent))
15385     (while subpack-alist
15386       (setq pack-key (cdar subpack-alist)
15387             lib-name (caar subpack-alist))
15388       (setq pack-entry (vhdl-aget pack-alist pack-key))
15389       (vhdl-speedbar-make-subpack-line
15390        (or (nth 0 pack-entry) pack-key) lib-name
15391        (cons (nth 1 pack-entry) (nth 2 pack-entry))
15392        (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent)
15393       (setq subpack-alist (cdr subpack-alist)))))
15394
15395 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15396 ;; Display help functions
15397
15398 (defvar vhdl-speedbar-update-current-unit t
15399   "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
15400
15401 (defun vhdl-speedbar-update-current-project ()
15402   "Highlight project that is currently active."
15403   (when (and vhdl-speedbar-show-projects
15404              (not (equal vhdl-speedbar-last-selected-project vhdl-project))
15405              (and (boundp 'speedbar-frame)
15406                   (frame-live-p speedbar-frame)))
15407     (let ((last-frame (selected-frame))
15408           (project-alist vhdl-project-alist)
15409           pos)
15410       (select-frame speedbar-frame)
15411       (speedbar-with-writable
15412        (save-excursion
15413          (while project-alist
15414            (goto-char (point-min))
15415            (when (re-search-forward
15416                   (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
15417              (put-text-property (match-beginning 1) (match-end 1) 'face
15418                                 (if (equal (caar project-alist) vhdl-project)
15419                                     'speedbar-selected-face
15420                                   'speedbar-directory-face))
15421              (when (equal (caar project-alist) vhdl-project)
15422                (setq pos (1- (match-beginning 1)))))
15423            (setq project-alist (cdr project-alist))))
15424        (when pos (goto-char pos)))
15425       (select-frame last-frame)
15426       (setq vhdl-speedbar-last-selected-project vhdl-project)))
15427   t)
15428
15429 (declare-function speedbar-position-cursor-on-line "speedbar" ())
15430
15431 (defun vhdl-speedbar-update-current-unit (&optional no-position always)
15432   "Highlight all design units that are contained in the current file.
15433 NO-POSITION non-nil means do not re-position cursor."
15434   (let ((last-frame (selected-frame))
15435         (project-list vhdl-speedbar-shown-project-list)
15436         file-alist pos file-name)
15437     ;; get current file name
15438     (if (fboundp 'speedbar-select-attached-frame)
15439         (speedbar-select-attached-frame)
15440       (select-frame speedbar-attached-frame))
15441     (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
15442     (when (and vhdl-speedbar-update-current-unit
15443                (or always (not (equal file-name speedbar-last-selected-file))))
15444       (if vhdl-speedbar-show-projects
15445           (while project-list
15446             (setq file-alist (append file-alist
15447                                      (vhdl-aget vhdl-file-alist
15448                                                 (car project-list))))
15449             (setq project-list (cdr project-list)))
15450         (setq file-alist
15451               (vhdl-aget vhdl-file-alist
15452                          (abbreviate-file-name default-directory))))
15453       (select-frame speedbar-frame)
15454       (set-buffer speedbar-buffer)
15455       (speedbar-with-writable
15456        (vhdl-prepare-search-1
15457         (save-excursion
15458           ;; unhighlight last units
15459           (let* ((file-entry (vhdl-aget file-alist
15460                                         speedbar-last-selected-file)))
15461             (vhdl-speedbar-update-units
15462              "\\[.\\] " (nth 0 file-entry)
15463              speedbar-last-selected-file 'vhdl-speedbar-entity-face)
15464             (vhdl-speedbar-update-units
15465              "{.} " (nth 1 file-entry)
15466              speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
15467             (vhdl-speedbar-update-units
15468              "\\[.\\] " (nth 3 file-entry)
15469              speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
15470             (vhdl-speedbar-update-units
15471              "[]>] " (nth 4 file-entry)
15472              speedbar-last-selected-file 'vhdl-speedbar-package-face)
15473             (vhdl-speedbar-update-units
15474              "\\[.\\].+(" '("body")
15475              speedbar-last-selected-file 'vhdl-speedbar-package-face)
15476             (vhdl-speedbar-update-units
15477              "> " (nth 6 file-entry)
15478              speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
15479           ;; highlight current units
15480           (let* ((file-entry (vhdl-aget file-alist file-name)))
15481             (setq
15482              pos (vhdl-speedbar-update-units
15483                   "\\[.\\] " (nth 0 file-entry)
15484                   file-name 'vhdl-speedbar-entity-selected-face pos)
15485              pos (vhdl-speedbar-update-units
15486                   "{.} " (nth 1 file-entry)
15487                   file-name 'vhdl-speedbar-architecture-selected-face pos)
15488              pos (vhdl-speedbar-update-units
15489                   "\\[.\\] " (nth 3 file-entry)
15490                   file-name 'vhdl-speedbar-configuration-selected-face pos)
15491              pos (vhdl-speedbar-update-units
15492                   "[]>] " (nth 4 file-entry)
15493                   file-name 'vhdl-speedbar-package-selected-face pos)
15494              pos (vhdl-speedbar-update-units
15495                   "\\[.\\].+(" '("body")
15496                   file-name 'vhdl-speedbar-package-selected-face pos)
15497              pos (vhdl-speedbar-update-units
15498                   "> " (nth 6 file-entry)
15499                   file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
15500       ;; move speedbar so the first highlighted unit is visible
15501       (when (and pos (not no-position))
15502         (goto-char pos)
15503         (speedbar-center-buffer-smartly)
15504         (speedbar-position-cursor-on-line))
15505       (setq speedbar-last-selected-file file-name))
15506     (select-frame last-frame)
15507     t))
15508
15509 (defun vhdl-speedbar-update-units (text unit-list file-name face
15510                                         &optional pos)
15511   "Help function to highlight design units."
15512   (while unit-list
15513     (goto-char (point-min))
15514     (while (re-search-forward
15515             (concat text "\\(" (car unit-list) "\\)\\>") nil t)
15516       (when (equal file-name (car (get-text-property
15517                                    (match-beginning 1) 'speedbar-token)))
15518         (setq pos (or pos (point-marker)))
15519         (put-text-property (match-beginning 1) (match-end 1) 'face face)))
15520     (setq unit-list (cdr unit-list)))
15521   pos)
15522
15523 (declare-function speedbar-make-button "speedbar"
15524                   (start end face mouse function &optional token))
15525
15526 (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
15527                                                ent-name ent-file-marker
15528                                                arch-name arch-file-marker
15529                                                conf-name conf-file-marker
15530                                                lib-name depth offset delimiter)
15531   "Insert instantiation entry."
15532   (let ((start (point))
15533         visible-start)
15534     (insert (int-to-string depth) ":")
15535     (put-text-property start (point) 'invisible t)
15536     (setq visible-start (point))
15537     (insert-char ?  (* depth speedbar-indentation-width))
15538     (while (> offset 0)
15539       (insert "|")
15540       (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
15541       (setq offset (1- offset)))
15542     (put-text-property visible-start (point) 'invisible nil)
15543     (setq start (point))
15544     (insert ">")
15545     (speedbar-make-button start (point) nil nil nil)
15546     (setq visible-start (point))
15547     (insert " ")
15548     (setq start (point))
15549     (if (not inst-name)
15550         (insert "(top)")
15551       (insert inst-name)
15552       (speedbar-make-button
15553        start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
15554        'vhdl-speedbar-find-file inst-file-marker))
15555     (insert delimiter)
15556     (when ent-name
15557       (setq start (point))
15558       (insert ent-name)
15559       (speedbar-make-button
15560        start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
15561        'vhdl-speedbar-find-file ent-file-marker)
15562       (when arch-name
15563         (insert " (")
15564         (setq start (point))
15565         (insert arch-name)
15566         (speedbar-make-button
15567          start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
15568          'vhdl-speedbar-find-file arch-file-marker)
15569         (insert ")"))
15570       (when conf-name
15571         (insert " (")
15572         (setq start (point))
15573         (insert conf-name)
15574         (speedbar-make-button
15575          start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
15576          'vhdl-speedbar-find-file conf-file-marker)
15577         (insert ")")))
15578     (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
15579       (setq start (point))
15580       (insert " (" lib-name ")")
15581       (put-text-property (+ 2 start) (1- (point)) 'face
15582                          'vhdl-speedbar-library-face))
15583     (insert-char ?\n 1)
15584     (put-text-property visible-start (point) 'invisible nil)))
15585
15586 (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
15587                                               body-file-marker depth)
15588   "Insert package entry."
15589   (let ((start (point))
15590         visible-start)
15591     (insert (int-to-string depth) ":")
15592     (put-text-property start (point) 'invisible t)
15593     (setq visible-start (point))
15594     (insert-char ?  (* depth speedbar-indentation-width))
15595     (put-text-property visible-start (point) 'invisible nil)
15596     (setq start (point))
15597     (insert "[+]")
15598     (speedbar-make-button
15599      start (point) 'speedbar-button-face 'speedbar-highlight-face
15600      'vhdl-speedbar-expand-package pack-key)
15601     (setq visible-start (point))
15602     (insert-char ?  1 nil)
15603     (setq start (point))
15604     (insert pack-name)
15605     (speedbar-make-button
15606      start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15607      'vhdl-speedbar-find-file pack-file-marker)
15608     (unless (car pack-file-marker)
15609       (insert "!"))
15610     (when (car body-file-marker)
15611       (insert " (")
15612       (setq start (point))
15613       (insert "body")
15614       (speedbar-make-button
15615        start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15616        'vhdl-speedbar-find-file body-file-marker)
15617       (insert ")"))
15618     (insert-char ?\n 1)
15619     (put-text-property visible-start (point) 'invisible nil)))
15620
15621 (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
15622                                                   pack-body-file-marker depth)
15623   "Insert used package entry."
15624   (let ((start (point))
15625         visible-start)
15626     (insert (int-to-string depth) ":")
15627     (put-text-property start (point) 'invisible t)
15628     (setq visible-start (point))
15629     (insert-char ?  (* depth speedbar-indentation-width))
15630     (put-text-property visible-start (point) 'invisible nil)
15631     (setq start (point))
15632     (insert ">")
15633     (speedbar-make-button start (point) nil nil nil)
15634     (setq visible-start (point))
15635     (insert " ")
15636     (setq start (point))
15637     (insert pack-name)
15638     (speedbar-make-button
15639      start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15640      'vhdl-speedbar-find-file pack-file-marker)
15641     (when (car pack-body-file-marker)
15642       (insert " (")
15643       (setq start (point))
15644       (insert "body")
15645       (speedbar-make-button
15646        start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15647        'vhdl-speedbar-find-file pack-body-file-marker)
15648       (insert ")"))
15649     (setq start (point))
15650     (insert " (" lib-name ")")
15651     (put-text-property (+ 2 start) (1- (point)) 'face
15652                        'vhdl-speedbar-library-face)
15653     (insert-char ?\n 1)
15654     (put-text-property visible-start (point) 'invisible nil)))
15655
15656 (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
15657                                                      func-body-file-marker
15658                                                      depth)
15659   "Insert subprogram entry."
15660   (let ((start (point))
15661         visible-start)
15662     (insert (int-to-string depth) ":")
15663     (put-text-property start (point) 'invisible t)
15664     (setq visible-start (point))
15665     (insert-char ?  (* depth speedbar-indentation-width))
15666     (put-text-property visible-start (point) 'invisible nil)
15667     (setq start (point))
15668     (insert ">")
15669     (speedbar-make-button start (point) nil nil nil)
15670     (setq visible-start (point))
15671     (insert " ")
15672     (setq start (point))
15673     (insert func-name)
15674     (speedbar-make-button
15675      start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15676      'vhdl-speedbar-find-file func-file-marker)
15677     (when (car func-body-file-marker)
15678       (insert " (")
15679       (setq start (point))
15680       (insert "body")
15681       (speedbar-make-button
15682        start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15683        'vhdl-speedbar-find-file func-body-file-marker)
15684       (insert ")"))
15685     (insert-char ?\n 1)
15686     (put-text-property visible-start (point) 'invisible nil)))
15687
15688 (defun vhdl-speedbar-make-title-line (text &optional depth)
15689   "Insert design unit title entry."
15690   (let ((start (point))
15691         visible-start)
15692     (when depth
15693       (insert (int-to-string depth) ":")
15694       (put-text-property start (point) 'invisible t))
15695     (setq visible-start (point))
15696     (insert-char ?  (* (or depth 0) speedbar-indentation-width))
15697     (setq start (point))
15698     (insert text)
15699     (speedbar-make-button start (point) nil nil nil nil)
15700     (insert-char ?\n 1)
15701     (put-text-property visible-start (point) 'invisible nil)))
15702
15703 (defun vhdl-speedbar-insert-dirs (files level)
15704   "Insert subdirectories."
15705   (let ((dirs (car files)))
15706     (while dirs
15707       (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs)
15708                               (car dirs) 'speedbar-dir-follow nil
15709                               'speedbar-directory-face level)
15710       (setq dirs (cdr dirs)))))
15711
15712 (declare-function speedbar-reset-scanners "speedbar" ())
15713
15714 (defun vhdl-speedbar-dired (text token indent)
15715   "Speedbar click handler for directory expand button in hierarchy mode."
15716   (cond ((string-match "+" text)        ; we have to expand this dir
15717          (setq speedbar-shown-directories
15718                (cons (expand-file-name
15719                       (concat (speedbar-line-directory indent) token "/"))
15720                      speedbar-shown-directories))
15721          (speedbar-change-expand-button-char ?-)
15722          (speedbar-reset-scanners)
15723          (speedbar-with-writable
15724            (save-excursion
15725              (end-of-line) (forward-char 1)
15726              (vhdl-speedbar-insert-dirs
15727               (speedbar-file-lists
15728                (concat (speedbar-line-directory indent) token "/"))
15729               (1+ indent))
15730              (speedbar-reset-scanners)
15731              (vhdl-speedbar-insert-dir-hierarchy
15732               (abbreviate-file-name
15733                (concat (speedbar-line-directory indent) token "/"))
15734               (1+ indent) speedbar-power-click)))
15735          (vhdl-speedbar-update-current-unit t t))
15736         ((string-match "-" text)        ; we have to contract this node
15737          (speedbar-reset-scanners)
15738          (let ((oldl speedbar-shown-directories)
15739                (newl nil)
15740                (td (expand-file-name
15741                     (concat (speedbar-line-directory indent) token))))
15742            (while oldl
15743              (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
15744                  (push (car oldl) newl))
15745              (setq oldl (cdr oldl)))
15746            (setq speedbar-shown-directories (nreverse newl)))
15747          (speedbar-change-expand-button-char ?+)
15748          (speedbar-delete-subblock indent))
15749         (t (error "Nothing to display")))
15750   (when (equal (selected-frame) speedbar-frame)
15751     (speedbar-center-buffer-smartly)))
15752
15753 (declare-function speedbar-files-item-info "speedbar" ())
15754
15755 (defun vhdl-speedbar-item-info ()
15756   "Derive and display information about this line item."
15757   (save-excursion
15758     (beginning-of-line)
15759     ;; skip invisible number info
15760     (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
15761     (cond
15762      ;; project/directory entry
15763      ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
15764       (if vhdl-speedbar-show-projects
15765           (message "Project \"%s\"" (match-string-no-properties 1))
15766         (speedbar-files-item-info)))
15767      ;; design unit entry
15768      ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
15769       (goto-char (match-end 1))
15770       (let ((face (get-text-property (point) 'face)))
15771         (message
15772          "%s \"%s\" in \"%s\""
15773          ;; design unit kind
15774          (cond ((or (eq face 'vhdl-speedbar-entity-face)
15775                     (eq face 'vhdl-speedbar-entity-selected-face))
15776                 (if (equal (match-string 2) ">") "Component" "Entity"))
15777                ((or (eq face 'vhdl-speedbar-architecture-face)
15778                     (eq face 'vhdl-speedbar-architecture-selected-face))
15779                 "Architecture")
15780                ((or (eq face 'vhdl-speedbar-configuration-face)
15781                     (eq face 'vhdl-speedbar-configuration-selected-face))
15782                 "Configuration")
15783                ((or (eq face 'vhdl-speedbar-package-face)
15784                     (eq face 'vhdl-speedbar-package-selected-face))
15785                 "Package")
15786                ((or (eq face 'vhdl-speedbar-instantiation-face)
15787                     (eq face 'vhdl-speedbar-instantiation-selected-face))
15788                 "Instantiation")
15789                ((eq face 'vhdl-speedbar-subprogram-face)
15790                 "Subprogram")
15791                (t ""))
15792          ;; design unit name
15793          (buffer-substring-no-properties
15794           (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
15795           (match-end 1))
15796          ;; file name
15797          (file-relative-name
15798           (or (car (get-text-property (point) 'speedbar-token))
15799               "?")
15800           (vhdl-default-directory)))))
15801      (t (message "")))))
15802
15803 (declare-function speedbar-line-text "speedbar" (&optional p))
15804
15805 (defun vhdl-speedbar-line-text ()
15806   "Calls `speedbar-line-text' and removes text properties."
15807   (let ((string (speedbar-line-text)))
15808     (set-text-properties 0 (length string) nil string)
15809     string))
15810
15811 (defun vhdl-speedbar-higher-text ()
15812   "Get speedbar-line-text of higher level."
15813   (let (depth string)
15814     (save-excursion
15815       (beginning-of-line)
15816       (looking-at "^\\([0-9]+\\):")
15817       (setq depth (string-to-number (match-string 1)))
15818       (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t)
15819         (setq string (match-string 1))
15820         (set-text-properties 0 (length string) nil string)
15821         string))))
15822
15823 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15824 ;; Help functions
15825
15826 (defun vhdl-speedbar-line-key (&optional indent)
15827   "Get currently displayed directory of project name."
15828   (if vhdl-speedbar-show-projects
15829       (vhdl-speedbar-line-project)
15830     (abbreviate-file-name
15831      (file-name-as-directory (speedbar-line-directory indent)))))
15832
15833 (defun vhdl-speedbar-line-project (&optional indent)
15834   "Get currently displayed project name."
15835   (and vhdl-speedbar-show-projects
15836        (save-excursion
15837          (end-of-line)
15838          (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
15839          (match-string-no-properties 1))))
15840
15841 (defun vhdl-add-modified-file ()
15842   "Add file to `vhdl-modified-file-list'."
15843   (when vhdl-file-alist
15844     (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
15845   nil)
15846
15847 (defun vhdl-resolve-paths (path-list)
15848   "Resolve path wildcards in PATH-LIST."
15849   (let (path-list-1 path-list-2 path-beg path-end dir)
15850     ;; eliminate non-existent directories
15851     (while path-list
15852       (setq dir (car path-list))
15853       (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
15854       (if (file-directory-p (match-string 2 dir))
15855           (push dir path-list-1)
15856         (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
15857       (setq path-list (cdr path-list)))
15858     ;; resolve path wildcards
15859     (while path-list-1
15860       (setq dir (car path-list-1))
15861       (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
15862           (progn
15863             (setq path-beg (match-string 1 dir)
15864                   path-end (match-string 5 dir))
15865             (setq path-list-1
15866                   (append
15867                    (mapcar
15868                     (function
15869                      (lambda (var) (concat path-beg var path-end)))
15870                     (let ((all-list (vhdl-directory-files
15871                                      (match-string 2 dir) t
15872                                      (concat "\\<" (wildcard-to-regexp
15873                                                     (match-string 4 dir)))))
15874                           dir-list)
15875                       (while all-list
15876                         (when (file-directory-p (car all-list))
15877                           (push (car all-list) dir-list))
15878                         (setq all-list (cdr all-list)))
15879                       dir-list))
15880                    (cdr path-list-1))))
15881         (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
15882         (when (file-directory-p (match-string 2 dir))
15883           (push dir path-list-2))
15884         (setq path-list-1 (cdr path-list-1))))
15885     (nreverse path-list-2)))
15886
15887 (defun vhdl-speedbar-goto-this-unit (directory unit)
15888   "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
15889   (let ((dest (point)))
15890     (if (and (if vhdl-speedbar-show-projects
15891                  (progn (goto-char (point-min)) t)
15892                (speedbar-goto-this-file directory))
15893              (re-search-forward (concat "[]}] " unit "\\>") nil t))
15894         (progn (speedbar-position-cursor-on-line)
15895                t)
15896       (goto-char dest)
15897       nil)))
15898
15899 (declare-function speedbar-find-file-in-frame "speedbar" (file))
15900 (declare-function speedbar-set-timer "speedbar" (timeout))
15901 ;; speedbar loads dframe at runtime.
15902 (declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
15903
15904 (defun vhdl-speedbar-find-file (text token indent)
15905   "When user clicks on TEXT, load file with name and position in TOKEN.
15906 Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15907 is already shown in a buffer."
15908   (if (not (car token))
15909       (error "ERROR:  File cannot be found")
15910     (let ((buffer (get-file-buffer (car token))))
15911       (speedbar-find-file-in-frame (car token))
15912       (when (or vhdl-speedbar-jump-to-unit buffer)
15913         (goto-char (point-min))
15914         (forward-line (1- (cdr token)))
15915         (recenter))
15916       (vhdl-speedbar-update-current-unit t t)
15917       (speedbar-set-timer dframe-update-speed)
15918       (dframe-maybee-jump-to-attached-frame))))
15919
15920 (defun vhdl-speedbar-port-copy ()
15921   "Copy the port of the entity/component or subprogram under the cursor."
15922   (interactive)
15923   (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
15924     (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
15925         (error "ERROR:  No entity/component or subprogram under cursor")
15926       (beginning-of-line)
15927       (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
15928           (condition-case info
15929               (let ((token (get-text-property
15930                             (match-beginning 3) 'speedbar-token)))
15931                 (vhdl-visit-file (car token) t
15932                                  (progn (goto-char (point-min))
15933                                         (forward-line (1- (cdr token)))
15934                                         (end-of-line)
15935                                         (if is-entity
15936                                             (vhdl-port-copy)
15937                                           (vhdl-subprog-copy)))))
15938             (error (error "ERROR:  %s not scanned successfully\n  (%s)"
15939                           (if is-entity "Port" "Interface") (cadr info))))
15940         (error "ERROR:  No entity/component or subprogram on current line")))))
15941
15942 (defun vhdl-speedbar-place-component ()
15943   "Place the entity/component under the cursor as component."
15944   (interactive)
15945   (if (not (vhdl-speedbar-check-unit 'entity))
15946       (error "ERROR:  No entity/component under cursor")
15947     (vhdl-speedbar-port-copy)
15948     (if (fboundp 'speedbar-select-attached-frame)
15949         (speedbar-select-attached-frame)
15950       (select-frame speedbar-attached-frame))
15951     (vhdl-compose-place-component)
15952     (select-frame speedbar-frame)))
15953
15954 (defun vhdl-speedbar-configuration ()
15955   "Generate configuration for the architecture under the cursor."
15956   (interactive)
15957   (if (not (vhdl-speedbar-check-unit 'architecture))
15958       (error "ERROR:  No architecture under cursor")
15959     (let ((arch-name (vhdl-speedbar-line-text))
15960           (ent-name (vhdl-speedbar-higher-text)))
15961       (if (fboundp 'speedbar-select-attached-frame)
15962           (speedbar-select-attached-frame)
15963         (select-frame speedbar-attached-frame))
15964       (vhdl-compose-configuration ent-name arch-name))))
15965
15966 (defun vhdl-speedbar-select-mra ()
15967   "Select the architecture under the cursor as MRA."
15968   (interactive)
15969   (if (not (vhdl-speedbar-check-unit 'architecture))
15970       (error "ERROR:  No architecture under cursor")
15971     (let* ((arch-key (downcase (vhdl-speedbar-line-text)))
15972            (ent-key (downcase (vhdl-speedbar-higher-text)))
15973            (ent-alist (vhdl-aget
15974                        vhdl-entity-alist
15975                        (or (vhdl-project-p)
15976                            (abbreviate-file-name default-directory))))
15977            (ent-entry (vhdl-aget ent-alist ent-key)))
15978       (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
15979       (speedbar-refresh))))
15980
15981 (declare-function speedbar-line-file "speedbar" (&optional p))
15982
15983 (defun vhdl-speedbar-make-design ()
15984   "Make (compile) design unit or directory/project under the cursor."
15985   (interactive)
15986   (if (not (save-excursion (beginning-of-line)
15987                            (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
15988       (error "ERROR:  No primary design unit or directory/project under cursor")
15989     (let ((is-unit (match-string 2))
15990           (unit-name (vhdl-speedbar-line-text))
15991           (vhdl-project (vhdl-speedbar-line-project))
15992           (directory (file-name-as-directory
15993                       (or (speedbar-line-file) (speedbar-line-directory)))))
15994       (if (fboundp 'speedbar-select-attached-frame)
15995           (speedbar-select-attached-frame)
15996         (select-frame speedbar-attached-frame))
15997       (let ((default-directory directory))
15998         (vhdl-make (and is-unit unit-name))))))
15999
16000 (defun vhdl-speedbar-generate-makefile ()
16001   "Generate Makefile for directory/project under the cursor."
16002   (interactive)
16003   (let ((vhdl-project (vhdl-speedbar-line-project))
16004         (default-directory (file-name-as-directory
16005                             (or (speedbar-line-file) (speedbar-line-directory)))))
16006     (vhdl-generate-makefile)))
16007
16008 (defun vhdl-speedbar-check-unit (design-unit)
16009   "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
16010 expansion function)."
16011     (save-excursion
16012       (speedbar-position-cursor-on-line)
16013       (cond ((eq design-unit 'entity)
16014              (memq (get-text-property (match-end 0) 'face)
16015                    '(vhdl-speedbar-entity-face
16016                      vhdl-speedbar-entity-selected-face)))
16017             ((eq design-unit 'architecture)
16018              (memq (get-text-property (match-end 0) 'face)
16019                    '(vhdl-speedbar-architecture-face
16020                      vhdl-speedbar-architecture-selected-face)))
16021             ((eq design-unit 'subprogram)
16022              (eq (get-text-property (match-end 0) 'face)
16023                  'vhdl-speedbar-subprogram-face))
16024             (t nil))))
16025
16026 (defun vhdl-speedbar-set-depth (depth)
16027   "Set hierarchy display depth to DEPTH and refresh speedbar."
16028   (setq vhdl-speedbar-hierarchy-depth depth)
16029   (speedbar-refresh))
16030
16031 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16032 ;; Fontification
16033
16034 (defface vhdl-speedbar-entity-face
16035   '((((class color) (background light)) (:foreground "ForestGreen"))
16036     (((class color) (background dark)) (:foreground "PaleGreen")))
16037   "Face used for displaying entity names."
16038   :group 'speedbar-faces)
16039
16040 (defface vhdl-speedbar-architecture-face
16041   '((((min-colors 88) (class color) (background light)) (:foreground "Blue1"))
16042     (((class color) (background light)) (:foreground "Blue"))
16043
16044     (((class color) (background dark)) (:foreground "LightSkyBlue")))
16045   "Face used for displaying architecture names."
16046   :group 'speedbar-faces)
16047
16048 (defface vhdl-speedbar-configuration-face
16049   '((((class color) (background light)) (:foreground "DarkGoldenrod"))
16050     (((class color) (background dark)) (:foreground "Salmon")))
16051   "Face used for displaying configuration names."
16052   :group 'speedbar-faces)
16053
16054 (defface vhdl-speedbar-package-face
16055   '((((class color) (background light)) (:foreground "Grey50"))
16056     (((class color) (background dark)) (:foreground "Grey80")))
16057   "Face used for displaying package names."
16058   :group 'speedbar-faces)
16059
16060 (defface vhdl-speedbar-library-face
16061   '((((class color) (background light)) (:foreground "Purple"))
16062     (((class color) (background dark)) (:foreground "Orchid1")))
16063   "Face used for displaying library names."
16064   :group 'speedbar-faces)
16065
16066 (defface vhdl-speedbar-instantiation-face
16067   '((((class color) (background light)) (:foreground "Brown"))
16068     (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1"))
16069     (((class color) (background dark)) (:foreground "Yellow")))
16070   "Face used for displaying instantiation names."
16071   :group 'speedbar-faces)
16072
16073 (defface vhdl-speedbar-subprogram-face
16074   '((((class color) (background light)) (:foreground "Orchid4"))
16075     (((class color) (background dark)) (:foreground "BurlyWood2")))
16076   "Face used for displaying subprogram names."
16077   :group 'speedbar-faces)
16078
16079 (defface vhdl-speedbar-entity-selected-face
16080   '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
16081     (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
16082   "Face used for displaying entity names."
16083   :group 'speedbar-faces)
16084
16085 (defface vhdl-speedbar-architecture-selected-face
16086   '((((min-colors 88) (class color) (background light)) (:foreground
16087   "Blue1" :underline t))
16088     (((class color) (background light)) (:foreground "Blue" :underline t))
16089     (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
16090   "Face used for displaying architecture names."
16091   :group 'speedbar-faces)
16092
16093 (defface vhdl-speedbar-configuration-selected-face
16094   '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
16095     (((class color) (background dark)) (:foreground "Salmon" :underline t)))
16096   "Face used for displaying configuration names."
16097   :group 'speedbar-faces)
16098
16099 (defface vhdl-speedbar-package-selected-face
16100   '((((class color) (background light)) (:foreground "Grey50" :underline t))
16101     (((class color) (background dark)) (:foreground "Grey80" :underline t)))
16102   "Face used for displaying package names."
16103   :group 'speedbar-faces)
16104
16105 (defface vhdl-speedbar-instantiation-selected-face
16106   '((((class color) (background light)) (:foreground "Brown" :underline t))
16107     (((class color) (background dark)) (:foreground "Yellow" :underline t)))
16108   "Face used for displaying instantiation names."
16109   :group 'speedbar-faces)
16110
16111 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16112 ;; Initialization
16113
16114 ;; add speedbar
16115 (when (fboundp 'speedbar)
16116   (let ((current-frame (selected-frame)))
16117     (condition-case ()
16118         (when (and vhdl-speedbar-auto-open
16119                    (not (and (boundp 'speedbar-frame)
16120                              (frame-live-p speedbar-frame))))
16121           (speedbar-frame-mode 1))
16122       (error (vhdl-warning-when-idle "ERROR:  An error occurred while opening speedbar")))
16123     (select-frame current-frame)))
16124
16125 ;; initialize speedbar
16126 (if (not (boundp 'speedbar-frame))
16127     (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
16128   (vhdl-speedbar-initialize)
16129   (when speedbar-frame (vhdl-speedbar-refresh)))
16130
16131
16132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16133 ;;; Structural composition
16134 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16135
16136 (defun vhdl-get-components-package-name ()
16137   "Return the name of the components package."
16138   (let ((project (vhdl-project-p)))
16139     (if project
16140         (vhdl-replace-string (car vhdl-components-package-name)
16141                              (subst-char-in-string ?  ?_ project))
16142       (cdr vhdl-components-package-name))))
16143
16144 (defun vhdl-compose-new-component ()
16145   "Create entity and architecture for new component."
16146   (interactive)
16147   (let* ((case-fold-search t)
16148          (ent-name (read-from-minibuffer "entity name: "
16149                                          nil vhdl-minibuffer-local-map))
16150          (arch-name
16151           (if (equal (cdr vhdl-compose-architecture-name) "")
16152               (read-from-minibuffer "architecture name: "
16153                                     nil vhdl-minibuffer-local-map)
16154             (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
16155          ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
16156     (message "Creating component \"%s(%s)\"..." ent-name arch-name)
16157     ;; open entity file
16158     (unless (eq vhdl-compose-create-files 'none)
16159       (setq ent-file-name
16160             (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16161                     "." (file-name-extension (buffer-file-name))))
16162       (when (and (file-exists-p ent-file-name)
16163                  (not (y-or-n-p (concat "File \"" ent-file-name
16164                                         "\" exists; overwrite? "))))
16165         (error "ERROR:  Creating component...aborted"))
16166       (find-file ent-file-name)
16167       (erase-buffer)
16168       (set-buffer-modified-p nil))
16169     ;; insert header
16170     (if vhdl-compose-include-header
16171         (progn (vhdl-template-header)
16172                (setq end-pos (point))
16173                (goto-char (point-max)))
16174       (vhdl-comment-display-line) (insert "\n\n"))
16175     ;; insert library clause
16176     (vhdl-template-package-std-logic-1164)
16177     (when vhdl-use-components-package
16178       (insert "\n")
16179       (vhdl-template-standard-package (vhdl-work-library)
16180                                       (vhdl-get-components-package-name)))
16181     (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
16182     ;; insert entity declaration
16183     (vhdl-insert-keyword "ENTITY ") (insert ent-name)
16184     (vhdl-insert-keyword " IS\n")
16185     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16186     (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
16187     (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16188     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16189     (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
16190     (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16191     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16192     (vhdl-insert-keyword "END ")
16193     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
16194     (insert ent-name ";\n\n")
16195     (vhdl-comment-display-line) (insert "\n")
16196     ;; open architecture file
16197     (if (not (eq vhdl-compose-create-files 'separate))
16198         (insert "\n")
16199       (goto-char (or end-pos (point-min)))
16200       (setq ent-buffer (current-buffer))
16201       (setq arch-file-name
16202             (concat (vhdl-replace-string vhdl-architecture-file-name
16203                                          (concat ent-name " " arch-name) t)
16204                     "." (file-name-extension (buffer-file-name))))
16205       (when (and (file-exists-p arch-file-name)
16206                  (not (y-or-n-p (concat "File \"" arch-file-name
16207                                         "\" exists; overwrite? "))))
16208         (error "ERROR:  Creating component...aborted"))
16209       (find-file arch-file-name)
16210       (erase-buffer)
16211       (set-buffer-modified-p nil)
16212       ;; insert header
16213       (if vhdl-compose-include-header
16214           (progn (vhdl-template-header)
16215                  (goto-char (point-max)))
16216         (vhdl-comment-display-line) (insert "\n\n")))
16217     ;; insert architecture body
16218     (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
16219     (vhdl-insert-keyword " OF ") (insert ent-name)
16220     (vhdl-insert-keyword " IS\n\n")
16221     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16222     (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
16223     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16224     (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
16225       (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16226       (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16227       (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
16228     (vhdl-insert-keyword "BEGIN")
16229     (when vhdl-self-insert-comments
16230       (insert "  -- ")
16231       (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16232       (insert arch-name))
16233     (insert "\n\n")
16234     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16235     (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
16236     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16237     (vhdl-insert-keyword "END ")
16238     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16239     (insert arch-name ";\n\n")
16240     ;; insert footer and save
16241     (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16242         (vhdl-template-footer)
16243       (vhdl-comment-display-line) (insert "\n"))
16244     (goto-char (or end-pos (point-min)))
16245     (setq arch-buffer (current-buffer))
16246     (when ent-buffer (set-buffer ent-buffer) (save-buffer))
16247     (set-buffer arch-buffer) (save-buffer)
16248     (message "%s"
16249      (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
16250              (and ent-file-name
16251                   (format "\n  File created: \"%s\"" ent-file-name))
16252              (and arch-file-name
16253                   (format "\n  File created: \"%s\"" arch-file-name))))))
16254
16255 (defun vhdl-compose-place-component ()
16256   "Place new component by pasting current port as component declaration and
16257 component instantiation."
16258   (interactive)
16259   (if (not vhdl-port-list)
16260       (error "ERROR:  No port has been read")
16261     (save-excursion
16262       (vhdl-prepare-search-2
16263        (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
16264                    (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
16265          (error "ERROR:  No architecture found"))
16266        (let* ((ent-name (match-string 1))
16267               (ent-file-name
16268                (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16269                        "." (file-name-extension (buffer-file-name))))
16270               (orig-buffer (current-buffer)))
16271          (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
16272          ;; place component declaration
16273          (unless (or vhdl-use-components-package
16274                      (vhdl-use-direct-instantiation)
16275                      (save-excursion
16276                        (re-search-forward
16277                         (concat "^\\s-*component\\s-+"
16278                                 (car vhdl-port-list) "\\>") nil t)))
16279            (re-search-forward "^begin\\>" nil)
16280            (beginning-of-line)
16281            (skip-chars-backward " \t\n\r\f")
16282            (insert "\n\n") (indent-to vhdl-basic-offset)
16283            (vhdl-port-paste-component t))
16284          ;; place component instantiation
16285          (re-search-forward "^end\\>" nil)
16286          (beginning-of-line)
16287          (skip-chars-backward " \t\n\r\f")
16288          (insert "\n\n") (indent-to vhdl-basic-offset)
16289          (vhdl-port-paste-instance nil t t)
16290          ;; place use clause for used packages
16291          (when (nth 3 vhdl-port-list)
16292            ;; open entity file
16293            (when (file-exists-p ent-file-name)
16294              (find-file ent-file-name))
16295            (goto-char (point-min))
16296            (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16297              (error "ERROR:  Entity not found: \"%s\"" ent-name))
16298            (goto-char (match-beginning 0))
16299            (if (and (save-excursion
16300                       (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
16301                     (match-string 1))
16302                (progn (goto-char (match-end 0))
16303                       (beginning-of-line 2))
16304              (insert "\n")
16305              (backward-char))
16306            (vhdl-port-paste-context-clause)
16307            (switch-to-buffer orig-buffer))
16308          (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
16309
16310 (defun vhdl-compose-wire-components ()
16311   "Connect components."
16312   (interactive)
16313   (save-excursion
16314     (vhdl-prepare-search-2
16315      (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
16316                  (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
16317        (error "ERROR:  No architecture found"))
16318      (let* ((ent-name (match-string 1))
16319             (ent-file-name
16320              (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16321                      "." (file-name-extension (buffer-file-name))))
16322             (arch-decl-pos (point-marker))
16323             (arch-stat-pos (re-search-forward "^begin\\>" nil))
16324             (arch-end-pos (re-search-forward "^end\\>" nil))
16325             (pack-name (vhdl-get-components-package-name))
16326             (pack-file-name
16327              (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16328                      "." (file-name-extension (buffer-file-name))))
16329             inst-name comp-name comp-ent-name comp-ent-file-name has-generic
16330             port-alist generic-alist inst-alist
16331             signal-name signal-entry signal-alist local-list written-list
16332             single-in-list multi-in-list single-out-list multi-out-list
16333             constant-name constant-entry constant-alist single-list multi-list
16334             port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
16335             generic-beg-pos generic-pos generic-inst-pos generic-end-pos
16336             signal-beg-pos signal-pos
16337             constant-temp-pos port-temp-pos signal-temp-pos)
16338        (message "Wiring components...")
16339        ;; process all instances
16340        (goto-char arch-stat-pos)
16341        (while (re-search-forward
16342                (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
16343                        "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
16344                        "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
16345                        "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
16346                        "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t)
16347          (setq inst-name (match-string-no-properties 1)
16348                comp-name (match-string-no-properties 4)
16349                comp-ent-name (match-string-no-properties 12)
16350                has-generic (or (match-string 7) (match-string 17)))
16351          ;; get port ...
16352          (if comp-name
16353              ;; ... from component declaration
16354              (vhdl-visit-file
16355               (when vhdl-use-components-package pack-file-name) t
16356               (save-excursion
16357                 (goto-char (point-min))
16358                 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
16359                   (error "ERROR:  Component declaration not found: \"%s\"" comp-name))
16360                 (vhdl-port-copy)))
16361            ;; ... from entity declaration (direct instantiation)
16362            (setq comp-ent-file-name
16363                  (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
16364                          "." (file-name-extension (buffer-file-name))))
16365            (vhdl-visit-file
16366             comp-ent-file-name t
16367             (save-excursion
16368               (goto-char (point-min))
16369               (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
16370                 (error "ERROR:  Entity declaration not found: \"%s\"" comp-ent-name))
16371               (vhdl-port-copy))))
16372          (vhdl-port-flatten t)
16373          (setq generic-alist (nth 1 vhdl-port-list)
16374                port-alist (nth 2 vhdl-port-list)
16375                vhdl-port-list nil)
16376          (setq constant-alist nil
16377                signal-alist nil)
16378          (when has-generic
16379            ;; process all constants in generic map
16380            (vhdl-forward-syntactic-ws)
16381            (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16382              (setq constant-name (match-string-no-properties 3))
16383              (setq constant-entry
16384                    (cons constant-name
16385                          (if (match-string 1)
16386                              (or (vhdl-aget generic-alist (match-string 2))
16387                                  (error "ERROR:  Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16388                            (cdar generic-alist))))
16389              (push constant-entry constant-alist)
16390              (setq constant-name (downcase constant-name))
16391              (if (or (member constant-name single-list)
16392                      (member constant-name multi-list))
16393                  (progn (setq single-list (delete constant-name single-list))
16394                         (add-to-list 'multi-list constant-name))
16395                (add-to-list 'single-list constant-name))
16396              (unless (match-string 1)
16397                (setq generic-alist (cdr generic-alist)))
16398              (vhdl-forward-syntactic-ws))
16399            (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
16400          ;; process all signals in port map
16401          (vhdl-forward-syntactic-ws)
16402          (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16403            (setq signal-name (match-string-no-properties 3))
16404            (setq signal-entry
16405                  (cons signal-name
16406                        (if (match-string 1)
16407                            (or (vhdl-aget port-alist (match-string 2))
16408                                (error "ERROR:  Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16409                          (cdar port-alist))))
16410            (push signal-entry signal-alist)
16411            (setq signal-name (downcase signal-name))
16412            (if (equal (upcase (nth 2 signal-entry)) "IN")
16413                ;; input signal
16414                (cond
16415                 ((member signal-name local-list)
16416                  nil)
16417                 ((or (member signal-name single-out-list)
16418                      (member signal-name multi-out-list))
16419                  (setq single-out-list (delete signal-name single-out-list))
16420                  (setq multi-out-list (delete signal-name multi-out-list))
16421                  (add-to-list 'local-list signal-name))
16422                 ((member signal-name single-in-list)
16423                  (setq single-in-list (delete signal-name single-in-list))
16424                  (add-to-list 'multi-in-list signal-name))
16425                 ((not (member signal-name multi-in-list))
16426                  (add-to-list 'single-in-list signal-name)))
16427              ;; output signal
16428              (cond
16429               ((member signal-name local-list)
16430                nil)
16431               ((or (member signal-name single-in-list)
16432                    (member signal-name multi-in-list))
16433                (setq single-in-list (delete signal-name single-in-list))
16434                (setq multi-in-list (delete signal-name multi-in-list))
16435                (add-to-list 'local-list signal-name))
16436               ((member signal-name single-out-list)
16437                (setq single-out-list (delete signal-name single-out-list))
16438                (add-to-list 'multi-out-list signal-name))
16439               ((not (member signal-name multi-out-list))
16440                (add-to-list 'single-out-list signal-name))))
16441            (unless (match-string 1)
16442              (setq port-alist (cdr port-alist)))
16443            (vhdl-forward-syntactic-ws))
16444          (push (list inst-name (nreverse constant-alist)
16445                      (nreverse signal-alist)) inst-alist))
16446        ;; prepare signal insertion
16447        (vhdl-goto-marker arch-decl-pos)
16448        (forward-line 1)
16449        (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
16450        (setq signal-pos (point-marker))
16451        (while (progn (vhdl-forward-syntactic-ws)
16452                      (looking-at "signal\\>"))
16453          (beginning-of-line 2)
16454          (delete-region signal-pos (point)))
16455        (setq signal-beg-pos signal-pos)
16456        ;; open entity file
16457        (when (file-exists-p ent-file-name)
16458          (find-file ent-file-name))
16459        (goto-char (point-min))
16460        (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16461          (error "ERROR:  Entity not found: \"%s\"" ent-name))
16462        ;; prepare generic clause insertion
16463        (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16464                     (match-string 1))
16465          (goto-char (match-beginning 0))
16466          (indent-to vhdl-basic-offset)
16467          (insert "generic ();\n\n")
16468          (backward-char 4))
16469        (backward-char)
16470        (setq generic-pos (point-marker))
16471        (forward-sexp) (end-of-line)
16472        (delete-region generic-pos (point)) (delete-char 1)
16473        (insert "(\n")
16474        (when multi-list
16475          (insert "\n")
16476          (indent-to (* 2 vhdl-basic-offset))
16477          (insert "-- global generics\n"))
16478        (setq generic-beg-pos (point-marker) generic-pos (point-marker)
16479              generic-inst-pos (point-marker) generic-end-pos (point-marker))
16480        ;; prepare port clause insertion
16481        (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16482                     (match-string 1))
16483          (goto-char (match-beginning 0))
16484          (indent-to vhdl-basic-offset)
16485          (insert "port ();\n\n")
16486          (backward-char 4))
16487        (backward-char)
16488        (setq port-in-pos (point-marker))
16489        (forward-sexp) (end-of-line)
16490        (delete-region port-in-pos (point)) (delete-char 1)
16491        (insert "(\n")
16492        (when (or multi-in-list multi-out-list)
16493          (insert "\n")
16494          (indent-to (* 2 vhdl-basic-offset))
16495          (insert "-- global ports\n"))
16496        (setq port-beg-pos (point-marker) port-in-pos (point-marker)
16497              port-out-pos (point-marker) port-inst-pos (point-marker)
16498              port-end-pos (point-marker))
16499        ;; insert generics, ports and signals
16500        (setq inst-alist (nreverse inst-alist))
16501        (while inst-alist
16502          (setq inst-name (nth 0 (car inst-alist))
16503                constant-alist (nth 1 (car inst-alist))
16504                signal-alist (nth 2 (car inst-alist))
16505                constant-temp-pos generic-inst-pos
16506                port-temp-pos port-inst-pos
16507                signal-temp-pos signal-pos)
16508          ;; generics
16509          (while constant-alist
16510            (setq constant-name (downcase (caar constant-alist))
16511                  constant-entry (car constant-alist))
16512            (unless (string-match "^[0-9]+" constant-name)
16513            (cond ((member constant-name written-list)
16514                   nil)
16515                  ((member constant-name multi-list)
16516                   (vhdl-goto-marker generic-pos)
16517                   (setq generic-end-pos
16518                         (vhdl-max-marker
16519                          generic-end-pos
16520                          (vhdl-compose-insert-generic constant-entry)))
16521                   (setq generic-pos (point-marker))
16522                   (add-to-list 'written-list constant-name))
16523                  (t
16524                   (vhdl-goto-marker
16525                    (vhdl-max-marker generic-inst-pos generic-pos))
16526                   (setq generic-end-pos
16527                         (vhdl-compose-insert-generic constant-entry))
16528                   (setq generic-inst-pos (point-marker))
16529                     (add-to-list 'written-list constant-name))))
16530            (setq constant-alist (cdr constant-alist)))
16531          (when (/= constant-temp-pos generic-inst-pos)
16532            (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
16533            (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16534            (insert "-- generics for \"" inst-name "\"\n")
16535            (vhdl-goto-marker generic-inst-pos))
16536          ;; ports and signals
16537          (while signal-alist
16538            (setq signal-name (downcase (caar signal-alist))
16539                  signal-entry (car signal-alist))
16540            (cond ((member signal-name written-list)
16541                   nil)
16542                  ((member signal-name multi-in-list)
16543                   (vhdl-goto-marker port-in-pos)
16544                   (setq port-end-pos
16545                         (vhdl-max-marker
16546                          port-end-pos (vhdl-compose-insert-port signal-entry)))
16547                   (setq port-in-pos (point-marker))
16548                   (add-to-list 'written-list signal-name))
16549                  ((member signal-name multi-out-list)
16550                   (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
16551                   (setq port-end-pos
16552                         (vhdl-max-marker
16553                          port-end-pos (vhdl-compose-insert-port signal-entry)))
16554                   (setq port-out-pos (point-marker))
16555                   (add-to-list 'written-list signal-name))
16556                  ((or (member signal-name single-in-list)
16557                       (member signal-name single-out-list))
16558                   (vhdl-goto-marker
16559                    (vhdl-max-marker
16560                     port-inst-pos
16561                     (vhdl-max-marker port-out-pos port-in-pos)))
16562                   (setq port-end-pos (vhdl-compose-insert-port signal-entry))
16563                   (setq port-inst-pos (point-marker))
16564                   (add-to-list 'written-list signal-name))
16565                  ((equal (upcase (nth 2 signal-entry)) "OUT")
16566                   (vhdl-goto-marker signal-pos)
16567                   (vhdl-compose-insert-signal signal-entry)
16568                   (setq signal-pos (point-marker))
16569                   (add-to-list 'written-list signal-name)))
16570            (setq signal-alist (cdr signal-alist)))
16571          (when (/= port-temp-pos port-inst-pos)
16572            (vhdl-goto-marker
16573             (vhdl-max-marker port-temp-pos
16574                              (vhdl-max-marker port-in-pos port-out-pos)))
16575            (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16576            (insert "-- ports to \"" inst-name "\"\n")
16577            (vhdl-goto-marker port-inst-pos))
16578          (when (/= signal-temp-pos signal-pos)
16579            (vhdl-goto-marker signal-temp-pos)
16580            (insert "\n") (indent-to vhdl-basic-offset)
16581            (insert "-- outputs of \"" inst-name "\"\n")
16582            (vhdl-goto-marker signal-pos))
16583          (setq inst-alist (cdr inst-alist)))
16584        ;; finalize generic/port clause
16585        (vhdl-goto-marker generic-end-pos) (backward-char)
16586        (when (= generic-beg-pos generic-end-pos)
16587          (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16588          (insert ";") (backward-char))
16589        (insert ")")
16590        (vhdl-goto-marker port-end-pos) (backward-char)
16591        (when (= port-beg-pos port-end-pos)
16592          (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16593          (insert ";") (backward-char))
16594        (insert ")")
16595        ;; align everything
16596        (when vhdl-auto-align
16597          (vhdl-goto-marker generic-beg-pos)
16598          (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
16599          (vhdl-align-region-groups port-beg-pos port-end-pos 1)
16600          (vhdl-goto-marker signal-beg-pos)
16601          (vhdl-align-region-groups signal-beg-pos signal-pos))
16602        (switch-to-buffer (marker-buffer signal-beg-pos))
16603        (message "Wiring components...done")))))
16604
16605 (defun vhdl-compose-insert-generic (entry)
16606   "Insert ENTRY as generic declaration."
16607   (let (pos)
16608     (indent-to (* 2 vhdl-basic-offset))
16609     (insert (nth 0 entry) " : " (nth 1 entry))
16610     (when (nth 2 entry)
16611       (insert " := " (nth 2 entry)))
16612     (insert ";")
16613     (setq pos (point-marker))
16614     (when (and vhdl-include-port-comments (nth 3 entry))
16615       (vhdl-comment-insert-inline (nth 3 entry) t))
16616     (insert "\n")
16617     pos))
16618
16619 (defun vhdl-compose-insert-port (entry)
16620   "Insert ENTRY as port declaration."
16621   (let (pos)
16622     (indent-to (* 2 vhdl-basic-offset))
16623     (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
16624     (setq pos (point-marker))
16625     (when (and vhdl-include-port-comments (nth 4 entry))
16626       (vhdl-comment-insert-inline (nth 4 entry) t))
16627     (insert "\n")
16628     pos))
16629
16630 (defun vhdl-compose-insert-signal (entry)
16631   "Insert ENTRY as signal declaration."
16632   (indent-to vhdl-basic-offset)
16633   (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
16634   (when (and vhdl-include-port-comments (nth 4 entry))
16635     (vhdl-comment-insert-inline (nth 4 entry) t))
16636   (insert "\n"))
16637
16638 (defun vhdl-compose-components-package ()
16639   "Generate a package containing component declarations for all entities in the
16640 current project/directory."
16641   (interactive)
16642   (vhdl-require-hierarchy-info)
16643   (let* ((project (vhdl-project-p))
16644          (pack-name (vhdl-get-components-package-name))
16645          (pack-file-name
16646           (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16647                   "." (file-name-extension (buffer-file-name))))
16648          (ent-alist (vhdl-aget vhdl-entity-alist
16649                                (or project
16650                                    (abbreviate-file-name default-directory))))
16651          (lazy-lock-minimum-size 0)
16652          clause-pos component-pos)
16653     (message "Generating components package \"%s\"..." pack-name)
16654     ;; open package file
16655     (when (and (file-exists-p pack-file-name)
16656                (not (y-or-n-p (concat "File \"" pack-file-name
16657                                       "\" exists; overwrite? "))))
16658       (error "ERROR:  Generating components package...aborted"))
16659     (find-file pack-file-name)
16660     (erase-buffer)
16661     ;; insert header
16662     (if vhdl-compose-include-header
16663         (progn (vhdl-template-header
16664                 (concat "Components package (generated by Emacs VHDL Mode "
16665                         vhdl-version ")"))
16666                (goto-char (point-max)))
16667       (vhdl-comment-display-line) (insert "\n\n"))
16668     ;; insert std_logic_1164 package
16669     (vhdl-template-package-std-logic-1164)
16670     (insert "\n") (setq clause-pos (point-marker))
16671     (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
16672     ;; insert package declaration
16673     (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
16674     (vhdl-insert-keyword " IS\n\n")
16675     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16676     (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16677     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16678     (indent-to vhdl-basic-offset)
16679     (setq component-pos (point-marker))
16680     (insert "\n\n") (vhdl-insert-keyword "END ")
16681     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
16682     (insert pack-name ";\n\n")
16683     ;; insert footer
16684     (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16685         (vhdl-template-footer)
16686       (vhdl-comment-display-line) (insert "\n"))
16687     ;; insert component declarations
16688     (while ent-alist
16689       (vhdl-visit-file (nth 2 (car ent-alist)) nil
16690                        (progn (goto-char (point-min))
16691                               (forward-line (1- (nth 3 (car ent-alist))))
16692                               (end-of-line)
16693                               (vhdl-port-copy)))
16694       (goto-char component-pos)
16695       (vhdl-port-paste-component t)
16696       (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
16697       (setq component-pos (point-marker))
16698       (goto-char clause-pos)
16699       (vhdl-port-paste-context-clause pack-name)
16700       (setq clause-pos (point-marker))
16701       (setq ent-alist (cdr ent-alist)))
16702     (goto-char (point-min))
16703     (save-buffer)
16704     (message "Generating components package \"%s\"...done\n  File created: \"%s\""
16705              pack-name pack-file-name)))
16706
16707 (defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
16708                                                          conf-alist inst-alist
16709                                                          &optional insert-conf)
16710   "Generate block configuration for architecture."
16711   (let ((margin (current-indentation))
16712         (beg (point-at-bol))
16713         ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
16714     ;; insert block configuration (for architecture)
16715     (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
16716     (setq margin (+ margin vhdl-basic-offset))
16717     ;; process all instances
16718     (while inst-alist
16719       (setq inst-entry (car inst-alist))
16720       ;; is component?
16721       (when (nth 4 inst-entry)
16722         (setq insert-conf t)
16723         (setq inst-path (nth 9 inst-entry))
16724         ;; skip common path with previous instance
16725         (while (and inst-path (equal (car inst-path) (car inst-prev-path)))
16726           (setq inst-path (cdr inst-path)
16727                 inst-prev-path (cdr inst-prev-path)))
16728         ;; insert block configuration end (for previous block/generate)
16729         (while inst-prev-path
16730           (setq margin (- margin vhdl-basic-offset))
16731           (indent-to margin)
16732           (vhdl-insert-keyword "END FOR;\n")
16733           (setq inst-prev-path (cdr inst-prev-path)))
16734         ;; insert block configuration beginning (for current block/generate)
16735         (indent-to margin)
16736         (while inst-path
16737           (setq margin (+ margin vhdl-basic-offset))
16738           (vhdl-insert-keyword "FOR ")
16739           (insert (car inst-path) "\n")
16740           (indent-to margin)
16741           (setq inst-path (cdr inst-path)))
16742         ;; insert component configuration beginning
16743         (vhdl-insert-keyword "FOR ")
16744         (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n")
16745         ;; find subconfiguration
16746         (setq conf-key (nth 7 inst-entry))
16747         (setq tmp-alist conf-alist)
16748         ;; use first configuration found for instance's entity
16749         (while (and tmp-alist (null conf-key))
16750           (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
16751             (setq conf-key (nth 0 (car tmp-alist))))
16752           (setq tmp-alist (cdr tmp-alist)))
16753         (setq conf-entry (vhdl-aget conf-alist conf-key))
16754         ;; insert binding indication ...
16755         ;; ... with subconfiguration (if exists)
16756         (if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
16757             (progn
16758               (indent-to (+ margin vhdl-basic-offset))
16759               (vhdl-insert-keyword "USE CONFIGURATION ")
16760               (insert (vhdl-work-library) "." (nth 0 conf-entry))
16761               (insert ";\n"))
16762           ;; ... with entity (if exists)
16763           (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry)))
16764           (when ent-entry
16765             (indent-to (+ margin vhdl-basic-offset))
16766             (vhdl-insert-keyword "USE ENTITY ")
16767             (insert (vhdl-work-library) "." (nth 0 ent-entry))
16768             ;; insert architecture name (if architecture exists)
16769             (when (nth 3 ent-entry)
16770               (setq arch-name
16771                     ;; choose architecture name a) from configuration,
16772                     ;; b) from mra, or c) from first architecture
16773                     (or (nth 0 (vhdl-aget (nth 3 ent-entry)
16774                                           (or (nth 6 inst-entry)
16775                                               (nth 4 ent-entry))))
16776                         (nth 1 (car (nth 3 ent-entry)))))
16777               (insert "(" arch-name ")"))
16778             (insert ";\n")
16779             ;; insert block configuration (for architecture of subcomponent)
16780             (when (and vhdl-compose-configuration-hierarchical
16781                        (nth 3 ent-entry))
16782               (indent-to (+ margin vhdl-basic-offset))
16783               (vhdl-compose-configuration-architecture
16784                (nth 0 ent-entry) arch-name ent-alist conf-alist
16785                (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name)))))))
16786         ;; insert component configuration end
16787         (indent-to margin)
16788         (vhdl-insert-keyword "END FOR;\n")
16789         (setq inst-prev-path (nth 9 inst-entry)))
16790       (setq inst-alist (cdr inst-alist)))
16791     ;; insert block configuration end (for block/generate)
16792     (while inst-prev-path
16793       (setq margin (- margin vhdl-basic-offset))
16794       (indent-to margin)
16795       (vhdl-insert-keyword "END FOR;\n")
16796       (setq inst-prev-path (cdr inst-prev-path)))
16797     (indent-to (- margin vhdl-basic-offset))
16798     ;; insert block configuration end or remove beginning (for architecture)
16799     (if insert-conf
16800         (vhdl-insert-keyword "END FOR;\n")
16801       (delete-region beg (point)))))
16802
16803 (defun vhdl-compose-configuration (&optional ent-name arch-name)
16804   "Generate configuration declaration."
16805   (interactive)
16806   (vhdl-require-hierarchy-info)
16807   (let ((ent-alist (vhdl-aget vhdl-entity-alist
16808                               (or (vhdl-project-p)
16809                                   (abbreviate-file-name default-directory))))
16810         (conf-alist (vhdl-aget vhdl-config-alist
16811                                (or (vhdl-project-p)
16812                                    (abbreviate-file-name default-directory))))
16813         (from-speedbar ent-name)
16814         inst-alist conf-name conf-file-name pos)
16815     (vhdl-prepare-search-2
16816      ;; get entity and architecture name
16817      (unless ent-name
16818        (save-excursion
16819          (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
16820                       (not (equal "END" (upcase (match-string 1))))
16821                       (setq ent-name (match-string-no-properties 3))
16822                       (setq arch-name (match-string-no-properties 2)))
16823            (error "ERROR:  Not within an architecture"))))
16824      (setq conf-name (vhdl-replace-string
16825                       vhdl-compose-configuration-name
16826                       (concat ent-name " " arch-name)))
16827      (setq inst-alist
16828            (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name)))
16829                              (downcase arch-name)))))
16830      (message "Generating configuration \"%s\"..." conf-name)
16831      (if vhdl-compose-configuration-create-file
16832          ;; open configuration file
16833          (progn
16834            (setq conf-file-name
16835                  (concat (vhdl-replace-string vhdl-configuration-file-name
16836                                               conf-name t)
16837                          "." (file-name-extension (buffer-file-name))))
16838            (when (and (file-exists-p conf-file-name)
16839                       (not (y-or-n-p (concat "File \"" conf-file-name
16840                                              "\" exists; overwrite? "))))
16841              (error "ERROR:  Creating configuration...aborted"))
16842            (find-file conf-file-name)
16843            (erase-buffer)
16844            (set-buffer-modified-p nil)
16845            ;; insert header
16846            (if vhdl-compose-include-header
16847                (progn (vhdl-template-header
16848                        (concat "Configuration declaration for design \""
16849                                ent-name "(" arch-name ")\""))
16850                       (goto-char (point-max)))
16851              (vhdl-comment-display-line) (insert "\n\n")))
16852        ;; goto end of architecture
16853        (unless from-speedbar
16854          (re-search-forward "^end\\>" nil)
16855          (end-of-line) (insert "\n\n")
16856          (vhdl-comment-display-line) (insert "\n\n")))
16857      ;; insert library clause
16858      (setq pos (point))
16859      (vhdl-template-standard-package (vhdl-work-library) nil)
16860      (when (/= pos (point))
16861        (insert "\n\n"))
16862      ;; insert configuration
16863      (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name)
16864      (vhdl-insert-keyword " OF ") (insert ent-name)
16865      (vhdl-insert-keyword " IS\n")
16866      (indent-to vhdl-basic-offset)
16867      ;; insert block configuration (for architecture)
16868      (vhdl-compose-configuration-architecture
16869       ent-name arch-name ent-alist conf-alist inst-alist t)
16870      (vhdl-insert-keyword "END ") (insert conf-name ";")
16871      (when conf-file-name
16872        ;; insert footer and save
16873        (insert "\n\n")
16874        (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16875            (vhdl-template-footer)
16876          (vhdl-comment-display-line) (insert "\n"))
16877        (save-buffer))
16878      (message "%s"
16879       (concat (format "Generating configuration \"%s\"...done" conf-name)
16880               (and conf-file-name
16881                    (format "\n  File created: \"%s\"" conf-file-name))))))
16882
16883
16884 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16885 ;;; Compilation / Makefile generation
16886 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16887 ;; (using `compile.el')
16888
16889 (defvar vhdl-compile-post-command ""
16890   "String appended to compile command after file name.")
16891
16892 (defun vhdl-makefile-name ()
16893   "Return the Makefile name of the current project or the current compiler if
16894 no project is defined."
16895   (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
16896         (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
16897     (vhdl-replace-string
16898      (cons "\\(.*\\)\n\\(.*\\)"
16899            (or (nth 8 project-alist) (nth 8 compiler-alist)))
16900      (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
16901
16902 (defun vhdl-compile-directory ()
16903   "Return the directory where compilation/make should be run."
16904   (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
16905          (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
16906          (directory (vhdl-resolve-env-variable
16907                      (if project
16908                          (vhdl-replace-string
16909                           (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
16910                        (nth 6 compiler)))))
16911     (file-name-as-directory
16912      (if (file-name-absolute-p directory)
16913          directory
16914        (expand-file-name directory (vhdl-default-directory))))))
16915
16916 (defun vhdl-uniquify (in-list)
16917   "Remove duplicate elements from IN-LIST."
16918   (let (out-list)
16919     (while in-list
16920       (add-to-list 'out-list (car in-list))
16921       (setq in-list (cdr in-list)))
16922     out-list))
16923
16924 (defun vhdl-set-compiler (name)
16925   "Set current compiler to NAME."
16926   (interactive
16927    (list (let ((completion-ignore-case t))
16928            (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
16929   (if (assoc name vhdl-compiler-alist)
16930       (progn (setq vhdl-compiler name)
16931              (message "Current compiler: \"%s\"" vhdl-compiler))
16932     (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
16933
16934 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16935 ;; Compilation
16936
16937 (defun vhdl-compile-init ()
16938   "Initialize for compilation."
16939   (when (and (not vhdl-emacs-22)
16940              (or (null compilation-error-regexp-alist)
16941                  (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
16942                              compilation-error-regexp-alist))))
16943     ;; `compilation-error-regexp-alist'
16944     (let ((commands-alist vhdl-compiler-alist)
16945           regexp-alist sublist)
16946       (while commands-alist
16947         (setq sublist (nth 11 (car commands-alist)))
16948         (unless (or (equal "" (car sublist))
16949                     (assoc (car sublist) regexp-alist))
16950           (push (list (nth 0 sublist)
16951                       (if (and (featurep 'xemacs) (not (nth 1 sublist)))
16952                           9
16953                                            (nth 1 sublist))
16954                                          (nth 2 sublist) (nth 3 sublist))
16955                 regexp-alist))
16956         (setq commands-alist (cdr commands-alist)))
16957       (setq compilation-error-regexp-alist
16958             (append compilation-error-regexp-alist (nreverse regexp-alist))))
16959     ;; `compilation-file-regexp-alist'
16960     (let ((commands-alist vhdl-compiler-alist)
16961           regexp-alist sublist)
16962       ;; matches vhdl-mode file name output
16963       (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
16964       (while commands-alist
16965         (setq sublist (nth 12 (car commands-alist)))
16966         (unless (or (equal "" (car sublist))
16967                     (assoc (car sublist) regexp-alist))
16968           (push sublist regexp-alist))
16969         (setq commands-alist (cdr commands-alist)))
16970       (setq compilation-file-regexp-alist
16971             (append compilation-file-regexp-alist (nreverse regexp-alist))))))
16972
16973 (defvar vhdl-compile-file-name nil
16974   "Name of file to be compiled.")
16975
16976 (defun vhdl-compile-print-file-name ()
16977   "Function called within `compile' to print out file name for compilers that
16978 do not print any file names."
16979   (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
16980
16981 (defun vhdl-get-compile-options (project compiler file-name
16982                                          &optional file-options-only)
16983   "Get compiler options.  Returning nil means do not compile this file."
16984   (let* ((compiler-options (nth 1 compiler))
16985          (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
16986          (project-options (nth 0 project-entry))
16987          (exception-list (and file-name (nth 2 project-entry)))
16988          (work-library (vhdl-work-library))
16989          (case-fold-search nil)
16990          file-options)
16991     (while (and exception-list
16992                 (not (string-match (caar exception-list) file-name)))
16993       (setq exception-list (cdr exception-list)))
16994     (if (and exception-list (not (cdar exception-list)))
16995         nil
16996       (if (and file-options-only (not exception-list))
16997           'default
16998         (setq file-options (cdar exception-list))
16999         ;; insert library name in compiler-specific options
17000         (setq compiler-options
17001               (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
17002                                    work-library))
17003         ;; insert compiler-specific options in project-specific options
17004         (when project-options
17005           (setq project-options
17006                 (vhdl-replace-string
17007                  (cons "\\(.*\\)\n\\(.*\\)" project-options)
17008                  (concat work-library "\n" compiler-options))))
17009         ;; insert project-specific options in file-specific options
17010         (when file-options
17011           (setq file-options
17012                 (vhdl-replace-string
17013                  (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
17014                  (concat work-library "\n" compiler-options "\n"
17015                          project-options))))
17016         ;; return options
17017         (or file-options project-options compiler-options)))))
17018
17019 (defun vhdl-get-make-options (project compiler)
17020   "Get make options."
17021   (let* ((compiler-options (nth 3 compiler))
17022          (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
17023          (project-options (nth 1 project-entry))
17024          (makefile-name (vhdl-makefile-name)))
17025     ;; insert Makefile name in compiler-specific options
17026     (setq compiler-options
17027           (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
17028                                makefile-name))
17029     ;; insert compiler-specific options in project-specific options
17030     (when project-options
17031       (setq project-options
17032             (vhdl-replace-string
17033              (cons "\\(.*\\)\n\\(.*\\)" project-options)
17034              (concat makefile-name "\n" compiler-options))))
17035     ;; return options
17036     (or project-options compiler-options)))
17037
17038 (defun vhdl-compile ()
17039   "Compile current buffer using the VHDL compiler specified in
17040 `vhdl-compiler'."
17041   (interactive)
17042   (vhdl-compile-init)
17043   (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17044          (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17045                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17046          (command (nth 0 compiler))
17047          (default-directory (vhdl-compile-directory))
17048          (file-name (if vhdl-compile-absolute-path
17049                         (buffer-file-name)
17050                       (file-relative-name (buffer-file-name))))
17051          (options (vhdl-get-compile-options project compiler file-name))
17052          compilation-process-setup-function)
17053     (unless (file-directory-p default-directory)
17054       (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17055     ;; put file name into quotes if it contains spaces
17056     (when (string-match " " file-name)
17057       (setq file-name (concat "\"" file-name "\"")))
17058     ;; print out file name if compiler does not
17059     (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
17060                                      (buffer-file-name)
17061                                    (file-relative-name (buffer-file-name))))
17062     (when (and (= 0 (nth 1 (nth 10 compiler)))
17063                (= 0 (nth 1 (nth 11 compiler))))
17064       (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
17065     ;; run compilation
17066     (if options
17067         (when command
17068           (compile (concat command " " options " " file-name
17069                            (unless (equal vhdl-compile-post-command "")
17070                              (concat " " vhdl-compile-post-command)))))
17071       (vhdl-warning "Your project settings tell me not to compile this file"))))
17072
17073 (defvar vhdl-make-target "all"
17074   "Default target for `vhdl-make' command.")
17075
17076 (defun vhdl-make (&optional target)
17077   "Call make command for compilation of all updated source files (requires
17078 `Makefile').  Optional argument TARGET allows you to compile the design
17079 specified by a target."
17080   (interactive)
17081   (setq vhdl-make-target
17082         (or target (read-from-minibuffer "Target: " vhdl-make-target
17083                                          vhdl-minibuffer-local-map)))
17084   (vhdl-compile-init)
17085   (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17086          (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17087                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17088          (command (nth 2 compiler))
17089          (options (vhdl-get-make-options project compiler))
17090          (default-directory (vhdl-compile-directory)))
17091     (unless (file-directory-p default-directory)
17092       (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17093     ;; run make
17094     (compile (concat (if (equal command "") "make" command)
17095                      " " options " " vhdl-make-target))))
17096
17097 ;; Emacs 22+ setup
17098 (defvar vhdl-error-regexp-emacs-alist
17099   ;; Get regexps from `vhdl-compiler-alist'
17100   (let ((compiler-alist vhdl-compiler-alist)
17101         (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
17102    (while compiler-alist
17103      ;; only add regexps for currently selected compiler
17104      (when (or (not vhdl-compile-use-local-error-regexp)
17105                (equal vhdl-compiler (nth 0 (car compiler-alist))))
17106        ;; add error message regexps
17107        (setq error-regexp-alist
17108              (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))))))
17109                            (nth 11 (car compiler-alist)))
17110                    error-regexp-alist))
17111        ;; add filename regexps
17112        (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
17113          (setq error-regexp-alist
17114                (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
17115                              (nth 12 (car compiler-alist)))
17116                      error-regexp-alist))))
17117      (setq compiler-alist (cdr compiler-alist)))
17118    error-regexp-alist)
17119   "List of regexps for VHDL compilers.  For Emacs 22+.")
17120
17121 ;; Add error regexps using compilation-mode-hook.
17122 (defun vhdl-error-regexp-add-emacs ()
17123   "Set up Emacs compile for VHDL."
17124   (interactive)
17125   (when (and (boundp 'compilation-error-regexp-alist-alist)
17126              (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
17127     ;; remove all other compilers
17128     (when vhdl-compile-use-local-error-regexp
17129       (setq compilation-error-regexp-alist nil))
17130     ;; add VHDL compilers
17131     (mapcar
17132      (lambda (item)
17133        (push (car item) compilation-error-regexp-alist)
17134        (push item compilation-error-regexp-alist-alist))
17135      vhdl-error-regexp-emacs-alist)))
17136
17137 (when vhdl-emacs-22
17138   (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs))
17139
17140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17141 ;; Makefile generation
17142
17143 (defun vhdl-generate-makefile ()
17144   "Generate `Makefile'."
17145   (interactive)
17146   (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17147                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17148          (command (nth 4 compiler)))
17149     ;; generate makefile
17150     (if command
17151         (let ((default-directory (vhdl-compile-directory)))
17152           (compile (vhdl-replace-string
17153                     (cons "\\(.*\\) \\(.*\\)" command)
17154                     (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
17155       (vhdl-generate-makefile-1))))
17156
17157 (defun vhdl-get-packages (lib-alist work-library)
17158   "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
17159   (let (pack-list)
17160     (while lib-alist
17161       (when (equal (downcase (caar lib-alist)) (downcase work-library))
17162         (push (cdar lib-alist) pack-list))
17163       (setq lib-alist (cdr lib-alist)))
17164     pack-list))
17165
17166 (defun vhdl-generate-makefile-1 ()
17167   "Generate Makefile for current project or directory."
17168   ;; scan hierarchy if required
17169   (if (vhdl-project-p)
17170       (unless (or (assoc vhdl-project vhdl-file-alist)
17171                   (vhdl-load-cache vhdl-project))
17172         (vhdl-scan-project-contents vhdl-project))
17173     (let ((directory (abbreviate-file-name default-directory)))
17174       (unless (or (assoc directory vhdl-file-alist)
17175                   (vhdl-load-cache directory))
17176         (vhdl-scan-directory-contents directory))))
17177   (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
17178          (project (vhdl-project-p))
17179          (ent-alist (vhdl-aget vhdl-entity-alist (or project directory)))
17180          (conf-alist (vhdl-aget vhdl-config-alist (or project directory)))
17181          (pack-alist (vhdl-aget vhdl-package-alist (or project directory)))
17182          (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17183                           '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
17184                             "\\1.vhd" "\\1_body.vhd" identity)))
17185          (mapping-exist
17186           (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
17187          (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
17188          (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
17189          (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
17190          (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
17191          (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
17192          (adjust-case (nth 5 regexp-list))
17193          (work-library (downcase (vhdl-work-library)))
17194          (compile-directory (expand-file-name (vhdl-compile-directory)
17195                                               default-directory))
17196          (makefile-name (vhdl-makefile-name))
17197          rule-alist arch-alist inst-alist
17198          target-list depend-list unit-list prim-list second-list subcomp-list
17199          lib-alist lib-body-alist pack-list all-pack-list
17200          ent-key ent-file-name arch-key arch-file-name ent-arch-key
17201          conf-key conf-file-name pack-key pack-file-name
17202          ent-entry arch-entry conf-entry pack-entry inst-entry
17203          pack-body-key pack-body-file-name inst-ent-key inst-conf-key
17204          tmp-key tmp-list rule)
17205     ;; check prerequisites
17206     (unless (file-exists-p compile-directory)
17207       (make-directory compile-directory t))
17208     (unless mapping-exist
17209       (vhdl-warning
17210        (format "No unit-to-file name mapping found for compiler \"%s\".\n  Directory of dummy files is created instead (to be used as dependencies).\n  Please contact the VHDL Mode maintainer for full support of \"%s\""
17211                vhdl-compiler vhdl-compiler) t))
17212     (message "Generating makefile \"%s\"..." makefile-name)
17213     ;; rules for all entities
17214     (setq tmp-list ent-alist)
17215     (while ent-alist
17216       (setq ent-entry (car ent-alist)
17217             ent-key (nth 0 ent-entry))
17218       (when (nth 2 ent-entry)
17219         (setq ent-file-name (if vhdl-compile-absolute-path
17220                                 (nth 2 ent-entry)
17221                               (file-relative-name (nth 2 ent-entry)
17222                                                   compile-directory))
17223               arch-alist (nth 4 ent-entry)
17224               lib-alist (nth 6 ent-entry)
17225               rule (vhdl-aget rule-alist ent-file-name)
17226               target-list (nth 0 rule)
17227               depend-list (nth 1 rule)
17228               second-list nil
17229               subcomp-list nil)
17230         (setq tmp-key (vhdl-replace-string
17231                        ent-regexp
17232                        (funcall adjust-case
17233                                 (concat ent-key "  " work-library))))
17234         (push (cons ent-key tmp-key) unit-list)
17235         ;; rule target for this entity
17236         (push ent-key target-list)
17237         ;; rule dependencies for all used packages
17238         (setq pack-list (vhdl-get-packages lib-alist work-library))
17239         (setq depend-list (append depend-list pack-list))
17240         (setq all-pack-list pack-list)
17241         ;; add rule
17242         (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
17243         ;; rules for all corresponding architectures
17244         (while arch-alist
17245           (setq arch-entry (car arch-alist)
17246                 arch-key (nth 0 arch-entry)
17247                 ent-arch-key (concat ent-key "-" arch-key)
17248                 arch-file-name (if vhdl-compile-absolute-path
17249                                    (nth 2 arch-entry)
17250                                  (file-relative-name (nth 2 arch-entry)
17251                                                      compile-directory))
17252                 inst-alist (nth 4 arch-entry)
17253                 lib-alist (nth 5 arch-entry)
17254                 rule (vhdl-aget rule-alist arch-file-name)
17255                 target-list (nth 0 rule)
17256                 depend-list (nth 1 rule))
17257           (setq tmp-key (vhdl-replace-string
17258                          arch-regexp
17259                          (funcall adjust-case
17260                                   (concat arch-key " " ent-key " "
17261                                           work-library))))
17262           (setq unit-list
17263                 (cons (cons ent-arch-key tmp-key) unit-list))
17264           (push ent-arch-key second-list)
17265           ;; rule target for this architecture
17266           (push ent-arch-key target-list)
17267           ;; rule dependency for corresponding entity
17268           (push ent-key depend-list)
17269           ;; rule dependencies for contained component instantiations
17270           (while inst-alist
17271             (setq inst-entry (car inst-alist))
17272             (when (or (null (nth 8 inst-entry))
17273                       (equal (downcase (nth 8 inst-entry)) work-library))
17274               (setq inst-ent-key (or (nth 7 inst-entry)
17275                                      (nth 5 inst-entry)))
17276               (setq depend-list (cons inst-ent-key depend-list)
17277                     subcomp-list (cons inst-ent-key subcomp-list)))
17278             (setq inst-alist (cdr inst-alist)))
17279           ;; rule dependencies for all used packages
17280           (setq pack-list (vhdl-get-packages lib-alist work-library))
17281           (setq depend-list (append depend-list pack-list))
17282           (setq all-pack-list (append all-pack-list pack-list))
17283           ;; add rule
17284           (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
17285           (setq arch-alist (cdr arch-alist)))
17286         (push (list ent-key second-list (append subcomp-list all-pack-list))
17287               prim-list))
17288       (setq ent-alist (cdr ent-alist)))
17289     (setq ent-alist tmp-list)
17290     ;; rules for all configurations
17291     (setq tmp-list conf-alist)
17292     (while conf-alist
17293       (setq conf-entry (car conf-alist)
17294             conf-key (nth 0 conf-entry)
17295             conf-file-name (if vhdl-compile-absolute-path
17296                                (nth 2 conf-entry)
17297                              (file-relative-name (nth 2 conf-entry)
17298                                                  compile-directory))
17299             ent-key (nth 4 conf-entry)
17300             arch-key (nth 5 conf-entry)
17301             inst-alist (nth 6 conf-entry)
17302             lib-alist (nth 7 conf-entry)
17303             rule (vhdl-aget rule-alist conf-file-name)
17304             target-list (nth 0 rule)
17305             depend-list (nth 1 rule)
17306             subcomp-list (list ent-key))
17307       (setq tmp-key (vhdl-replace-string
17308                      conf-regexp
17309                      (funcall adjust-case
17310                               (concat conf-key "  " work-library))))
17311       (push (cons conf-key tmp-key) unit-list)
17312       ;; rule target for this configuration
17313       (push conf-key target-list)
17314       ;; rule dependency for corresponding entity and architecture
17315       (setq depend-list
17316             (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
17317       ;; rule dependencies for used packages
17318       (setq pack-list (vhdl-get-packages lib-alist work-library))
17319       (setq depend-list (append depend-list pack-list))
17320       ;; rule dependencies for contained component configurations
17321       (while inst-alist
17322         (setq inst-entry (car inst-alist))
17323         (setq inst-ent-key (nth 2 inst-entry)
17324               inst-conf-key (nth 4 inst-entry))
17325         (when (equal (downcase (nth 5 inst-entry)) work-library)
17326           (when inst-ent-key
17327             (setq depend-list (cons inst-ent-key depend-list)
17328                   subcomp-list (cons inst-ent-key subcomp-list)))
17329           (when inst-conf-key
17330             (setq depend-list (cons inst-conf-key depend-list)
17331                   subcomp-list (cons inst-conf-key subcomp-list))))
17332         (setq inst-alist (cdr inst-alist)))
17333       ;; add rule
17334       (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
17335       (push (list conf-key nil (append subcomp-list pack-list)) prim-list)
17336       (setq conf-alist (cdr conf-alist)))
17337     (setq conf-alist tmp-list)
17338     ;; rules for all packages
17339     (setq tmp-list pack-alist)
17340     (while pack-alist
17341       (setq pack-entry (car pack-alist)
17342             pack-key (nth 0 pack-entry)
17343             pack-body-key nil)
17344       (when (nth 2 pack-entry)
17345         (setq pack-file-name (if vhdl-compile-absolute-path
17346                                  (nth 2 pack-entry)
17347                                (file-relative-name (nth 2 pack-entry)
17348                                                    compile-directory))
17349               lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
17350               rule (vhdl-aget rule-alist pack-file-name)
17351               target-list (nth 0 rule) depend-list (nth 1 rule))
17352         (setq tmp-key (vhdl-replace-string
17353                        pack-regexp
17354                        (funcall adjust-case
17355                                 (concat pack-key "  " work-library))))
17356         (push (cons pack-key tmp-key) unit-list)
17357         ;; rule target for this package
17358         (push pack-key target-list)
17359         ;; rule dependencies for all used packages
17360         (setq pack-list (vhdl-get-packages lib-alist work-library))
17361         (setq depend-list (append depend-list pack-list))
17362         (setq all-pack-list pack-list)
17363         ;; add rule
17364         (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
17365         ;; rules for this package's body
17366         (when (nth 7 pack-entry)
17367           (setq pack-body-key (concat pack-key "-body")
17368                 pack-body-file-name (if vhdl-compile-absolute-path
17369                                         (nth 7 pack-entry)
17370                                       (file-relative-name (nth 7 pack-entry)
17371                                                           compile-directory))
17372                 rule (vhdl-aget rule-alist pack-body-file-name)
17373                 target-list (nth 0 rule)
17374                 depend-list (nth 1 rule))
17375           (setq tmp-key (vhdl-replace-string
17376                          pack-body-regexp
17377                          (funcall adjust-case
17378                                   (concat pack-key "  " work-library))))
17379           (setq unit-list
17380                 (cons (cons pack-body-key tmp-key) unit-list))
17381           ;; rule target for this package's body
17382           (push pack-body-key target-list)
17383           ;; rule dependency for corresponding package declaration
17384           (push pack-key depend-list)
17385           ;; rule dependencies for all used packages
17386           (setq pack-list (vhdl-get-packages lib-body-alist work-library))
17387           (setq depend-list (append depend-list pack-list))
17388           (setq all-pack-list (append all-pack-list pack-list))
17389           ;; add rule
17390           (vhdl-aput 'rule-alist pack-body-file-name
17391                      (list target-list depend-list)))
17392         (setq prim-list
17393               (cons (list pack-key (when pack-body-key (list pack-body-key))
17394                           all-pack-list)
17395                     prim-list)))
17396       (setq pack-alist (cdr pack-alist)))
17397     (setq pack-alist tmp-list)
17398     ;; generate Makefile
17399     (let* ((project (vhdl-aget vhdl-project-alist project))
17400            (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17401            (compiler-id (nth 9 compiler))
17402            (library-directory
17403             (vhdl-resolve-env-variable
17404              (vhdl-replace-string
17405               (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
17406               compiler-id)))
17407            (makefile-path-name (expand-file-name
17408                                 makefile-name compile-directory))
17409            (orig-buffer (current-buffer))
17410            cell second-list subcomp-list options unit-key unit-name)
17411       ;; sort lists
17412       (setq unit-list (vhdl-sort-alist unit-list))
17413       (setq prim-list (vhdl-sort-alist prim-list))
17414       (setq tmp-list rule-alist)
17415       (while tmp-list                   ; pre-sort rule targets
17416         (setq cell (cdar tmp-list))
17417         (setcar cell (sort (car cell) 'string<))
17418         (setq tmp-list (cdr tmp-list)))
17419       (setq rule-alist                  ; sort by first rule target
17420             (sort rule-alist
17421                   (function (lambda (a b)
17422                               (string< (car (cadr a)) (car (cadr b)))))))
17423       ;; open and clear Makefile
17424       (set-buffer (find-file-noselect makefile-path-name t t))
17425       (erase-buffer)
17426       (insert "# -*- Makefile -*-\n"
17427               "### " (file-name-nondirectory makefile-name)
17428               " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
17429               "\n")
17430       (if project
17431           (insert "\n# Project   : " (nth 0 project))
17432         (insert "\n# Directory : \"" directory "\""))
17433       (insert "\n# Platform  : " vhdl-compiler
17434               "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
17435               (user-login-name) "\n")
17436       ;; insert compile and option variable settings
17437       (insert "\n\n# Define compilation command and options\n"
17438               "\nCOMPILE = " (nth 0 compiler)
17439               "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
17440               (if (equal vhdl-compile-post-command "") ""
17441                 (concat "\nPOST-COMPILE = " vhdl-compile-post-command))
17442               "\n")
17443       ;; insert library paths
17444       (setq library-directory
17445             (directory-file-name
17446              (if (file-name-absolute-p library-directory)
17447                  library-directory
17448                (file-relative-name
17449                 (expand-file-name library-directory directory)
17450                 compile-directory))))
17451       (insert "\n\n# Define library paths\n"
17452               "\nLIBRARY-" work-library " = " library-directory "\n")
17453       (unless mapping-exist
17454         (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
17455                 ")/make" "\n"))
17456       ;; insert variable definitions for all library unit files
17457       (insert "\n\n# Define library unit files\n")
17458       (setq tmp-list unit-list)
17459       (while unit-list
17460         (insert "\nUNIT-" work-library "-" (caar unit-list)
17461                 " = \\\n\t$(LIBRARY-" work-library
17462                 (if mapping-exist "" "-make") ")/" (cdar unit-list))
17463         (setq unit-list (cdr unit-list)))
17464       ;; insert variable definition for list of all library unit files
17465       (insert "\n\n\n# Define list of all library unit files\n"
17466               "\nALL_UNITS =")
17467       (setq unit-list tmp-list)
17468       (while unit-list
17469         (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
17470         (setq unit-list (cdr unit-list)))
17471       (insert "\n")
17472       (setq unit-list tmp-list)
17473       ;; insert `make all' rule
17474       (insert "\n\n\n# Rule for compiling entire design\n"
17475               "\n" (nth 0 vhdl-makefile-default-targets) " :"
17476               " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
17477               " \\\n\t\t$(ALL_UNITS)\n")
17478       ;; insert `make clean' rule
17479       (insert "\n\n# Rule for cleaning entire design\n"
17480               "\n" (nth 1 vhdl-makefile-default-targets) " : "
17481               "\n\t-rm -f $(ALL_UNITS)\n")
17482       ;; insert `make library' rule
17483       (insert "\n\n# Rule for creating library directory\n"
17484               "\n" (nth 2 vhdl-makefile-default-targets) " :"
17485               " \\\n\t\t$(LIBRARY-" work-library ")"
17486               (if mapping-exist ""
17487                 (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
17488               "\n"
17489               "\n$(LIBRARY-" work-library ") :"
17490               "\n\t"
17491               (vhdl-replace-string
17492                (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
17493                (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
17494               "\n")
17495       (unless mapping-exist
17496         (insert "\n$(LIBRARY-" work-library "-make) :"
17497                 "\n\t"
17498                 "mkdir -p $(LIBRARY-" work-library "-make)\n"))
17499       ;; insert '.PHONY' declaration
17500       (insert "\n\n.PHONY : "
17501               (nth 0 vhdl-makefile-default-targets) " "
17502               (nth 1 vhdl-makefile-default-targets) " "
17503               (nth 2 vhdl-makefile-default-targets) "\n")
17504       ;; insert rule for each library unit
17505       (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
17506       (while prim-list
17507         (setq second-list (sort (nth 1 (car prim-list)) 'string<))
17508         (setq subcomp-list
17509               (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
17510         (setq unit-key (caar prim-list)
17511               unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
17512                             (nth 0 (vhdl-aget conf-alist unit-key))
17513                             (nth 0 (vhdl-aget pack-alist unit-key))))
17514         (insert "\n" unit-key)
17515         (unless (equal unit-key unit-name)
17516           (insert " \\\n" unit-name))
17517         (insert " :"
17518                 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets))
17519         (while subcomp-list
17520           (when (and (assoc (car subcomp-list) unit-list)
17521                      (not (equal unit-key (car subcomp-list))))
17522             (insert " \\\n\t\t" (car subcomp-list)))
17523           (setq subcomp-list (cdr subcomp-list)))
17524         (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
17525         (while second-list
17526           (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
17527           (setq second-list (cdr second-list)))
17528         (insert "\n")
17529         (setq prim-list (cdr prim-list)))
17530       ;; insert rule for each library unit file
17531       (insert "\n\n# Rules for compiling single library unit files\n")
17532       (while rule-alist
17533         (setq rule (car rule-alist))
17534         ;; get compiler options for this file
17535         (setq options
17536               (vhdl-get-compile-options project compiler (nth 0 rule) t))
17537         ;; insert rule if file is supposed to be compiled
17538         (setq target-list (nth 1 rule)
17539               depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
17540         ;; insert targets
17541         (setq tmp-list target-list)
17542         (while target-list
17543           (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
17544                   (if (cdr target-list) " \\" " :"))
17545           (setq target-list (cdr target-list)))
17546         (setq target-list tmp-list)
17547         ;; insert file name as first dependency
17548         (insert " \\\n\t\t" (nth 0 rule))
17549         ;; insert dependencies (except if also target or unit does not exist)
17550         (while depend-list
17551           (when (and (not (member (car depend-list) target-list))
17552                      (assoc (car depend-list) unit-list))
17553             (insert " \\\n\t\t"
17554                     "$(UNIT-" work-library "-" (car depend-list) ")"))
17555           (setq depend-list (cdr depend-list)))
17556         ;; insert compile command
17557         (if options
17558             (insert "\n\t$(COMPILE) "
17559                     (if (eq options 'default) "$(OPTIONS)" options) " "
17560                     (nth 0 rule)
17561                     (if (equal vhdl-compile-post-command "") ""
17562                       " $(POST-COMPILE)") "\n")
17563           (insert "\n"))
17564         (unless (and options mapping-exist)
17565           (setq tmp-list target-list)
17566           (while target-list
17567             (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
17568             (setq target-list (cdr target-list)))
17569           (setq target-list tmp-list))
17570         (setq rule-alist (cdr rule-alist)))
17571
17572       (insert "\n\n### " makefile-name " ends here\n")
17573       ;; run Makefile generation hook
17574       (run-hooks 'vhdl-makefile-generation-hook)
17575       (message "Generating makefile \"%s\"...done" makefile-name)
17576       ;; save and close file
17577       (if (file-writable-p makefile-path-name)
17578           (progn (save-buffer)
17579                  (kill-buffer (current-buffer))
17580                  (set-buffer orig-buffer)
17581                  (when (fboundp 'add-to-history)
17582                    (add-to-history 'file-name-history makefile-path-name)))
17583         (vhdl-warning-when-idle
17584          (format "File not writable: \"%s\""
17585                  (abbreviate-file-name makefile-path-name)))
17586         (switch-to-buffer (current-buffer))))))
17587
17588
17589 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17590 ;;; Bug reports
17591 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17592 ;; (using `reporter.el')
17593
17594 (defconst vhdl-mode-help-address
17595   "Reto Zimmermann <reto@gnu.org>"
17596   "Address for VHDL Mode bug reports.")
17597
17598 (defun vhdl-submit-bug-report ()
17599   "Submit via mail a bug report on VHDL Mode."
17600   (interactive)
17601   ;; load in reporter
17602   (and
17603    (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
17604    (let ((reporter-prompt-for-summary-p t))
17605      (reporter-submit-bug-report
17606       vhdl-mode-help-address
17607       (concat "VHDL Mode " vhdl-version)
17608       (list
17609        ;; report all important user options
17610        'vhdl-offsets-alist
17611        'vhdl-comment-only-line-offset
17612        'tab-width
17613        'vhdl-electric-mode
17614        'vhdl-stutter-mode
17615        'vhdl-indent-tabs-mode
17616        'vhdl-project-alist
17617        'vhdl-project
17618        'vhdl-project-file-name
17619        'vhdl-project-auto-load
17620        'vhdl-project-sort
17621        'vhdl-compiler-alist
17622        'vhdl-compiler
17623        'vhdl-compile-use-local-error-regexp
17624        'vhdl-makefile-default-targets
17625        'vhdl-makefile-generation-hook
17626        'vhdl-default-library
17627        'vhdl-standard
17628        'vhdl-basic-offset
17629        'vhdl-upper-case-keywords
17630        'vhdl-upper-case-types
17631        'vhdl-upper-case-attributes
17632        'vhdl-upper-case-enum-values
17633        'vhdl-upper-case-constants
17634        'vhdl-use-direct-instantiation
17635        'vhdl-array-index-record-field-in-sensitivity-list
17636        'vhdl-compose-configuration-name
17637        'vhdl-entity-file-name
17638        'vhdl-architecture-file-name
17639        'vhdl-configuration-file-name
17640        'vhdl-package-file-name
17641        'vhdl-file-name-case
17642        'vhdl-electric-keywords
17643        'vhdl-optional-labels
17644        'vhdl-insert-empty-lines
17645        'vhdl-argument-list-indent
17646        'vhdl-association-list-with-formals
17647        'vhdl-conditions-in-parenthesis
17648        'vhdl-sensitivity-list-all
17649        'vhdl-zero-string
17650        'vhdl-one-string
17651        'vhdl-file-header
17652        'vhdl-file-footer
17653        'vhdl-company-name
17654        'vhdl-copyright-string
17655        'vhdl-platform-spec
17656        'vhdl-date-format
17657        'vhdl-modify-date-prefix-string
17658        'vhdl-modify-date-on-saving
17659        'vhdl-reset-kind
17660        'vhdl-reset-active-high
17661        'vhdl-clock-rising-edge
17662        'vhdl-clock-edge-condition
17663        'vhdl-clock-name
17664        'vhdl-reset-name
17665        'vhdl-model-alist
17666        'vhdl-include-port-comments
17667        'vhdl-include-direction-comments
17668        'vhdl-include-type-comments
17669        'vhdl-include-group-comments
17670        'vhdl-actual-generic-name
17671        'vhdl-actual-port-name
17672        'vhdl-instance-name
17673        'vhdl-testbench-entity-name
17674        'vhdl-testbench-architecture-name
17675        'vhdl-testbench-configuration-name
17676        'vhdl-testbench-dut-name
17677        'vhdl-testbench-include-header
17678        'vhdl-testbench-declarations
17679        'vhdl-testbench-statements
17680        'vhdl-testbench-initialize-signals
17681        'vhdl-testbench-include-library
17682        'vhdl-testbench-include-configuration
17683        'vhdl-testbench-create-files
17684        'vhdl-testbench-entity-file-name
17685        'vhdl-testbench-architecture-file-name
17686        'vhdl-compose-create-files
17687        'vhdl-compose-configuration-create-file
17688        'vhdl-compose-configuration-hierarchical
17689        'vhdl-compose-configuration-use-subconfiguration
17690        'vhdl-compose-include-header
17691        'vhdl-compose-architecture-name
17692        'vhdl-components-package-name
17693        'vhdl-use-components-package
17694        'vhdl-self-insert-comments
17695        'vhdl-prompt-for-comments
17696        'vhdl-inline-comment-column
17697        'vhdl-end-comment-column
17698        'vhdl-auto-align
17699        'vhdl-align-groups
17700        'vhdl-align-group-separate
17701        'vhdl-align-same-indent
17702        'vhdl-highlight-keywords
17703        'vhdl-highlight-names
17704        'vhdl-highlight-special-words
17705        'vhdl-highlight-forbidden-words
17706        'vhdl-highlight-verilog-keywords
17707        'vhdl-highlight-translate-off
17708        'vhdl-highlight-case-sensitive
17709        'vhdl-special-syntax-alist
17710        'vhdl-forbidden-words
17711        'vhdl-forbidden-syntax
17712        'vhdl-directive-keywords
17713        'vhdl-speedbar-auto-open
17714        'vhdl-speedbar-display-mode
17715        'vhdl-speedbar-scan-limit
17716        'vhdl-speedbar-jump-to-unit
17717        'vhdl-speedbar-update-on-saving
17718        'vhdl-speedbar-save-cache
17719        'vhdl-speedbar-cache-file-name
17720        'vhdl-index-menu
17721        'vhdl-source-file-menu
17722        'vhdl-hideshow-menu
17723        'vhdl-hide-all-init
17724        'vhdl-print-two-column
17725        'vhdl-print-customize-faces
17726        'vhdl-intelligent-tab
17727        'vhdl-indent-syntax-based
17728        'vhdl-indent-comment-like-next-code-line
17729        'vhdl-word-completion-case-sensitive
17730        'vhdl-word-completion-in-minibuffer
17731        'vhdl-underscore-is-part-of-word
17732        'vhdl-mode-hook)
17733       (function
17734        (lambda ()
17735          (insert
17736           (if vhdl-special-indent-hook
17737               (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
17738                       "vhdl-special-indent-hook is set to '"
17739                       (format "%s" vhdl-special-indent-hook)
17740                       ".\nPerhaps this is your problem?\n"
17741                       "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
17742             "\n"))))
17743       nil
17744       "Hi Reto,"))))
17745
17746
17747 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17748 ;;; Documentation
17749 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17750
17751 (defconst vhdl-doc-release-notes nil
17752   "\
17753 Release Notes for VHDL Mode 3.37
17754 ================================
17755
17756 - Added support for VHDL'08:
17757   - New keywords, types, functions, attributes, operators, packages
17758   - Context declaration
17759   - Block comments
17760   - Directives
17761   - 'all' keyword in sensitivity list
17762
17763
17764 Release Notes for VHDL Mode 3.34
17765 ================================
17766
17767 - Added support for GNU Emacs 22/23/24:
17768   - Compilation error parsing fixed for new `compile.el' package.
17769
17770 - Port translation: Derive actual generic name from formal generic name.
17771
17772 - New user options:
17773   `vhdl-actual-generic-name': Specify how actual generic names are obtained.
17774
17775
17776 Release Notes for VHDL Mode 3.33
17777 ================================
17778
17779 New Features
17780 ------------
17781
17782 CONFIGURATION DECLARATION GENERATION:
17783   - Automatic generation of a configuration declaration for a design.
17784     (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
17785
17786
17787 Key Bindings
17788 ------------
17789
17790 For Emacs compliance the following key bindings have been changed:
17791
17792 - `C-c c'        ->  `C-c C-c'      `vhdl-comment-uncomment-region'
17793 - `C-c f'        ->  `C-c C-i C-f'  `vhdl-fontify-buffer'
17794 - `C-c s'        ->  `C-c C-i C-s'  `vhdl-statistics-buffer'
17795 - `C-c C-c ...'  ->  `C-c C-m ...'  `vhdl-compose-...'
17796
17797
17798 User Options
17799 ------------
17800
17801 `vhdl-configuration-file-name': (new)
17802   Specify how the configuration file name is obtained.
17803 `vhdl-compose-configuration-name': (new)
17804   Specify how the configuration name is obtained.
17805 `vhdl-compose-configuration-create-file': (new)
17806   Specify whether a new file should be created for a configuration.
17807 `vhdl-compose-configuration-hierarchical': (new)
17808   Specify whether hierarchical configurations should be created.
17809 `vhdl-compose-configuration-use-subconfiguration': (new)
17810   Specify whether subconfigurations should be used inside configurations.
17811 `vhdl-makefile-default-targets': (new)
17812   Customize names of Makefile default targets.
17813 `vhdl-indent-comment-like-next-code-line': (new)
17814   Specify whether comment lines are indented like following code line.
17815 `vhdl-array-index-record-field-in-sensitivity-list': (new)
17816   Specify whether to include array indices / record fields in sensitivity list.
17817 ")
17818
17819
17820 (defconst vhdl-doc-keywords nil
17821   "\
17822 Reserved words in VHDL
17823 ----------------------
17824
17825 VHDL'08 (IEEE Std 1076-2008):
17826   `vhdl-08-keywords'      : keywords
17827   `vhdl-08-types'         : standardized types
17828   `vhdl-08-attributes'    : standardized attributes
17829   `vhdl-08-functions'     : standardized functions
17830   `vhdl-08-packages'      : standardized packages and libraries
17831
17832 VHDL'93/02 (IEEE Std 1076-1993/2002):
17833   `vhdl-02-keywords'      : keywords
17834   `vhdl-02-types'         : standardized types
17835   `vhdl-02-attributes'    : standardized attributes
17836   `vhdl-02-enum-values'   : standardized enumeration values
17837   `vhdl-02-functions'     : standardized functions
17838   `vhdl-02-packages'      : standardized packages and libraries
17839
17840 VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
17841   `vhdl-ams-keywords'     : keywords
17842   `vhdl-ams-types'        : standardized types
17843   `vhdl-ams-attributes'   : standardized attributes
17844   `vhdl-ams-enum-values'  : standardized enumeration values
17845   `vhdl-ams-constants'    : standardized constants
17846   `vhdl-ams-functions'    : standardized functions
17847
17848 Math Packages (IEEE Std 1076.2):
17849   `vhdl-math-types'       : standardized types
17850   `vhdl-math-constants'   : standardized constants
17851   `vhdl-math-functions'   : standardized functions
17852   `vhdl-math-packages'    : standardized packages
17853
17854 Forbidden words:
17855   `vhdl-verilog-keywords' : Verilog reserved words
17856
17857 NOTE: click `mouse-2' on variable names above (not in XEmacs).")
17858
17859
17860 (defconst vhdl-doc-coding-style nil
17861   "\
17862 For VHDL coding style and naming convention guidelines, see the following
17863 references:
17864
17865 \[1] Ben Cohen.
17866     \"VHDL Coding Styles and Methodologies\".
17867     Kluwer Academic Publishers, 1999.
17868     http://members.aol.com/vhdlcohen/vhdl/
17869
17870 \[2] Michael Keating and Pierre Bricaud.
17871     \"Reuse Methodology Manual, Second Edition\".
17872     Kluwer Academic Publishers, 1999.
17873     http://www.openmore.com/openmore/rmm2.html
17874
17875 \[3] European Space Agency.
17876     \"VHDL Modelling Guidelines\".
17877     ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
17878
17879 Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
17880 to visually support naming conventions.")
17881
17882
17883 (defun vhdl-version ()
17884   "Echo the current version of VHDL Mode in the minibuffer."
17885   (interactive)
17886   (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
17887   (vhdl-keep-region-active))
17888
17889 (defun vhdl-doc-variable (variable)
17890   "Display VARIABLE's documentation in *Help* buffer."
17891   (interactive)
17892   (unless (featurep 'xemacs)
17893     (help-setup-xref (list #'vhdl-doc-variable variable)
17894                      (called-interactively-p 'interactive)))
17895   (with-output-to-temp-buffer
17896       (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17897     (princ (documentation-property variable 'variable-documentation))
17898     (with-current-buffer standard-output
17899       (help-mode))
17900     (help-print-return-message)))
17901
17902 (defun vhdl-doc-mode ()
17903   "Display VHDL Mode documentation in *Help* buffer."
17904   (interactive)
17905   (unless (featurep 'xemacs)
17906     (help-setup-xref (list #'vhdl-doc-mode)
17907                      (called-interactively-p 'interactive)))
17908   (with-output-to-temp-buffer
17909       (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17910     (princ mode-name)
17911     (princ " mode:\n")
17912     (princ (documentation 'vhdl-mode))
17913     (with-current-buffer standard-output
17914       (help-mode))
17915     (help-print-return-message)))
17916
17917
17918 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17919
17920 (provide 'vhdl-mode)
17921
17922 ;;; vhdl-mode.el ends here