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-2016 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   (let ((message (apply #'format-message args)))
2309     (if noninteractive
2310         (vhdl-warning message t)
2311       (unless vhdl-warnings
2312         (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2313       (push message vhdl-warnings))))
2314
2315 (defun vhdl-warning (string &optional nobeep)
2316   "Print out warning STRING and beep."
2317   (message "WARNING:  %s" string)
2318   (unless (or nobeep noninteractive) (beep)))
2319
2320 (defun vhdl-print-warnings ()
2321   "Print out messages in variable `vhdl-warnings'."
2322   (let ((no-warnings (length vhdl-warnings)))
2323     (setq vhdl-warnings (nreverse vhdl-warnings))
2324     (while vhdl-warnings
2325       (message "WARNING:  %s" (car vhdl-warnings))
2326       (setq vhdl-warnings (cdr vhdl-warnings)))
2327     (beep)
2328     (when (> no-warnings 1)
2329       (message "WARNING:  See warnings in message buffer (type `C-c M-m')."))))
2330
2331 ;; Backward compatibility checks and fixes
2332 ;; option `vhdl-compiler' changed format
2333 (unless (stringp vhdl-compiler)
2334   (setq vhdl-compiler "ModelSim")
2335   (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2336
2337 ;; option `vhdl-standard' changed format
2338 (unless (listp vhdl-standard)
2339   (setq vhdl-standard '(87 nil))
2340   (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2341
2342 ;; option `vhdl-model-alist' changed format
2343 (when (= (length (car vhdl-model-alist)) 3)
2344   (let ((old-alist vhdl-model-alist)
2345         new-alist)
2346     (while old-alist
2347       (push (append (car old-alist) '("")) new-alist)
2348       (setq old-alist (cdr old-alist)))
2349     (setq vhdl-model-alist (nreverse new-alist)))
2350   (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2351
2352 ;; option `vhdl-project-alist' changed format
2353 (when (= (length (car vhdl-project-alist)) 3)
2354   (let ((old-alist vhdl-project-alist)
2355         new-alist)
2356     (while old-alist
2357       (push (append (car old-alist) '("")) new-alist)
2358       (setq old-alist (cdr old-alist)))
2359     (setq vhdl-project-alist (nreverse new-alist)))
2360   (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2361
2362 ;; option `vhdl-project-alist' changed format (3.31.1)
2363 (when (= (length (car vhdl-project-alist)) 4)
2364   (let ((old-alist vhdl-project-alist)
2365         new-alist elem)
2366     (while old-alist
2367       (setq elem (car old-alist))
2368       (setq new-alist
2369             (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2370                         nil "./" "work" "work/" "Makefile" (nth 3 elem))
2371                   new-alist))
2372       (setq old-alist (cdr old-alist)))
2373     (setq vhdl-project-alist (nreverse new-alist)))
2374   (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2375
2376 ;; option `vhdl-project-alist' changed format (3.31.12)
2377 (when (= (length (car vhdl-project-alist)) 10)
2378   (let ((tmp-alist vhdl-project-alist))
2379     (while tmp-alist
2380       (setcdr (nthcdr 3 (car tmp-alist))
2381               (cons "" (nthcdr 4 (car tmp-alist))))
2382       (setq tmp-alist (cdr tmp-alist))))
2383   (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2384
2385 ;; option `vhdl-compiler-alist' changed format (3.31.1)
2386 (when (= (length (car vhdl-compiler-alist)) 7)
2387   (let ((old-alist vhdl-compiler-alist)
2388         new-alist elem)
2389     (while old-alist
2390       (setq elem (car old-alist))
2391       (setq new-alist
2392             (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2393                         (if (equal (nth 3 elem) "") nil (nth 3 elem))
2394                         (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2395                         (nth 5 elem) (nth 6 elem) nil)
2396                   new-alist))
2397       (setq old-alist (cdr old-alist)))
2398     (setq vhdl-compiler-alist (nreverse new-alist)))
2399   (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2400
2401 ;; option `vhdl-compiler-alist' changed format (3.31.10)
2402 (when (= (length (car vhdl-compiler-alist)) 12)
2403   (let ((tmp-alist vhdl-compiler-alist))
2404     (while tmp-alist
2405       (setcdr (nthcdr 4 (car tmp-alist))
2406               (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2407       (setq tmp-alist (cdr tmp-alist))))
2408   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2409
2410 ;; option `vhdl-compiler-alist' changed format (3.31.11)
2411 (when (= (length (car vhdl-compiler-alist)) 13)
2412   (let ((tmp-alist vhdl-compiler-alist))
2413     (while tmp-alist
2414       (setcdr (nthcdr 3 (car tmp-alist))
2415               (cons "" (nthcdr 4 (car tmp-alist))))
2416       (setq tmp-alist (cdr tmp-alist))))
2417   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2418
2419 ;; option `vhdl-compiler-alist' changed format (3.32.7)
2420 (when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2421   (let ((tmp-alist vhdl-compiler-alist))
2422     (while tmp-alist
2423       (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2424               '(0 . nil))
2425       (setq tmp-alist (cdr tmp-alist))))
2426   (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2427
2428 ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2429 (when (equal vhdl-project "")
2430   (setq vhdl-project nil)
2431   (customize-save-variable 'vhdl-project vhdl-project))
2432
2433 ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2434 (when (stringp vhdl-project-file-name)
2435   (setq vhdl-project-file-name (list vhdl-project-file-name))
2436   (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2437
2438 ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2439 (if (not (boundp 'speedbar-indentation-width))
2440     (defvar speedbar-indentation-width 2)
2441   ;; set default to 2 if not already customized
2442   (unless (get 'speedbar-indentation-width 'saved-value)
2443     (setq speedbar-indentation-width 2)))
2444
2445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2446 ;;; Help functions / inline substitutions / macros
2447 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2448
2449 (defun vhdl-standard-p (standard)
2450   "Check if STANDARD is specified as used standard."
2451   (or (eq standard (car vhdl-standard))
2452       (memq standard (cadr vhdl-standard))))
2453
2454 (defun vhdl-project-p (&optional warning)
2455   "Return non-nil if a project is displayed, i.e. directories or files are
2456 specified."
2457   (if (assoc vhdl-project vhdl-project-alist)
2458       vhdl-project
2459     (when (and vhdl-project warning)
2460       (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2461     nil))
2462
2463 (defun vhdl-resolve-env-variable (string)
2464   "Resolve environment variables in STRING."
2465   (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2466     (setq string (concat (match-string 1 string)
2467                          (getenv (match-string 2 string))
2468                          (match-string 4 string))))
2469   string)
2470
2471 (defun vhdl-default-directory ()
2472   "Return the default directory of the current project or the directory of the
2473 current buffer if no project is defined."
2474   (if (vhdl-project-p)
2475       (expand-file-name (vhdl-resolve-env-variable
2476                          (nth 1 (vhdl-aget vhdl-project-alist vhdl-project))))
2477     default-directory))
2478
2479 (defmacro vhdl-prepare-search-1 (&rest body)
2480   "Enable case insensitive search and switch to syntax table that includes `_',
2481 then execute BODY, and finally restore the old environment.  Used for
2482 consistent searching."
2483   `(let ((case-fold-search t))          ; case insensitive search
2484      ;; use extended syntax table
2485      (with-syntax-table vhdl-mode-ext-syntax-table
2486        ,@body)))
2487
2488 (defmacro vhdl-prepare-search-2 (&rest body)
2489   "Enable case insensitive search, switch to syntax table that includes `_',
2490 arrange to ignore `intangible' overlays, then execute BODY, and finally restore
2491 the old environment.  Used for consistent searching."
2492   `(let ((case-fold-search t)           ; case insensitive search
2493          (current-syntax-table (syntax-table))
2494          (inhibit-point-motion-hooks t))
2495      ;; use extended syntax table
2496      (set-syntax-table vhdl-mode-ext-syntax-table)
2497      ;; execute BODY safely
2498      (unwind-protect
2499          (progn ,@body)
2500        ;; restore syntax table
2501        (set-syntax-table current-syntax-table))))
2502
2503 (defmacro vhdl-visit-file (file-name issue-error &rest body)
2504   "Visit file FILE-NAME and execute BODY."
2505   `(if (null ,file-name)
2506        (progn ,@body)
2507      (unless (file-directory-p ,file-name)
2508        (let ((source-buffer (current-buffer))
2509              (visiting-buffer (find-buffer-visiting ,file-name))
2510              file-opened)
2511          (when (or (and visiting-buffer (set-buffer visiting-buffer))
2512                    (condition-case ()
2513                        (progn (set-buffer (create-file-buffer ,file-name))
2514                               (setq file-opened t)
2515                               (vhdl-insert-file-contents ,file-name)
2516                               ;; FIXME: This modifies a global syntax-table!
2517                               (modify-syntax-entry ?\- ". 12" (syntax-table))
2518                               (modify-syntax-entry ?\n ">" (syntax-table))
2519                               (modify-syntax-entry ?\^M ">" (syntax-table))
2520                               (modify-syntax-entry ?_ "w" (syntax-table))
2521                               t)
2522                      (error
2523                       (if ,issue-error
2524                           (progn
2525                             (when file-opened (kill-buffer (current-buffer)))
2526                             (set-buffer source-buffer)
2527                             (error "ERROR:  File cannot be opened: \"%s\"" ,file-name))
2528                         (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
2529                         nil))))
2530            (condition-case info
2531                (progn ,@body)
2532              (error
2533               (if ,issue-error
2534                   (progn
2535                     (when file-opened (kill-buffer (current-buffer)))
2536                     (set-buffer source-buffer)
2537                     (error (cadr info)))
2538                 (vhdl-warning (cadr info))))))
2539          (when file-opened (kill-buffer (current-buffer)))
2540          (set-buffer source-buffer)))))
2541
2542 (defun vhdl-insert-file-contents (filename)
2543   "Nicked from `insert-file-contents-literally', but allow coding system
2544 conversion."
2545   (let ((format-alist nil)
2546         (after-insert-file-functions nil)
2547         (jka-compr-compression-info-list nil))
2548     (insert-file-contents filename t)))
2549
2550 (defun vhdl-sort-alist (alist)
2551   "Sort ALIST."
2552   (sort alist (function (lambda (a b) (string< (car a) (car b))))))
2553
2554 (defun vhdl-get-subdirs (directory)
2555   "Recursively get subdirectories of DIRECTORY."
2556   (let ((dir-list (list (file-name-as-directory directory)))
2557         file-list)
2558     (setq file-list (vhdl-directory-files directory t "\\w.*"))
2559     (while file-list
2560       (when (file-directory-p (car file-list))
2561         (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2562       (setq file-list (cdr file-list)))
2563     dir-list))
2564
2565 (defun vhdl-aput-delete-if-nil (alist-symbol key &optional value)
2566   "As `aput', but delete key-value pair if VALUE is nil."
2567   (if value
2568       (vhdl-aput alist-symbol key value)
2569     (vhdl-adelete alist-symbol key)))
2570
2571 (defun vhdl-delete (elt list)
2572   "Delete by side effect the first occurrence of ELT as a member of LIST."
2573   (push nil list)
2574   (let ((list1 list))
2575     (while (and (cdr list1) (not (equal elt (cadr list1))))
2576       (setq list1 (cdr list1)))
2577     (when list
2578       (setcdr list1 (cddr list1))))
2579   (cdr list))
2580
2581 (declare-function speedbar-refresh "speedbar" (&optional arg))
2582 (declare-function speedbar-do-function-pointer "speedbar" ())
2583
2584 (defun vhdl-speedbar-refresh (&optional key)
2585   "Refresh directory or project with name KEY."
2586   (when (and (boundp 'speedbar-frame)
2587              (frame-live-p speedbar-frame))
2588     (let ((pos (point))
2589           (last-frame (selected-frame)))
2590       (if (null key)
2591           (speedbar-refresh)
2592         (select-frame speedbar-frame)
2593         (when (save-excursion
2594                 (goto-char (point-min))
2595                 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2596           (goto-char (match-end 1))
2597           (speedbar-do-function-pointer)
2598           (backward-char 2)
2599           (speedbar-do-function-pointer)
2600           (message "Refreshing speedbar...done"))
2601         (select-frame last-frame)))))
2602
2603 (defun vhdl-show-messages ()
2604   "Get *Messages* buffer to show recent messages."
2605   (interactive)
2606   (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*")))
2607
2608 (defun vhdl-use-direct-instantiation ()
2609   "Return whether direct instantiation is used."
2610   (or (eq vhdl-use-direct-instantiation 'always)
2611       (and (eq vhdl-use-direct-instantiation 'standard)
2612            (not (vhdl-standard-p '87)))))
2613
2614 (defun vhdl-max-marker (marker1 marker2)
2615   "Return larger marker."
2616   (if (> marker1 marker2) marker1 marker2))
2617
2618 (defun vhdl-goto-marker (marker)
2619   "Goto marker in appropriate buffer."
2620   (when (markerp marker)
2621     (set-buffer (marker-buffer marker)))
2622   (goto-char marker))
2623
2624 (defun vhdl-menu-split (list title)
2625   "Split menu LIST into several submenus, if number of
2626 elements > `vhdl-menu-max-size'."
2627   (if (> (length list) vhdl-menu-max-size)
2628       (let ((remain list)
2629             (result '())
2630             (sublist '())
2631             (menuno 1)
2632             (i 0))
2633         (while remain
2634           (push (car remain) sublist)
2635           (setq remain (cdr remain))
2636           (setq i (+ i 1))
2637           (if (= i vhdl-menu-max-size)
2638               (progn
2639                 (push (cons (format "%s %s" title menuno)
2640                             (nreverse sublist)) result)
2641                 (setq i 0)
2642                 (setq menuno (+ menuno 1))
2643                 (setq sublist '()))))
2644         (and sublist
2645              (push (cons (format "%s %s" title menuno)
2646                          (nreverse sublist)) result))
2647         (nreverse result))
2648     list))
2649
2650
2651 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2652 ;;; Bindings
2653 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2654
2655 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2656 ;; Key bindings
2657
2658 (defvar vhdl-template-map nil
2659   "Keymap for VHDL templates.")
2660
2661 (defun vhdl-template-map-init ()
2662   "Initialize `vhdl-template-map'."
2663   (setq vhdl-template-map (make-sparse-keymap))
2664   ;; key bindings for VHDL templates
2665   (define-key vhdl-template-map "al"    'vhdl-template-alias)
2666   (define-key vhdl-template-map "ar"    'vhdl-template-architecture)
2667   (define-key vhdl-template-map "at"    'vhdl-template-assert)
2668   (define-key vhdl-template-map "ad"    'vhdl-template-attribute-decl)
2669   (define-key vhdl-template-map "as"    'vhdl-template-attribute-spec)
2670   (define-key vhdl-template-map "bl"    'vhdl-template-block)
2671   (define-key vhdl-template-map "ca"    'vhdl-template-case-is)
2672   (define-key vhdl-template-map "cd"    'vhdl-template-component-decl)
2673   (define-key vhdl-template-map "ci"    'vhdl-template-component-inst)
2674   (define-key vhdl-template-map "cs"    'vhdl-template-conditional-signal-asst)
2675   (define-key vhdl-template-map "Cb"    'vhdl-template-block-configuration)
2676   (define-key vhdl-template-map "Cc"    'vhdl-template-component-conf)
2677   (define-key vhdl-template-map "Cd"    'vhdl-template-configuration-decl)
2678   (define-key vhdl-template-map "Cs"    'vhdl-template-configuration-spec)
2679   (define-key vhdl-template-map "co"    'vhdl-template-constant)
2680   (define-key vhdl-template-map "ct"    'vhdl-template-context)
2681   (define-key vhdl-template-map "di"    'vhdl-template-disconnect)
2682   (define-key vhdl-template-map "el"    'vhdl-template-else)
2683   (define-key vhdl-template-map "ei"    'vhdl-template-elsif)
2684   (define-key vhdl-template-map "en"    'vhdl-template-entity)
2685   (define-key vhdl-template-map "ex"    'vhdl-template-exit)
2686   (define-key vhdl-template-map "fi"    'vhdl-template-file)
2687   (define-key vhdl-template-map "fg"    'vhdl-template-for-generate)
2688   (define-key vhdl-template-map "fl"    'vhdl-template-for-loop)
2689   (define-key vhdl-template-map "\C-f"  'vhdl-template-footer)
2690   (define-key vhdl-template-map "fb"    'vhdl-template-function-body)
2691   (define-key vhdl-template-map "fd"    'vhdl-template-function-decl)
2692   (define-key vhdl-template-map "ge"    'vhdl-template-generic)
2693   (define-key vhdl-template-map "gd"    'vhdl-template-group-decl)
2694   (define-key vhdl-template-map "gt"    'vhdl-template-group-template)
2695   (define-key vhdl-template-map "\C-h"  'vhdl-template-header)
2696   (define-key vhdl-template-map "ig"    'vhdl-template-if-generate)
2697   (define-key vhdl-template-map "it"    'vhdl-template-if-then)
2698   (define-key vhdl-template-map "li"    'vhdl-template-library)
2699   (define-key vhdl-template-map "lo"    'vhdl-template-bare-loop)
2700   (define-key vhdl-template-map "\C-m"  'vhdl-template-modify)
2701   (define-key vhdl-template-map "\C-t"  'vhdl-template-insert-date)
2702   (define-key vhdl-template-map "ma"    'vhdl-template-map)
2703   (define-key vhdl-template-map "ne"    'vhdl-template-next)
2704   (define-key vhdl-template-map "ot"    'vhdl-template-others)
2705   (define-key vhdl-template-map "Pd"    'vhdl-template-package-decl)
2706   (define-key vhdl-template-map "Pb"    'vhdl-template-package-body)
2707   (define-key vhdl-template-map "("     'vhdl-template-paired-parens)
2708   (define-key vhdl-template-map "po"    'vhdl-template-port)
2709   (define-key vhdl-template-map "pb"    'vhdl-template-procedure-body)
2710   (define-key vhdl-template-map "pd"    'vhdl-template-procedure-decl)
2711   (define-key vhdl-template-map "pc"    'vhdl-template-process-comb)
2712   (define-key vhdl-template-map "ps"    'vhdl-template-process-seq)
2713   (define-key vhdl-template-map "rp"    'vhdl-template-report)
2714   (define-key vhdl-template-map "rt"    'vhdl-template-return)
2715   (define-key vhdl-template-map "ss"    'vhdl-template-selected-signal-asst)
2716   (define-key vhdl-template-map "si"    'vhdl-template-signal)
2717   (define-key vhdl-template-map "su"    'vhdl-template-subtype)
2718   (define-key vhdl-template-map "ty"    'vhdl-template-type)
2719   (define-key vhdl-template-map "us"    'vhdl-template-use)
2720   (define-key vhdl-template-map "va"    'vhdl-template-variable)
2721   (define-key vhdl-template-map "wa"    'vhdl-template-wait)
2722   (define-key vhdl-template-map "wl"    'vhdl-template-while-loop)
2723   (define-key vhdl-template-map "wi"    'vhdl-template-with)
2724   (define-key vhdl-template-map "wc"    'vhdl-template-clocked-wait)
2725   (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit)
2726   (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std)
2727   (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164)
2728   (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith)
2729   (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc)
2730   (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed)
2731   (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio)
2732   (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned)
2733   (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio)
2734   (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on)
2735   (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off)
2736   (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on)
2737   (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off)
2738   (define-key vhdl-template-map "\C-q"  'vhdl-template-search-prompt)
2739   (when (vhdl-standard-p 'ams)
2740     (define-key vhdl-template-map "br"  'vhdl-template-break)
2741     (define-key vhdl-template-map "cu"  'vhdl-template-case-use)
2742     (define-key vhdl-template-map "iu"  'vhdl-template-if-use)
2743     (define-key vhdl-template-map "lm"  'vhdl-template-limit)
2744     (define-key vhdl-template-map "na"  'vhdl-template-nature)
2745     (define-key vhdl-template-map "pa"  'vhdl-template-procedural)
2746     (define-key vhdl-template-map "qf"  'vhdl-template-quantity-free)
2747     (define-key vhdl-template-map "qb"  'vhdl-template-quantity-branch)
2748     (define-key vhdl-template-map "qs"  'vhdl-template-quantity-source)
2749     (define-key vhdl-template-map "sn"  'vhdl-template-subnature)
2750     (define-key vhdl-template-map "te"  'vhdl-template-terminal)
2751     )
2752   (when (vhdl-standard-p 'math)
2753     (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex)
2754     (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real)
2755     ))
2756
2757 ;; initialize template map for VHDL Mode
2758 (vhdl-template-map-init)
2759
2760 (defun vhdl-function-name (prefix string &optional postfix)
2761   "Generate a Lisp function name.
2762 PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in
2763 STRING are replaced by `-' and substrings are converted to lower case."
2764   (let ((name prefix))
2765     (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string)
2766       (setq name
2767             (concat name "-" (downcase (substring string 0 (match-end 1)))))
2768       (setq string (substring string (match-beginning 2))))
2769     (when postfix (setq name (concat name "-" postfix)))
2770     (intern name)))
2771
2772 (defvar vhdl-model-map nil
2773   "Keymap for VHDL models.")
2774
2775 (defun vhdl-model-map-init ()
2776   "Initialize `vhdl-model-map'."
2777   (setq vhdl-model-map (make-sparse-keymap))
2778   ;; key bindings for VHDL models
2779   (let ((model-alist vhdl-model-alist) model)
2780     (while model-alist
2781       (setq model (car model-alist))
2782       (define-key vhdl-model-map (nth 2 model)
2783         (vhdl-function-name "vhdl-model" (nth 0 model)))
2784       (setq model-alist (cdr model-alist)))))
2785
2786 ;; initialize user model map for VHDL Mode
2787 (vhdl-model-map-init)
2788
2789 (defvar vhdl-mode-map nil
2790   "Keymap for VHDL Mode.")
2791
2792 (defun vhdl-mode-map-init ()
2793   "Initialize `vhdl-mode-map'."
2794   (setq vhdl-mode-map (make-sparse-keymap))
2795   ;; template key bindings
2796   (define-key vhdl-mode-map "\C-c\C-t"     vhdl-template-map)
2797   ;; model key bindings
2798   (define-key vhdl-mode-map "\C-c\C-m"     vhdl-model-map)
2799   ;; standard key bindings
2800   (define-key vhdl-mode-map "\M-a"         'vhdl-beginning-of-statement)
2801   (define-key vhdl-mode-map "\M-e"         'vhdl-end-of-statement)
2802   (define-key vhdl-mode-map "\M-\C-f"      'vhdl-forward-sexp)
2803   (define-key vhdl-mode-map "\M-\C-b"      'vhdl-backward-sexp)
2804   (define-key vhdl-mode-map "\M-\C-u"      'vhdl-backward-up-list)
2805   (define-key vhdl-mode-map "\M-\C-a"      'vhdl-backward-same-indent)
2806   (define-key vhdl-mode-map "\M-\C-e"      'vhdl-forward-same-indent)
2807   (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
2808     (define-key vhdl-mode-map "\M-\C-h"    'vhdl-mark-defun))
2809   (define-key vhdl-mode-map "\M-\C-q"      'vhdl-indent-sexp)
2810   (define-key vhdl-mode-map "\M-^"         'vhdl-delete-indentation)
2811   ;; mode specific key bindings
2812   (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
2813   (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
2814   (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
2815   (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
2816   (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
2817   (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
2818   (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
2819   (define-key vhdl-mode-map "\C-c\C-k"     'vhdl-compile)
2820   (define-key vhdl-mode-map "\C-c\M-\C-k"  'vhdl-make)
2821   (define-key vhdl-mode-map "\C-c\M-k"     'vhdl-generate-makefile)
2822   (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
2823   (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
2824   (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
2825   (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component)
2826   (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
2827   (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
2828   (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
2829   (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
2830       (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
2831     (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
2832   (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
2833   (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
2834   (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
2835   (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
2836   (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
2837   (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
2838   (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
2839   (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
2840   (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
2841   (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
2842   (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component)
2843   (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component)
2844   (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components)
2845   (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration)
2846   (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package)
2847   (define-key vhdl-mode-map "\C-c\C-c"     'vhdl-comment-uncomment-region)
2848   (define-key vhdl-mode-map "\C-c-"        'vhdl-comment-append-inline)
2849   (define-key vhdl-mode-map "\C-c\M--"     'vhdl-comment-display-line)
2850   (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
2851   (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
2852   (define-key vhdl-mode-map "\M-\C-\\"     'vhdl-indent-region)
2853   (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
2854   (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
2855   (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
2856   (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
2857   (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
2858   (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
2859   (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
2860   (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
2861   (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
2862   (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
2863   (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
2864   (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
2865   (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
2866   (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
2867   (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
2868   (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
2869   (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
2870   (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
2871   (define-key vhdl-mode-map "\C-c\C-l\t"   'vhdl-line-expand)
2872   (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next)
2873   (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous)
2874   (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
2875   (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
2876   (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
2877   (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region)
2878   (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer)
2879   (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
2880   (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
2881   (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
2882   (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
2883   (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
2884   (define-key vhdl-mode-map "\C-c\M-b"     'vhdl-beautify-region)
2885   (define-key vhdl-mode-map "\C-c\C-b"     'vhdl-beautify-buffer)
2886   (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
2887   (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
2888   (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer)
2889   (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer)
2890   (define-key vhdl-mode-map "\C-c\M-m"     'vhdl-show-messages)
2891   (define-key vhdl-mode-map "\C-c\C-h"     'vhdl-doc-mode)
2892   (define-key vhdl-mode-map "\C-c\C-v"     'vhdl-version)
2893   (define-key vhdl-mode-map "\M-\t"        'insert-tab)
2894   ;; insert commands bindings
2895   (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
2896   (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
2897   (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
2898   (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
2899   ;; electric key bindings
2900   (define-key vhdl-mode-map " "            'vhdl-electric-space)
2901   (when vhdl-intelligent-tab
2902     (define-key vhdl-mode-map "\t"         'vhdl-electric-tab))
2903   (define-key vhdl-mode-map "\r"           'vhdl-electric-return)
2904   (define-key vhdl-mode-map "-"            'vhdl-electric-dash)
2905   (define-key vhdl-mode-map "["            'vhdl-electric-open-bracket)
2906   (define-key vhdl-mode-map "]"            'vhdl-electric-close-bracket)
2907   (define-key vhdl-mode-map "'"            'vhdl-electric-quote)
2908   (define-key vhdl-mode-map ";"            'vhdl-electric-semicolon)
2909   (define-key vhdl-mode-map ","            'vhdl-electric-comma)
2910   (define-key vhdl-mode-map "."            'vhdl-electric-period)
2911   (when (vhdl-standard-p 'ams)
2912     (define-key vhdl-mode-map "="          'vhdl-electric-equal)))
2913
2914 ;; initialize mode map for VHDL Mode
2915 (vhdl-mode-map-init)
2916
2917 ;; define special minibuffer keymap for enabling word completion in minibuffer
2918 ;; (useful in template generator prompts)
2919 (defvar vhdl-minibuffer-local-map
2920   (let ((map (make-sparse-keymap)))
2921     (set-keymap-parent map minibuffer-local-map)
2922     (when vhdl-word-completion-in-minibuffer
2923       (define-key map "\t" 'vhdl-minibuffer-tab))
2924     map)
2925   "Keymap for minibuffer used in VHDL Mode.")
2926
2927 ;; set up electric character functions to work with
2928 ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
2929 (mapc
2930  (function
2931   (lambda (sym)
2932     (put sym 'delete-selection t)       ; for `delete-selection-mode' (Emacs)
2933     (put sym 'pending-delete t)))       ; for `pending-delete-mode' (XEmacs)
2934  '(vhdl-electric-space
2935    vhdl-electric-tab
2936    vhdl-electric-return
2937    vhdl-electric-dash
2938    vhdl-electric-open-bracket
2939    vhdl-electric-close-bracket
2940    vhdl-electric-quote
2941    vhdl-electric-semicolon
2942    vhdl-electric-comma
2943    vhdl-electric-period
2944    vhdl-electric-equal))
2945
2946 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2947 ;; Syntax table
2948
2949 (defvar vhdl-mode-syntax-table
2950   (let ((st (make-syntax-table)))
2951     ;; define punctuation
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     (modify-syntax-entry ?\| "."    st)
2968     ;; define string
2969     (modify-syntax-entry ?\" "\""   st)
2970     ;; define underscore
2971     (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st)
2972     ;; single-line comments
2973     (modify-syntax-entry ?\- ". 12b" st)
2974     ;; multi-line comments
2975     (modify-syntax-entry ?\/ ". 14b" st)
2976     (modify-syntax-entry ?*  ". 23" st)
2977     (modify-syntax-entry ?\n "> b"  st)
2978     (modify-syntax-entry ?\^M "> b"   st)
2979     ;; define parentheses to match
2980     (modify-syntax-entry ?\( "()"   st)
2981     (modify-syntax-entry ?\) ")("   st)
2982     (modify-syntax-entry ?\[ "(]"   st)
2983     (modify-syntax-entry ?\] ")["   st)
2984     (modify-syntax-entry ?\{ "(}"   st)
2985     (modify-syntax-entry ?\} "){"   st)
2986     st)
2987   "Syntax table used in `vhdl-mode' buffers.")
2988
2989 (defvar vhdl-mode-ext-syntax-table
2990   ;; Extended syntax table including '_' (for simpler search regexps).
2991   (let ((st (copy-syntax-table vhdl-mode-syntax-table)))
2992     (modify-syntax-entry ?_ "w" st)
2993     st)
2994   "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2995
2996 (defvar vhdl-syntactic-context nil
2997   "Buffer local variable containing syntactic analysis list.")
2998 (make-variable-buffer-local 'vhdl-syntactic-context)
2999
3000 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3001 ;; Abbrev hook bindings
3002
3003 (defvar vhdl-mode-abbrev-table nil
3004   "Abbrev table to use in `vhdl-mode' buffers.")
3005
3006 (defun vhdl-mode-abbrev-table-init ()
3007   "Initialize `vhdl-mode-abbrev-table'."
3008   (define-abbrev-table 'vhdl-mode-abbrev-table
3009     (append
3010      (when (memq 'vhdl vhdl-electric-keywords)
3011        ;; VHDL'02 keywords
3012        (mapcar (if (featurep 'xemacs)
3013                    (lambda (x) (list (car x) "" (cdr x) 0))
3014                  (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3015                '(
3016                  ("--"            . vhdl-template-display-comment-hook)
3017                  ("abs"           . vhdl-template-default-hook)
3018                  ("access"        . vhdl-template-default-hook)
3019                  ("after"         . vhdl-template-default-hook)
3020                  ("alias"         . vhdl-template-alias-hook)
3021                  ("all"           . vhdl-template-default-hook)
3022                  ("and"           . vhdl-template-default-hook)
3023                  ("arch"          . vhdl-template-architecture-hook)
3024                  ("architecture"  . vhdl-template-architecture-hook)
3025                  ("array"         . vhdl-template-default-hook)
3026                  ("assert"        . vhdl-template-assert-hook)
3027                  ("attr"          . vhdl-template-attribute-hook)
3028                  ("attribute"     . vhdl-template-attribute-hook)
3029                  ("begin"         . vhdl-template-default-indent-hook)
3030                  ("block"         . vhdl-template-block-hook)
3031                  ("body"          . vhdl-template-default-hook)
3032                  ("buffer"        . vhdl-template-default-hook)
3033                  ("bus"           . vhdl-template-default-hook)
3034                  ("case"          . vhdl-template-case-hook)
3035                  ("comp"          . vhdl-template-component-hook)
3036                  ("component"     . vhdl-template-component-hook)
3037                  ("cond"          . vhdl-template-conditional-signal-asst-hook)
3038                  ("conditional"   . vhdl-template-conditional-signal-asst-hook)
3039                  ("conf"          . vhdl-template-configuration-hook)
3040                  ("configuration" . vhdl-template-configuration-hook)
3041                  ("cons"          . vhdl-template-constant-hook)
3042                  ("constant"      . vhdl-template-constant-hook)
3043                  ("context"       . vhdl-template-context-hook)
3044                  ("disconnect"    . vhdl-template-disconnect-hook)
3045                  ("downto"        . vhdl-template-default-hook)
3046                  ("else"          . vhdl-template-else-hook)
3047                  ("elseif"        . vhdl-template-elsif-hook)
3048                  ("elsif"         . vhdl-template-elsif-hook)
3049                  ("end"           . vhdl-template-default-indent-hook)
3050                  ("entity"        . vhdl-template-entity-hook)
3051                  ("exit"          . vhdl-template-exit-hook)
3052                  ("file"          . vhdl-template-file-hook)
3053                  ("for"           . vhdl-template-for-hook)
3054                  ("func"          . vhdl-template-function-hook)
3055                  ("function"      . vhdl-template-function-hook)
3056                  ("generic"       . vhdl-template-generic-hook)
3057                  ("group"         . vhdl-template-group-hook)
3058                  ("guarded"       . vhdl-template-default-hook)
3059                  ("if"            . vhdl-template-if-hook)
3060                  ("impure"        . vhdl-template-default-hook)
3061                  ("in"            . vhdl-template-default-hook)
3062                  ("inertial"      . vhdl-template-default-hook)
3063                  ("inout"         . vhdl-template-default-hook)
3064                  ("inst"          . vhdl-template-instance-hook)
3065                  ("instance"      . vhdl-template-instance-hook)
3066                  ("is"            . vhdl-template-default-hook)
3067                  ("label"         . vhdl-template-default-hook)
3068                  ("library"       . vhdl-template-library-hook)
3069                  ("linkage"       . vhdl-template-default-hook)
3070                  ("literal"       . vhdl-template-default-hook)
3071                  ("loop"          . vhdl-template-bare-loop-hook)
3072                  ("map"           . vhdl-template-map-hook)
3073                  ("mod"           . vhdl-template-default-hook)
3074                  ("nand"          . vhdl-template-default-hook)
3075                  ("new"           . vhdl-template-default-hook)
3076                  ("next"          . vhdl-template-next-hook)
3077                  ("nor"           . vhdl-template-default-hook)
3078                  ("not"           . vhdl-template-default-hook)
3079                  ("null"          . vhdl-template-default-hook)
3080                  ("of"            . vhdl-template-default-hook)
3081                  ("on"            . vhdl-template-default-hook)
3082                  ("open"          . vhdl-template-default-hook)
3083                  ("or"            . vhdl-template-default-hook)
3084                  ("others"        . vhdl-template-others-hook)
3085                  ("out"           . vhdl-template-default-hook)
3086                  ("pack"          . vhdl-template-package-hook)
3087                  ("package"       . vhdl-template-package-hook)
3088                  ("port"          . vhdl-template-port-hook)
3089                  ("postponed"     . vhdl-template-default-hook)
3090                  ("procedure"     . vhdl-template-procedure-hook)
3091                  ("process"       . vhdl-template-process-hook)
3092                  ("pure"          . vhdl-template-default-hook)
3093                  ("range"         . vhdl-template-default-hook)
3094                  ("record"        . vhdl-template-default-hook)
3095                  ("register"      . vhdl-template-default-hook)
3096                  ("reject"        . vhdl-template-default-hook)
3097                  ("rem"           . vhdl-template-default-hook)
3098                  ("report"        . vhdl-template-report-hook)
3099                  ("return"        . vhdl-template-return-hook)
3100                  ("rol"           . vhdl-template-default-hook)
3101                  ("ror"           . vhdl-template-default-hook)
3102                  ("select"        . vhdl-template-selected-signal-asst-hook)
3103                  ("severity"      . vhdl-template-default-hook)
3104                  ("shared"        . vhdl-template-default-hook)
3105                  ("sig"           . vhdl-template-signal-hook)
3106                  ("signal"        . vhdl-template-signal-hook)
3107                  ("sla"           . vhdl-template-default-hook)
3108                  ("sll"           . vhdl-template-default-hook)
3109                  ("sra"           . vhdl-template-default-hook)
3110                  ("srl"           . vhdl-template-default-hook)
3111                  ("subtype"       . vhdl-template-subtype-hook)
3112                  ("then"          . vhdl-template-default-hook)
3113                  ("to"            . vhdl-template-default-hook)
3114                  ("transport"     . vhdl-template-default-hook)
3115                  ("type"          . vhdl-template-type-hook)
3116                  ("unaffected"    . vhdl-template-default-hook)
3117                  ("units"         . vhdl-template-default-hook)
3118                  ("until"         . vhdl-template-default-hook)
3119                  ("use"           . vhdl-template-use-hook)
3120                  ("var"           . vhdl-template-variable-hook)
3121                  ("variable"      . vhdl-template-variable-hook)
3122                  ("wait"          . vhdl-template-wait-hook)
3123                  ("when"          . vhdl-template-when-hook)
3124                  ("while"         . vhdl-template-while-loop-hook)
3125                  ("with"          . vhdl-template-with-hook)
3126                  ("xnor"          . vhdl-template-default-hook)
3127                  ("xor"           . vhdl-template-default-hook)
3128                  )))
3129      ;; VHDL-AMS keywords
3130      (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
3131        (mapcar (if (featurep 'xemacs)
3132                    (lambda (x) (list (car x) "" (cdr x) 0))
3133                  (lambda (x) (list (car x) "" (cdr x) 0 'system)))
3134                '(
3135                  ("across"     . vhdl-template-default-hook)
3136                  ("break"      . vhdl-template-break-hook)
3137                  ("limit"      . vhdl-template-limit-hook)
3138                  ("nature"     . vhdl-template-nature-hook)
3139                  ("noise"      . vhdl-template-default-hook)
3140                  ("procedural" . vhdl-template-procedural-hook)
3141                  ("quantity"   . vhdl-template-quantity-hook)
3142                  ("reference"  . vhdl-template-default-hook)
3143                  ("spectrum"   . vhdl-template-default-hook)
3144                  ("subnature"  . vhdl-template-subnature-hook)
3145                  ("terminal"   . vhdl-template-terminal-hook)
3146                  ("through"    . vhdl-template-default-hook)
3147                  ("tolerance"  . vhdl-template-default-hook)
3148                  )))
3149      ;; user model keywords
3150      (when (memq 'user vhdl-electric-keywords)
3151        (let (abbrev-list keyword)
3152          (dolist (elem vhdl-model-alist)
3153            (setq keyword (nth 3 elem))
3154            (unless (equal keyword "")
3155              (push (list keyword ""
3156                          (vhdl-function-name
3157                           "vhdl-model" (nth 0 elem) "hook") 0 'system)
3158                    abbrev-list)))
3159          abbrev-list)))))
3160
3161 ;; initialize abbrev table for VHDL Mode
3162 (vhdl-mode-abbrev-table-init)
3163
3164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3165 ;; Template completion lists
3166
3167 (defvar vhdl-template-construct-alist nil
3168   "List of built-in construct templates.")
3169
3170 (defun vhdl-template-construct-alist-init ()
3171   "Initialize `vhdl-template-construct-alist'."
3172   (setq
3173    vhdl-template-construct-alist
3174    (append
3175     '(
3176       ("alias declaration"                 vhdl-template-alias)
3177       ("architecture body"                 vhdl-template-architecture)
3178       ("assertion"                         vhdl-template-assert)
3179       ("attribute declaration"             vhdl-template-attribute-decl)
3180       ("attribute specification"           vhdl-template-attribute-spec)
3181       ("block configuration"               vhdl-template-block-configuration)
3182       ("block statement"                   vhdl-template-block)
3183       ("case statement"                    vhdl-template-case-is)
3184       ("component configuration"           vhdl-template-component-conf)
3185       ("component declaration"             vhdl-template-component-decl)
3186       ("component instantiation statement" vhdl-template-component-inst)
3187       ("conditional signal assignment"     vhdl-template-conditional-signal-asst)
3188       ("configuration declaration"         vhdl-template-configuration-decl)
3189       ("configuration specification"       vhdl-template-configuration-spec)
3190       ("constant declaration"              vhdl-template-constant)
3191       ("context declaration"               vhdl-template-context)
3192       ("disconnection specification"       vhdl-template-disconnect)
3193       ("entity declaration"                vhdl-template-entity)
3194       ("exit statement"                    vhdl-template-exit)
3195       ("file declaration"                  vhdl-template-file)
3196       ("generate statement"                vhdl-template-generate)
3197       ("generic clause"                    vhdl-template-generic)
3198       ("group declaration"                 vhdl-template-group-decl)
3199       ("group template declaration"        vhdl-template-group-template)
3200       ("if statement"                      vhdl-template-if-then)
3201       ("library clause"                    vhdl-template-library)
3202       ("loop statement"                    vhdl-template-loop)
3203       ("next statement"                    vhdl-template-next)
3204       ("package declaration"               vhdl-template-package-decl)
3205       ("package body"                      vhdl-template-package-body)
3206       ("port clause"                       vhdl-template-port)
3207       ("process statement"                 vhdl-template-process)
3208       ("report statement"                  vhdl-template-report)
3209       ("return statement"                  vhdl-template-return)
3210       ("selected signal assignment"        vhdl-template-selected-signal-asst)
3211       ("signal declaration"                vhdl-template-signal)
3212       ("subprogram declaration"            vhdl-template-subprogram-decl)
3213       ("subprogram body"                   vhdl-template-subprogram-body)
3214       ("subtype declaration"               vhdl-template-subtype)
3215       ("type declaration"                  vhdl-template-type)
3216       ("use clause"                        vhdl-template-use)
3217       ("variable declaration"              vhdl-template-variable)
3218       ("wait statement"                    vhdl-template-wait)
3219       )
3220     (when (vhdl-standard-p 'ams)
3221       '(
3222         ("break statement"                   vhdl-template-break)
3223         ("nature declaration"                vhdl-template-nature)
3224         ("quantity declaration"              vhdl-template-quantity)
3225         ("simultaneous case statement"       vhdl-template-case-use)
3226         ("simultaneous if statement"         vhdl-template-if-use)
3227         ("simultaneous procedural statement" vhdl-template-procedural)
3228         ("step limit specification"          vhdl-template-limit)
3229         ("subnature declaration"             vhdl-template-subnature)
3230         ("terminal declaration"              vhdl-template-terminal)
3231         )))))
3232
3233 ;; initialize for VHDL Mode
3234 (vhdl-template-construct-alist-init)
3235
3236 (defvar vhdl-template-package-alist nil
3237   "List of built-in package templates.")
3238
3239 (defun vhdl-template-package-alist-init ()
3240   "Initialize `vhdl-template-package-alist'."
3241   (setq
3242    vhdl-template-package-alist
3243    (append
3244     '(
3245       ("numeric_bit"        vhdl-template-package-numeric-bit)
3246       ("numeric_std"        vhdl-template-package-numeric-std)
3247       ("std_logic_1164"     vhdl-template-package-std-logic-1164)
3248       ("std_logic_arith"    vhdl-template-package-std-logic-arith)
3249       ("std_logic_misc"     vhdl-template-package-std-logic-misc)
3250       ("std_logic_signed"   vhdl-template-package-std-logic-signed)
3251       ("std_logic_textio"   vhdl-template-package-std-logic-textio)
3252       ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned)
3253       ("textio"             vhdl-template-package-textio)
3254       )
3255     (when (vhdl-standard-p 'math)
3256       '(
3257         ("math_complex" vhdl-template-package-math-complex)
3258         ("math_real"    vhdl-template-package-math-real)
3259         )))))
3260
3261 ;; initialize for VHDL Mode
3262 (vhdl-template-package-alist-init)
3263
3264 (defvar vhdl-template-directive-alist
3265   '(
3266     ("translate_on"     vhdl-template-directive-translate-on)
3267     ("translate_off"    vhdl-template-directive-translate-off)
3268     ("synthesis_on"     vhdl-template-directive-synthesis-on)
3269     ("synthesis_off"    vhdl-template-directive-synthesis-off)
3270     )
3271   "List of built-in directive templates.")
3272
3273
3274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3275 ;;; Menus
3276 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3277
3278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3279 ;; VHDL menu (using `easy-menu.el')
3280
3281 (defun vhdl-customize ()
3282   "Call the customize function with `vhdl' as argument."
3283   (interactive)
3284   (customize-browse 'vhdl))
3285
3286 (defun vhdl-create-mode-menu ()
3287   "Create VHDL Mode menu."
3288   `("VHDL"
3289     ,(append
3290       '("Project"
3291         ["None"                 (vhdl-set-project "")
3292                                 :style radio :selected (null vhdl-project)]
3293         "--")
3294       ;; add menu entries for defined projects
3295       (let ((project-alist vhdl-project-alist) menu-list name)
3296         (while project-alist
3297           (setq name (caar project-alist))
3298           (setq menu-list
3299                 (cons `[,name (vhdl-set-project ,name)
3300                         :style radio :selected (equal ,name vhdl-project)]
3301                       menu-list))
3302           (setq project-alist (cdr project-alist)))
3303         (setq menu-list
3304               (if vhdl-project-sort
3305                   (sort menu-list
3306                         (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
3307                 (nreverse menu-list)))
3308         (vhdl-menu-split menu-list "Project"))
3309       '("--" "--"
3310         ["Select Project..."    vhdl-set-project t]
3311         ["Set As Default Project" vhdl-set-default-project t]
3312         "--"
3313         ["Duplicate Project"    vhdl-duplicate-project vhdl-project]
3314         ["Import Project..."    vhdl-import-project
3315                                 :keys "C-c C-p C-m" :active t]
3316         ["Export Project"       vhdl-export-project vhdl-project]
3317         "--"
3318         ["Customize Project..." (customize-option 'vhdl-project-alist) t]))
3319     "--"
3320     ("Compile"
3321      ["Compile Buffer"          vhdl-compile t]
3322      ["Stop Compilation"        kill-compilation t]
3323      "--"
3324      ["Make"                    vhdl-make t]
3325      ["Generate Makefile"       vhdl-generate-makefile t]
3326      "--"
3327      ["Next Error"              next-error t]
3328      ["Previous Error"          previous-error t]
3329      ["First Error"             first-error t]
3330      "--"
3331      ,(append
3332        '("Compiler")
3333        ;; add menu entries for defined compilers
3334        (let ((comp-alist vhdl-compiler-alist) menu-list name)
3335          (while comp-alist
3336            (setq name (caar comp-alist))
3337            (setq menu-list
3338                  (cons `[,name (setq vhdl-compiler ,name)
3339                          :style radio :selected (equal ,name vhdl-compiler)]
3340                        menu-list))
3341            (setq comp-alist (cdr comp-alist)))
3342          (setq menu-list (nreverse menu-list))
3343          (vhdl-menu-split menu-list "Compiler"))
3344        '("--" "--"
3345          ["Select Compiler..."  vhdl-set-compiler t]
3346          "--"
3347          ["Customize Compiler..."
3348           (customize-option 'vhdl-compiler-alist) t])))
3349     "--"
3350     ,(append
3351       '("Template"
3352         ("VHDL Construct 1"
3353          ["Alias"               vhdl-template-alias t]
3354          ["Architecture"        vhdl-template-architecture t]
3355          ["Assert"              vhdl-template-assert t]
3356          ["Attribute (Decl)"    vhdl-template-attribute-decl t]
3357          ["Attribute (Spec)"    vhdl-template-attribute-spec t]
3358          ["Block"               vhdl-template-block t]
3359          ["Case"                vhdl-template-case-is t]
3360          ["Component (Decl)"    vhdl-template-component-decl t]
3361          ["(Component) Instance"        vhdl-template-component-inst t]
3362          ["Conditional (Signal Asst)"   vhdl-template-conditional-signal-asst t]
3363          ["Configuration (Block)"       vhdl-template-block-configuration t]
3364          ["Configuration (Comp)"        vhdl-template-component-conf t]
3365          ["Configuration (Decl)"        vhdl-template-configuration-decl t]
3366          ["Configuration (Spec)"        vhdl-template-configuration-spec t]
3367          ["Constant"            vhdl-template-constant t]
3368          ["Context"             vhdl-template-context t]
3369          ["Disconnect"          vhdl-template-disconnect t]
3370          ["Else"                vhdl-template-else t]
3371          ["Elsif"               vhdl-template-elsif t]
3372          ["Entity"              vhdl-template-entity t]
3373          ["Exit"                vhdl-template-exit t]
3374          ["File"                vhdl-template-file t]
3375          ["For (Generate)"      vhdl-template-for-generate t]
3376          ["For (Loop)"          vhdl-template-for-loop t]
3377          ["Function (Body)"     vhdl-template-function-body t]
3378          ["Function (Decl)"     vhdl-template-function-decl t]
3379          ["Generic"             vhdl-template-generic t]
3380          ["Group (Decl)"        vhdl-template-group-decl t]
3381          ["Group (Template)"    vhdl-template-group-template t])
3382         ("VHDL Construct 2"
3383          ["If (Generate)"       vhdl-template-if-generate t]
3384          ["If (Then)"           vhdl-template-if-then t]
3385          ["Library"             vhdl-template-library t]
3386          ["Loop"                vhdl-template-bare-loop t]
3387          ["Map"                 vhdl-template-map t]
3388          ["Next"                vhdl-template-next t]
3389          ["Others (Aggregate)"  vhdl-template-others t]
3390          ["Package (Decl)"      vhdl-template-package-decl t]
3391          ["Package (Body)"      vhdl-template-package-body t]
3392          ["Port"                vhdl-template-port t]
3393          ["Procedure (Body)"    vhdl-template-procedure-body t]
3394          ["Procedure (Decl)"    vhdl-template-procedure-decl t]
3395          ["Process (Comb)"      vhdl-template-process-comb t]
3396          ["Process (Seq)"       vhdl-template-process-seq t]
3397          ["Report"              vhdl-template-report t]
3398          ["Return"              vhdl-template-return t]
3399          ["Select"              vhdl-template-selected-signal-asst t]
3400          ["Signal"              vhdl-template-signal t]
3401          ["Subtype"             vhdl-template-subtype t]
3402          ["Type"                vhdl-template-type t]
3403          ["Use"                 vhdl-template-use t]
3404          ["Variable"            vhdl-template-variable t]
3405          ["Wait"                vhdl-template-wait t]
3406          ["(Clocked Wait)"      vhdl-template-clocked-wait t]
3407          ["When"                vhdl-template-when t]
3408          ["While (Loop)"        vhdl-template-while-loop t]
3409          ["With"                vhdl-template-with t]))
3410       (when (vhdl-standard-p 'ams)
3411         '(("VHDL-AMS Construct"
3412            ["Break"             vhdl-template-break t]
3413            ["Case (Use)"        vhdl-template-case-use t]
3414            ["If (Use)"          vhdl-template-if-use t]
3415            ["Limit"             vhdl-template-limit t]
3416            ["Nature"            vhdl-template-nature t]
3417            ["Procedural"        vhdl-template-procedural t]
3418            ["Quantity (Free)"   vhdl-template-quantity-free t]
3419            ["Quantity (Branch)" vhdl-template-quantity-branch t]
3420            ["Quantity (Source)" vhdl-template-quantity-source t]
3421            ["Subnature"         vhdl-template-subnature t]
3422            ["Terminal"          vhdl-template-terminal t])))
3423       '(["Insert Construct..."  vhdl-template-insert-construct
3424                                 :keys "C-c C-i C-t"]
3425         "--")
3426       (list
3427        (append
3428         '("Package")
3429         '(["numeric_bit"        vhdl-template-package-numeric-bit t]
3430           ["numeric_std"        vhdl-template-package-numeric-std t]
3431           ["std_logic_1164"     vhdl-template-package-std-logic-1164 t]
3432           ["textio"             vhdl-template-package-textio t]
3433           "--"
3434           ["std_logic_arith"    vhdl-template-package-std-logic-arith t]
3435           ["std_logic_signed"   vhdl-template-package-std-logic-signed t]
3436           ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
3437           ["std_logic_misc"     vhdl-template-package-std-logic-misc t]
3438           ["std_logic_textio"   vhdl-template-package-std-logic-textio t]
3439           "--")
3440         (when (vhdl-standard-p 'ams)
3441           '(["fundamental_constants" vhdl-template-package-fundamental-constants t]
3442             ["material_constants" vhdl-template-package-material-constants t]
3443             ["energy_systems"   vhdl-template-package-energy-systems t]
3444             ["electrical_systems" vhdl-template-package-electrical-systems t]
3445             ["mechanical_systems" vhdl-template-package-mechanical-systems t]
3446             ["radiant_systems"  vhdl-template-package-radiant-systems t]
3447             ["thermal_systems"  vhdl-template-package-thermal-systems t]
3448             ["fluidic_systems"  vhdl-template-package-fluidic-systems t]
3449             "--"))
3450         (when (vhdl-standard-p 'math)
3451           '(["math_complex"     vhdl-template-package-math-complex t]
3452             ["math_real"        vhdl-template-package-math-real t]
3453             "--"))
3454         '(["Insert Package..."  vhdl-template-insert-package
3455                                 :keys "C-c C-i C-p"])))
3456       '(("Directive"
3457          ["translate_on"        vhdl-template-directive-translate-on t]
3458          ["translate_off"       vhdl-template-directive-translate-off t]
3459          ["synthesis_on"        vhdl-template-directive-synthesis-on t]
3460          ["synthesis_off"       vhdl-template-directive-synthesis-off t]
3461          "--"
3462          ["Insert Directive..." vhdl-template-insert-directive
3463                                 :keys "C-c C-i C-d"])
3464         "--"
3465         ["Insert Header"        vhdl-template-header :keys "C-c C-t C-h"]
3466         ["Insert Footer"        vhdl-template-footer t]
3467         ["Insert Date"          vhdl-template-insert-date t]
3468         ["Modify Date"          vhdl-template-modify :keys "C-c C-t C-m"]
3469         "--"
3470         ["Query Next Prompt"    vhdl-template-search-prompt t]))
3471     ,(append
3472       '("Model")
3473       ;; add menu entries for defined models
3474       (let ((model-alist vhdl-model-alist) menu-list model)
3475         (while model-alist
3476           (setq model (car model-alist))
3477           (setq menu-list
3478                 (cons
3479                  (vector
3480                   (nth 0 model)
3481                   (vhdl-function-name "vhdl-model" (nth 0 model))
3482                   :keys (concat "C-c C-m " (key-description (nth 2 model))))
3483                  menu-list))
3484           (setq model-alist (cdr model-alist)))
3485         (setq menu-list (nreverse menu-list))
3486         (vhdl-menu-split menu-list "Model"))
3487       '("--" "--"
3488         ["Insert Model..."      vhdl-model-insert :keys "C-c C-i C-m"]
3489         ["Customize Model..."   (customize-option 'vhdl-model-alist) t]))
3490     ("Port"
3491      ["Copy"                    vhdl-port-copy t]
3492      "--"
3493      ["Paste As Entity"         vhdl-port-paste-entity vhdl-port-list]
3494      ["Paste As Component"      vhdl-port-paste-component vhdl-port-list]
3495      ["Paste As Instance"       vhdl-port-paste-instance
3496                                 :keys "C-c C-p C-i" :active vhdl-port-list]
3497      ["Paste As Signals"        vhdl-port-paste-signals vhdl-port-list]
3498      ["Paste As Constants"      vhdl-port-paste-constants vhdl-port-list]
3499      ["Paste As Generic Map"    vhdl-port-paste-generic-map vhdl-port-list]
3500      ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3501      "--"
3502      ["Paste As Testbench"      vhdl-port-paste-testbench vhdl-port-list]
3503      "--"
3504      ["Flatten"                 vhdl-port-flatten
3505       :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3506      ["Reverse Direction"       vhdl-port-reverse-direction
3507       :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3508     ("Compose"
3509      ["New Component"           vhdl-compose-new-component t]
3510      ["Copy Component"          vhdl-port-copy t]
3511      ["Place Component"         vhdl-compose-place-component vhdl-port-list]
3512      ["Wire Components"         vhdl-compose-wire-components t]
3513      "--"
3514      ["Generate Configuration"  vhdl-compose-configuration t]
3515      ["Generate Components Package"     vhdl-compose-components-package t])
3516     ("Subprogram"
3517      ["Copy"                    vhdl-subprog-copy t]
3518      "--"
3519      ["Paste As Declaration"    vhdl-subprog-paste-declaration vhdl-subprog-list]
3520      ["Paste As Body"           vhdl-subprog-paste-body vhdl-subprog-list]
3521      ["Paste As Call"           vhdl-subprog-paste-call vhdl-subprog-list]
3522      "--"
3523      ["Flatten"                 vhdl-subprog-flatten
3524       :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3525     "--"
3526     ("Comment"
3527      ["(Un)Comment Out Region"  vhdl-comment-uncomment-region (mark)]
3528      "--"
3529      ["Insert Inline Comment"   vhdl-comment-append-inline t]
3530      ["Insert Horizontal Line"  vhdl-comment-display-line t]
3531      ["Insert Display Comment"  vhdl-comment-display t]
3532      "--"
3533      ["Fill Comment"            fill-paragraph t]
3534      ["Fill Comment Region"     fill-region (mark)]
3535      ["Kill Comment Region"     vhdl-comment-kill-region (mark)]
3536      ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3537     ("Line"
3538      ["Kill"                    vhdl-line-kill t]
3539      ["Copy"                    vhdl-line-copy t]
3540      ["Yank"                    vhdl-line-yank t]
3541      ["Expand"                  vhdl-line-expand t]
3542      "--"
3543      ["Transpose Next"          vhdl-line-transpose-next t]
3544      ["Transpose Prev"          vhdl-line-transpose-previous t]
3545      ["Open"                    vhdl-line-open t]
3546      ["Join"                    vhdl-delete-indentation t]
3547      "--"
3548      ["Goto"                    goto-line t]
3549      ["(Un)Comment Out"         vhdl-comment-uncomment-line t])
3550     ("Move"
3551      ["Forward Statement"       vhdl-end-of-statement t]
3552      ["Backward Statement"      vhdl-beginning-of-statement t]
3553      ["Forward Expression"      vhdl-forward-sexp t]
3554      ["Backward Expression"     vhdl-backward-sexp t]
3555      ["Forward Same Indent"     vhdl-forward-same-indent t]
3556      ["Backward Same Indent"    vhdl-backward-same-indent t]
3557      ["Forward Function"        vhdl-end-of-defun t]
3558      ["Backward Function"       vhdl-beginning-of-defun t]
3559      ["Mark Function"           vhdl-mark-defun t])
3560     "--"
3561     ("Indent"
3562      ["Line"                    indent-according-to-mode :keys "C-c C-i C-l"]
3563      ["Group"                   vhdl-indent-group :keys "C-c C-i C-g"]
3564      ["Region"                  vhdl-indent-region (mark)]
3565      ["Buffer"                  vhdl-indent-buffer :keys "C-c C-i C-b"])
3566     ("Align"
3567      ["Group"                   vhdl-align-group t]
3568      ["Same Indent"             vhdl-align-same-indent :keys "C-c C-a C-i"]
3569      ["List"                    vhdl-align-list t]
3570      ["Declarations"            vhdl-align-declarations t]
3571      ["Region"                  vhdl-align-region (mark)]
3572      ["Buffer"                  vhdl-align-buffer t]
3573      "--"
3574      ["Inline Comment Group"    vhdl-align-inline-comment-group t]
3575      ["Inline Comment Region"   vhdl-align-inline-comment-region (mark)]
3576      ["Inline Comment Buffer"   vhdl-align-inline-comment-buffer t])
3577     ("Fill"
3578      ["List"                    vhdl-fill-list t]
3579      ["Group"                   vhdl-fill-group t]
3580      ["Same Indent"             vhdl-fill-same-indent :keys "C-c C-f C-i"]
3581      ["Region"                  vhdl-fill-region (mark)])
3582     ("Beautify"
3583      ["Region"                  vhdl-beautify-region (mark)]
3584      ["Buffer"                  vhdl-beautify-buffer t])
3585     ("Fix"
3586      ["Generic/Port Clause"     vhdl-fix-clause t]
3587      ["Generic/Port Clause Buffer" vhdl-fix-clause t]
3588      "--"
3589      ["Case Region"             vhdl-fix-case-region (mark)]
3590      ["Case Buffer"             vhdl-fix-case-buffer t]
3591      "--"
3592      ["Whitespace Region"       vhdl-fixup-whitespace-region (mark)]
3593      ["Whitespace Buffer"       vhdl-fixup-whitespace-buffer t]
3594      "--"
3595      ["Statement Region"        vhdl-fix-statement-region (mark)]
3596      ["Statement Buffer"        vhdl-fix-statement-buffer t]
3597      "--"
3598      ["Trailing Spaces Buffer"  vhdl-remove-trailing-spaces t])
3599     ("Update"
3600      ["Sensitivity List"        vhdl-update-sensitivity-list-process t]
3601      ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t])
3602     "--"
3603     ["Fontify Buffer"           vhdl-fontify-buffer t]
3604     ["Statistics Buffer"        vhdl-statistics-buffer t]
3605     ["Show Messages"            vhdl-show-messages t]
3606     ["Syntactic Info"           vhdl-show-syntactic-information t]
3607     "--"
3608     ["Speedbar"                 vhdl-speedbar t]
3609     ["Hide/Show"                vhdl-hs-minor-mode t]
3610     "--"
3611     ("Documentation"
3612      ["VHDL Mode"               vhdl-doc-mode :keys "C-c C-h"]
3613      ["Release Notes"           (vhdl-doc-variable 'vhdl-doc-release-notes) t]
3614      ["Reserved Words"          (vhdl-doc-variable 'vhdl-doc-keywords) t]
3615      ["Coding Style"            (vhdl-doc-variable 'vhdl-doc-coding-style) t])
3616     ["Version"                  vhdl-version t]
3617     ["Bug Report..."            vhdl-submit-bug-report t]
3618     "--"
3619     ("Options"
3620      ("Mode"
3621       ["Electric Mode"
3622        (progn (customize-set-variable 'vhdl-electric-mode
3623                                       (not vhdl-electric-mode))
3624               (vhdl-mode-line-update))
3625        :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3626       ["Stutter Mode"
3627        (progn (customize-set-variable 'vhdl-stutter-mode
3628                                       (not vhdl-stutter-mode))
3629               (vhdl-mode-line-update))
3630        :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3631       ["Indent Tabs Mode"
3632        (progn (customize-set-variable 'vhdl-indent-tabs-mode
3633                                       (not vhdl-indent-tabs-mode))
3634               (setq indent-tabs-mode vhdl-indent-tabs-mode))
3635        :style toggle :selected vhdl-indent-tabs-mode]
3636       "--"
3637       ["Customize Group..." (customize-group 'vhdl-mode) t])
3638      ("Project"
3639       ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3640       ,(append
3641         '("Selected Project at Startup"
3642           ["None" (progn (customize-set-variable 'vhdl-project nil)
3643                          (vhdl-set-project ""))
3644            :style radio :selected (null vhdl-project)]
3645           "--")
3646         ;; add menu entries for defined projects
3647         (let ((project-alist vhdl-project-alist) menu-list name)
3648           (while project-alist
3649             (setq name (caar project-alist))
3650             (setq menu-list
3651                   (cons `[,name (progn (customize-set-variable
3652                                         'vhdl-project ,name)
3653                                        (vhdl-set-project ,name))
3654                           :style radio :selected (equal ,name vhdl-project)]
3655                         menu-list))
3656             (setq project-alist (cdr project-alist)))
3657           (setq menu-list (nreverse menu-list))
3658           (vhdl-menu-split menu-list "Project")))
3659       ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3660       ("Auto Load Setup File"
3661        ["At Startup"
3662         (customize-set-variable 'vhdl-project-auto-load
3663                                 (if (memq 'startup vhdl-project-auto-load)
3664                                    (delq 'startup vhdl-project-auto-load)
3665                                  (cons 'startup vhdl-project-auto-load)))
3666        :style toggle :selected (memq 'startup vhdl-project-auto-load)])
3667       ["Sort Projects"
3668        (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3669        :style toggle :selected vhdl-project-sort]
3670       "--"
3671       ["Customize Group..." (customize-group 'vhdl-project) t])
3672      ("Compiler"
3673       ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3674       ,(append
3675         '("Selected Compiler at Startup")
3676         ;; add menu entries for defined compilers
3677         (let ((comp-alist vhdl-compiler-alist) menu-list name)
3678           (while comp-alist
3679             (setq name (caar comp-alist))
3680             (setq menu-list
3681                   (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3682                           :style radio :selected (equal ,name vhdl-compiler)]
3683                         menu-list))
3684             (setq comp-alist (cdr comp-alist)))
3685           (setq menu-list (nreverse menu-list))
3686           (vhdl-menu-split menu-list "Compiler")))
3687       ["Use Local Error Regexp"
3688        (customize-set-variable 'vhdl-compile-use-local-error-regexp
3689                                (not vhdl-compile-use-local-error-regexp))
3690        :style toggle :selected vhdl-compile-use-local-error-regexp]
3691       ["Makefile Default Targets..."
3692        (customize-option 'vhdl-makefile-default-targets) t]
3693       ["Makefile Generation Hook..."
3694        (customize-option 'vhdl-makefile-generation-hook) t]
3695       ["Default Library Name" (customize-option 'vhdl-default-library) t]
3696       "--"
3697       ["Customize Group..." (customize-group 'vhdl-compiler) t])
3698      ("Style"
3699       ("VHDL Standard"
3700        ["VHDL'87"
3701         (progn (customize-set-variable 'vhdl-standard
3702                                        (list '87 (cadr vhdl-standard)))
3703                (vhdl-activate-customizations))
3704         :style radio :selected (eq '87 (car vhdl-standard))]
3705        ["VHDL'93/02"
3706         (progn (customize-set-variable 'vhdl-standard
3707                                        (list '93 (cadr vhdl-standard)))
3708                (vhdl-activate-customizations))
3709         :style radio :selected (eq '93 (car vhdl-standard))]
3710        ["VHDL'08"
3711         (progn (customize-set-variable 'vhdl-standard
3712                                        (list '08 (cadr vhdl-standard)))
3713                (vhdl-activate-customizations))
3714         :style radio :selected (eq '08 (car vhdl-standard))]
3715        "--"
3716        ["VHDL-AMS"
3717         (progn (customize-set-variable
3718                 'vhdl-standard (list (car vhdl-standard)
3719                                      (if (memq 'ams (cadr vhdl-standard))
3720                                          (delq 'ams (cadr vhdl-standard))
3721                                        (cons 'ams (cadr vhdl-standard)))))
3722                (vhdl-activate-customizations))
3723         :style toggle :selected (memq 'ams (cadr vhdl-standard))]
3724        ["Math Packages"
3725         (progn (customize-set-variable
3726                 'vhdl-standard (list (car vhdl-standard)
3727                                      (if (memq 'math (cadr vhdl-standard))
3728                                          (delq 'math (cadr vhdl-standard))
3729                                        (cons 'math (cadr vhdl-standard)))))
3730                (vhdl-activate-customizations))
3731         :style toggle :selected (memq 'math (cadr vhdl-standard))])
3732       ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3733       ["Upper Case Keywords"
3734        (customize-set-variable 'vhdl-upper-case-keywords
3735                                (not vhdl-upper-case-keywords))
3736        :style toggle :selected vhdl-upper-case-keywords]
3737       ["Upper Case Types"
3738        (customize-set-variable 'vhdl-upper-case-types
3739                                (not vhdl-upper-case-types))
3740        :style toggle :selected vhdl-upper-case-types]
3741       ["Upper Case Attributes"
3742        (customize-set-variable 'vhdl-upper-case-attributes
3743                                (not vhdl-upper-case-attributes))
3744        :style toggle :selected vhdl-upper-case-attributes]
3745       ["Upper Case Enumeration Values"
3746        (customize-set-variable 'vhdl-upper-case-enum-values
3747                                (not vhdl-upper-case-enum-values))
3748        :style toggle :selected vhdl-upper-case-enum-values]
3749       ["Upper Case Constants"
3750        (customize-set-variable 'vhdl-upper-case-constants
3751                                (not vhdl-upper-case-constants))
3752        :style toggle :selected vhdl-upper-case-constants]
3753       ("Use Direct Instantiation"
3754        ["Never"
3755         (customize-set-variable 'vhdl-use-direct-instantiation 'never)
3756         :style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3757        ["Standard"
3758         (customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3759         :style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3760        ["Always"
3761         (customize-set-variable 'vhdl-use-direct-instantiation 'always)
3762         :style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3763       ["Include Array Index and Record Field in Sensitivity List"
3764        (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list
3765                                (not vhdl-array-index-record-field-in-sensitivity-list))
3766        :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list]
3767       "--"
3768       ["Customize Group..." (customize-group 'vhdl-style) t])
3769      ("Naming"
3770       ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3771       ["Architecture File Name..."
3772        (customize-option 'vhdl-architecture-file-name) t]
3773       ["Configuration File Name..."
3774        (customize-option 'vhdl-configuration-file-name) t]
3775       ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3776       ("File Name Case"
3777        ["As Is"
3778         (customize-set-variable 'vhdl-file-name-case 'identity)
3779         :style radio :selected (eq 'identity vhdl-file-name-case)]
3780        ["Lower Case"
3781         (customize-set-variable 'vhdl-file-name-case 'downcase)
3782         :style radio :selected (eq 'downcase vhdl-file-name-case)]
3783        ["Upper Case"
3784         (customize-set-variable 'vhdl-file-name-case 'upcase)
3785         :style radio :selected (eq 'upcase vhdl-file-name-case)]
3786        ["Capitalize"
3787         (customize-set-variable 'vhdl-file-name-case 'capitalize)
3788         :style radio :selected (eq 'capitalize vhdl-file-name-case)])
3789       "--"
3790       ["Customize Group..." (customize-group 'vhdl-naming) t])
3791      ("Template"
3792       ("Electric Keywords"
3793        ["VHDL Keywords"
3794         (customize-set-variable 'vhdl-electric-keywords
3795                                 (if (memq 'vhdl vhdl-electric-keywords)
3796                                     (delq 'vhdl vhdl-electric-keywords)
3797                                   (cons 'vhdl vhdl-electric-keywords)))
3798         :style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3799        ["User Model Keywords"
3800         (customize-set-variable 'vhdl-electric-keywords
3801                                 (if (memq 'user vhdl-electric-keywords)
3802                                      (delq 'user vhdl-electric-keywords)
3803                                    (cons 'user vhdl-electric-keywords)))
3804         :style toggle :selected (memq 'user vhdl-electric-keywords)])
3805       ("Insert Optional Labels"
3806        ["None"
3807         (customize-set-variable 'vhdl-optional-labels 'none)
3808         :style radio :selected (eq 'none vhdl-optional-labels)]
3809        ["Processes Only"
3810         (customize-set-variable 'vhdl-optional-labels 'process)
3811         :style radio :selected (eq 'process vhdl-optional-labels)]
3812        ["All Constructs"
3813         (customize-set-variable 'vhdl-optional-labels 'all)
3814         :style radio :selected (eq 'all vhdl-optional-labels)])
3815       ("Insert Empty Lines"
3816        ["None"
3817         (customize-set-variable 'vhdl-insert-empty-lines 'none)
3818         :style radio :selected (eq 'none vhdl-insert-empty-lines)]
3819        ["Design Units Only"
3820         (customize-set-variable 'vhdl-insert-empty-lines 'unit)
3821         :style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3822        ["All Constructs"
3823         (customize-set-variable 'vhdl-insert-empty-lines 'all)
3824         :style radio :selected (eq 'all vhdl-insert-empty-lines)])
3825       ["Argument List Indent"
3826        (customize-set-variable 'vhdl-argument-list-indent
3827                                (not vhdl-argument-list-indent))
3828        :style toggle :selected vhdl-argument-list-indent]
3829       ["Association List with Formals"
3830        (customize-set-variable 'vhdl-association-list-with-formals
3831                                (not vhdl-association-list-with-formals))
3832        :style toggle :selected vhdl-association-list-with-formals]
3833       ["Conditions in Parenthesis"
3834        (customize-set-variable 'vhdl-conditions-in-parenthesis
3835                                (not vhdl-conditions-in-parenthesis))
3836        :style toggle :selected vhdl-conditions-in-parenthesis]
3837       ["Sensitivity List uses 'all'"
3838        (customize-set-variable 'vhdl-sensitivity-list-all
3839                                (not vhdl-sensitivity-list-all))
3840        :style toggle :selected vhdl-sensitivity-list-all]
3841       ["Zero String..." (customize-option 'vhdl-zero-string) t]
3842       ["One String..." (customize-option 'vhdl-one-string) t]
3843       ("File Header"
3844        ["Header String..." (customize-option 'vhdl-file-header) t]
3845        ["Footer String..." (customize-option 'vhdl-file-footer) t]
3846        ["Company Name..." (customize-option 'vhdl-company-name) t]
3847        ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3848        ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3849        ["Date Format..." (customize-option 'vhdl-date-format) t]
3850        ["Modify Date Prefix String..."
3851         (customize-option 'vhdl-modify-date-prefix-string) t]
3852        ["Modify Date on Saving"
3853         (progn (customize-set-variable 'vhdl-modify-date-on-saving
3854                                        (not vhdl-modify-date-on-saving))
3855                (vhdl-activate-customizations))
3856         :style toggle :selected vhdl-modify-date-on-saving])
3857       ("Sequential Process"
3858        ("Kind of Reset"
3859         ["None"
3860          (customize-set-variable 'vhdl-reset-kind 'none)
3861          :style radio :selected (eq 'none vhdl-reset-kind)]
3862         ["Synchronous"
3863          (customize-set-variable 'vhdl-reset-kind 'sync)
3864          :style radio :selected (eq 'sync vhdl-reset-kind)]
3865         ["Asynchronous"
3866          (customize-set-variable 'vhdl-reset-kind 'async)
3867          :style radio :selected (eq 'async vhdl-reset-kind)]
3868         ["Query"
3869          (customize-set-variable 'vhdl-reset-kind 'query)
3870          :style radio :selected (eq 'query vhdl-reset-kind)])
3871        ["Reset is Active High"
3872         (customize-set-variable 'vhdl-reset-active-high
3873                                 (not vhdl-reset-active-high))
3874         :style toggle :selected vhdl-reset-active-high]
3875        ["Use Rising Clock Edge"
3876         (customize-set-variable 'vhdl-clock-rising-edge
3877                                 (not vhdl-clock-rising-edge))
3878         :style toggle :selected vhdl-clock-rising-edge]
3879        ("Clock Edge Condition"
3880         ["Standard"
3881          (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3882          :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3883         ["Function \"rising_edge\""
3884          (customize-set-variable 'vhdl-clock-edge-condition 'function)
3885          :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3886        ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3887        ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3888       "--"
3889       ["Customize Group..." (customize-group 'vhdl-template) t])
3890      ("Model"
3891       ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3892      ("Port"
3893       ["Include Port Comments"
3894        (customize-set-variable 'vhdl-include-port-comments
3895                                (not vhdl-include-port-comments))
3896        :style toggle :selected vhdl-include-port-comments]
3897       ["Include Direction Comments"
3898        (customize-set-variable 'vhdl-include-direction-comments
3899                                (not vhdl-include-direction-comments))
3900        :style toggle :selected vhdl-include-direction-comments]
3901       ["Include Type Comments"
3902        (customize-set-variable 'vhdl-include-type-comments
3903                                (not vhdl-include-type-comments))
3904        :style toggle :selected vhdl-include-type-comments]
3905       ("Include Group Comments"
3906        ["Never"
3907         (customize-set-variable 'vhdl-include-group-comments 'never)
3908         :style radio :selected (eq 'never vhdl-include-group-comments)]
3909        ["Declarations"
3910         (customize-set-variable 'vhdl-include-group-comments 'decl)
3911         :style radio :selected (eq 'decl vhdl-include-group-comments)]
3912        ["Always"
3913         (customize-set-variable 'vhdl-include-group-comments 'always)
3914         :style radio :selected (eq 'always vhdl-include-group-comments)])
3915       ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t]
3916       ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3917       ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3918       ("Testbench"
3919        ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3920        ["Architecture Name..."
3921         (customize-option 'vhdl-testbench-architecture-name) t]
3922        ["Configuration Name..."
3923         (customize-option 'vhdl-testbench-configuration-name) t]
3924        ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3925        ["Include Header"
3926         (customize-set-variable 'vhdl-testbench-include-header
3927                                 (not vhdl-testbench-include-header))
3928         :style toggle :selected vhdl-testbench-include-header]
3929        ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3930        ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3931        ["Initialize Signals"
3932         (customize-set-variable 'vhdl-testbench-initialize-signals
3933                                 (not vhdl-testbench-initialize-signals))
3934         :style toggle :selected vhdl-testbench-initialize-signals]
3935        ["Include Library Clause"
3936         (customize-set-variable 'vhdl-testbench-include-library
3937                                 (not vhdl-testbench-include-library))
3938         :style toggle :selected vhdl-testbench-include-library]
3939        ["Include Configuration"
3940         (customize-set-variable 'vhdl-testbench-include-configuration
3941                                 (not vhdl-testbench-include-configuration))
3942         :style toggle :selected vhdl-testbench-include-configuration]
3943        ("Create Files"
3944         ["None"
3945          (customize-set-variable 'vhdl-testbench-create-files 'none)
3946          :style radio :selected (eq 'none vhdl-testbench-create-files)]
3947         ["Single"
3948          (customize-set-variable 'vhdl-testbench-create-files 'single)
3949          :style radio :selected (eq 'single vhdl-testbench-create-files)]
3950         ["Separate"
3951          (customize-set-variable 'vhdl-testbench-create-files 'separate)
3952          :style radio :selected (eq 'separate vhdl-testbench-create-files)])
3953        ["Testbench Entity File Name..."
3954         (customize-option 'vhdl-testbench-entity-file-name) t]
3955        ["Testbench Architecture File Name..."
3956         (customize-option 'vhdl-testbench-architecture-file-name) t])
3957       "--"
3958       ["Customize Group..." (customize-group 'vhdl-port) t])
3959      ("Compose"
3960       ["Architecture Name..."
3961        (customize-option 'vhdl-compose-architecture-name) t]
3962       ["Configuration Name..."
3963        (customize-option 'vhdl-compose-configuration-name) t]
3964       ["Components Package Name..."
3965        (customize-option 'vhdl-components-package-name) t]
3966       ["Use Components Package"
3967        (customize-set-variable 'vhdl-use-components-package
3968                                (not vhdl-use-components-package))
3969        :style toggle :selected vhdl-use-components-package]
3970       ["Include Header"
3971        (customize-set-variable 'vhdl-compose-include-header
3972                                (not vhdl-compose-include-header))
3973        :style toggle :selected vhdl-compose-include-header]
3974       ("Create Entity/Architecture Files"
3975        ["None"
3976         (customize-set-variable 'vhdl-compose-create-files 'none)
3977         :style radio :selected (eq 'none vhdl-compose-create-files)]
3978        ["Single"
3979         (customize-set-variable 'vhdl-compose-create-files 'single)
3980         :style radio :selected (eq 'single vhdl-compose-create-files)]
3981        ["Separate"
3982         (customize-set-variable 'vhdl-compose-create-files 'separate)
3983         :style radio :selected (eq 'separate vhdl-compose-create-files)])
3984       ["Create Configuration File"
3985        (customize-set-variable 'vhdl-compose-configuration-create-file
3986                                (not vhdl-compose-configuration-create-file))
3987        :style toggle :selected vhdl-compose-configuration-create-file]
3988       ["Hierarchical Configuration"
3989        (customize-set-variable 'vhdl-compose-configuration-hierarchical
3990                                (not vhdl-compose-configuration-hierarchical))
3991        :style toggle :selected vhdl-compose-configuration-hierarchical]
3992       ["Use Subconfiguration"
3993        (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration
3994                                (not vhdl-compose-configuration-use-subconfiguration))
3995        :style toggle :selected vhdl-compose-configuration-use-subconfiguration]
3996       "--"
3997       ["Customize Group..." (customize-group 'vhdl-compose) t])
3998      ("Comment"
3999       ["Self Insert Comments"
4000        (customize-set-variable 'vhdl-self-insert-comments
4001                                (not vhdl-self-insert-comments))
4002        :style toggle :selected vhdl-self-insert-comments]
4003       ["Prompt for Comments"
4004        (customize-set-variable 'vhdl-prompt-for-comments
4005                                (not vhdl-prompt-for-comments))
4006        :style toggle :selected vhdl-prompt-for-comments]
4007       ["Inline Comment Column..."
4008        (customize-option 'vhdl-inline-comment-column) t]
4009       ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
4010       "--"
4011       ["Customize Group..." (customize-group 'vhdl-comment) t])
4012      ("Beautify"
4013       ["Auto Align Templates"
4014        (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
4015        :style toggle :selected vhdl-auto-align]
4016       ["Align Line Groups"
4017        (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
4018        :style toggle :selected vhdl-align-groups]
4019       ["Group Separation String..."
4020        (customize-option 'vhdl-align-group-separate) t]
4021       ["Align Lines with Same Indent"
4022        (customize-set-variable 'vhdl-align-same-indent
4023                                (not vhdl-align-same-indent))
4024        :style toggle :selected vhdl-align-same-indent]
4025       ["Beautify Options..." (customize-option 'vhdl-beautify-options) t]
4026       "--"
4027       ["Customize Group..." (customize-group 'vhdl-beautify) t])
4028      ("Highlight"
4029       ["Highlighting On/Off..."
4030        (customize-option
4031         (if (fboundp 'global-font-lock-mode)
4032             'global-font-lock-mode 'font-lock-auto-fontify)) t]
4033       ["Highlight Keywords"
4034        (progn (customize-set-variable 'vhdl-highlight-keywords
4035                                       (not vhdl-highlight-keywords))
4036               (vhdl-fontify-buffer))
4037        :style toggle :selected vhdl-highlight-keywords]
4038       ["Highlight Names"
4039        (progn (customize-set-variable 'vhdl-highlight-names
4040                                       (not vhdl-highlight-names))
4041               (vhdl-fontify-buffer))
4042        :style toggle :selected vhdl-highlight-names]
4043       ["Highlight Special Words"
4044        (progn (customize-set-variable 'vhdl-highlight-special-words
4045                                       (not vhdl-highlight-special-words))
4046               (vhdl-fontify-buffer))
4047        :style toggle :selected vhdl-highlight-special-words]
4048       ["Highlight Forbidden Words"
4049        (progn (customize-set-variable 'vhdl-highlight-forbidden-words
4050                                       (not vhdl-highlight-forbidden-words))
4051               (vhdl-fontify-buffer))
4052        :style toggle :selected vhdl-highlight-forbidden-words]
4053       ["Highlight Verilog Keywords"
4054        (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
4055                                       (not vhdl-highlight-verilog-keywords))
4056               (vhdl-fontify-buffer))
4057        :style toggle :selected vhdl-highlight-verilog-keywords]
4058       ["Highlight \"translate_off\""
4059        (progn (customize-set-variable 'vhdl-highlight-translate-off
4060                                       (not vhdl-highlight-translate-off))
4061               (vhdl-fontify-buffer))
4062        :style toggle :selected vhdl-highlight-translate-off]
4063       ["Case Sensitive Highlighting"
4064        (progn (customize-set-variable 'vhdl-highlight-case-sensitive
4065                                       (not vhdl-highlight-case-sensitive))
4066               (vhdl-fontify-buffer))
4067        :style toggle :selected vhdl-highlight-case-sensitive]
4068       ["Special Syntax Definition..."
4069        (customize-option 'vhdl-special-syntax-alist) t]
4070       ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
4071       ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
4072       ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
4073       ["Colors..." (customize-group 'vhdl-highlight-faces) t]
4074       "--"
4075       ["Customize Group..." (customize-group 'vhdl-highlight) t])
4076      ("Speedbar"
4077       ["Auto Open at Startup"
4078        (customize-set-variable 'vhdl-speedbar-auto-open
4079                                (not vhdl-speedbar-auto-open))
4080        :style toggle :selected vhdl-speedbar-auto-open]
4081       ("Default Displaying Mode"
4082        ["Files"
4083         (customize-set-variable 'vhdl-speedbar-display-mode 'files)
4084         :style radio :selected (eq 'files vhdl-speedbar-display-mode)]
4085        ["Directory Hierarchy"
4086         (customize-set-variable 'vhdl-speedbar-display-mode 'directory)
4087         :style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
4088        ["Project Hierarchy"
4089         (customize-set-variable 'vhdl-speedbar-display-mode 'project)
4090         :style radio :selected (eq 'project vhdl-speedbar-display-mode)])
4091       ["Indentation Offset..."
4092        (customize-option 'speedbar-indentation-width) t]
4093       ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
4094       ["Jump to Unit when Opening"
4095        (customize-set-variable 'vhdl-speedbar-jump-to-unit
4096                                (not vhdl-speedbar-jump-to-unit))
4097        :style toggle :selected vhdl-speedbar-jump-to-unit]
4098       ["Update Hierarchy on File Saving"
4099        (customize-set-variable 'vhdl-speedbar-update-on-saving
4100                                (not vhdl-speedbar-update-on-saving))
4101        :style toggle :selected vhdl-speedbar-update-on-saving]
4102       ("Save in Cache File"
4103        ["Hierarchy Information"
4104         (customize-set-variable 'vhdl-speedbar-save-cache
4105                                 (if (memq 'hierarchy vhdl-speedbar-save-cache)
4106                                     (delq 'hierarchy vhdl-speedbar-save-cache)
4107                                   (cons 'hierarchy vhdl-speedbar-save-cache)))
4108         :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
4109        ["Displaying Status"
4110         (customize-set-variable 'vhdl-speedbar-save-cache
4111                                 (if (memq 'display vhdl-speedbar-save-cache)
4112                                     (delq 'display vhdl-speedbar-save-cache)
4113                                   (cons 'display vhdl-speedbar-save-cache)))
4114         :style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
4115       ["Cache File Name..."
4116        (customize-option 'vhdl-speedbar-cache-file-name) t]
4117       "--"
4118       ["Customize Group..." (customize-group 'vhdl-speedbar) t])
4119      ("Menu"
4120       ["Add Index Menu when Loading File"
4121        (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
4122               (vhdl-index-menu-init))
4123        :style toggle :selected vhdl-index-menu]
4124       ["Add Source File Menu when Loading File"
4125        (progn (customize-set-variable 'vhdl-source-file-menu
4126                                       (not vhdl-source-file-menu))
4127               (vhdl-add-source-files-menu))
4128        :style toggle :selected vhdl-source-file-menu]
4129       ["Add Hideshow Menu at Startup"
4130        (progn (customize-set-variable 'vhdl-hideshow-menu
4131                                       (not vhdl-hideshow-menu))
4132               (vhdl-activate-customizations))
4133        :style toggle :selected vhdl-hideshow-menu]
4134       ["Hide Everything Initially"
4135        (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
4136        :style toggle :selected vhdl-hide-all-init]
4137       "--"
4138       ["Customize Group..." (customize-group 'vhdl-menu) t])
4139      ("Print"
4140       ["In Two Column Format"
4141        (progn (customize-set-variable 'vhdl-print-two-column
4142                                       (not vhdl-print-two-column))
4143               (message "Activate new setting by saving options and restarting Emacs"))
4144        :style toggle :selected vhdl-print-two-column]
4145       ["Use Customized Faces"
4146        (progn (customize-set-variable 'vhdl-print-customize-faces
4147                                       (not vhdl-print-customize-faces))
4148               (message "Activate new setting by saving options and restarting Emacs"))
4149        :style toggle :selected vhdl-print-customize-faces]
4150       "--"
4151       ["Customize Group..." (customize-group 'vhdl-print) t])
4152      ("Miscellaneous"
4153       ["Use Intelligent Tab"
4154        (progn (customize-set-variable 'vhdl-intelligent-tab
4155                                       (not vhdl-intelligent-tab))
4156               (vhdl-activate-customizations))
4157        :style toggle :selected vhdl-intelligent-tab]
4158       ["Indent Syntax-Based"
4159        (customize-set-variable 'vhdl-indent-syntax-based
4160                                (not vhdl-indent-syntax-based))
4161        :style toggle :selected vhdl-indent-syntax-based]
4162       ["Indent Comments Like Next Code Line"
4163        (customize-set-variable 'vhdl-indent-comment-like-next-code-line
4164                                (not vhdl-indent-comment-like-next-code-line))
4165        :style toggle :selected vhdl-indent-comment-like-next-code-line]
4166       ["Word Completion is Case Sensitive"
4167        (customize-set-variable 'vhdl-word-completion-case-sensitive
4168                                (not vhdl-word-completion-case-sensitive))
4169        :style toggle :selected vhdl-word-completion-case-sensitive]
4170       ["Word Completion in Minibuffer"
4171        (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
4172                                       (not vhdl-word-completion-in-minibuffer))
4173               (message "Activate new setting by saving options and restarting Emacs"))
4174        :style toggle :selected vhdl-word-completion-in-minibuffer]
4175       ["Underscore is Part of Word"
4176        (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
4177                                       (not vhdl-underscore-is-part-of-word))
4178               (vhdl-activate-customizations))
4179        :style toggle :selected vhdl-underscore-is-part-of-word]
4180       "--"
4181       ["Customize Group..." (customize-group 'vhdl-misc) t])
4182      ["Related..." (customize-browse 'vhdl-related) t]
4183      "--"
4184      ["Save Options" customize-save-customized t]
4185      ["Activate Options" vhdl-activate-customizations t]
4186      ["Browse Options..." vhdl-customize t])))
4187
4188 (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
4189   "VHDL Mode menu.")
4190
4191 (defun vhdl-update-mode-menu ()
4192   "Update VHDL Mode menu."
4193   (interactive)
4194   (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
4195   (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
4196   (easy-menu-add vhdl-mode-menu-list)   ; for XEmacs
4197   (easy-menu-define vhdl-mode-menu vhdl-mode-map
4198                     "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
4199
4200 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4201 ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
4202
4203 (defconst vhdl-imenu-generic-expression
4204   '(
4205     ("Subprogram"
4206      "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
4207      4)
4208     ("Instance"
4209      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>"
4210      1)
4211     ("Component"
4212      "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4213      2)
4214     ("Procedural"
4215      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)"
4216      1)
4217     ("Process"
4218      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)"
4219      1)
4220     ("Block"
4221      "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)"
4222      1)
4223     ("Package"
4224      "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4225      3)
4226     ("Configuration"
4227      "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4228      2)
4229     ("Architecture"
4230      "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)"
4231      2)
4232     ("Entity"
4233      "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4234      2)
4235     ("Context"
4236      "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)"
4237      2)
4238     )
4239   "Imenu generic expression for VHDL Mode.  See `imenu-generic-expression'.")
4240
4241 (defun vhdl-index-menu-init ()
4242   "Initialize index menu."
4243   (set (make-local-variable 'imenu-case-fold-search) t)
4244   (set (make-local-variable 'imenu-generic-expression)
4245        vhdl-imenu-generic-expression)
4246   (when (and vhdl-index-menu (fboundp 'imenu))
4247     (imenu-add-to-menubar "Index")))
4248
4249 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4250 ;; Source file menu (using `easy-menu.el')
4251
4252 (defvar vhdl-sources-menu nil)
4253
4254 (defun vhdl-directory-files (directory &optional full match)
4255   "Call `directory-files' if DIRECTORY exists, otherwise generate error
4256 message."
4257   (if (not (file-directory-p directory))
4258       (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
4259     (let ((dir (directory-files directory full match)))
4260       (setq dir (delete "." dir))
4261       (setq dir (delete ".." dir))
4262       dir)))
4263
4264 (defun vhdl-get-source-files (&optional full directory)
4265   "Get list of VHDL source files in DIRECTORY or current directory."
4266   (let ((mode-alist auto-mode-alist)
4267         filename-regexp)
4268     ;; create regular expressions for matching file names
4269     (setq filename-regexp "\\`[^.].*\\(")
4270     (while mode-alist
4271       (when (eq (cdar mode-alist) 'vhdl-mode)
4272         (setq filename-regexp
4273               (concat filename-regexp (caar mode-alist) "\\|")))
4274       (setq mode-alist (cdr mode-alist)))
4275     (setq filename-regexp
4276           (concat (substring filename-regexp 0
4277                              (string-match "\\\\|$" filename-regexp)) "\\)"))
4278     ;; find files
4279     (vhdl-directory-files
4280      (or directory default-directory) full filename-regexp)))
4281
4282 (defun vhdl-add-source-files-menu ()
4283   "Scan directory for all VHDL source files and generate menu.
4284 The directory of the current source file is scanned."
4285   (interactive)
4286   (message "Scanning directory for source files ...")
4287   (let ((newmap (current-local-map))
4288         (file-list (vhdl-get-source-files))
4289         menu-list found)
4290     ;; Create list for menu
4291     (setq found nil)
4292     (while file-list
4293       (setq found t)
4294       (push (vector (car file-list) (list 'find-file (car file-list)) t)
4295             menu-list)
4296       (setq file-list (cdr file-list)))
4297     (setq menu-list (vhdl-menu-split menu-list "Sources"))
4298     (when found (push "--" menu-list))
4299     (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list)
4300     (push "Sources" menu-list)
4301     ;; Create menu
4302     (easy-menu-add menu-list)
4303     (easy-menu-define vhdl-sources-menu newmap
4304                       "VHDL source files menu" menu-list))
4305   (message ""))
4306
4307
4308 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4309 ;;; Mode definition
4310 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4311 ;; performs all buffer local initializations
4312
4313 ;;;###autoload
4314 (define-derived-mode vhdl-mode prog-mode
4315   '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/"))
4316            (vhdl-electric-mode "e")
4317            (vhdl-stutter-mode "s"))
4318   "Major mode for editing VHDL code.
4319
4320 Usage:
4321 ------
4322
4323   TEMPLATE INSERTION (electrification):
4324     After typing a VHDL keyword and entering `SPC', you are prompted for
4325     arguments while a template is generated for that VHDL construct.  Typing
4326     `RET' or `C-g' at the first (mandatory) prompt aborts the current
4327     template generation.  Optional arguments are indicated by square
4328     brackets and removed if the queried string is left empty.  Prompts for
4329     mandatory arguments remain in the code if the queried string is left
4330     empty.  They can be queried again by `C-c C-t C-q'.  Enabled
4331     electrification is indicated by `/e' in the mode line.
4332
4333       Typing `M-SPC' after a keyword inserts a space without calling the
4334     template generator.  Automatic template generation (i.e.
4335     electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4336     setting option `vhdl-electric-mode' (see OPTIONS).
4337
4338       Template generators can be invoked from the VHDL menu, by key
4339     bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4340     the keyword (i.e. first word of menu entry not in parenthesis) and
4341     `SPC'.  The following abbreviations can also be used: arch, attr, cond,
4342     conf, comp, cons, func, inst, pack, sig, var.
4343
4344       Template styles can be customized in customization group
4345     `vhdl-template' (see OPTIONS).
4346
4347
4348   HEADER INSERTION:
4349     A file header can be inserted by `C-c C-t C-h'.  A file footer
4350     (template at the end of the file) can be inserted by `C-c C-t C-f'.
4351     See customization group `vhdl-header'.
4352
4353
4354   STUTTERING:
4355     Double striking of some keys inserts cumbersome VHDL syntax elements.
4356     Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4357     option `vhdl-stutter-mode'.  Enabled stuttering is indicated by `/s' in
4358     the mode line.  The stuttering keys and their effects are:
4359
4360       ;;   -->  \" : \"       [   -->  (        --    -->  comment
4361       ;;;  -->  \" := \"      [[  -->  [        --CR  -->  comment-out code
4362       ..   -->  \" => \"      ]   -->  )        ---   -->  horizontal line
4363       ,,   -->  \" <= \"      ]]  -->  ]        ----  -->  display comment
4364       ==   -->  \" == \"      \\='\\='  -->  \\\"
4365
4366
4367   WORD COMPLETION:
4368     Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4369     word in the buffer that starts alike, inserts it and adjusts case.
4370     Re-typing `TAB' toggles through alternative word completions.  This also
4371     works in the minibuffer (i.e. in template generator prompts).
4372
4373       Typing `TAB' after `(' looks for and inserts complete parenthesized
4374     expressions (e.g. for array index ranges).  All keywords as well as
4375     standard types and subprograms of VHDL have predefined abbreviations
4376     (e.g., type \"std\" and `TAB' will toggle through all standard types
4377     beginning with \"std\").
4378
4379       Typing `TAB' after a non-word character indents the line if at the
4380     beginning of a line (i.e. no preceding non-blank characters), and
4381     inserts a tabulator stop otherwise.  `M-TAB' always inserts a tabulator
4382     stop.
4383
4384
4385   COMMENTS:
4386         `--'       puts a single comment.
4387         `---'      draws a horizontal line for separating code segments.
4388         `----'     inserts a display comment, i.e. two horizontal lines
4389                    with a comment in between.
4390         `--CR'     comments out code on that line.  Re-hitting CR comments
4391                    out following lines.
4392         `C-c C-c'  comments out a region if not commented out,
4393                    uncomments a region if already commented out.  Option
4394                    `comment-style' defines where the comment characters
4395                    should be placed (beginning of line, indent, etc.).
4396
4397       You are prompted for comments after object definitions (i.e. signals,
4398     variables, constants, ports) and after subprogram and process
4399     specifications if option `vhdl-prompt-for-comments' is non-nil.
4400     Comments are automatically inserted as additional labels (e.g. after
4401     begin statements) and as help comments if `vhdl-self-insert-comments' is
4402     non-nil.
4403
4404       Inline comments (i.e. comments after a piece of code on the same line)
4405     are indented at least to `vhdl-inline-comment-column'.  Comments go at
4406     maximum to `vhdl-end-comment-column'.  `RET' after a space in a comment
4407     will open a new comment line.  Typing beyond `vhdl-end-comment-column'
4408     in a comment automatically opens a new comment line.  `M-q' re-fills
4409     multi-line comments.
4410
4411
4412   INDENTATION:
4413     `TAB' indents a line if at the beginning of the line.  The amount of
4414     indentation is specified by option `vhdl-basic-offset'.  `C-c C-i C-l'
4415     always indents the current line (is bound to `TAB' if option
4416     `vhdl-intelligent-tab' is nil).  If a region is active, `TAB' indents
4417     the entire region.
4418
4419       Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4420     (`M-C-\\') or the entire buffer (menu).  Argument and port lists are
4421     indented normally (nil) or relative to the opening parenthesis (non-nil)
4422     according to option `vhdl-argument-list-indent'.
4423
4424       If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4425     tabs.  `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to
4426     tabs and vice versa.
4427
4428       Syntax-based indentation can be very slow in large files.  Option
4429     `vhdl-indent-syntax-based' allows you to use faster but simpler indentation.
4430
4431       Option `vhdl-indent-comment-like-next-code-line' controls whether
4432     comment lines are indented like the preceding or like the following code
4433     line.
4434
4435
4436   ALIGNMENT:
4437     The alignment functions align operators, keywords, and inline comments
4438     to beautify the code.  `C-c C-a C-a' aligns a group of consecutive lines
4439     separated by blank lines, `C-c C-a C-i' a block of lines with same
4440     indent.  `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4441     a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4442     C-a C-d' all lines within the declarative part of a design unit.  `C-c
4443     C-a M-a' aligns an entire region.  `C-c C-a C-c' aligns inline comments
4444     for a group of lines, and `C-c C-a M-c' for a region.
4445
4446       If option `vhdl-align-groups' is non-nil, groups of code lines
4447     separated by special lines (see option `vhdl-align-group-separate') are
4448     aligned individually.  If option `vhdl-align-same-indent' is non-nil,
4449     blocks of lines with same indent are aligned separately.  Some templates
4450     are automatically aligned after generation if option `vhdl-auto-align'
4451     is non-nil.
4452
4453       Alignment tries to align inline comments at
4454     `vhdl-inline-comment-column' and tries inline comment not to exceed
4455     `vhdl-end-comment-column'.
4456
4457       `C-c C-x M-w' fixes up whitespace in a region.  That is, operator
4458     symbols are surrounded by one space, and multiple spaces are eliminated.
4459
4460
4461   CODE FILLING:
4462     Code filling allows you to condense code (e.g. sensitivity lists or port
4463     maps) by removing comments and newlines and re-wrapping so that all
4464     lines are maximally filled (block filling).  `C-c C-f C-f' fills a list
4465     enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4466     blank lines, `C-c C-f C-i' a block of lines with same indent, and
4467     `C-c C-f M-f' an entire region.
4468
4469
4470   CODE BEAUTIFICATION:
4471     `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4472     buffer respectively.  This includes indentation, alignment, and case
4473     fixing.  Code beautification can also be run non-interactively using the
4474     command:
4475
4476       emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4477
4478
4479   PORT TRANSLATION:
4480     Generic and port clauses from entity or component declarations can be
4481     copied (`C-c C-p C-w') and pasted as entity and component declarations,
4482     as component instantiations and corresponding internal constants and
4483     signals, as a generic map with constants as actual generics, and as
4484     internal signal initializations (menu).
4485
4486       To include formals in component instantiations, see option
4487     `vhdl-association-list-with-formals'.  To include comments in pasting,
4488     see options `vhdl-include-...-comments'.
4489
4490       A clause with several generic/port names on the same line can be
4491     flattened (`C-c C-p C-f') so that only one name per line exists.  The
4492     direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4493     outputs and vice versa, which can be useful in testbenches.  (This
4494     reversion is done on the internal data structure and is only reflected
4495     in subsequent paste operations.)
4496
4497       Names for actual ports, instances, testbenches, and
4498     design-under-test instances can be derived from existing names according
4499     to options `vhdl-...-name'.  See customization group `vhdl-port'.
4500
4501
4502   SUBPROGRAM TRANSLATION:
4503     Similar functionality exists for copying/pasting the interface of
4504     subprograms (function/procedure).  A subprogram interface can be copied
4505     and then pasted as a subprogram declaration, body or call (uses
4506     association list with formals).
4507
4508
4509   TESTBENCH GENERATION:
4510     A copied port can also be pasted as a testbench.  The generated
4511     testbench includes an entity, an architecture, and an optional
4512     configuration.  The architecture contains the component declaration and
4513     instantiation of the DUT as well as internal constant and signal
4514     declarations.  Additional user-defined templates can be inserted.  The
4515     names used for entity/architecture/configuration/DUT as well as the file
4516     structure to be generated can be customized. See customization group
4517    `vhdl-testbench'.
4518
4519
4520   KEY BINDINGS:
4521     Key bindings (`C-c ...') exist for most commands (see in menu).
4522
4523
4524   VHDL MENU:
4525     All commands can be found in the VHDL menu including their key bindings.
4526
4527
4528   FILE BROWSER:
4529     The speedbar allows browsing of directories and file contents.  It can
4530     be accessed from the VHDL menu and is automatically opened if option
4531     `vhdl-speedbar-auto-open' is non-nil.
4532
4533       In speedbar, open files and directories with `mouse-2' on the name and
4534     browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4535
4536
4537   DESIGN HIERARCHY BROWSER:
4538     The speedbar can also be used for browsing the hierarchy of design units
4539     contained in the source files of the current directory or the specified
4540     projects (see option `vhdl-project-alist').
4541
4542       The speedbar can be switched between file, directory hierarchy and
4543     project hierarchy browsing mode in the speedbar menu or by typing `f',
4544     `h' or `H' in speedbar.
4545
4546       In speedbar, open design units with `mouse-2' on the name and browse
4547     their hierarchy with `mouse-2' on the `+'.  Ports can directly be copied
4548     from entities and components (in packages).  Individual design units and
4549     complete designs can directly be compiled (\"Make\" menu entry).
4550
4551       The hierarchy is automatically updated upon saving a modified source
4552     file when option `vhdl-speedbar-update-on-saving' is non-nil.  The
4553     hierarchy is only updated for projects that have been opened once in the
4554     speedbar.  The hierarchy is cached between Emacs sessions in a file (see
4555     options in group `vhdl-speedbar').
4556
4557       Simple design consistency checks are done during scanning, such as
4558     multiple declarations of the same unit or missing primary units that are
4559     required by secondary units.
4560
4561
4562   STRUCTURAL COMPOSITION:
4563     Enables simple structural composition.  `C-c C-m C-n' creates a skeleton
4564     for a new component.  Subcomponents (i.e. component declaration and
4565     instantiation) can be automatically placed from a previously read port
4566     (`C-c C-m C-p') or directly from the hierarchy browser (`P').  Finally,
4567     all subcomponents can be automatically connected using internal signals
4568     and ports (`C-c C-m C-w') following these rules:
4569       - subcomponent actual ports with same name are considered to be
4570         connected by a signal (internal signal or port)
4571       - signals that are only inputs to subcomponents are considered as
4572         inputs to this component -> input port created
4573       - signals that are only outputs from subcomponents are considered as
4574         outputs from this component -> output port created
4575       - signals that are inputs to AND outputs from subcomponents are
4576         considered as internal connections -> internal signal created
4577
4578       Purpose:  With appropriate naming conventions it is possible to
4579     create higher design levels with only a few mouse clicks or key
4580     strokes.  A new design level can be created by simply generating a new
4581     component, placing the required subcomponents from the hierarchy
4582     browser, and wiring everything automatically.
4583
4584       Note: Automatic wiring only works reliably on templates of new
4585     components and component instantiations that were created by VHDL mode.
4586
4587       Component declarations can be placed in a components package (option
4588     `vhdl-use-components-package') which can be automatically generated for
4589     an entire directory or project (`C-c C-m M-p').  The VHDL'93 direct
4590     component instantiation is also supported (option
4591     `vhdl-use-direct-instantiation').
4592
4593       Configuration declarations can automatically be generated either from
4594     the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from
4595     the speedbar menu (for the architecture under the cursor).  The
4596     configurations can optionally be hierarchical (i.e. include all
4597     component levels of a hierarchical design, option
4598     `vhdl-compose-configuration-hierarchical') or include subconfigurations
4599     (option `vhdl-compose-configuration-use-subconfiguration').  For
4600     subcomponents in hierarchical configurations, the most-recently-analyzed
4601     (mra) architecture is selected.  If another architecture is desired, it
4602     can be marked as most-recently-analyzed (speedbar menu) before
4603     generating the configuration.
4604
4605       Note: Configurations of subcomponents (i.e. hierarchical configuration
4606     declarations) are currently not considered when displaying
4607     configurations in speedbar.
4608
4609       See the options group `vhdl-compose' for all relevant user options.
4610
4611
4612   SOURCE FILE COMPILATION:
4613     The syntax of the current buffer can be analyzed by calling a VHDL
4614     compiler (menu, `C-c C-k').  The compiler to be used is specified by
4615     option `vhdl-compiler'.  The available compilers are listed in option
4616     `vhdl-compiler-alist' including all required compilation command,
4617     command options, compilation directory, and error message syntax
4618     information.  New compilers can be added.
4619
4620       All the source files of an entire design can be compiled by the `make'
4621     command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4622
4623
4624   MAKEFILE GENERATION:
4625     Makefiles can be generated automatically by an internal generation
4626     routine (`C-c M-k').  The library unit dependency information is
4627     obtained from the hierarchy browser.  Makefile generation can be
4628     customized for each compiler in option `vhdl-compiler-alist'.
4629
4630       Makefile generation can also be run non-interactively using the
4631     command:
4632
4633         emacs -batch -l ~/.emacs -l vhdl-mode
4634               [-compiler compilername] [-project projectname]
4635               -f vhdl-generate-makefile
4636
4637       The Makefile's default target \"all\" compiles the entire design, the
4638     target \"clean\" removes it and the target \"library\" creates the
4639     library directory if not existent.  These target names can be customized
4640     by option `vhdl-makefile-default-targets'.  The Makefile also includes a
4641     target for each primary library unit which allows selective compilation
4642     of this unit, its secondary units and its subhierarchy (example:
4643     compilation of a design specified by a configuration).  User specific
4644     parts can be inserted into a Makefile with option
4645     `vhdl-makefile-generation-hook'.
4646
4647     Limitations:
4648       - Only library units and dependencies within the current library are
4649         considered.  Makefiles for designs that span multiple libraries are
4650         not (yet) supported.
4651       - Only one-level configurations are supported (also hierarchical),
4652         but configurations that go down several levels are not.
4653       - The \"others\" keyword in configurations is not supported.
4654
4655
4656   PROJECTS:
4657     Projects can be defined in option `vhdl-project-alist' and a current
4658     project be selected using option `vhdl-project' (permanently) or from
4659     the menu or speedbar (temporarily).  For each project, title and
4660     description strings (for the file headers), source files/directories
4661     (for the hierarchy browser and Makefile generation), library name, and
4662     compiler-dependent options, exceptions and compilation directory can be
4663     specified.  Compilation settings overwrite the settings of option
4664     `vhdl-compiler-alist'.
4665
4666       Project setups can be exported (i.e. written to a file) and imported.
4667     Imported setups are not automatically saved in `vhdl-project-alist' but
4668     can be saved afterwards in its customization buffer.  When starting
4669     Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4670     vhdl-mode\") in a directory with an existing project setup file, it is
4671     automatically loaded and its project activated if option
4672     `vhdl-project-auto-load' is non-nil.  Names/paths of the project setup
4673     files can be specified in option `vhdl-project-file-name'.  Multiple
4674     project setups can be automatically loaded from global directories.
4675     This is an alternative to specifying project setups with option
4676     `vhdl-project-alist'.
4677
4678
4679   SPECIAL MENUES:
4680     As an alternative to the speedbar, an index menu can be added (set
4681     option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4682     (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4683     file) for browsing the file contents (is not populated if buffer is
4684     larger than 256000).  Also, a source file menu can be
4685     added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4686     current directory for VHDL source files.
4687
4688
4689   VHDL STANDARDS:
4690     The VHDL standards to be used are specified in option `vhdl-standard'.
4691     Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages.
4692
4693
4694   KEYWORD CASE:
4695     Lower and upper case for keywords and standardized types, attributes,
4696     and enumeration values is supported.  If the option
4697     `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4698     lower case and are converted into upper case automatically (not for
4699     types, attributes, and enumeration values).  The case of keywords,
4700     types, attributes,and enumeration values can be fixed for an entire
4701     region (menu) or buffer (`C-c C-x C-c') according to the options
4702     `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4703
4704
4705   HIGHLIGHTING (fontification):
4706     Keywords and standardized types, attributes, enumeration values, and
4707     function names (controlled by option `vhdl-highlight-keywords'), as well
4708     as comments, strings, and template prompts are highlighted using
4709     different colors.  Unit, subprogram, signal, variable, constant,
4710     parameter and generic/port names in declarations as well as labels are
4711     highlighted if option `vhdl-highlight-names' is non-nil.
4712
4713       Additional reserved words or words with a forbidden syntax (e.g. words
4714     that should be avoided) can be specified in option
4715     `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4716     a warning color (option `vhdl-highlight-forbidden-words').  Verilog
4717     keywords are highlighted as forbidden words if option
4718     `vhdl-highlight-verilog-keywords' is non-nil.
4719
4720       Words with special syntax can be highlighted by specifying their
4721     syntax and color in option `vhdl-special-syntax-alist' and by setting
4722     option `vhdl-highlight-special-words' to non-nil.  This allows you to
4723     establish some naming conventions (e.g. to distinguish different kinds
4724     of signals or other objects by using name suffices) and to support them
4725     visually.
4726
4727       Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4728     to support case-sensitive highlighting.  However, keywords are then only
4729     highlighted if written in lower case.
4730
4731       Code between \"translate_off\" and \"translate_on\" pragmas is
4732     highlighted using a different background color if option
4733     `vhdl-highlight-translate-off' is non-nil.
4734
4735       For documentation and customization of the used colors see
4736     customization group `vhdl-highlight-faces' (`\\[customize-group]').  For
4737     highlighting of matching parenthesis, see customization group
4738     `paren-showing'.  Automatic buffer highlighting is turned on/off by
4739     option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4740
4741
4742   USER MODELS:
4743     VHDL models (templates) can be specified by the user and made accessible
4744     in the menu, through key bindings (`C-c C-m ...'), or by keyword
4745     electrification.  See option `vhdl-model-alist'.
4746
4747
4748   HIDE/SHOW:
4749     The code of blocks, processes, subprograms, component declarations and
4750     instantiations, generic/port clauses, and configuration declarations can
4751     be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4752     the code (see customization group `vhdl-menu').  XEmacs: limited
4753     functionality due to old `hideshow.el' package.
4754
4755
4756   CODE UPDATING:
4757     - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4758       current process, `C-c C-u M-s' of all processes in the current buffer.
4759       Limitations:
4760         - Only declared local signals (ports, signals declared in
4761           architecture and blocks) are automatically inserted.
4762         - Global signals declared in packages are not automatically inserted.
4763           Insert them once manually (will be kept afterwards).
4764         - Out parameters of procedures are considered to be read.
4765       Use option `vhdl-entity-file-name' to specify the entity file name
4766       (used to obtain the port names).
4767       Use option `vhdl-array-index-record-field-in-sensitivity-list' to
4768       specify whether to include array indices and record fields in
4769       sensitivity lists.
4770
4771
4772   CODE FIXING:
4773     `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4774     (e.g., if the closing parenthesis is on the wrong line or is missing).
4775
4776
4777   PRINTING:
4778     PostScript printing with different faces (an optimized set of faces is
4779     used if `vhdl-print-customize-faces' is non-nil) or colors (if
4780     `ps-print-color-p' is non-nil) is possible using the standard Emacs
4781     PostScript printing commands.  Option `vhdl-print-two-column' defines
4782     appropriate default settings for nice landscape two-column printing.
4783     The paper format can be set by option `ps-paper-type'.  Do not forget to
4784     switch `ps-print-color-p' to nil for printing on black-and-white
4785     printers.
4786
4787
4788   OPTIONS:
4789     User options allow customization of VHDL Mode.  All options are
4790     accessible from the \"Options\" menu entry.  Simple options (switches
4791     and choices) can directly be changed, while for complex options a
4792     customization buffer is opened.  Changed options can be saved for future
4793     sessions using the \"Save Options\" menu entry.
4794
4795       Options and their detailed descriptions can also be accessed by using
4796     the \"Customize\" menu entry or the command `\\[customize-option]'
4797     (`\\[customize-group]' for groups).  Some customizations only take effect
4798     after some action (read the NOTE in the option documentation).
4799     Customization can also be done globally (i.e. site-wide, read the
4800     INSTALL file).
4801
4802       Not all options are described in this documentation, so go and see
4803     what other useful user options there are (`\\[vhdl-customize]' or menu)!
4804
4805
4806   FILE EXTENSIONS:
4807     As default, files with extensions \".vhd\" and \".vhdl\" are
4808     automatically recognized as VHDL source files.  To add an extension
4809     \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4810
4811       (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist)
4812
4813
4814   HINTS:
4815     - To start Emacs with open VHDL hierarchy browser without having to load
4816       a VHDL file first, use the command:
4817
4818         emacs -l vhdl-mode -f speedbar-frame-mode
4819
4820     - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4821
4822     - Some features only work on properly indented code.
4823
4824
4825   RELEASE NOTES:
4826     See also the release notes (menu) for added features in new releases.
4827
4828
4829 Maintenance:
4830 ------------
4831
4832 To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.
4833 Add a description of the problem and include a reproducible test case.
4834
4835 Questions and enhancement requests can be sent to <reto@gnu.org>.
4836
4837 The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4838 The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4839 releases.  You are kindly invited to participate in beta testing.  Subscribe
4840 to above mailing lists by sending an email to <reto@gnu.org>.
4841
4842 VHDL Mode is officially distributed at
4843 http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
4844 where the latest version can be found.
4845
4846
4847 Known problems:
4848 ---------------
4849
4850 - XEmacs: Incorrect start-up when automatically opening speedbar.
4851 - XEmacs: Indentation in XEmacs 21.4 (and higher).
4852 - Indentation incorrect for new 'postponed' VHDL keyword.
4853 - Indentation incorrect for 'protected body' construct.
4854
4855
4856                                                 The VHDL Mode Authors
4857                                             Reto Zimmermann and Rod Whitby
4858
4859 Key bindings:
4860 -------------
4861
4862 \\{vhdl-mode-map}"
4863   :abbrev-table vhdl-mode-abbrev-table
4864
4865   ;; set local variables
4866   (set (make-local-variable 'paragraph-start)
4867        "\\s-*\\(--+\\s-*$\\|$\\)")
4868   (set (make-local-variable 'paragraph-separate) paragraph-start)
4869   (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
4870   (set (make-local-variable 'parse-sexp-ignore-comments) t)
4871   (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
4872   (set (make-local-variable 'comment-start) "--")
4873   (set (make-local-variable 'comment-end) "")
4874   (when vhdl-emacs-21
4875     (set (make-local-variable 'comment-padding) ""))
4876   (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4877   (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4878   (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4879   (set (make-local-variable 'comment-multi-line) nil)
4880   (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
4881   (set (make-local-variable 'hippie-expand-verbose) nil)
4882
4883   ;; setup the comment indent variable in a Emacs version portable way
4884   ;; ignore any byte compiler warnings you might get here
4885   (when (boundp 'comment-indent-function)
4886     (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent))
4887
4888   ;; initialize font locking
4889   (set (make-local-variable 'font-lock-defaults)
4890        (list
4891         '(nil vhdl-font-lock-keywords) nil
4892         (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
4893   (if (eval-when-compile (fboundp 'syntax-propertize-rules))
4894       (set (make-local-variable 'syntax-propertize-function)
4895            (syntax-propertize-rules
4896             ;; Mark single quotes as having string quote syntax in
4897             ;; 'c' instances.
4898             ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'"))))
4899     (set (make-local-variable 'font-lock-syntactic-keywords)
4900          vhdl-font-lock-syntactic-keywords))
4901   (unless vhdl-emacs-21
4902     (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4903     (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4904     (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4905     (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4906
4907   ;; variables for source file compilation
4908   (when vhdl-compile-use-local-error-regexp
4909     (set (make-local-variable 'compilation-error-regexp-alist) nil)
4910     (set (make-local-variable 'compilation-file-regexp-alist) nil))
4911
4912   ;; add index menu
4913   (vhdl-index-menu-init)
4914   ;; add source file menu
4915   (if vhdl-source-file-menu (vhdl-add-source-files-menu))
4916   ;; add VHDL menu
4917   (easy-menu-add vhdl-mode-menu-list)   ; for XEmacs
4918   (easy-menu-define vhdl-mode-menu vhdl-mode-map
4919                     "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4920   ;; initialize hideshow and add menu
4921   (vhdl-hideshow-init)
4922   (run-hooks 'menu-bar-update-hook)
4923
4924   ;; miscellaneous
4925   (vhdl-ps-print-init)
4926   (vhdl-write-file-hooks-init)
4927   (message "VHDL Mode %s.%s" vhdl-version
4928            (if noninteractive "" "  See menu for documentation and release notes.")))
4929
4930 (defun vhdl-activate-customizations ()
4931   "Activate all customizations on local variables."
4932   (interactive)
4933   (vhdl-mode-map-init)
4934   (use-local-map vhdl-mode-map)
4935   (set-syntax-table vhdl-mode-syntax-table)
4936   (setq comment-column vhdl-inline-comment-column)
4937   (setq end-comment-column vhdl-end-comment-column)
4938   (vhdl-write-file-hooks-init)
4939   (vhdl-update-mode-menu)
4940   (vhdl-hideshow-init)
4941   (run-hooks 'menu-bar-update-hook))
4942
4943 (defun vhdl-write-file-hooks-init ()
4944   "Add/remove hooks when buffer is saved."
4945   (if vhdl-modify-date-on-saving
4946       (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t)
4947     (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t))
4948   (if (featurep 'xemacs) (make-local-hook 'after-save-hook))
4949   (add-hook 'after-save-hook 'vhdl-add-modified-file nil t))
4950
4951 (defun vhdl-process-command-line-option (option)
4952   "Process command line options for VHDL Mode."
4953   (cond
4954    ;; set compiler
4955    ((equal option "-compiler")
4956     (vhdl-set-compiler (car command-line-args-left))
4957     (setq command-line-args-left (cdr command-line-args-left)))
4958    ;; set project
4959    ((equal option "-project")
4960     (vhdl-set-project (car command-line-args-left))
4961     (setq command-line-args-left (cdr command-line-args-left)))))
4962
4963 ;; make Emacs process VHDL Mode options
4964 (setq command-switch-alist
4965       (append command-switch-alist
4966               '(("-compiler" . vhdl-process-command-line-option)
4967                 ("-project" . vhdl-process-command-line-option))))
4968
4969
4970 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4971 ;;; Keywords and standardized words
4972 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4973
4974 (defconst vhdl-02-keywords
4975   '(
4976     "abs" "access" "after" "alias" "all" "and" "architecture" "array"
4977     "assert" "attribute"
4978     "begin" "block" "body" "buffer" "bus"
4979     "case" "component" "configuration" "constant"
4980     "disconnect" "downto"
4981     "else" "elsif" "end" "entity" "exit"
4982     "file" "for" "function"
4983     "generate" "generic" "group" "guarded"
4984     "if" "impure" "in" "inertial" "inout" "is"
4985     "label" "library" "linkage" "literal" "loop"
4986     "map" "mod"
4987     "nand" "new" "next" "nor" "not" "null"
4988     "of" "on" "open" "or" "others" "out"
4989     "package" "port" "postponed" "procedure" "process" "protected" "pure"
4990     "range" "record" "register" "reject" "rem" "report" "return"
4991     "rol" "ror"
4992     "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype"
4993     "then" "to" "transport" "type"
4994     "unaffected" "units" "until" "use"
4995     "variable"
4996     "wait" "when" "while" "with"
4997     "xnor" "xor"
4998     )
4999   "List of VHDL'02 keywords.")
5000
5001 (defconst vhdl-08-keywords
5002   '(
5003     "context" "force" "property" "release" "sequence"
5004     )
5005   "List of VHDL'08 keywords.")
5006
5007 (defconst vhdl-ams-keywords
5008   '(
5009     "across" "break" "limit" "nature" "noise" "procedural" "quantity"
5010     "reference" "spectrum" "subnature" "terminal" "through"
5011     "tolerance"
5012     )
5013   "List of VHDL-AMS keywords.")
5014
5015 (defconst vhdl-verilog-keywords
5016   '(
5017     "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef"
5018     "always" "and" "assign" "begin" "buf" "bufif0" "bufif1"
5019     "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable"
5020     "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule"
5021     "endprimitive" "endspecify" "endtable" "endtask" "event"
5022     "for" "force" "forever" "fork" "function"
5023     "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large"
5024     "macromodule" "makefile" "medium" "module"
5025     "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output"
5026     "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown"
5027     "pullup"
5028     "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran"
5029     "rtranif0" "rtranif1"
5030     "scalared" "signed" "small" "specify" "specparam" "strength" "strong0"
5031     "strong1" "supply" "supply0" "supply1"
5032     "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1"
5033     "triand" "trior" "trireg"
5034     "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor"
5035     )
5036   "List of Verilog keywords as candidate for additional reserved words.")
5037
5038 (defconst vhdl-02-types
5039   '(
5040     "boolean" "bit" "bit_vector" "character" "severity_level" "integer"
5041     "real" "time" "natural" "positive" "string" "line" "text" "side"
5042     "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status"
5043     "std_logic" "std_logic_vector"
5044     "std_ulogic" "std_ulogic_vector"
5045     )
5046   "List of VHDL'02 standardized types.")
5047
5048 (defconst vhdl-08-types
5049   '(
5050     "boolean_vector" "integer_vector" "real_vector" "time_vector"
5051     )
5052   "List of VHDL'08 standardized types.")
5053
5054 (defconst vhdl-ams-types
5055   ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004
5056   '(
5057     ;; package `standard'
5058     "domain_type" "real_vector"
5059     ;; package `energy_systems'
5060     "energy" "power" "periodicity" "real_across" "real_through" "unspecified"
5061     "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector"
5062     "real_across_vector" "real_through_vector"
5063     ;; package `electrical_systems'
5064     "voltage" "current" "charge" "resistance" "conductance" "capacitance"
5065     "mmf" "electric_flux" "electric_flux_density" "electric_field_strength"
5066     "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength"
5067     "inductance" "reluctance" "electrical" "electrical_vector" "magnetic"
5068     "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector"
5069     "magnetic_flux_vector" "charge_vector" "resistance_vector"
5070     "conductance_vector" "capacitance_vector" "electric_flux_vector"
5071     "electric_flux_density_vector" "electric_field_strength_vector"
5072     "magnetic_flux_density_vector" "magnetic_field_strength_vector"
5073     "inductance_vector" "reluctance_vector" "ground"
5074     ;; package `mechanical_systems'
5075     "displacement" "force" "velocity" "acceleration" "mass" "stiffness"
5076     "damping" "momentum" "angle" "torque" "angular_velocity"
5077     "angular_acceleration" "moment_inertia" "angular_momentum"
5078     "angular_stiffness" "angular_damping" "translational"
5079     "translational_vector" "translational_velocity"
5080     "translational_velocity_vector" "rotational" "rotational_vector"
5081     "rotational_velocity" "rotational_velocity_vector" "displacement_vector"
5082     "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector"
5083     "torque_vector" "angular_velocity_vector" "torque_velocity_vector"
5084     "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector"
5085     "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector"
5086     "angular_momentum_vector" "angular_stiffness_vector"
5087     "angular_damping_vector" "anchor" "translational_v_ref"
5088     "rotational_v_ref" "translational_v" "rotational_v"
5089     ;; package `radiant_systems'
5090     "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant"
5091     "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector"
5092     "illuminance_vector" "irradiance_vector"
5093     ;; package `thermal_systems'
5094     "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance"
5095     "thermal_conductance" "thermal" "thermal_vector" "temperature_vector"
5096     "heat_flow_vector" "thermal_capacitance_vector"
5097     "thermal_resistance_vector" "thermal_conductance_vector"
5098     ;; package `fluidic_systems'
5099     "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity"
5100     "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance"
5101     "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector"
5102     "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector"
5103     "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector"
5104     "density_vector" "viscosity_vector" "fresistance_vector"
5105     "fconductance_vector" "fcapacitance_vector" "inertance_vector"
5106     "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector"
5107     "cfinertance_vector"
5108     )
5109   "List of VHDL-AMS standardized types.")
5110
5111 (defconst vhdl-math-types
5112   '(
5113     "complex" "complex_polar" "positive_real" "principal_value"
5114     )
5115   "List of Math Packages standardized types.")
5116
5117 (defconst vhdl-02-attributes
5118   '(
5119     "base" "left" "right" "high" "low" "pos" "val" "succ"
5120     "pred" "leftof" "rightof" "range" "reverse_range"
5121     "length" "delayed" "stable" "quiet" "transaction"
5122     "event" "active" "last_event" "last_active" "last_value"
5123     "driving" "driving_value" "ascending" "value" "image"
5124     "simple_name" "instance_name" "path_name"
5125     "foreign"
5126     )
5127   "List of VHDL'02 standardized attributes.")
5128
5129 (defconst vhdl-08-attributes
5130   '(
5131     "instance_name" "path_name"
5132     )
5133   "List of VHDL'08 standardized attributes.")
5134
5135 (defconst vhdl-ams-attributes
5136   '(
5137     "across" "through"
5138     "reference" "contribution" "tolerance"
5139     "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf"
5140     "ramp" "slew"
5141     )
5142   "List of VHDL-AMS standardized attributes.")
5143
5144 (defconst vhdl-02-enum-values
5145   '(
5146     "true" "false"
5147     "note" "warning" "error" "failure"
5148     "read_mode" "write_mode" "append_mode"
5149     "open_ok" "status_error" "name_error" "mode_error"
5150     "fs" "ps" "ns" "us" "ms" "sec" "min" "hr"
5151     "right" "left"
5152     )
5153   "List of VHDL'02 standardized enumeration values.")
5154
5155 (defconst vhdl-ams-enum-values
5156   '(
5157     "quiescent_domain" "time_domain" "frequency_domain"
5158     ;; from `nature_pkg' package
5159     "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
5160     )
5161   "List of VHDL-AMS standardized enumeration values.")
5162
5163 (defconst vhdl-ams-constants
5164   ;; standard: IEEE Std 1076.1.1-2004
5165   '(
5166     ;; package `fundamental_constants'
5167     "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok"
5168     "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto"
5169     "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega"
5170     "giga" "tera" "peta" "exa" "zetta" "yotta" "deca"
5171     ;; package `material_constants'
5172     "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly"
5173     "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2"
5174     "ambient_temperature" "ambient_pressure" "ambient_illuminance"
5175     )
5176   "List of VHDL-AMS standardized constants.")
5177
5178 (defconst vhdl-math-constants
5179   ;; standard: IEEE Std 1076.2-1996
5180   '(
5181     "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi"
5182     "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero"
5183     "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e"
5184     "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2"
5185     "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2"
5186     "math_sqrt_pi"
5187     )
5188   "List of Math Packages standardized constants.")
5189
5190 (defconst vhdl-02-functions
5191   '(
5192     "now" "resolved" "rising_edge" "falling_edge"
5193     "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite"
5194     "endfile"
5195     "resize" "is_X" "std_match"
5196     "shift_left" "shift_right" "rotate_left" "rotate_right"
5197     "to_unsigned" "to_signed" "to_integer"
5198     "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector"
5199     "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
5200     "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
5201     "shl" "shr" "ext" "sxt"
5202     "deallocate"
5203     )
5204   "List of VHDL'02 standardized functions.")
5205
5206 (defconst vhdl-08-functions
5207   '(
5208     "finish" "flush" "justify" "maximum" "minimum"
5209     "resolution_limit" "rising_edge" "stop" "swrite"
5210     "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring"
5211     "to_octalstring" "to_ostring" "to_string"
5212     )
5213   "List of VHDL'08 standardized functions.")
5214
5215 (defconst vhdl-ams-functions
5216   '(
5217     ;; package `standard'
5218     "frequency"
5219     )
5220   "List of VHDL-AMS standardized functions.")
5221
5222 (defconst vhdl-math-functions
5223   ;; standard: IEEE Std 1076.2-1996
5224   '(
5225     "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg"
5226     "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp"
5227     "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex"
5228     "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt"
5229     "tan" "tanh" "trunc" "uniform"
5230     )
5231   "List of Math Packages standardized functions.")
5232
5233 (defconst vhdl-02-packages
5234   '(
5235     "std_logic_1164" "numeric_std" "numeric_bit"
5236     "standard" "textio"
5237     "std_logic_arith" "std_logic_signed" "std_logic_unsigned"
5238     "std_logic_misc" "std_logic_textio"
5239     "ieee" "std" "work"
5240     )
5241   "List of VHDL'02 standardized packages and libraries.")
5242
5243 (defconst vhdl-08-packages
5244   '(
5245     "env" "numeric_std_signed" "numeric_std_unsigned"
5246     "ieee_bit_context" "ieee_std_context"  ;; contexts
5247     )
5248   "List of VHDL'08 standardized packages and libraries.")
5249
5250 (defconst vhdl-ams-packages
5251   '(
5252     "fundamental_constants" "material_constants" "energy_systems"
5253     "electrical_systems" "mechanical_systems" "radiant_systems"
5254     "thermal_systems" "fluidic_systems"
5255     )
5256   "List of VHDL-AMS standardized packages and libraries.")
5257
5258 (defconst vhdl-math-packages
5259   '(
5260     "math_real" "math_complex"
5261     )
5262   "List of Math Packages standardized packages and libraries.")
5263
5264 (defconst vhdl-08-directives
5265   '(
5266     "author" "author_info" "begin" "begin_protected" "comment"
5267     "data_block" "data_keyname" "data_keyowner" "data_method"
5268     "decrypt_license" "digest_block" "digest_key_method" "digest_keyname"
5269     "digest_keyowner" "digest_method"
5270     "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected"
5271     "key_block" "key_keyname" "key_keyowner" "key_method"
5272     "runtime_license" "viewport"
5273     )
5274   "List of VHDL'08 standardized tool directives.")
5275
5276 (defvar vhdl-keywords nil
5277   "List of VHDL keywords.")
5278
5279 (defvar vhdl-types nil
5280   "List of VHDL standardized types.")
5281
5282 (defvar vhdl-attributes nil
5283   "List of VHDL standardized attributes.")
5284
5285 (defvar vhdl-enum-values nil
5286   "List of VHDL standardized enumeration values.")
5287
5288 (defvar vhdl-constants nil
5289   "List of VHDL standardized constants.")
5290
5291 (defvar vhdl-functions nil
5292   "List of VHDL standardized functions.")
5293
5294 (defvar vhdl-packages nil
5295   "List of VHDL standardized packages and libraries.")
5296
5297 (defvar vhdl-directives nil
5298   "List of VHDL standardized packages and libraries.")
5299
5300 (defvar vhdl-reserved-words nil
5301   "List of additional reserved words.")
5302
5303 (defvar vhdl-keywords-regexp nil
5304   "Regexp for VHDL keywords.")
5305
5306 (defvar vhdl-types-regexp nil
5307   "Regexp for VHDL standardized types.")
5308
5309 (defvar vhdl-attributes-regexp nil
5310   "Regexp for VHDL standardized attributes.")
5311
5312 (defvar vhdl-enum-values-regexp nil
5313   "Regexp for VHDL standardized enumeration values.")
5314
5315 (defvar vhdl-constants-regexp nil
5316   "Regexp for VHDL standardized constants.")
5317
5318 (defvar vhdl-functions-regexp nil
5319   "Regexp for VHDL standardized functions.")
5320
5321 (defvar vhdl-packages-regexp nil
5322   "Regexp for VHDL standardized packages and libraries.")
5323
5324 (defvar vhdl-reserved-words-regexp nil
5325   "Regexp for additional reserved words.")
5326
5327 (defvar vhdl-directive-keywords-regexp nil
5328   "Regexp for compiler directive keywords.")
5329
5330 (defun vhdl-upcase-list (condition list)
5331   "Upcase all elements in LIST based on CONDITION."
5332   (when condition
5333     (let ((tmp-list list))
5334       (while tmp-list
5335         (setcar tmp-list (upcase (car tmp-list)))
5336         (setq tmp-list (cdr tmp-list)))))
5337   list)
5338
5339 (defun vhdl-words-init ()
5340   "Initialize reserved words."
5341   (setq vhdl-keywords
5342         (vhdl-upcase-list
5343          (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords)
5344          (append vhdl-02-keywords
5345                  (when (vhdl-standard-p '08) vhdl-08-keywords)
5346                  (when (vhdl-standard-p 'ams) vhdl-ams-keywords))))
5347   (setq vhdl-types
5348         (vhdl-upcase-list
5349          (and vhdl-highlight-case-sensitive vhdl-upper-case-types)
5350          (append vhdl-02-types
5351                  (when (vhdl-standard-p '08) vhdl-08-types)
5352                  (when (vhdl-standard-p 'ams) vhdl-ams-types)
5353                  (when (vhdl-standard-p 'math) vhdl-math-types))))
5354   (setq vhdl-attributes
5355         (vhdl-upcase-list
5356          (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes)
5357          (append vhdl-02-attributes
5358                  (when (vhdl-standard-p '08) vhdl-08-attributes)
5359                  (when (vhdl-standard-p 'ams) vhdl-ams-attributes))))
5360   (setq vhdl-enum-values
5361         (vhdl-upcase-list
5362          (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values)
5363          (append vhdl-02-enum-values
5364                  (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))))
5365   (setq vhdl-constants
5366         (vhdl-upcase-list
5367          (and vhdl-highlight-case-sensitive vhdl-upper-case-constants)
5368          (append (when (vhdl-standard-p 'ams) vhdl-ams-constants)
5369                  (when (vhdl-standard-p 'math) vhdl-math-constants)
5370                  '(""))))
5371   (setq vhdl-functions
5372         (append vhdl-02-functions
5373                 (when (vhdl-standard-p '08) vhdl-08-functions)
5374                 (when (vhdl-standard-p 'ams) vhdl-ams-functions)
5375                 (when (vhdl-standard-p 'math) vhdl-math-functions)))
5376   (setq vhdl-packages
5377         (append vhdl-02-packages
5378                 (when (vhdl-standard-p '08) vhdl-08-packages)
5379                 (when (vhdl-standard-p 'ams) vhdl-ams-packages)
5380                 (when (vhdl-standard-p 'math) vhdl-math-packages)))
5381   (setq vhdl-directives
5382         (append (when (vhdl-standard-p '08) vhdl-08-directives)))
5383   (setq vhdl-reserved-words
5384         (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
5385                 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords)
5386                 '("")))
5387   (setq vhdl-keywords-regexp
5388         (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>"))
5389   (setq vhdl-types-regexp
5390         (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>"))
5391   (setq vhdl-attributes-regexp
5392         (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>"))
5393   (setq vhdl-enum-values-regexp
5394         (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>"))
5395   (setq vhdl-constants-regexp
5396         (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>"))
5397   (setq vhdl-functions-regexp
5398         (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>"))
5399   (setq vhdl-packages-regexp
5400         (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>"))
5401   (setq vhdl-reserved-words-regexp
5402         (concat "\\<\\("
5403                 (unless (equal vhdl-forbidden-syntax "")
5404                   (concat vhdl-forbidden-syntax "\\|"))
5405                 (regexp-opt vhdl-reserved-words)
5406                 "\\)\\>"))
5407   (setq vhdl-directive-keywords-regexp
5408         (concat "\\<\\(" (mapconcat 'regexp-quote
5409                                     vhdl-directive-keywords "\\|") "\\)\\>"))
5410   (vhdl-abbrev-list-init))
5411
5412 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5413 ;; Words to expand
5414
5415 (defvar vhdl-abbrev-list nil
5416   "Predefined abbreviations for VHDL.")
5417
5418 (defun vhdl-abbrev-list-init ()
5419   (setq vhdl-abbrev-list
5420         (append
5421          (list vhdl-upper-case-keywords) vhdl-keywords
5422          (list vhdl-upper-case-types) vhdl-types
5423          (list vhdl-upper-case-attributes) vhdl-attributes
5424          (list vhdl-upper-case-enum-values) vhdl-enum-values
5425          (list vhdl-upper-case-constants) vhdl-constants
5426          (list nil) vhdl-functions
5427          (list nil) vhdl-packages
5428          (list nil) vhdl-directives)))
5429
5430 ;; initialize reserved words for VHDL Mode
5431 (vhdl-words-init)
5432
5433
5434 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5435 ;;; Indentation
5436 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5437
5438 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5439 ;; Syntax analysis
5440
5441 ;; constant regular expressions for looking at various constructs
5442
5443 (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+"
5444   "Regexp describing a VHDL symbol.
5445 We cannot use just `word' syntax class since `_' cannot be in word
5446 class.  Putting underscore in word class breaks forward word movement
5447 behavior that users are familiar with.")
5448
5449 (defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is"
5450   "Regexp describing a case statement header key.")
5451
5452 (defconst vhdl-label-key
5453   (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]")
5454   "Regexp describing a VHDL label.")
5455
5456 ;; Macro definitions:
5457
5458 (defmacro vhdl-point (position)
5459   "Return the value of point at certain commonly referenced POSITIONs.
5460 POSITION can be one of the following symbols:
5461
5462 bol  -- beginning of line
5463 eol  -- end of line
5464 bod  -- beginning of defun
5465 boi  -- back to indentation
5466 eoi  -- last whitespace on line
5467 ionl -- indentation of next line
5468 iopl -- indentation of previous line
5469 bonl -- beginning of next line
5470 bopl -- beginning of previous line
5471
5472 This function does not modify point or mark."
5473   (or (and (eq 'quote (car-safe position))
5474            (null (cddr position)))
5475       (error "ERROR:  Bad buffer position requested: %s" position))
5476   (setq position (nth 1 position))
5477   `(let ((here (point)))
5478      ,@(cond
5479         ((eq position 'bol)  '((beginning-of-line)))
5480         ((eq position 'eol)  '((end-of-line)))
5481         ((eq position 'bod)  '((save-match-data
5482                                  (vhdl-beginning-of-defun))))
5483         ((eq position 'boi)  '((back-to-indentation)))
5484         ((eq position 'eoi)  '((end-of-line) (skip-chars-backward " \t")))
5485         ((eq position 'bonl) '((forward-line 1)))
5486         ((eq position 'bopl) '((forward-line -1)))
5487         ((eq position 'iopl)
5488          '((forward-line -1)
5489            (back-to-indentation)))
5490         ((eq position 'ionl)
5491          '((forward-line 1)
5492            (back-to-indentation)))
5493         (t (error "ERROR:  Unknown buffer position requested: %s" position))
5494         )
5495      (prog1
5496          (point)
5497        (goto-char here))
5498      ;; workaround for an Emacs18 bug -- blech! Well, at least it
5499      ;; doesn't hurt for v19
5500      ,@nil
5501      ))
5502
5503 (defmacro vhdl-safe (&rest body)
5504   "Safely execute BODY, return nil if an error occurred."
5505   `(condition-case nil
5506        (progn ,@body)
5507      (error nil)))
5508
5509 (defmacro vhdl-add-syntax (symbol &optional relpos)
5510   "A simple macro to append the syntax in SYMBOL to the syntax list.
5511 Try to increase performance by using this macro."
5512   `(setq vhdl-syntactic-context
5513          (cons (cons ,symbol ,relpos) vhdl-syntactic-context)))
5514
5515 (defmacro vhdl-has-syntax (symbol)
5516   "A simple macro to return check the syntax list.
5517 Try to increase performance by using this macro."
5518   `(assoc ,symbol vhdl-syntactic-context))
5519
5520 ;; Syntactic element offset manipulation:
5521
5522 (defun vhdl-read-offset (langelem)
5523   "Read new offset value for LANGELEM from minibuffer.
5524 Return a valid value only."
5525   (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist))))
5526         (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ")
5527         (prompt "Offset: ")
5528         offset input interned)
5529     (while (not offset)
5530       (setq input (read-string prompt oldoff)
5531             offset (cond ((string-equal "+" input) '+)
5532                          ((string-equal "-" input) '-)
5533                          ((string-equal "++" input) '++)
5534                          ((string-equal "--" input) '--)
5535                          ((string-match "^-?[0-9]+$" input)
5536                           (string-to-number input))
5537                          ((fboundp (setq interned (intern input)))
5538                           interned)
5539                          ((boundp interned) interned)
5540                          ;; error, but don't signal one, keep trying
5541                          ;; to read an input value
5542                          (t (ding)
5543                             (setq prompt errmsg)
5544                             nil))))
5545     offset))
5546
5547 (defun vhdl-set-offset (symbol offset &optional add-p)
5548   "Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
5549 SYMBOL is the syntactic element symbol to change and OFFSET is the new
5550 offset for that syntactic element.  Optional ADD-P says to add SYMBOL to
5551 `vhdl-offsets-alist' if it doesn't already appear there."
5552   (interactive
5553    (let* ((langelem
5554            (intern (completing-read
5555                     (concat "Syntactic symbol to change"
5556                             (if current-prefix-arg " or add" "")
5557                             ": ")
5558                     (mapcar
5559                      (function
5560                       (lambda (langelem)
5561                         (cons (format "%s" (car langelem)) nil)))
5562                      vhdl-offsets-alist)
5563                     nil (not current-prefix-arg)
5564                     ;; initial contents tries to be the last element
5565                     ;; on the syntactic analysis list for the current
5566                     ;; line
5567                     (let* ((syntax (vhdl-get-syntactic-context))
5568                            (len (length syntax))
5569                            (ic (format "%s" (car (nth (1- len) syntax)))))
5570                       ic)
5571                     )))
5572           (offset (vhdl-read-offset langelem)))
5573      (list langelem offset current-prefix-arg)))
5574   ;; sanity check offset
5575   (or (eq offset '+)
5576       (eq offset '-)
5577       (eq offset '++)
5578       (eq offset '--)
5579       (integerp offset)
5580       (fboundp offset)
5581       (boundp offset)
5582       (error "ERROR:  Offset must be int, func, var, or one of +, -, ++, --: %s"
5583              offset))
5584   (let ((entry (assq symbol vhdl-offsets-alist)))
5585     (if entry
5586         (setcdr entry offset)
5587       (if add-p
5588           (setq vhdl-offsets-alist
5589                 (cons (cons symbol offset) vhdl-offsets-alist))
5590         (error "ERROR:  %s is not a valid syntactic symbol" symbol))))
5591   (vhdl-keep-region-active))
5592
5593 (defun vhdl-set-style (style &optional local)
5594   "Set `vhdl-mode' variables to use one of several different indentation styles.
5595 STYLE is a string representing the desired style and optional LOCAL is
5596 a flag which, if non-nil, means to make the style variables being
5597 changed buffer local, instead of the default, which is to set the
5598 global variables.  Interactively, the flag comes from the prefix
5599 argument.  The styles are chosen from the `vhdl-style-alist' variable."
5600   (interactive (list (completing-read "Use which VHDL indentation style? "
5601                                       vhdl-style-alist nil t)
5602                      current-prefix-arg))
5603   (let ((vars (cdr (assoc style vhdl-style-alist))))
5604     (or vars
5605         (error "ERROR:  Invalid VHDL indentation style `%s'" style))
5606     ;; set all the variables
5607     (mapc
5608      (function
5609       (lambda (varentry)
5610         (let ((var (car varentry))
5611               (val (cdr varentry)))
5612           ;; special case for vhdl-offsets-alist
5613           (if (not (eq var 'vhdl-offsets-alist))
5614               (set (if local (make-local-variable var) var) val)
5615             ;; reset vhdl-offsets-alist to the default value first
5616             (set (if local (make-local-variable var) var)
5617                  (copy-alist vhdl-offsets-alist-default))
5618             ;; now set the langelems that are different
5619             (mapcar
5620              (function
5621               (lambda (langentry)
5622                 (let ((langelem (car langentry))
5623                       (offset (cdr langentry)))
5624                   (vhdl-set-offset langelem offset)
5625                   )))
5626              val))
5627           )))
5628      vars))
5629   (vhdl-keep-region-active))
5630
5631 (defun vhdl-get-offset (langelem)
5632   "Get offset from LANGELEM which is a cons cell of the form:
5633 \(SYMBOL . RELPOS).  The symbol is matched against
5634 vhdl-offsets-alist and the offset found there is either returned,
5635 or added to the indentation at RELPOS.  If RELPOS is nil, then
5636 the offset is simply returned."
5637   (let* ((symbol (car langelem))
5638          (relpos (cdr langelem))
5639          (match  (assq symbol vhdl-offsets-alist))
5640          (offset (cdr-safe match)))
5641     ;; offset can be a number, a function, a variable, or one of the
5642     ;; symbols + or -
5643     (cond
5644      ((not match)
5645       (if vhdl-strict-syntax-p
5646           (error "ERROR:  Don't know how to indent a %s" symbol)
5647         (setq offset 0
5648               relpos 0)))
5649      ((eq offset '+)  (setq offset vhdl-basic-offset))
5650      ((eq offset '-)  (setq offset (- vhdl-basic-offset)))
5651      ((eq offset '++) (setq offset (* 2 vhdl-basic-offset)))
5652      ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset))))
5653      ((and (not (numberp offset))
5654            (fboundp offset))
5655       (setq offset (funcall offset langelem)))
5656      ((not (numberp offset))
5657       (setq offset (eval offset)))
5658      )
5659     (+ (if (and relpos
5660                 (< relpos (vhdl-point 'bol)))
5661            (save-excursion
5662              (goto-char relpos)
5663              (current-column))
5664          0)
5665        offset)))
5666
5667 ;; Syntactic support functions:
5668
5669 (defun vhdl-in-comment-p (&optional pos)
5670   "Check if point is in a comment (include multi-line comments)."
5671   (let ((parse (lambda (p)
5672                  (let ((c (char-after p)))
5673                    (or (and c (eq (char-syntax c) ?<))
5674                        (nth 4 (parse-partial-sexp
5675                                (save-excursion
5676                                  (beginning-of-defun)
5677                                  (point)) p)))))))
5678     (save-excursion
5679       (goto-char (or pos (point)))
5680       (or (funcall parse (point))
5681           ;; `parse-partial-sexp's notion of comments doesn't span lines
5682           (progn
5683             (back-to-indentation)
5684             (unless (eolp)
5685               (forward-char)
5686               (funcall parse (point))))))))
5687
5688 (defun vhdl-in-string-p ()
5689   "Check if point is in a string."
5690   (eq (vhdl-in-literal) 'string))
5691
5692 (defun vhdl-in-quote-p ()
5693   "Check if point is in a quote ('x')."
5694   (or (and (> (point) (point-min))
5695            (< (1+ (point)) (point-max))
5696            (= (char-before (point)) ?\')
5697            (= (char-after (1+ (point))) ?\'))
5698       (and (> (1- (point)) (point-min))
5699            (< (point) (point-max))
5700            (= (char-before (1- (point))) ?\')
5701            (= (char-after (point)) ?\'))))
5702
5703 (defun vhdl-in-literal ()
5704   "Determine if point is in a VHDL literal."
5705   (save-excursion
5706     (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
5707       (cond
5708        ((nth 3 state) 'string)
5709        ((nth 4 state) 'comment)
5710        ((vhdl-beginning-of-macro) 'pound)
5711        ((vhdl-beginning-of-directive) 'directive)
5712        ;; for multi-line comments
5713        ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment)
5714        (t nil)))))
5715
5716 (defun vhdl-in-extended-identifier-p ()
5717   "Determine if point is inside extended identifier (delimited by `\\')."
5718   (save-match-data
5719     (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t))
5720          (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t)))))
5721
5722 (defun vhdl-forward-comment (&optional direction)
5723   "Skip all comments (including whitespace).  Skip backwards if DIRECTION is
5724 negative, skip forward otherwise."
5725   (interactive "p")
5726   (if (and direction (< direction 0))
5727       ;; skip backwards
5728       (progn
5729         (skip-chars-backward " \t\n\r\f")
5730         (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5731           (goto-char (match-beginning 3))
5732           (skip-chars-backward " \t\n\r\f")))
5733     ;; skip forwards
5734     (skip-chars-forward " \t\n\r\f")
5735     (while (looking-at "--.*")
5736       (goto-char (match-end 0))
5737       (skip-chars-forward " \t\n\r\f"))))
5738
5739 ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5740 (unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
5741   (defalias 'vhdl-forward-comment 'forward-comment))
5742
5743 (defun vhdl-back-to-indentation ()
5744   "Move point to the first non-whitespace character on this line."
5745   (interactive)
5746   (beginning-of-line 1)
5747   (skip-syntax-forward " " (vhdl-point 'eol)))
5748
5749 ;; XEmacs hack: work around old `back-to-indentation' in XEmacs
5750 (when (featurep 'xemacs)
5751   (defalias 'back-to-indentation 'vhdl-back-to-indentation))
5752
5753 ;; This is the best we can do in Win-Emacs.
5754 (defun vhdl-win-il (&optional lim)
5755   "Determine if point is in a VHDL literal."
5756   (save-excursion
5757     (let* ((here (point))
5758            (state nil)
5759            (match nil)
5760            (lim  (or lim (vhdl-point 'bod))))
5761       (goto-char lim )
5762       (while (< (point) here)
5763         (setq match
5764               (and (re-search-forward "--\\|[\"']\\|`"
5765                                       here 'move)
5766                    (buffer-substring (match-beginning 0) (match-end 0))))
5767         (setq state
5768               (cond
5769                ;; no match
5770                ((null match) nil)
5771                ;; looking at the opening of a VHDL style comment
5772                ((string= "--" match)
5773                 (if (<= here (progn (end-of-line) (point))) 'comment))
5774                ;; looking at a directive
5775                ((string= "`" match)
5776                 (if (<= here (progn (end-of-line) (point))) 'directive))
5777                ;; looking at the opening of a double quote string
5778                ((string= "\"" match)
5779                 (if (not (save-restriction
5780                            ;; this seems to be necessary since the
5781                            ;; re-search-forward will not work without it
5782                            (narrow-to-region (point) here)
5783                            (re-search-forward
5784                             ;; this regexp matches a double quote
5785                             ;; which is preceded by an even number
5786                             ;; of backslashes, including zero
5787                             "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move)))
5788                     'string))
5789                ;; looking at the opening of a single quote string
5790                ((string= "'" match)
5791                 (if (not (save-restriction
5792                            ;; see comments from above
5793                            (narrow-to-region (point) here)
5794                            (re-search-forward
5795                             ;; this matches a single quote which is
5796                             ;; preceded by zero or two backslashes.
5797                             "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'"
5798                             here 'move)))
5799                     'string))
5800                (t nil)))
5801         ) ; end-while
5802       state)))
5803
5804 (and (string-match "Win-Emacs" emacs-version)
5805      (fset 'vhdl-in-literal 'vhdl-win-il))
5806
5807 ;; Skipping of "syntactic whitespace".  Syntactic whitespace is
5808 ;; defined as lexical whitespace or comments.  Search no farther back
5809 ;; or forward than optional LIM.  If LIM is omitted, (point-min) is
5810 ;; used for backward skipping, (point-max) is used for forward
5811 ;; skipping.
5812
5813 (defun vhdl-forward-syntactic-ws (&optional lim)
5814   "Forward skip of syntactic whitespace."
5815   (let* ((here (point-max))
5816          (hugenum (point-max)))
5817     (while (/= here (point))
5818       (setq here (point))
5819       (vhdl-forward-comment hugenum)
5820       ;; skip preprocessor directives
5821       (when (and (or (eq (char-after) ?#) (eq (char-after) ?`))
5822                  (= (vhdl-point 'boi) (point)))
5823         (while (and (eq (char-before (vhdl-point 'eol)) ?\\)
5824                     (= (forward-line 1) 0)))
5825         (end-of-line)))
5826     (if lim (goto-char (min (point) lim)))))
5827
5828
5829 ;; This is the best we can do in Win-Emacs.
5830 (defun vhdl-win-fsws (&optional lim)
5831   "Forward skip syntactic whitespace for Win-Emacs."
5832   (let ((lim (or lim (point-max)))
5833         stop)
5834     (while (not stop)
5835       (skip-chars-forward " \t\n\r\f" lim)
5836       (cond
5837        ;; vhdl comment
5838        ((looking-at "--") (end-of-line))
5839        ;; none of the above
5840        (t (setq stop t))))))
5841
5842 (and (string-match "Win-Emacs" emacs-version)
5843      (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
5844
5845 (defun vhdl-beginning-of-macro (&optional lim)
5846   "Go to the beginning of a cpp macro definition (nicked from `cc-engine')."
5847   (let ((here (point)))
5848     (beginning-of-line)
5849     (while (eq (char-before (1- (point))) ?\\)
5850       (forward-line -1))
5851     (back-to-indentation)
5852     (if (and (<= (point) here)
5853              (eq (char-after) ?#))
5854         t
5855       (goto-char here)
5856       nil)))
5857
5858 (defun vhdl-beginning-of-directive (&optional lim)
5859   "Go to the beginning of a directive (nicked from `cc-engine')."
5860   (let ((here (point)))
5861     (beginning-of-line)
5862     (while (eq (char-before (1- (point))) ?\\)
5863       (forward-line -1))
5864     (back-to-indentation)
5865     (if (and (<= (point) here)
5866              (eq (char-after) ?`))
5867         t
5868       (goto-char here)
5869       nil)))
5870
5871 (defun vhdl-backward-syntactic-ws (&optional lim)
5872   "Backward skip over syntactic whitespace."
5873   (let* ((here (point-min))
5874          (hugenum (- (point-max))))
5875     (while (/= here (point))
5876       (setq here (point))
5877       (vhdl-forward-comment hugenum)
5878       (vhdl-beginning-of-macro))
5879     (if lim (goto-char (max (point) lim)))))
5880
5881 ;; This is the best we can do in Win-Emacs.
5882 (defun vhdl-win-bsws (&optional lim)
5883   "Backward skip syntactic whitespace for Win-Emacs."
5884   (let ((lim (or lim (vhdl-point 'bod)))
5885         stop)
5886     (while (not stop)
5887       (skip-chars-backward " \t\n\r\f" lim)
5888       (cond
5889        ;; vhdl comment
5890        ((eq (vhdl-in-literal) 'comment)
5891         (skip-chars-backward "^-" lim)
5892         (skip-chars-backward "-" lim)
5893         (while (not (or (and (= (following-char) ?-)
5894                              (= (char-after (1+ (point))) ?-))
5895                         (<= (point) lim)))
5896           (skip-chars-backward "^-" lim)
5897           (skip-chars-backward "-" lim)))
5898        ;; none of the above
5899        (t (setq stop t))))))
5900
5901 (and (string-match "Win-Emacs" emacs-version)
5902     (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
5903
5904 ;; Functions to help finding the correct indentation column:
5905
5906 (defun vhdl-first-word (point)
5907   "If the keyword at POINT is at boi, then return (current-column) at
5908 that point, else nil."
5909   (save-excursion
5910     (and (goto-char point)
5911          (eq (point) (vhdl-point 'boi))
5912          (current-column))))
5913
5914 (defun vhdl-last-word (point)
5915   "If the keyword at POINT is at eoi, then return (current-column) at
5916 that point, else nil."
5917   (save-excursion
5918     (and (goto-char point)
5919          (save-excursion (or (eq (progn (forward-sexp) (point))
5920                                  (vhdl-point 'eoi))
5921                              (looking-at "\\s-*\\(--\\)?")))
5922          (current-column))))
5923
5924 ;; Core syntactic evaluation functions:
5925
5926 (defconst vhdl-libunit-re
5927   "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]")
5928
5929 (defun vhdl-libunit-p ()
5930   (and
5931    (save-excursion
5932      (forward-sexp)
5933      (skip-chars-forward " \t\n\r\f")
5934      (not (looking-at "is\\b[^_]")))
5935    (save-excursion
5936      (backward-sexp)
5937      (and (not (looking-at "use\\b[^_]"))
5938           (progn
5939             (forward-sexp)
5940             (vhdl-forward-syntactic-ws)
5941             (/= (following-char) ?:))))
5942    ))
5943
5944 (defconst vhdl-defun-re
5945   "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]")
5946
5947 (defun vhdl-defun-p ()
5948   (save-excursion
5949     (if (looking-at "block\\|process\\|procedural")
5950         ;; "block", "process", "procedural":
5951         (save-excursion
5952           (backward-sexp)
5953           (not (looking-at "end\\s-+\\w")))
5954       ;; "architecture", "configuration", "context", "entity",
5955       ;; "package", "procedure", "function":
5956       t)))
5957
5958 (defun vhdl-corresponding-defun ()
5959   "If the word at the current position corresponds to a \"defun\"
5960 keyword, then return a string that can be used to find the
5961 corresponding \"begin\" keyword, else return nil."
5962   (save-excursion
5963     (and (looking-at vhdl-defun-re)
5964          (vhdl-defun-p)
5965          (if (looking-at "block\\|process\\|procedural")
5966              ;; "block", "process". "procedural:
5967              (buffer-substring (match-beginning 0) (match-end 0))
5968            ;; "architecture", "configuration", "context", "entity", "package",
5969            ;; "procedure", "function":
5970            "is"))))
5971
5972 (defconst vhdl-begin-fwd-re
5973   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)"
5974   "A regular expression for searching forward that matches all known
5975 \"begin\" keywords.")
5976
5977 (defconst vhdl-begin-bwd-re
5978   "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]"
5979   "A regular expression for searching backward that matches all known
5980 \"begin\" keywords.")
5981
5982 (defun vhdl-begin-p (&optional lim)
5983   "Return t if we are looking at a real \"begin\" keyword.
5984 Assumes that the caller will make sure that we are looking at
5985 vhdl-begin-fwd-re, and are not inside a literal, and that we are not in
5986 the middle of an identifier that just happens to contain a \"begin\"
5987 keyword."
5988   (cond
5989    ;; "[architecture|case|configuration|context|entity|package|
5990    ;;   procedure|function] ... is":
5991    ((and (looking-at "i")
5992          (save-excursion
5993            ;; Skip backward over first sexp (needed to skip over a
5994            ;; procedure interface list, and is harmless in other
5995            ;; situations).  Note that we need "return" in the
5996            ;; following search list so that we don't run into
5997            ;; semicolons in the function interface list.
5998            (backward-sexp)
5999            (let (foundp)
6000              (while (and (not foundp)
6001                          (re-search-backward
6002                           ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
6003                           lim 'move))
6004                (if (or (= (preceding-char) ?_)
6005                        (vhdl-in-literal))
6006                    (backward-char)
6007                  (setq foundp t))))
6008            (and (/= (following-char) ?\;)
6009                 (not (looking-at "is\\|begin\\|process\\|procedural\\|block")))))
6010     t)
6011    ;; "begin", "then", "use":
6012    ((looking-at "be\\|t\\|use")
6013     t)
6014    ;; "else":
6015    ((and (looking-at "e")
6016          ;; make sure that the "else" isn't inside a
6017          ;; conditional signal assignment.
6018          (save-excursion
6019            (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6020            (or (eq (following-char) ?\;)
6021                (eq (point) lim))))
6022     t)
6023    ;; "block", "generate", "loop", "process", "procedural",
6024    ;; "units", "record", "protected body":
6025    ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record")
6026          (save-excursion
6027            (backward-sexp)
6028            (not (looking-at "end\\s-+\\w"))))
6029     t)
6030    ;; "component":
6031    ((and (looking-at "c")
6032          (save-excursion
6033            (backward-sexp)
6034            (not (looking-at "end\\s-+\\w")))
6035          ;; look out for the dreaded entity class in an attribute
6036          (save-excursion
6037            (vhdl-backward-syntactic-ws lim)
6038            (/= (preceding-char) ?:)))
6039     t)
6040    ;; "for" (inside configuration declaration):
6041    ((and (looking-at "f")
6042          (save-excursion
6043            (backward-sexp)
6044            (not (looking-at "end\\s-+\\w")))
6045          (vhdl-has-syntax 'configuration))
6046     t)
6047    ))
6048
6049 (defun vhdl-corresponding-mid (&optional lim)
6050   (cond
6051    ((looking-at "is\\|block\\|generate\\|process\\|procedural")
6052     "begin")
6053    ((looking-at "then\\|use")
6054     "<else>")
6055    (t
6056     "end")))
6057
6058 (defun vhdl-corresponding-end (&optional lim)
6059   "If the word at the current position corresponds to a \"begin\"
6060 keyword, then return a vector containing enough information to find
6061 the corresponding \"end\" keyword, else return nil.  The keyword to
6062 search forward for is aref 0.  The column in which the keyword must
6063 appear is aref 1 or nil if any column is suitable.
6064 Assumes that the caller will make sure that we are not in the middle
6065 of an identifier that just happens to contain a \"begin\" keyword."
6066   (save-excursion
6067     (and (looking-at vhdl-begin-fwd-re)
6068          (or (not (looking-at "\\<use\\>"))
6069              (save-excursion (back-to-indentation)
6070                              (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6071          (/= (preceding-char) ?_)
6072          (not (vhdl-in-literal))
6073          (vhdl-begin-p lim)
6074          (cond
6075           ;; "is", "generate", "loop":
6076           ((looking-at "[igl]")
6077            (vector "end"
6078                    (and (vhdl-last-word (point))
6079                         (or (vhdl-first-word (point))
6080                             (save-excursion
6081                               (vhdl-beginning-of-statement-1 lim)
6082                               (vhdl-backward-skip-label lim)
6083                               (vhdl-first-word (point)))))))
6084           ;; "begin", "else", "for":
6085           ((looking-at "be\\|[ef]")
6086            (vector "end"
6087                    (and (vhdl-last-word (point))
6088                         (or (vhdl-first-word (point))
6089                             (save-excursion
6090                               (vhdl-beginning-of-statement-1 lim)
6091                               (vhdl-backward-skip-label lim)
6092                               (vhdl-first-word (point)))))))
6093           ;; "component", "units", "record", "protected body":
6094           ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record")
6095            ;; The first end found will close the block
6096            (vector "end" nil))
6097           ;; "block", "process", "procedural":
6098           ((looking-at "bl\\|p")
6099            (vector "end"
6100                    (or (vhdl-first-word (point))
6101                        (save-excursion
6102                          (vhdl-beginning-of-statement-1 lim)
6103                          (vhdl-backward-skip-label lim)
6104                          (vhdl-first-word (point))))))
6105           ;; "then":
6106           ((looking-at "t\\|use")
6107            (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)"
6108                    (and (vhdl-last-word (point))
6109                         (or (vhdl-first-word (point))
6110                             (save-excursion
6111                               (vhdl-beginning-of-statement-1 lim)
6112                               (vhdl-backward-skip-label lim)
6113                               (vhdl-first-word (point)))))))
6114           ))))
6115
6116 (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)")
6117
6118 (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]")
6119
6120 (defun vhdl-end-p (&optional lim)
6121   "Return t if we are looking at a real \"end\" keyword.
6122 Assumes that the caller will make sure that we are looking at
6123 vhdl-end-fwd-re, and are not inside a literal, and that we are not in
6124 the middle of an identifier that just happens to contain an \"end\"
6125 keyword."
6126   (or (not (looking-at "else"))
6127       ;; make sure that the "else" isn't inside a conditional signal
6128       ;; assignment.
6129       (save-excursion
6130         (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move)
6131         (or (eq (following-char) ?\;)
6132             (eq (point) lim)
6133             (vhdl-in-literal)))))
6134
6135 (defun vhdl-corresponding-begin (&optional lim)
6136   "If the word at the current position corresponds to an \"end\"
6137 keyword, then return a vector containing enough information to find
6138 the corresponding \"begin\" keyword, else return nil.  The keyword to
6139 search backward for is aref 0.  The column in which the keyword must
6140 appear is aref 1 or nil if any column is suitable.  The supplementary
6141 keyword to search forward for is aref 2 or nil if this is not
6142 required.  If aref 3 is t, then the \"begin\" keyword may be found in
6143 the middle of a statement.
6144 Assumes that the caller will make sure that we are not in the middle
6145 of an identifier that just happens to contain an \"end\" keyword."
6146   (save-excursion
6147     (let (pos)
6148       (if (and (looking-at vhdl-end-fwd-re)
6149                (not (vhdl-in-literal))
6150                (vhdl-end-p lim))
6151           (if (looking-at "el")
6152               ;; "else", "elsif":
6153               (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil)
6154             ;; "end ...":
6155             (setq pos (point))
6156             (forward-sexp)
6157             (skip-chars-forward " \t\n\r\f")
6158             (cond
6159              ;; "end if":
6160              ((looking-at "if\\b[^_]")
6161               (vector "else\\|elsif\\|if"
6162                       (vhdl-first-word pos)
6163                       "else\\|then\\|use" nil))
6164              ;; "end component":
6165              ((looking-at "component\\b[^_]")
6166               (vector (buffer-substring (match-beginning 1)
6167                                         (match-end 1))
6168                       (vhdl-first-word pos)
6169                       nil nil))
6170              ;; "end units", "end record", "end protected":
6171              ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]")
6172               (vector (buffer-substring (match-beginning 1)
6173                                         (match-end 1))
6174                       (vhdl-first-word pos)
6175                       nil t))
6176              ;; "end block", "end process", "end procedural":
6177              ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]")
6178               (vector "begin" (vhdl-first-word pos) nil nil))
6179              ;; "end case":
6180              ((looking-at "case\\b[^_]")
6181               (vector "case" (vhdl-first-word pos) "is" nil))
6182              ;; "end generate":
6183              ((looking-at "generate\\b[^_]")
6184               (vector "generate\\|for\\|if"
6185                       (vhdl-first-word pos)
6186                       "generate" nil))
6187              ;; "end loop":
6188              ((looking-at "loop\\b[^_]")
6189               (vector "loop\\|while\\|for"
6190                       (vhdl-first-word pos)
6191                       "loop" nil))
6192              ;; "end for" (inside configuration declaration):
6193              ((looking-at "for\\b[^_]")
6194               (vector "for" (vhdl-first-word pos) nil nil))
6195              ;; "end [id]":
6196              (t
6197               (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function"
6198                       (vhdl-first-word pos)
6199                       ;; return an alist of (statement . keyword) mappings
6200                       '(
6201                         ;; "begin ... end [id]":
6202                         ("begin"          . nil)
6203                         ;; "architecture ... is ... begin ... end [id]":
6204                         ("architecture"   . "is")
6205                         ;; "configuration ... is ... end [id]":
6206                         ("configuration"  . "is")
6207                         ;; "context ... is ... end [id]":
6208                         ("context"        . "is")
6209                         ;; "entity ... is ... end [id]":
6210                         ("entity"         . "is")
6211                         ;; "package ... is ... end [id]":
6212                         ("package"        . "is")
6213                         ;; "procedure ... is ... begin ... end [id]":
6214                         ("procedure"      . "is")
6215                         ;; "function ... is ... begin ... end [id]":
6216                         ("function"       . "is")
6217                         )
6218                       nil))
6219              ))) ; "end ..."
6220       )))
6221
6222 (defconst vhdl-leader-re
6223   "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]")
6224
6225 (defun vhdl-end-of-leader ()
6226   (save-excursion
6227     (cond ((looking-at "block\\|process\\|procedural")
6228            (if (save-excursion
6229                  (forward-sexp)
6230                  (skip-chars-forward " \t\n\r\f")
6231                  (= (following-char) ?\())
6232                (forward-sexp 2)
6233              (forward-sexp))
6234            (when (looking-at "[ \t\n\r\f]*is")
6235              (goto-char (match-end 0)))
6236            (point))
6237           ((looking-at "component")
6238            (forward-sexp 2)
6239            (when (looking-at "[ \t\n\r\f]*is")
6240              (goto-char (match-end 0)))
6241            (point))
6242           ((looking-at "for")
6243            (forward-sexp 2)
6244            (skip-chars-forward " \t\n\r\f")
6245            (while (looking-at "[,:(]")
6246              (forward-sexp)
6247              (skip-chars-forward " \t\n\r\f"))
6248            (point))
6249           (t nil)
6250           )))
6251
6252 (defconst vhdl-trailer-re
6253   "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]")
6254
6255 (defconst vhdl-statement-fwd-re
6256   "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)"
6257   "A regular expression for searching forward that matches all known
6258 \"statement\" keywords.")
6259
6260 (defconst vhdl-statement-bwd-re
6261   "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]"
6262   "A regular expression for searching backward that matches all known
6263 \"statement\" keywords.")
6264
6265 (defun vhdl-statement-p (&optional lim)
6266   "Return t if we are looking at a real \"statement\" keyword.
6267 Assumes that the caller will make sure that we are looking at
6268 vhdl-statement-fwd-re, and are not inside a literal, and that we are not
6269 in the middle of an identifier that just happens to contain a
6270 \"statement\" keyword."
6271   (cond
6272    ;; "for" ... "generate":
6273    ((and (looking-at "f")
6274          ;; Make sure it's the start of a parameter specification.
6275          (save-excursion
6276            (forward-sexp 2)
6277            (skip-chars-forward " \t\n\r\f")
6278            (looking-at "in\\b[^_]"))
6279          ;; Make sure it's not an "end for".
6280          (save-excursion
6281            (backward-sexp)
6282            (not (looking-at "end\\s-+\\w"))))
6283     t)
6284    ;; "if" ... "then", "if" ... "generate", "if" ... "loop":
6285    ((and (looking-at "i")
6286          ;; Make sure it's not an "end if".
6287          (save-excursion
6288            (backward-sexp)
6289            (not (looking-at "end\\s-+\\w"))))
6290     t)
6291    ;; "while" ... "loop":
6292    ((looking-at "w")
6293     t)
6294    ))
6295
6296 (defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>"
6297   "Regexp describing a case statement alternative key.")
6298
6299 (defun vhdl-case-alternative-p (&optional lim)
6300   "Return t if we are looking at a real case alternative.
6301 Assumes that the caller will make sure that we are looking at
6302 vhdl-case-alternative-re, and are not inside a literal, and that
6303 we are not in the middle of an identifier that just happens to
6304 contain a \"when\" keyword."
6305   (save-excursion
6306     (let (foundp)
6307       (while (and (not foundp)
6308                   (re-search-backward ";\\|<=" lim 'move))
6309         (if (or (= (preceding-char) ?_)
6310                 (vhdl-in-literal))
6311             (backward-char)
6312           (setq foundp t)))
6313       (or (eq (following-char) ?\;)
6314           (eq (point) lim)))
6315     ))
6316
6317 ;; Core syntactic movement functions:
6318
6319 (defconst vhdl-b-t-b-re
6320   (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re))
6321
6322 (defun vhdl-backward-to-block (&optional lim)
6323   "Move backward to the previous \"begin\" or \"end\" keyword."
6324   (let (foundp)
6325     (while (and (not foundp)
6326                 (re-search-backward vhdl-b-t-b-re lim 'move))
6327       (if (or (= (preceding-char) ?_)
6328               (vhdl-in-literal))
6329           (backward-char)
6330         (cond
6331          ;; "begin" keyword:
6332          ((and (looking-at vhdl-begin-fwd-re)
6333                (or (not (looking-at "\\<use\\>"))
6334                    (save-excursion (back-to-indentation)
6335                                    (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6336                (/= (preceding-char) ?_)
6337                (vhdl-begin-p lim))
6338           (setq foundp 'begin))
6339          ;; "end" keyword:
6340          ((and (looking-at vhdl-end-fwd-re)
6341                (/= (preceding-char) ?_)
6342                (vhdl-end-p lim))
6343           (setq foundp 'end))
6344          ))
6345       )
6346     foundp
6347     ))
6348
6349 (defun vhdl-forward-sexp (&optional count lim)
6350   "Move forward across one balanced expression (sexp).
6351 With COUNT, do it that many times."
6352   (interactive "p")
6353   (let ((count (or count 1))
6354         (case-fold-search t)
6355         end-vec target)
6356     (save-excursion
6357       (while (> count 0)
6358         ;; skip whitespace
6359         (skip-chars-forward " \t\n\r\f")
6360         ;; Check for an unbalanced "end" keyword
6361         (if (and (looking-at vhdl-end-fwd-re)
6362                  (/= (preceding-char) ?_)
6363                  (not (vhdl-in-literal))
6364                  (vhdl-end-p lim)
6365                  (not (looking-at "else")))
6366             (error
6367              "ERROR:  Containing expression ends prematurely in vhdl-forward-sexp"))
6368         ;; If the current keyword is a "begin" keyword, then find the
6369         ;; corresponding "end" keyword.
6370         (if (setq end-vec (vhdl-corresponding-end lim))
6371             (let (
6372                   ;; end-re is the statement keyword to search for
6373                   (end-re
6374                    (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)"))
6375                   ;; column is either the statement keyword target column
6376                   ;; or nil
6377                   (column (aref end-vec 1))
6378                   (eol (vhdl-point 'eol))
6379                   foundp literal placeholder)
6380               ;; Look for the statement keyword.
6381               (while (and (not foundp)
6382                           (re-search-forward end-re nil t)
6383                           (setq placeholder (match-end 1))
6384                           (goto-char (match-beginning 0)))
6385                 ;; If we are in a literal, or not in the right target
6386                 ;; column and not on the same line as the begin, then
6387                 ;; try again.
6388                 (if (or (and column
6389                              (/= (current-indentation) column)
6390                              (> (point) eol))
6391                         (= (preceding-char) ?_)
6392                         (setq literal (vhdl-in-literal)))
6393                     (if (eq literal 'comment)
6394                         (end-of-line)
6395                       (forward-char))
6396                   ;; An "else" keyword corresponds to both the opening brace
6397                   ;; of the following sexp and the closing brace of the
6398                   ;; previous sexp.
6399                   (if (not (looking-at "else"))
6400                       (goto-char placeholder))
6401                   (setq foundp t))
6402                 )
6403               (if (not foundp)
6404                   (error "ERROR:  Unbalanced keywords in vhdl-forward-sexp"))
6405               )
6406           ;; If the current keyword is not a "begin" keyword, then just
6407           ;; perform the normal forward-sexp.
6408           (forward-sexp)
6409           )
6410         (setq count (1- count))
6411         )
6412       (setq target (point)))
6413     (goto-char target)
6414     nil))
6415
6416 (defun vhdl-backward-sexp (&optional count lim)
6417   "Move backward across one balanced expression (sexp).
6418 With COUNT, do it that many times.  LIM bounds any required backward
6419 searches."
6420   (interactive "p")
6421   (let ((count (or count 1))
6422         (case-fold-search t)
6423         begin-vec target)
6424     (save-excursion
6425       (while (> count 0)
6426         ;; Perform the normal backward-sexp, unless we are looking at
6427         ;; "else" - an "else" keyword corresponds to both the opening brace
6428         ;; of the following sexp and the closing brace of the previous sexp.
6429         (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
6430                  (/= (preceding-char) ?_)
6431                  (not (vhdl-in-literal)))
6432             nil
6433           (backward-sexp)
6434           (if (and (looking-at vhdl-begin-fwd-re)
6435                    (or (not (looking-at "\\<use\\>"))
6436                        (save-excursion
6437                          (back-to-indentation)
6438                          (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6439                    (/= (preceding-char) ?_)
6440                    (not (vhdl-in-literal))
6441                    (vhdl-begin-p lim))
6442               (error "ERROR:  Containing expression ends prematurely in vhdl-backward-sexp")))
6443         ;; If the current keyword is an "end" keyword, then find the
6444         ;; corresponding "begin" keyword.
6445         (if (and (setq begin-vec (vhdl-corresponding-begin lim))
6446                  (/= (preceding-char) ?_))
6447             (let (
6448                   ;; begin-re is the statement keyword to search for
6449                   (begin-re
6450                    (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]"))
6451                   ;; column is either the statement keyword target column
6452                   ;; or nil
6453                   (column (aref begin-vec 1))
6454                   ;; internal-p controls where the statement keyword can
6455                   ;; be found.
6456                   (internal-p (aref begin-vec 3))
6457                   (last-backward (point)) last-forward
6458                   foundp literal keyword)
6459               ;; Look for the statement keyword.
6460               (while (and (not foundp)
6461                           (re-search-backward begin-re lim t)
6462                           (setq keyword
6463                                 (buffer-substring (match-beginning 1)
6464                                                   (match-end 1))))
6465                 ;; If we are in a literal or in the wrong column,
6466                 ;; then try again.
6467                 (if (or (and column
6468                              (and (/= (current-indentation) column)
6469                                   ;; possibly accept current-column as
6470                                   ;; well as current-indentation.
6471                                   (or (not internal-p)
6472                                       (/= (current-column) column))))
6473                         (= (preceding-char) ?_)
6474                         (vhdl-in-literal))
6475                     (backward-char)
6476                   ;; If there is a supplementary keyword, then
6477                   ;; search forward for it.
6478                   (if (and (setq begin-re (aref begin-vec 2))
6479                            (or (not (listp begin-re))
6480                                ;; If begin-re is an alist, then find the
6481                                ;; element corresponding to the actual
6482                                ;; keyword that we found.
6483                                (progn
6484                                  (setq begin-re
6485                                        (assoc keyword begin-re))
6486                                  (and begin-re
6487                                       (setq begin-re (cdr begin-re))))))
6488                       (and
6489                        (setq begin-re
6490                              (concat "\\b\\(" begin-re "\\)\\b[^_]"))
6491                        (save-excursion
6492                          (setq last-forward (point))
6493                          ;; Look for the supplementary keyword
6494                          ;; (bounded by the backward search start
6495                          ;; point).
6496                          (while (and (not foundp)
6497                                      (re-search-forward begin-re
6498                                                         last-backward t)
6499                                      (goto-char (match-beginning 1)))
6500                            ;; If we are in a literal, then try again.
6501                            (if (or (= (preceding-char) ?_)
6502                                    (setq literal
6503                                          (vhdl-in-literal)))
6504                                (if (eq literal 'comment)
6505                                    (goto-char
6506                                     (min (vhdl-point 'eol) last-backward))
6507                                  (forward-char))
6508                              ;; We have found the supplementary keyword.
6509                              ;; Save the position of the keyword in foundp.
6510                              (setq foundp (point)))
6511                            )
6512                          foundp)
6513                        ;; If the supplementary keyword was found, then
6514                        ;; move point to the supplementary keyword.
6515                        (goto-char foundp))
6516                     ;; If there was no supplementary keyword, then
6517                     ;; point is already at the statement keyword.
6518                     (setq foundp t)))
6519                 ) ; end of the search for the statement keyword
6520               (if (not foundp)
6521                   (error "ERROR:  Unbalanced keywords in vhdl-backward-sexp"))
6522               ))
6523         (setq count (1- count))
6524         )
6525       (setq target (point)))
6526     (goto-char target)
6527     nil))
6528
6529 (defun vhdl-backward-up-list (&optional count limit)
6530   "Move backward out of one level of blocks.
6531 With argument, do this that many times."
6532   (interactive "p")
6533   (let ((count (or count 1))
6534         target)
6535     (save-excursion
6536       (while (> count 0)
6537         (if (looking-at vhdl-defun-re)
6538             (error "ERROR:  Unbalanced blocks"))
6539         (vhdl-backward-to-block limit)
6540         (setq count (1- count)))
6541       (setq target (point)))
6542     (goto-char target)))
6543
6544 (defun vhdl-end-of-defun (&optional count)
6545   "Move forward to the end of a VHDL defun."
6546   (interactive)
6547   (let ((case-fold-search t))
6548     (vhdl-beginning-of-defun)
6549     (if (not (looking-at "block\\|process\\|procedural"))
6550         (re-search-forward "\\bis\\b"))
6551     (vhdl-forward-sexp)))
6552
6553 (defun vhdl-mark-defun ()
6554   "Put mark at end of this \"defun\", point at beginning."
6555   (interactive)
6556   (let ((case-fold-search t))
6557     (push-mark)
6558     (vhdl-beginning-of-defun)
6559     (push-mark)
6560     (if (not (looking-at "block\\|process\\|procedural"))
6561         (re-search-forward "\\bis\\b"))
6562     (vhdl-forward-sexp)
6563     (exchange-point-and-mark)))
6564
6565 (defun vhdl-beginning-of-libunit ()
6566   "Move backward to the beginning of a VHDL library unit.
6567 Returns the location of the corresponding begin keyword, unless search
6568 stops due to beginning or end of buffer.
6569 Note that if point is between the \"libunit\" keyword and the
6570 corresponding \"begin\" keyword, then that libunit will not be
6571 recognized, and the search will continue backwards.  If point is
6572 at the \"begin\" keyword, then the defun will be recognized.  The
6573 returned point is at the first character of the \"libunit\" keyword."
6574   (let ((last-forward (point))
6575         (last-backward
6576          ;; Just in case we are actually sitting on the "begin"
6577          ;; keyword, allow for the keyword and an extra character,
6578          ;; as this will be used when looking forward for the
6579          ;; "begin" keyword.
6580          (save-excursion (forward-word-strictly 1) (1+ (point))))
6581         foundp literal placeholder)
6582     ;; Find the "libunit" keyword.
6583     (while (and (not foundp)
6584                 (re-search-backward vhdl-libunit-re nil 'move))
6585       ;; If we are in a literal, or not at a real libunit, then try again.
6586       (if (or (= (preceding-char) ?_)
6587               (vhdl-in-literal)
6588               (not (vhdl-libunit-p)))
6589           (backward-char)
6590         ;; Find the corresponding "begin" keyword.
6591         (setq last-forward (point))
6592         (while (and (not foundp)
6593                     (re-search-forward "\\bis\\b[^_]" last-backward t)
6594                     (setq placeholder (match-beginning 0)))
6595           (if (or (= (preceding-char) ?_)
6596                   (setq literal (vhdl-in-literal)))
6597               ;; It wasn't a real keyword, so keep searching.
6598               (if (eq literal 'comment)
6599                   (goto-char
6600                    (min (vhdl-point 'eol) last-backward))
6601                 (forward-char))
6602             ;; We have found the begin keyword, loop will exit.
6603             (setq foundp placeholder)))
6604         ;; Go back to the libunit keyword
6605         (goto-char last-forward)))
6606     foundp))
6607
6608 (defun vhdl-beginning-of-defun (&optional count)
6609   "Move backward to the beginning of a VHDL defun.
6610 With argument, do it that many times.
6611 Returns the location of the corresponding begin keyword, unless search
6612 stops due to beginning or end of buffer."
6613   ;; Note that if point is between the "defun" keyword and the
6614   ;; corresponding "begin" keyword, then that defun will not be
6615   ;; recognized, and the search will continue backwards.  If point is
6616   ;; at the "begin" keyword, then the defun will be recognized.  The
6617   ;; returned point is at the first character of the "defun" keyword.
6618   (interactive "p")
6619   (let ((count (or count 1))
6620         (case-fold-search t)
6621         (last-forward (point))
6622         foundp)
6623     (while (> count 0)
6624       (setq foundp nil)
6625       (goto-char last-forward)
6626       (let ((last-backward
6627              ;; Just in case we are actually sitting on the "begin"
6628              ;; keyword, allow for the keyword and an extra character,
6629              ;; as this will be used when looking forward for the
6630              ;; "begin" keyword.
6631              (save-excursion (forward-word-strictly 1) (1+ (point))))
6632             begin-string literal)
6633         (while (and (not foundp)
6634                     (re-search-backward vhdl-defun-re nil 'move))
6635           ;; If we are in a literal, then try again.
6636           (if (or (= (preceding-char) ?_)
6637                   (vhdl-in-literal))
6638               (backward-char)
6639             (if (setq begin-string (vhdl-corresponding-defun))
6640                 ;; This is a real defun keyword.
6641                 ;; Find the corresponding "begin" keyword.
6642                 ;; Look for the begin keyword.
6643                 (progn
6644                   ;; Save the search start point.
6645                   (setq last-forward (point))
6646                   (while (and (not foundp)
6647                               (search-forward begin-string last-backward t))
6648                     (if (or (= (preceding-char) ?_)
6649                             (save-match-data
6650                               (setq literal (vhdl-in-literal))))
6651                         ;; It wasn't a real keyword, so keep searching.
6652                         (if (eq literal 'comment)
6653                             (goto-char
6654                              (min (vhdl-point 'eol) last-backward))
6655                           (forward-char))
6656                       ;; We have found the begin keyword, loop will exit.
6657                       (setq foundp (match-beginning 0)))
6658                     )
6659                   ;; Go back to the defun keyword
6660                   (goto-char last-forward)) ; end search for begin keyword
6661               ))
6662           ) ; end of the search for the defun keyword
6663         )
6664       (setq count (1- count))
6665       )
6666     (vhdl-keep-region-active)
6667     foundp))
6668
6669 (defun vhdl-beginning-of-statement (&optional count lim interactive)
6670   "Go to the beginning of the innermost VHDL statement.
6671 With prefix arg, go back N - 1 statements.  If already at the
6672 beginning of a statement then go to the beginning of the preceding
6673 one.  If within a string or comment, or next to a comment (only
6674 whitespace between), move by sentences instead of statements.
6675
6676 When called from a program, this function takes 3 optional args: the
6677 prefix arg, a buffer position limit which is the farthest back to
6678 search, and an argument indicating an interactive call."
6679   (interactive "p\np")
6680   (let ((count (or count 1))
6681         (case-fold-search t)
6682         (lim (or lim (point-min)))
6683         (here (point))
6684         state)
6685     (save-excursion
6686       (goto-char lim)
6687       (setq state (parse-partial-sexp (point) here nil nil)))
6688     (if (and interactive
6689              (or (nth 3 state)
6690                  (nth 4 state)
6691                  (looking-at (concat "[ \t]*" comment-start-skip))))
6692         (forward-sentence (- count))
6693       (while (> count 0)
6694         (vhdl-beginning-of-statement-1 lim)
6695         (setq count (1- count))))
6696     ;; its possible we've been left up-buf of lim
6697     (goto-char (max (point) lim))
6698     )
6699   (vhdl-keep-region-active))
6700
6701 (defconst vhdl-e-o-s-re
6702   (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re))
6703
6704 (defun vhdl-end-of-statement ()
6705   "Very simple implementation."
6706   (interactive)
6707   (re-search-forward vhdl-e-o-s-re))
6708
6709 (defconst vhdl-b-o-s-re
6710   (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|"
6711           vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re))
6712
6713 (defun vhdl-beginning-of-statement-1 (&optional lim)
6714   "Move to the start of the current statement, or the previous
6715 statement if already at the beginning of one."
6716   (let ((lim (or lim (point-min)))
6717         (here (point))
6718         (pos (point))
6719         donep)
6720     ;; go backwards one balanced expression, but be careful of
6721     ;; unbalanced paren being reached
6722     (if (not (vhdl-safe (progn (backward-sexp) t)))
6723         (progn
6724           (backward-up-list 1)
6725           (forward-char)
6726           (vhdl-forward-syntactic-ws here)
6727           (setq donep t)))
6728     (while (and (not donep)
6729                 (not (bobp))
6730                 ;; look backwards for a statement boundary
6731                 (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move)))
6732       (if (or (= (preceding-char) ?_)
6733               (vhdl-in-literal))
6734           (backward-char)
6735         (cond
6736          ;; If we are looking at an open paren, then stop after it
6737          ((eq (following-char) ?\()
6738           (forward-char)
6739           (vhdl-forward-syntactic-ws here)
6740           (setq donep t))
6741          ;; If we are looking at a close paren, then skip it
6742          ((eq (following-char) ?\))
6743           (forward-char)
6744           (setq pos (point))
6745           (backward-sexp)
6746           (if (< (point) lim)
6747               (progn (goto-char pos)
6748                      (vhdl-forward-syntactic-ws here)
6749                      (setq donep t))))
6750          ;; If we are looking at a semicolon, then stop
6751          ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p)))
6752           (progn
6753             (forward-char)
6754             (vhdl-forward-syntactic-ws here)
6755             (setq donep t)))
6756          ;; If we are looking at a "begin", then stop
6757          ((and (looking-at vhdl-begin-fwd-re)
6758                (or (not (looking-at "\\<use\\>"))
6759                    (save-excursion
6760                      (back-to-indentation)
6761                      (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
6762                (/= (preceding-char) ?_)
6763                (vhdl-begin-p nil))
6764           ;; If it's a leader "begin", then find the
6765           ;; right place
6766           (if (looking-at vhdl-leader-re)
6767               (save-excursion
6768                 ;; set a default stop point at the begin
6769                 (setq pos (point))
6770                 ;; is the start point inside the leader area ?
6771                 (goto-char (vhdl-end-of-leader))
6772                 (vhdl-forward-syntactic-ws here)
6773                 (if (< (point) here)
6774                     ;; start point was not inside leader area
6775                     ;; set stop point at word after leader
6776                     (setq pos (point))))
6777             (forward-word-strictly 1)
6778             (vhdl-forward-syntactic-ws here)
6779             (setq pos (point)))
6780           (goto-char pos)
6781           (setq donep t))
6782          ;; If we are looking at a "statement", then stop
6783          ((and (looking-at vhdl-statement-fwd-re)
6784                (/= (preceding-char) ?_)
6785                (vhdl-statement-p nil))
6786           (setq donep t))
6787          ;; If we are looking at a case alternative key, then stop
6788          ((and (looking-at vhdl-case-alternative-re)
6789                (vhdl-case-alternative-p lim))
6790           (save-excursion
6791             ;; set a default stop point at the when
6792             (setq pos (point))
6793             ;; is the start point inside the case alternative key ?
6794             (looking-at vhdl-case-alternative-re)
6795             (goto-char (match-end 0))
6796             (vhdl-forward-syntactic-ws here)
6797             (if (< (point) here)
6798                 ;; start point was not inside the case alternative key
6799                 ;; set stop point at word after case alternative keyleader
6800                 (setq pos (point))))
6801           (goto-char pos)
6802           (setq donep t))
6803          ;; Bogus find, continue
6804          (t
6805           (backward-char)))))
6806     ))
6807
6808 ;; Defuns for calculating the current syntactic state:
6809
6810 (defun vhdl-get-library-unit (bod placeholder)
6811   "If there is an enclosing library unit at BOD, with its \"begin\"
6812 keyword at PLACEHOLDER, then return the library unit type."
6813   (let ((here (vhdl-point 'bol)))
6814     (if (save-excursion
6815           (goto-char placeholder)
6816           (vhdl-safe (vhdl-forward-sexp 1 bod))
6817           (<= here (point)))
6818         (save-excursion
6819           (goto-char bod)
6820           (cond
6821            ((looking-at "e") 'entity)
6822            ((looking-at "a") 'architecture)
6823            ((looking-at "conf") 'configuration)
6824            ((looking-at "cont") 'context)
6825            ((looking-at "p")
6826             (save-excursion
6827               (goto-char bod)
6828               (forward-sexp)
6829               (vhdl-forward-syntactic-ws here)
6830               (if (looking-at "body\\b[^_]")
6831                   'package-body 'package))))))
6832     ))
6833
6834 (defun vhdl-get-block-state (&optional lim)
6835   "Finds and records all the closest opens.
6836 LIM is the furthest back we need to search (it should be the
6837 previous libunit keyword)."
6838   (let ((here (point))
6839         (lim (or lim (point-min)))
6840         keyword sexp-start sexp-mid sexp-end
6841         preceding-sexp containing-sexp
6842         containing-begin containing-mid containing-paren)
6843     (save-excursion
6844       ;; Find the containing-paren, and use that as the limit
6845       (if (setq containing-paren
6846                 (save-restriction
6847                   (narrow-to-region lim (point))
6848                   (vhdl-safe (scan-lists (point) -1 1))))
6849           (setq lim containing-paren))
6850       ;; Look backwards for "begin" and "end" keywords.
6851       (while (and (> (point) lim)
6852                   (not containing-sexp))
6853         (setq keyword (vhdl-backward-to-block lim))
6854         (cond
6855          ((eq keyword 'begin)
6856           ;; Found a "begin" keyword
6857           (setq sexp-start (point))
6858           (setq sexp-mid (vhdl-corresponding-mid lim))
6859           (setq sexp-end (vhdl-safe
6860                           (save-excursion
6861                             (vhdl-forward-sexp 1 lim) (point))))
6862           (if (and sexp-end (<= sexp-end here))
6863               ;; we want to record this sexp, but we only want to
6864               ;; record the last-most of any of them before here
6865               (or preceding-sexp
6866                   (setq preceding-sexp sexp-start))
6867             ;; we're contained in this sexp so put sexp-start on
6868             ;; front of list
6869             (setq containing-sexp sexp-start)
6870             (setq containing-mid sexp-mid)
6871             (setq containing-begin t)))
6872          ((eq keyword 'end)
6873           ;; Found an "end" keyword
6874           (forward-sexp)
6875           (setq sexp-end (point))
6876           (setq sexp-mid nil)
6877           (setq sexp-start
6878                 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point))
6879                     (progn (backward-sexp) (point))))
6880           ;; we want to record this sexp, but we only want to
6881           ;; record the last-most of any of them before here
6882           (or preceding-sexp
6883               (setq preceding-sexp sexp-start)))
6884          )))
6885     ;; Check if the containing-paren should be the containing-sexp
6886     (if (and containing-paren
6887              (or (null containing-sexp)
6888                  (< containing-sexp containing-paren)))
6889         (setq containing-sexp containing-paren
6890               preceding-sexp nil
6891               containing-begin nil
6892               containing-mid nil))
6893     (vector containing-sexp preceding-sexp containing-begin containing-mid)
6894     ))
6895
6896
6897 (defconst vhdl-s-c-a-re
6898   (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key))
6899
6900 (defun vhdl-skip-case-alternative (&optional lim)
6901   "Skip forward over case/when bodies, with optional maximal
6902 limit.  If no next case alternative is found, nil is returned and
6903 point is not moved."
6904   (let ((lim (or lim (point-max)))
6905         (here (point))
6906         donep foundp)
6907     (while (and (< (point) lim)
6908                 (not donep))
6909       (if (and (re-search-forward vhdl-s-c-a-re lim 'move)
6910                (save-match-data
6911                  (not (vhdl-in-literal)))
6912                (/= (match-beginning 0) here))
6913           (progn
6914             (goto-char (match-beginning 0))
6915             (cond
6916              ((and (looking-at "case")
6917                    (re-search-forward "\\bis[^_]" lim t))
6918               (backward-sexp)
6919               (vhdl-forward-sexp))
6920              (t
6921               (setq donep t
6922                     foundp t))))))
6923     (if (not foundp)
6924         (goto-char here))
6925     foundp))
6926
6927 (defun vhdl-backward-skip-label (&optional lim)
6928   "Skip backward over a label, with optional maximal
6929 limit.  If label is not found, nil is returned and point
6930 is not moved."
6931   (let ((lim (or lim (point-min)))
6932         placeholder)
6933     (if (save-excursion
6934           (vhdl-backward-syntactic-ws lim)
6935           (and (eq (preceding-char) ?:)
6936                (progn
6937                  (backward-sexp)
6938                  (setq placeholder (point))
6939                  (looking-at vhdl-label-key))))
6940         (goto-char placeholder))
6941     ))
6942
6943 (defun vhdl-forward-skip-label (&optional lim)
6944   "Skip forward over a label, with optional maximal
6945 limit.  If label is not found, nil is returned and point
6946 is not moved."
6947   (let ((lim (or lim (point-max))))
6948     (if (looking-at vhdl-label-key)
6949         (progn
6950           (goto-char (match-end 0))
6951           (vhdl-forward-syntactic-ws lim)))
6952     ))
6953
6954 (defun vhdl-get-syntactic-context ()
6955   "Guess the syntactic description of the current line of VHDL code."
6956   (save-excursion
6957     (save-restriction
6958       (beginning-of-line)
6959       (let* ((indent-point (point))
6960              (case-fold-search t)
6961              vec literal containing-sexp preceding-sexp
6962              containing-begin containing-mid containing-leader
6963              char-before-ip char-after-ip begin-after-ip end-after-ip
6964              placeholder lim library-unit
6965             )
6966
6967         ;; Reset the syntactic context
6968         (setq vhdl-syntactic-context nil)
6969
6970         (save-excursion
6971           ;; Move to the start of the previous library unit, and
6972           ;; record the position of the "begin" keyword.
6973           (setq placeholder (vhdl-beginning-of-libunit))
6974           ;; The position of the "libunit" keyword gives us a gross
6975           ;; limit point.
6976           (setq lim (point))
6977           )
6978
6979         ;; If there is a previous library unit, and we are enclosed by
6980         ;; it, then set the syntax accordingly.
6981         (and placeholder
6982              (setq library-unit (vhdl-get-library-unit lim placeholder))
6983              (vhdl-add-syntax library-unit lim))
6984
6985         ;; Find the surrounding state.
6986         (if (setq vec (vhdl-get-block-state lim))
6987             (progn
6988               (setq containing-sexp (aref vec 0))
6989               (setq preceding-sexp (aref vec 1))
6990               (setq containing-begin (aref vec 2))
6991               (setq containing-mid (aref vec 3))
6992               ))
6993
6994         ;; set the limit on the farthest back we need to search
6995         (setq lim (if containing-sexp
6996                       (save-excursion
6997                         (goto-char containing-sexp)
6998                         ;; set containing-leader if required
6999                         (if (looking-at vhdl-leader-re)
7000                             (setq containing-leader (vhdl-end-of-leader)))
7001                         (vhdl-point 'bol))
7002                     (point-min)))
7003
7004         ;; cache char before and after indent point, and move point to
7005         ;; the most likely position to perform the majority of tests
7006         (goto-char indent-point)
7007         (skip-chars-forward " \t")
7008         (setq literal (vhdl-in-literal))
7009         (setq char-after-ip (following-char))
7010         (setq begin-after-ip (and
7011                               (not literal)
7012                               (looking-at vhdl-begin-fwd-re)
7013                               (or (not (looking-at "\\<use\\>"))
7014                                   (save-excursion
7015                                     (back-to-indentation)
7016                                     (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>")))
7017                               (vhdl-begin-p)))
7018         (setq end-after-ip (and
7019                             (not literal)
7020                             (looking-at vhdl-end-fwd-re)
7021                             (vhdl-end-p)))
7022         (vhdl-backward-syntactic-ws lim)
7023         (setq char-before-ip (preceding-char))
7024         (goto-char indent-point)
7025         (skip-chars-forward " \t")
7026
7027         ;; now figure out syntactic qualities of the current line
7028         (cond
7029          ;; CASE 1: in a string or comment.
7030          ((memq literal '(string comment))
7031           (vhdl-add-syntax literal (vhdl-point 'bopl)))
7032          ;; CASE 2: Line is at top level.
7033          ((null containing-sexp)
7034           ;; Find the point to which indentation will be relative
7035           (save-excursion
7036             (if (null preceding-sexp)
7037                 ;; CASE 2X.1
7038                 ;; no preceding-sexp -> use the preceding statement
7039                 (vhdl-beginning-of-statement-1 lim)
7040               ;; CASE 2X.2
7041               ;; if there is a preceding-sexp then indent relative to it
7042               (goto-char preceding-sexp)
7043               ;; if not at boi, then the block-opening keyword is
7044               ;; probably following a label, so we need a different
7045               ;; relpos
7046               (if (/= (point) (vhdl-point 'boi))
7047                   ;; CASE 2X.3
7048                   (vhdl-beginning-of-statement-1 lim)))
7049             ;; v-b-o-s could have left us at point-min
7050             (and (bobp)
7051                  ;; CASE 2X.4
7052                  (vhdl-forward-syntactic-ws indent-point))
7053             (setq placeholder (point)))
7054           (cond
7055            ;; CASE 2A : we are looking at a block-open
7056            (begin-after-ip
7057             (vhdl-add-syntax 'block-open placeholder))
7058            ;; CASE 2B: we are looking at a block-close
7059            (end-after-ip
7060             (vhdl-add-syntax 'block-close placeholder))
7061            ;; CASE 2C: we are looking at a top-level statement
7062            ((progn
7063               (vhdl-backward-syntactic-ws lim)
7064               (or (bobp)
7065                   (and (= (preceding-char) ?\;)
7066                        (not (vhdl-in-quote-p)))))
7067             (vhdl-add-syntax 'statement placeholder))
7068            ;; CASE 2D: we are looking at a top-level statement-cont
7069            (t
7070             (vhdl-beginning-of-statement-1 lim)
7071             ;; v-b-o-s could have left us at point-min
7072             (and (bobp)
7073                  ;; CASE 2D.1
7074                  (vhdl-forward-syntactic-ws indent-point))
7075             (vhdl-add-syntax 'statement-cont (point)))
7076            )) ; end CASE 2
7077          ;; CASE 3: line is inside parentheses.  Most likely we are
7078          ;; either in a subprogram argument (interface) list, or a
7079          ;; continued expression containing parentheses.
7080          ((null containing-begin)
7081           (vhdl-backward-syntactic-ws containing-sexp)
7082           (cond
7083            ;; CASE 3A: we are looking at the arglist closing paren
7084            ((eq char-after-ip ?\))
7085             (goto-char containing-sexp)
7086             (vhdl-add-syntax 'arglist-close (vhdl-point 'boi)))
7087            ;; CASE 3B: we are looking at the first argument in an empty
7088            ;; argument list.
7089            ((eq char-before-ip ?\()
7090             (goto-char containing-sexp)
7091             (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi)))
7092            ;; CASE 3C: we are looking at an arglist continuation line,
7093            ;; but the preceding argument is on the same line as the
7094            ;; opening paren.  This case includes multi-line
7095            ;; expression paren groupings.
7096            ((and (save-excursion
7097                    (goto-char (1+ containing-sexp))
7098                    (skip-chars-forward " \t")
7099                    (not (eolp))
7100                    (not (looking-at "--\\|`")))
7101                  (save-excursion
7102                    (vhdl-beginning-of-statement-1 containing-sexp)
7103                    (skip-chars-backward " \t(")
7104                    (while (and (= (preceding-char) ?\;)
7105                                (not (vhdl-in-quote-p)))
7106                      (vhdl-beginning-of-statement-1 containing-sexp)
7107                      (skip-chars-backward " \t("))
7108                    (<= (point) containing-sexp)))
7109             (goto-char containing-sexp)
7110             (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi)))
7111            ;; CASE 3D: we are looking at just a normal arglist
7112            ;; continuation line
7113            (t (vhdl-beginning-of-statement-1 containing-sexp)
7114               (vhdl-forward-syntactic-ws indent-point)
7115               (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi)))
7116            ))
7117          ;; CASE 4: A block mid open
7118          ((and begin-after-ip
7119                (looking-at containing-mid))
7120           (goto-char containing-sexp)
7121           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7122           (if (looking-at vhdl-trailer-re)
7123               ;; CASE 4.1
7124               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7125           (vhdl-backward-skip-label (vhdl-point 'boi))
7126           (vhdl-add-syntax 'block-open (point)))
7127          ;; CASE 5: block close brace
7128          (end-after-ip
7129           (goto-char containing-sexp)
7130           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7131           (if (looking-at vhdl-trailer-re)
7132               ;; CASE 5.1
7133               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7134           (vhdl-backward-skip-label (vhdl-point 'boi))
7135           (vhdl-add-syntax 'block-close (point)))
7136          ;; CASE 6: A continued statement
7137          ((and (/= char-before-ip ?\;)
7138                ;; check it's not a trailer begin keyword, or a begin
7139                ;; keyword immediately following a label.
7140                (not (and begin-after-ip
7141                          (or (looking-at vhdl-trailer-re)
7142                              (save-excursion
7143                                (vhdl-backward-skip-label containing-sexp)))))
7144                ;; check it's not a statement keyword
7145                (not (and (looking-at vhdl-statement-fwd-re)
7146                          (vhdl-statement-p)))
7147                ;; see if the b-o-s is before the indent point
7148                (> indent-point
7149                   (save-excursion
7150                     (vhdl-beginning-of-statement-1 containing-sexp)
7151                     ;; If we ended up after a leader, then this will
7152                     ;; move us forward to the start of the first
7153                     ;; statement.  Note that a containing sexp here is
7154                     ;; always a keyword, not a paren, so this will
7155                     ;; have no effect if we hit the containing-sexp.
7156                     (vhdl-forward-syntactic-ws indent-point)
7157                     (setq placeholder (point))))
7158                ;; check it's not a block-intro
7159                (/= placeholder containing-sexp)
7160                ;; check it's not a case block-intro
7161                (save-excursion
7162                  (goto-char placeholder)
7163                  (or (not (looking-at vhdl-case-alternative-re))
7164                      (> (match-end 0) indent-point))))
7165           ;; Make placeholder skip a label, but only if it puts us
7166           ;; before the indent point at the start of a line.
7167           (let ((new placeholder))
7168             (if (and (> indent-point
7169                         (save-excursion
7170                           (goto-char placeholder)
7171                           (vhdl-forward-skip-label indent-point)
7172                           (setq new (point))))
7173                      (save-excursion
7174                        (goto-char new)
7175                        (eq new (progn (back-to-indentation) (point)))))
7176                 (setq placeholder new)))
7177           (vhdl-add-syntax 'statement-cont placeholder)
7178           (if begin-after-ip
7179               (vhdl-add-syntax 'block-open)))
7180          ;; Statement. But what kind?
7181          ;; CASE 7: A case alternative key
7182          ((and (looking-at vhdl-case-alternative-re)
7183                (vhdl-case-alternative-p containing-sexp))
7184           ;; for a case alternative key, we set relpos to the first
7185           ;; non-whitespace char on the line containing the "case"
7186           ;; keyword.
7187           (goto-char containing-sexp)
7188           ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7189           (if (looking-at vhdl-trailer-re)
7190               (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7191           (vhdl-add-syntax 'case-alternative (vhdl-point 'boi)))
7192          ;; CASE 8: statement catchall
7193          (t
7194           ;; we know its a statement, but we need to find out if it is
7195           ;; the first statement in a block
7196           (if containing-leader
7197               (goto-char containing-leader)
7198             (goto-char containing-sexp)
7199             ;; Note that a containing sexp here is always a keyword,
7200             ;; not a paren, so skip over the keyword.
7201             (forward-sexp))
7202           ;; move to the start of the first statement
7203           (vhdl-forward-syntactic-ws indent-point)
7204           (setq placeholder (point))
7205           ;; we want to ignore case alternatives keys when skipping forward
7206           (let (incase-p)
7207             (while (looking-at vhdl-case-alternative-re)
7208               (setq incase-p (point))
7209               ;; we also want to skip over the body of the
7210               ;; case/when statement if that doesn't put us at
7211               ;; after the indent-point
7212               (while (vhdl-skip-case-alternative indent-point))
7213               ;; set up the match end
7214               (looking-at vhdl-case-alternative-re)
7215               (goto-char (match-end 0))
7216               ;; move to the start of the first case alternative statement
7217               (vhdl-forward-syntactic-ws indent-point)
7218               (setq placeholder (point)))
7219             (cond
7220              ;; CASE 8A: we saw a case/when statement so we must be
7221              ;; in a switch statement.  find out if we are at the
7222              ;; statement just after a case alternative key
7223              ((and incase-p
7224                    (= (point) indent-point))
7225               ;; relpos is the "when" keyword
7226               (vhdl-add-syntax 'statement-case-intro incase-p))
7227              ;; CASE 8B: any old statement
7228              ((< (point) indent-point)
7229               ;; relpos is the first statement of the block
7230               (vhdl-add-syntax 'statement placeholder)
7231               (if begin-after-ip
7232                   (vhdl-add-syntax 'block-open)))
7233              ;; CASE 8C: first statement in a block
7234              (t
7235               (goto-char containing-sexp)
7236               ;; If the \"begin\" keyword is a trailer, then find v-b-o-s
7237               (if (looking-at vhdl-trailer-re)
7238                   (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil)))
7239               (vhdl-backward-skip-label (vhdl-point 'boi))
7240               (vhdl-add-syntax 'statement-block-intro (point))
7241               (if begin-after-ip
7242                   (vhdl-add-syntax 'block-open)))
7243              )))
7244          )
7245
7246         ;; now we need to look at any modifiers
7247         (goto-char indent-point)
7248         (skip-chars-forward " \t")
7249         (if (or (looking-at "--") (looking-at "/\\*"))
7250             (vhdl-add-syntax 'comment))
7251         (if (looking-at "`")
7252             (vhdl-add-syntax 'directive))
7253         (if (eq literal 'pound)
7254             (vhdl-add-syntax 'cpp-macro))
7255         ;; return the syntax
7256         vhdl-syntactic-context))))
7257
7258 ;; Standard indentation line-ups:
7259
7260 (defun vhdl-lineup-arglist (langelem)
7261   "Lineup the current arglist line with the arglist appearing just
7262 after the containing paren which starts the arglist."
7263   (save-excursion
7264     (let* ((containing-sexp
7265             (save-excursion
7266               ;; arglist-cont-nonempty gives relpos ==
7267               ;; to boi of containing-sexp paren. This
7268               ;; is good when offset is +, but bad
7269               ;; when it is vhdl-lineup-arglist, so we
7270               ;; have to special case a kludge here.
7271               (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty))
7272                   (progn
7273                     (beginning-of-line)
7274                     (backward-up-list 1)
7275                     (skip-chars-forward " \t" (vhdl-point 'eol)))
7276                 (goto-char (cdr langelem)))
7277               (point)))
7278            (cs-curcol (save-excursion
7279                         (goto-char (cdr langelem))
7280                         (current-column))))
7281       (if (save-excursion
7282             (beginning-of-line)
7283             (looking-at "[ \t]*)"))
7284           (progn (goto-char (match-end 0))
7285                  (backward-sexp)
7286                  (forward-char)
7287                  (vhdl-forward-syntactic-ws)
7288                  (- (current-column) cs-curcol))
7289         (goto-char containing-sexp)
7290         (or (eolp)
7291             (let ((eol (vhdl-point 'eol))
7292                   (here (progn
7293                           (forward-char)
7294                           (skip-chars-forward " \t")
7295                           (point))))
7296               (vhdl-forward-syntactic-ws)
7297               (if (< (point) eol)
7298                   (goto-char here))))
7299         (- (current-column) cs-curcol)
7300         ))))
7301
7302 (defun vhdl-lineup-arglist-intro (langelem)
7303   "Lineup an arglist-intro line to just after the open paren."
7304   (save-excursion
7305     (let ((cs-curcol (save-excursion
7306                        (goto-char (cdr langelem))
7307                        (current-column)))
7308           (ce-curcol (save-excursion
7309                        (beginning-of-line)
7310                        (backward-up-list 1)
7311                        (skip-chars-forward " \t" (vhdl-point 'eol))
7312                        (current-column))))
7313       (- ce-curcol cs-curcol -1))))
7314
7315 (defun vhdl-lineup-comment (langelem)
7316   "Support old behavior for comment indentation.  We look at
7317 vhdl-comment-only-line-offset to decide how to indent comment
7318 only-lines."
7319   (save-excursion
7320     (back-to-indentation)
7321     ;; at or to the right of comment-column
7322     (if (>= (current-column) comment-column)
7323         (vhdl-comment-indent)
7324       ;; otherwise, indent as specified by vhdl-comment-only-line-offset
7325       (if (not (bolp))
7326           ;; inside multi-line comment
7327           (if (looking-at "\\*")
7328               1
7329             ;; otherwise
7330           (or (car-safe vhdl-comment-only-line-offset)
7331                 vhdl-comment-only-line-offset))
7332         (or (cdr-safe vhdl-comment-only-line-offset)
7333             (car-safe vhdl-comment-only-line-offset)
7334             -1000                       ;jam it against the left side
7335             )))))
7336
7337 (defun vhdl-lineup-statement-cont (langelem)
7338   "Line up statement-cont after the assignment operator."
7339   (save-excursion
7340     (let* ((relpos (cdr langelem))
7341            (assignp (save-excursion
7342                      (goto-char (vhdl-point 'boi))
7343                      (and (re-search-forward "\\(<\\|:\\|=\\)="
7344                                              (vhdl-point 'eol) t)
7345                           (- (point) (vhdl-point 'boi)))))
7346            (curcol (progn
7347                      (goto-char relpos)
7348                      (current-column)))
7349            foundp)
7350       (while (and (not foundp)
7351                   (< (point) (vhdl-point 'eol)))
7352         (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move)
7353         (if (vhdl-in-literal)
7354             (forward-char)
7355           (if (= (preceding-char) ?\()
7356               ;; skip over any parenthesized expressions
7357               (goto-char (min (vhdl-point 'eol)
7358                               (scan-lists (point) 1 1)))
7359             ;; found an assignment operator (not at eol)
7360             (setq foundp (not (looking-at "\\s-*$"))))))
7361       (if (not foundp)
7362           ;; there's no assignment operator on the line
7363           vhdl-basic-offset
7364         ;; calculate indentation column after assign and ws, unless
7365         ;; our line contains an assignment operator
7366         (if (not assignp)
7367             (progn
7368               (forward-char)
7369               (skip-chars-forward " \t")
7370               (setq assignp 0)))
7371         (- (current-column) assignp curcol))
7372       )))
7373
7374 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7375 ;; Progress reporting
7376
7377 (defvar vhdl-progress-info nil
7378   "Array variable for progress information: 0 begin, 1 end, 2 time.")
7379
7380 (defun vhdl-update-progress-info (string pos)
7381   "Update progress information."
7382   (when (and vhdl-progress-info (not noninteractive)
7383              (< vhdl-progress-interval
7384                 (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
7385     (let ((delta (- (aref vhdl-progress-info 1)
7386                     (aref vhdl-progress-info 0))))
7387       (message "%s... (%2d%%)" string
7388                (if (= 0 delta)
7389                    100
7390                  (floor (* 100.0 (- pos (aref vhdl-progress-info 0)))
7391                         delta))))
7392     (aset vhdl-progress-info 2 (nth 1 (current-time)))))
7393
7394 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7395 ;; Indentation commands
7396
7397 (defun vhdl-electric-tab (&optional prefix-arg)
7398   "If preceding character is part of a word or a paren then hippie-expand,
7399 else if right of non whitespace on line then insert tab,
7400 else if last command was a tab or return then dedent one step or if a comment
7401 toggle between normal indent and inline comment indent,
7402 else indent `correctly'."
7403   (interactive "*P")
7404   (vhdl-prepare-search-2
7405    (cond
7406     ;; indent region if region is active
7407     ((and (not (featurep 'xemacs)) (use-region-p))
7408      (vhdl-indent-region (region-beginning) (region-end) nil))
7409     ;; expand word
7410     ((= (char-syntax (preceding-char)) ?w)
7411      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7412            (case-replace nil)
7413            (hippie-expand-only-buffers
7414             (or (and (boundp 'hippie-expand-only-buffers)
7415                      hippie-expand-only-buffers)
7416                 '(vhdl-mode))))
7417        (vhdl-expand-abbrev prefix-arg)))
7418     ;; expand parenthesis
7419     ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
7420      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
7421            (case-replace nil))
7422        (vhdl-expand-paren prefix-arg)))
7423     ;; insert tab
7424     ((> (current-column) (current-indentation))
7425      (insert-tab))
7426     ;; toggle comment indent
7427     ((and (looking-at "--")
7428           (or (eq last-command 'vhdl-electric-tab)
7429               (eq last-command 'vhdl-electric-return)))
7430      (cond ((= (current-indentation) 0) ; no indent
7431             (indent-to 1)
7432             (indent-according-to-mode))
7433            ((< (current-indentation) comment-column) ; normal indent
7434             (indent-to comment-column)
7435             (indent-according-to-mode))
7436            (t                           ; inline comment indent
7437             (delete-region (line-beginning-position) (point)))))
7438     ;; dedent
7439     ((and (>= (current-indentation) vhdl-basic-offset)
7440           (or (eq last-command 'vhdl-electric-tab)
7441               (eq last-command 'vhdl-electric-return)))
7442      (backward-delete-char-untabify vhdl-basic-offset nil))
7443     ;; indent line
7444     (t (indent-according-to-mode)))
7445    (setq this-command 'vhdl-electric-tab)))
7446
7447 (defun vhdl-electric-return ()
7448   "newline-and-indent or indent-new-comment-line if in comment and preceding
7449 character is a space."
7450   (interactive)
7451   (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
7452       (indent-new-comment-line)
7453     (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)
7454                (not (vhdl-in-comment-p)))
7455       (vhdl-fix-case-word -1))
7456     (newline-and-indent)))
7457
7458 (defun vhdl-indent-line ()
7459   "Indent the current line as VHDL code.  Returns the amount of
7460 indentation change."
7461   (interactive)
7462   (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
7463          (pos (- (point-max) (point)))
7464          (is-comment nil)
7465          (indent
7466           (if syntax
7467               ;; indent syntax-based
7468               (if (and (eq (caar syntax) 'comment)
7469                        (>= (vhdl-get-offset (car syntax)) comment-column))
7470                   ;; special case: comments at or right of comment-column
7471                   (vhdl-get-offset (car syntax))
7472                 ;; align comments like following code line
7473                 (when vhdl-indent-comment-like-next-code-line
7474                   (save-excursion
7475                     (while (eq (caar syntax) 'comment)
7476                       (setq is-comment t)
7477                       (beginning-of-line 2)
7478                       (setq syntax (vhdl-get-syntactic-context)))))
7479                 (when is-comment
7480                   (push (cons 'comment nil) syntax))
7481                 (apply '+ (mapcar 'vhdl-get-offset syntax)))
7482             ;; indent like previous nonblank line
7483             (save-excursion (beginning-of-line)
7484                             (re-search-backward "^[^\n]" nil t)
7485                             (current-indentation))))
7486          (shift-amt  (- indent (current-indentation))))
7487     (and vhdl-echo-syntactic-information-p
7488          (message "syntax: %s, indent= %d" syntax indent))
7489     (let ((has-formfeed
7490            (save-excursion (beginning-of-line) (looking-at "\\s-*\f"))))
7491       (when (or (not (zerop shift-amt)) has-formfeed)
7492         (delete-region (vhdl-point 'bol) (vhdl-point 'boi))
7493         (beginning-of-line)
7494         (when has-formfeed (insert "\f"))
7495         (indent-to indent)))
7496     (if (< (point) (vhdl-point 'boi))
7497         (back-to-indentation)
7498       ;; If initial point was within line's indentation, position after
7499       ;; the indentation.  Else stay at same point in text.
7500       (when (> (- (point-max) pos) (point))
7501         (goto-char (- (point-max) pos))))
7502     (run-hooks 'vhdl-special-indent-hook)
7503     (vhdl-update-progress-info "Indenting" (vhdl-current-line))
7504     shift-amt))
7505
7506 (defun vhdl-indent-region (beg end &optional column)
7507   "Indent region as VHDL code.
7508 Adds progress reporting to `indent-region'."
7509   (interactive "r\nP")
7510   (when vhdl-progress-interval
7511     (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7512                                      (count-lines (point-min) end) 0)))
7513   (indent-region beg end column)
7514   (when vhdl-progress-interval (message "Indenting...done"))
7515   (setq vhdl-progress-info nil))
7516
7517 (defun vhdl-indent-buffer ()
7518   "Indent whole buffer as VHDL code.
7519 Calls `indent-region' for whole buffer and adds progress reporting."
7520   (interactive)
7521   (vhdl-indent-region (point-min) (point-max)))
7522
7523 (defun vhdl-indent-group ()
7524   "Indent group of lines between empty lines."
7525   (interactive)
7526   (let ((beg (save-excursion
7527                (if (re-search-backward vhdl-align-group-separate nil t)
7528                    (point-marker)
7529                  (point-min-marker))))
7530         (end (save-excursion
7531                (if (re-search-forward vhdl-align-group-separate nil t)
7532                    (point-marker)
7533                  (point-max-marker)))))
7534     (vhdl-indent-region beg end)))
7535
7536 (defun vhdl-indent-sexp (&optional endpos)
7537   "Indent each line of the list starting just after point.
7538 If optional arg ENDPOS is given, indent each line, stopping when
7539 ENDPOS is encountered."
7540   (interactive)
7541   (save-excursion
7542     (let ((beg (point))
7543           (end (progn (vhdl-forward-sexp nil endpos) (point))))
7544       (indent-region beg end nil))))
7545
7546 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7547 ;; Miscellaneous commands
7548
7549 (defun vhdl-show-syntactic-information ()
7550   "Show syntactic information for current line."
7551   (interactive)
7552   (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
7553   (vhdl-keep-region-active))
7554
7555 ;; Verification and regression functions:
7556
7557 (defun vhdl-regress-line (&optional arg)
7558   "Check syntactic information for current line."
7559   (interactive "P")
7560   (let ((expected (save-excursion
7561                     (end-of-line)
7562                     (when (search-backward " -- ((" (vhdl-point 'bol) t)
7563                       (forward-char 4)
7564                       (read (current-buffer)))))
7565         (actual (vhdl-get-syntactic-context))
7566         (expurgated))
7567     ;; remove the library unit symbols
7568     (mapc
7569      (function
7570       (lambda (elt)
7571         (if (memq (car elt) '(entity configuration context package
7572                                      package-body architecture))
7573             nil
7574           (setq expurgated (append expurgated (list elt))))))
7575      actual)
7576     (if (and (not arg) expected (listp expected))
7577         (if (not (equal expected expurgated))
7578             (error "ERROR:  Should be: %s, is: %s" expected expurgated))
7579       (save-excursion
7580         (beginning-of-line)
7581         (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
7582           (end-of-line)
7583           (if (search-backward " -- ((" (vhdl-point 'bol) t)
7584               (delete-region (point) (line-end-position)))
7585           (insert " -- ")
7586           (insert (format "%s" expurgated))))))
7587   (vhdl-keep-region-active))
7588
7589
7590 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7591 ;;; Alignment, beautifying
7592 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7593
7594 (defconst vhdl-align-alist
7595   '(
7596     ;; after some keywords
7597     (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]"
7598                "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2)
7599     ;; before ':'
7600     (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7601     ;; after direction specifications
7602     (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7603                ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7604     ;; before "==", ":=", "=>", and "<="
7605     (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur
7606     (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7607     (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur
7608     ;; before some keywords
7609     (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7610     (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7611     (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7612     (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1)
7613     (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1)
7614     ;; before "=>" since "when/else ... =>" can occur
7615     (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7616     )
7617   "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7618 It is searched in order.  If REGEXP is found anywhere in the first
7619 line of a region to be aligned, ALIGN-PATTERN will be used for that
7620 region.  ALIGN-PATTERN must include the whitespace to be expanded or
7621 contracted.  It may also provide regexps for the text surrounding the
7622 whitespace.  SUBEXP specifies which sub-expression of
7623 ALIGN-PATTERN matches the white space to be expanded/contracted.")
7624
7625 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7626 ;; Align code
7627
7628 (defvar vhdl-align-try-all-clauses t
7629   "If REGEXP is not found on the first line of the region that clause
7630 is ignored.  If this variable is non-nil, then the clause is tried anyway.")
7631
7632 (defun vhdl-do-group (function &optional spacing)
7633   "Apply FUNCTION on group of lines between empty lines."
7634   (let
7635       ;; search for group beginning
7636       ((beg (save-excursion
7637               (if (re-search-backward vhdl-align-group-separate nil t)
7638                   (progn (beginning-of-line 2) (back-to-indentation) (point))
7639                 (point-min))))
7640        ;; search for group end
7641        (end (save-excursion
7642               (if (re-search-forward vhdl-align-group-separate nil t)
7643                   (progn (beginning-of-line) (point))
7644                 (point-max)))))
7645     ;; run FUNCTION
7646     (funcall function beg end spacing)))
7647
7648 (defun vhdl-do-list (function &optional spacing)
7649   "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7650 parentheses."
7651   (let (beg end)
7652     (save-excursion
7653       ;; search for beginning of balanced group of parentheses
7654       (setq beg (vhdl-re-search-backward "[()]" nil t))
7655       (while (looking-at ")")
7656         (forward-char) (backward-sexp)
7657         (setq beg (vhdl-re-search-backward "[()]" nil t)))
7658       ;; search for end of balanced group of parentheses
7659       (when beg
7660         (forward-list)
7661         (setq end (point))
7662         (goto-char (1+ beg))
7663         (skip-chars-forward " \t\n\r\f")
7664         (setq beg (point))))
7665     ;; run FUNCTION
7666     (if beg
7667         (funcall function beg end spacing)
7668       (error "ERROR:  Not within a list enclosed by a pair of parentheses"))))
7669
7670 (defun vhdl-do-same-indent (function &optional spacing)
7671   "Apply FUNCTION to block of lines with same indent."
7672   (let ((indent (current-indentation))
7673         beg end)
7674     ;; search for first line with same indent
7675     (save-excursion
7676       (while (and (not (bobp))
7677                   (or (looking-at "^\\s-*\\(--.*\\)?$")
7678                       (= (current-indentation) indent)))
7679         (unless (looking-at "^\\s-*$")
7680           (back-to-indentation) (setq beg (point)))
7681         (beginning-of-line -0)))
7682     ;; search for last line with same indent
7683     (save-excursion
7684       (while (and (not (eobp))
7685                   (or (looking-at "^\\s-*\\(--.*\\)?$")
7686                       (= (current-indentation) indent)))
7687         (if (looking-at "^\\s-*$")
7688             (beginning-of-line 2)
7689           (beginning-of-line 2)
7690           (setq end (point)))))
7691     ;; run FUNCTION
7692     (funcall function beg end spacing)))
7693
7694 (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
7695   "Attempt to align a range of lines based on the content of the
7696 lines.  The definition of `alignment-list' determines the matching
7697 order and the manner in which the lines are aligned.  If ALIGNMENT-LIST
7698 is not specified `vhdl-align-alist' is used.  If INDENT is non-nil,
7699 indentation is done before aligning."
7700   (interactive "r\np")
7701   (setq alignment-list (or alignment-list vhdl-align-alist))
7702   (setq spacing (or spacing 1))
7703   (save-excursion
7704     (let (bol indent)
7705       (goto-char end)
7706       (setq end (point-marker))
7707       (goto-char begin)
7708       (setq bol (setq begin (progn (beginning-of-line) (point))))
7709       (when indent
7710         (indent-region bol end nil))))
7711   (let ((copy (copy-alist alignment-list)))
7712     (vhdl-prepare-search-2
7713      (while copy
7714        (save-excursion
7715          (goto-char begin)
7716          (let (element
7717                (eol (point-at-eol)))
7718            (setq element (nth 0 copy))
7719            (when (and (or (and (listp (car element))
7720                                (memq major-mode (car element)))
7721                           (eq major-mode (car element)))
7722                       (or vhdl-align-try-all-clauses
7723                           (re-search-forward (car (cdr element)) eol t)))
7724              (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7725                                   (car (cdr (cdr (cdr element)))) spacing))
7726            (setq copy (cdr copy))))))))
7727
7728 (defun vhdl-align-region-2 (begin end match &optional substr spacing)
7729   "Align a range of lines from BEGIN to END.  The regular expression
7730 MATCH must match exactly one field: the whitespace to be
7731 contracted/expanded.  The alignment column will equal the
7732 rightmost column of the widest whitespace block.  SPACING is
7733 the amount of extra spaces to add to the calculated maximum required.
7734 SPACING defaults to 1 so that at least one space is inserted after
7735 the token in MATCH."
7736   (setq spacing (or spacing 1))
7737   (setq substr (or substr 1))
7738   (save-excursion
7739     (let (distance (max 0) (lines 0) bol eol width)
7740       ;; Determine the greatest whitespace distance to the alignment
7741       ;; character
7742       (goto-char begin)
7743       (setq eol (point-at-eol)
7744             bol (setq begin (progn (beginning-of-line) (point))))
7745       (while (< bol end)
7746         (save-excursion
7747           (when (and (vhdl-re-search-forward match eol t)
7748                      (save-excursion
7749                        (goto-char (match-beginning 0))
7750                        (forward-char)
7751                        (and (not (vhdl-in-literal))
7752                             (not (vhdl-in-quote-p))
7753                             (not (vhdl-in-extended-identifier-p))))
7754                      (not (looking-at "\\s-*$")))
7755             (setq distance (- (match-beginning substr) bol))
7756             (when (> distance max)
7757               (setq max distance))))
7758         (forward-line)
7759         (setq bol (point)
7760               eol (point-at-eol))
7761         (setq lines (1+ lines)))
7762       ;; Now insert enough maxs to push each assignment operator to
7763       ;; the same column.  We need to use 'lines' as a counter, since
7764       ;; the location of the mark may change
7765       (goto-char (setq bol begin))
7766       (setq eol (point-at-eol))
7767       (while (> lines 0)
7768         (when (and (vhdl-re-search-forward match eol t)
7769                    (save-excursion
7770                      (goto-char (match-beginning 0))
7771                      (forward-char)
7772                      (and (not (vhdl-in-literal))
7773                           (not (vhdl-in-quote-p))
7774                           (not (vhdl-in-extended-identifier-p))))
7775                    (not (looking-at "\\s-*$"))
7776                    (> (match-beginning 0)  ; not if at boi
7777                       (save-excursion (back-to-indentation) (point))))
7778           (setq width (- (match-end substr) (match-beginning substr)))
7779           (setq distance (- (match-beginning substr) bol))
7780           (goto-char (match-beginning substr))
7781           (delete-char width)
7782           (insert-char ?  (+ (- max distance) spacing)))
7783         (beginning-of-line)
7784         (forward-line)
7785         (setq bol (point)
7786               eol (point-at-eol))
7787         (setq lines (1- lines))))))
7788
7789 (defun vhdl-align-region-groups (beg end &optional spacing
7790                                      no-message no-comments)
7791   "Align region, treat groups of lines separately."
7792   (interactive "r\nP")
7793   (save-excursion
7794     (let (orig pos)
7795       (goto-char beg)
7796       (beginning-of-line)
7797       (setq orig (point-marker))
7798       (setq beg (point))
7799       (goto-char end)
7800       (setq end (point-marker))
7801       (untabify beg end)
7802       (unless no-message
7803         (when vhdl-progress-interval
7804           (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7805                                            (count-lines (point-min) end) 0))))
7806       (when (nth 0 vhdl-beautify-options)
7807         (vhdl-fixup-whitespace-region beg end t))
7808       (goto-char beg)
7809       (if (not vhdl-align-groups)
7810           ;; align entire region
7811           (progn (vhdl-align-region-1 beg end spacing)
7812                  (unless no-comments
7813                    (vhdl-align-inline-comment-region-1 beg end)))
7814         ;; align groups
7815         (while (and (< beg end)
7816                     (re-search-forward vhdl-align-group-separate end t))
7817           (setq pos (point-marker))
7818           (vhdl-align-region-1 beg pos spacing)
7819           (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7820           (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7821           (setq beg (1+ pos))
7822           (goto-char beg))
7823         ;; align last group
7824         (when (< beg end)
7825           (vhdl-align-region-1 beg end spacing)
7826           (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7827           (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7828       (when vhdl-indent-tabs-mode
7829         (tabify orig end))
7830       (unless no-message
7831         (when vhdl-progress-interval (message "Aligning...done"))
7832         (setq vhdl-progress-info nil)))))
7833
7834 (defun vhdl-align-region (beg end &optional spacing)
7835   "Align region, treat blocks with same indent and argument lists separately."
7836   (interactive "r\nP")
7837   (if (not vhdl-align-same-indent)
7838       ;; align entire region
7839       (vhdl-align-region-groups beg end spacing)
7840     ;; align blocks with same indent and argument lists
7841     (save-excursion
7842       (let ((cur-beg beg)
7843             indent cur-end)
7844         (when vhdl-progress-interval
7845           (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7846                                            (count-lines (point-min) end) 0)))
7847         (goto-char end)
7848         (setq end (point-marker))
7849         (goto-char cur-beg)
7850         (while (< (point) end)
7851           ;; is argument list opening?
7852           (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7853                                                     (point) (vhdl-point 'eol)))))
7854               ;; determine region for argument list
7855               (progn (goto-char cur-beg)
7856                      (forward-sexp)
7857                      (setq cur-end (point))
7858                      (beginning-of-line 2))
7859             ;; determine region with same indent
7860             (setq indent (current-indentation))
7861             (setq cur-beg (point))
7862             (setq cur-end (vhdl-point 'bonl))
7863             (beginning-of-line 2)
7864             (while (and (< (point) end)
7865                         (or (looking-at "^\\s-*\\(--.*\\)?$")
7866                             (= (current-indentation) indent))
7867                         (<= (save-excursion
7868                               (nth 0 (parse-partial-sexp
7869                                       (point) (vhdl-point 'eol)))) 0))
7870               (unless (looking-at "^\\s-*$")
7871                 (setq cur-end (vhdl-point 'bonl)))
7872               (beginning-of-line 2)))
7873           ;; align region
7874           (vhdl-align-region-groups cur-beg cur-end spacing t t))
7875         (vhdl-align-inline-comment-region beg end spacing noninteractive)
7876         (when vhdl-progress-interval (message "Aligning...done"))
7877         (setq vhdl-progress-info nil)))))
7878
7879 (defun vhdl-align-group (&optional spacing)
7880   "Align group of lines between empty lines."
7881   (interactive)
7882   (vhdl-do-group 'vhdl-align-region spacing))
7883
7884 (defun vhdl-align-list (&optional spacing)
7885   "Align the lines of a list surrounded by a balanced group of parentheses."
7886   (interactive)
7887   (vhdl-do-list 'vhdl-align-region-groups spacing))
7888
7889 (defun vhdl-align-same-indent (&optional spacing)
7890   "Align block of lines with same indent."
7891   (interactive)
7892   (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7893
7894 (defun vhdl-align-declarations (&optional spacing)
7895   "Align the lines within the declarative part of a design unit."
7896   (interactive)
7897   (let (beg end)
7898     (vhdl-prepare-search-2
7899      (save-excursion
7900        ;; search for declarative part
7901        (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t)
7902                   (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7903          (setq beg (point))
7904          (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7905          (setq end (point)))))
7906     (if beg
7907         (vhdl-align-region-groups beg end spacing)
7908       (error "ERROR:  Not within the declarative part of a design unit"))))
7909
7910 (defun vhdl-align-buffer ()
7911   "Align buffer."
7912   (interactive)
7913   (vhdl-align-region (point-min) (point-max)))
7914
7915 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7916 ;; Align inline comments
7917
7918 (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7919   "Align inline comments in region."
7920   (save-excursion
7921     (let ((start-max comment-column)
7922           (length-max 0)
7923           comment-list start-list tmp-list start length
7924           cur-start prev-start no-code)
7925       (setq spacing (or spacing 2))
7926       (vhdl-prepare-search-2
7927        (goto-char beg)
7928        ;; search for comment start positions and lengths
7929        (while (< (point) end)
7930          (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7931                     (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$")
7932                     (not (save-excursion (goto-char (match-beginning 2))
7933                                          (vhdl-in-literal))))
7934            (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7935            (setq length (- (match-end 2) (match-beginning 2)))
7936            (setq start-max (max start start-max))
7937            (setq length-max (max length length-max))
7938            (push (cons start length) comment-list))
7939          (beginning-of-line 2))
7940        (setq comment-list
7941              (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
7942        ;; reduce start positions
7943        (setq start-list (list (caar comment-list)))
7944        (setq comment-list (cdr comment-list))
7945        (while comment-list
7946          (unless (or (= (caar comment-list) (car start-list))
7947                      (<= (+ (car start-list) (cdar comment-list))
7948                             end-comment-column))
7949            (push (caar comment-list) start-list))
7950          (setq comment-list (cdr comment-list)))
7951        ;; align lines as nicely as possible
7952        (goto-char beg)
7953        (while (< (point) end)
7954          (setq cur-start nil)
7955          (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7956                     (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7957                              (not (save-excursion
7958                                     (goto-char (match-beginning 3))
7959                                     (vhdl-in-literal))))
7960                         (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7961                              (>= (- (match-end 2) (match-beginning 2))
7962                                  comment-column))))
7963            (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7964            (setq length (- (match-end 3) (match-beginning 3)))
7965            (setq no-code (= (match-beginning 1) (match-end 1)))
7966            ;; insert minimum whitespace
7967            (goto-char (match-end 2))
7968            (delete-region (match-beginning 2) (match-end 2))
7969            (insert-char ?\  spacing)
7970            (setq tmp-list start-list)
7971            ;; insert additional whitespace to align
7972            (setq cur-start
7973                  (cond
7974                   ;; align comment-only line to inline comment of previous line
7975                   ((and no-code prev-start
7976                         (<= length (- end-comment-column prev-start)))
7977                    prev-start)
7978                   ;; align all comments at `start-max' if this is possible
7979                   ((<= (+ start-max length-max) end-comment-column)
7980                    start-max)
7981                   ;; align at `comment-column' if possible
7982                   ((and (<= start comment-column)
7983                         (<= length (- end-comment-column comment-column)))
7984                    comment-column)
7985                   ;; align at left-most possible start position otherwise
7986                   (t
7987                    (while (and tmp-list (< (car tmp-list) start))
7988                      (setq tmp-list (cdr tmp-list)))
7989                    (car tmp-list))))
7990            (indent-to cur-start))
7991          (setq prev-start cur-start)
7992          (beginning-of-line 2))))))
7993
7994 (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7995   "Align inline comments within a region.  Groups of code lines separated by
7996 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7997   (interactive "r\nP")
7998   (save-excursion
7999     (let (orig pos)
8000       (goto-char beg)
8001       (beginning-of-line)
8002       (setq orig (point-marker))
8003       (setq beg (point))
8004       (goto-char end)
8005       (setq end (point-marker))
8006       (untabify beg end)
8007       (unless no-message (message "Aligning inline comments..."))
8008       (goto-char beg)
8009       (if (not vhdl-align-groups)
8010           ;; align entire region
8011           (vhdl-align-inline-comment-region-1 beg end spacing)
8012         ;; align groups
8013         (while (and (< beg end)
8014                     (re-search-forward vhdl-align-group-separate end t))
8015           (setq pos (point-marker))
8016           (vhdl-align-inline-comment-region-1 beg pos spacing)
8017           (setq beg (1+ pos))
8018           (goto-char beg))
8019         ;; align last group
8020         (when (< beg end)
8021           (vhdl-align-inline-comment-region-1 beg end spacing)))
8022       (when vhdl-indent-tabs-mode
8023         (tabify orig end))
8024       (unless no-message (message "Aligning inline comments...done")))))
8025
8026 (defun vhdl-align-inline-comment-group (&optional spacing)
8027   "Align inline comments within a group of lines between empty lines."
8028   (interactive)
8029   (save-excursion
8030     (let ((start (point))
8031           beg end)
8032       (setq end (if (re-search-forward vhdl-align-group-separate nil t)
8033                     (point-marker) (point-max)))
8034       (goto-char start)
8035       (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
8036                     (point) (point-min)))
8037       (untabify beg end)
8038       (message "Aligning inline comments...")
8039       (vhdl-align-inline-comment-region-1 beg end)
8040       (when vhdl-indent-tabs-mode
8041         (tabify beg end))
8042       (message "Aligning inline comments...done"))))
8043
8044 (defun vhdl-align-inline-comment-buffer ()
8045   "Align inline comments within buffer.  Groups of code lines separated by
8046 empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
8047   (interactive)
8048   (vhdl-align-inline-comment-region (point-min) (point-max)))
8049
8050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8051 ;; Fixup whitespace
8052
8053 (defun vhdl-fixup-whitespace-region (beg end &optional no-message)
8054   "Fixup whitespace in region.  Surround operator symbols by one space,
8055 eliminate multiple spaces (except at beginning of line), eliminate spaces at
8056 end of line, do nothing in comments and strings."
8057   (interactive "r")
8058   (unless no-message (message "Fixing up whitespace..."))
8059   (save-excursion
8060     (goto-char end)
8061     (setq end (point-marker))
8062     ;; have no space before and one space after `,' and ';'
8063     (goto-char beg)
8064     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
8065       (if (match-string 1)
8066           (goto-char (match-end 1))
8067         (replace-match "\\3 " nil nil nil 2)))
8068     ;; have no space after `('
8069     (goto-char beg)
8070     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t)
8071       (if (match-string 1)
8072           (goto-char (match-end 1))
8073         (replace-match "\\2")))
8074     ;; have no space before `)'
8075     (goto-char beg)
8076     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
8077       (if (match-string 1)
8078           (goto-char (match-end 1))
8079         (replace-match "\\2")))
8080     ;; surround operator symbols by one space
8081     (goto-char beg)
8082     (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t)
8083       (if (or (match-string 1)
8084               (<= (match-beginning 0)  ; not if at boi
8085                  (save-excursion (back-to-indentation) (point))))
8086           (goto-char (match-end 0))
8087         (replace-match "\\3 \\4 \\5")
8088         (goto-char (match-end 2))))
8089     ;; eliminate multiple spaces and spaces at end of line
8090     (goto-char beg)
8091     (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
8092                (and (looking-at "--.*") (re-search-forward "--.*" end t))
8093                (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
8094                (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
8095                     (progn (replace-match "" nil nil) t))
8096                (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
8097                     (progn (replace-match ";" nil nil) t))
8098                (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
8099                (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
8100                     (progn (replace-match "  " nil nil) t))
8101                (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
8102                     (progn (replace-match " " nil nil) t))
8103                (and (looking-at "-") (re-search-forward "-" end t))
8104                (re-search-forward "[^ \t\"-]+" end t))))
8105   (unless no-message (message "Fixing up whitespace...done")))
8106
8107 (defun vhdl-fixup-whitespace-buffer ()
8108   "Fixup whitespace in buffer.  Surround operator symbols by one space,
8109 eliminate multiple spaces (except at beginning of line), eliminate spaces at
8110 end of line, do nothing in comments."
8111   (interactive)
8112   (vhdl-fixup-whitespace-region (point-min) (point-max)))
8113
8114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8115 ;; Case fixing
8116
8117 (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
8118   "Convert all words matching WORD-REGEXP in region to lower or upper case,
8119 depending on parameter UPPER-CASE."
8120   (let ((case-replace nil)
8121         (last-update 0))
8122     (vhdl-prepare-search-2
8123      (save-excursion
8124        (goto-char end)
8125        (setq end (point-marker))
8126        (goto-char beg)
8127        (while (re-search-forward word-regexp end t)
8128          (or (vhdl-in-literal)
8129              (if upper-case
8130                  (upcase-word -1)
8131                (downcase-word -1)))
8132          (when (and count vhdl-progress-interval (not noninteractive)
8133                     (< vhdl-progress-interval
8134                        (- (nth 1 (current-time)) last-update)))
8135            (message "Fixing case... (%2d%s)"
8136                     (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg)))
8137                     "%")
8138            (setq last-update (nth 1 (current-time)))))
8139        (goto-char end)))))
8140
8141 (defun vhdl-fix-case-region (beg end &optional arg)
8142   "Convert all VHDL words in region to lower or upper case, depending on
8143 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8144   (interactive "r\nP")
8145   (vhdl-fix-case-region-1
8146    beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
8147   (vhdl-fix-case-region-1
8148    beg end vhdl-upper-case-types vhdl-types-regexp 1)
8149   (vhdl-fix-case-region-1
8150    beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
8151   (vhdl-fix-case-region-1
8152    beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
8153   (vhdl-fix-case-region-1
8154    beg end vhdl-upper-case-constants vhdl-constants-regexp 4)
8155   (when vhdl-progress-interval (message "Fixing case...done")))
8156
8157 (defun vhdl-fix-case-buffer ()
8158   "Convert all VHDL words in buffer to lower or upper case, depending on
8159 options vhdl-upper-case-{keywords,types,attributes,enum-values}."
8160   (interactive)
8161   (vhdl-fix-case-region (point-min) (point-max)))
8162
8163 (defun vhdl-fix-case-word (&optional arg)
8164   "Convert word after cursor to upper case if necessary."
8165   (interactive "p")
8166   (save-excursion
8167     (when arg (backward-word 1))
8168     (vhdl-prepare-search-1
8169      (when (and vhdl-upper-case-keywords
8170                 (looking-at vhdl-keywords-regexp))
8171        (upcase-word 1))
8172      (when (and vhdl-upper-case-types
8173                 (looking-at vhdl-types-regexp))
8174        (upcase-word 1))
8175      (when (and vhdl-upper-case-attributes
8176                 (looking-at vhdl-attributes-regexp))
8177        (upcase-word 1))
8178      (when (and vhdl-upper-case-enum-values
8179                 (looking-at vhdl-enum-values-regexp))
8180        (upcase-word 1))
8181      (when (and vhdl-upper-case-constants
8182                 (looking-at vhdl-constants-regexp))
8183        (upcase-word 1)))))
8184
8185 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8186 ;; Fix statements
8187 ;; - force each statement to be on a separate line except when on same line
8188 ;;   with 'end' keyword
8189
8190 (defun vhdl-fix-statement-region (beg end &optional arg)
8191   "Force statements in region on separate line except when on same line
8192 with `end' keyword (necessary for correct indentation).
8193 Currently supported keywords: `begin', `if'."
8194   (interactive "r\nP")
8195   (vhdl-prepare-search-2
8196    (let (point)
8197      (save-excursion
8198        (goto-char end)
8199        (setq end (point-marker))
8200        (goto-char beg)
8201        ;; `begin' keyword
8202        (while (re-search-forward
8203                "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t)
8204          (goto-char (match-end 0))
8205          (setq point (point-marker))
8206          (when (and (match-string 1)
8207                     (or (not (match-string 2))
8208                         (save-excursion (goto-char (match-end 2))
8209                                         (vhdl-in-literal)))
8210                     (not (save-excursion (goto-char (match-beginning 1))
8211                                          (vhdl-in-literal))))
8212            (goto-char (match-beginning 1))
8213            (insert "\n")
8214            (indent-according-to-mode))
8215          (goto-char point))
8216        (goto-char beg)
8217        ;; `for', `if' keywords
8218        (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t)
8219          (goto-char (match-end 1))
8220          (setq point (point-marker))
8221          ;; exception: in literal or preceded by `end', `wait' or label
8222          (when (and (not (save-excursion (goto-char (match-beginning 1))
8223                                          (vhdl-in-literal)))
8224                     (save-excursion
8225                       (beginning-of-line 1)
8226                       (save-match-data
8227                         (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)"
8228                                                 (match-beginning 1) t)
8229                              (not (string-match
8230                                    "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$"
8231                                    (match-string 1)))))))
8232            (goto-char (match-beginning 1))
8233            (insert "\n")
8234            (indent-according-to-mode))
8235          (goto-char point))))))
8236
8237 (defun vhdl-fix-statement-buffer ()
8238   "Force statements in buffer on separate line except when on same line
8239 with `end' keyword (necessary for correct indentation)."
8240   (interactive)
8241   (vhdl-fix-statement-region (point-min) (point-max)))
8242
8243 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8244 ;; Trailing spaces
8245
8246 (defun vhdl-remove-trailing-spaces-region (beg end &optional arg)
8247   "Remove trailing spaces in region."
8248   (interactive "r\nP")
8249   (save-excursion
8250     (goto-char end)
8251     (setq end (point-marker))
8252     (goto-char beg)
8253     (while (re-search-forward "[ \t]+$" end t)
8254       (unless (vhdl-in-literal)
8255         (replace-match "" nil nil)))))
8256
8257 (defun vhdl-remove-trailing-spaces ()
8258   "Remove trailing spaces in buffer."
8259   (interactive)
8260   (vhdl-remove-trailing-spaces-region (point-min) (point-max)))
8261
8262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8263 ;; Beautify
8264
8265 (defun vhdl-beautify-region (beg end)
8266   "Beautify region by applying indentation, whitespace fixup, alignment, and
8267 case fixing to a region.  Calls functions `vhdl-indent-buffer',
8268 `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
8269 `vhdl-fix-case-buffer'."
8270   (interactive "r")
8271   (setq end (save-excursion (goto-char end) (point-marker)))
8272   (save-excursion ; remove DOS EOL characters in UNIX file
8273     (goto-char beg)
8274     (while (search-forward "\r" nil t)
8275       (replace-match "" nil t)))
8276   (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t))
8277   (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end))
8278   (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end))
8279   (when (nth 3 vhdl-beautify-options)
8280     (let ((vhdl-align-groups t)) (vhdl-align-region beg end)))
8281   (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end))
8282   (when (nth 0 vhdl-beautify-options)
8283     (vhdl-remove-trailing-spaces-region beg end)
8284     (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end))))
8285
8286 (defun vhdl-beautify-buffer ()
8287   "Beautify buffer by applying indentation, whitespace fixup, alignment, and
8288 case fixing to entire buffer.  Calls `vhdl-beautify-region' for the entire
8289 buffer."
8290   (interactive)
8291   (vhdl-beautify-region (point-min) (point-max))
8292   (when noninteractive (save-buffer)))
8293
8294 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8295 ;; Code filling
8296
8297 (defun vhdl-fill-region (beg end &optional arg)
8298   "Fill lines for a region of code."
8299   (interactive "r\np")
8300   (save-excursion
8301     (goto-char beg)
8302     (let ((margin (if arg (current-indentation) (current-column))))
8303       (goto-char end)
8304       (setq end (point-marker))
8305       ;; remove inline comments, newlines and whitespace
8306       (vhdl-comment-kill-region beg end)
8307       (vhdl-comment-kill-inline-region beg end)
8308       (subst-char-in-region beg (1- end) ?\n ?\ )
8309       (vhdl-fixup-whitespace-region beg end)
8310       ;; wrap and end-comment-column
8311       (goto-char beg)
8312       (while (re-search-forward "\\s-" end t)
8313         (when(> (current-column) vhdl-end-comment-column)
8314           (backward-char)
8315           (when (re-search-backward "\\s-" beg t)
8316             (replace-match "\n")
8317             (indent-to margin)))))))
8318
8319 (defun vhdl-fill-group ()
8320   "Fill group of lines between empty lines."
8321   (interactive)
8322   (vhdl-do-group 'vhdl-fill-region))
8323
8324 (defun vhdl-fill-list ()
8325   "Fill the lines of a list surrounded by a balanced group of parentheses."
8326   (interactive)
8327   (vhdl-do-list 'vhdl-fill-region))
8328
8329 (defun vhdl-fill-same-indent ()
8330   "Fill the lines of block of lines with same indent."
8331   (interactive)
8332   (vhdl-do-same-indent 'vhdl-fill-region))
8333
8334
8335 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8336 ;;; Code updating/fixing
8337 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8338
8339 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8340 ;; Sensitivity list update
8341
8342 ;; Strategy:
8343 ;; - no sensitivity list is generated for processes with wait statements
8344 ;; - otherwise, do the following:
8345 ;;   1. scan for all local signals (ports, signals declared in arch./blocks)
8346 ;;   2. scan for all signals already in the sensitivity list (in order to catch
8347 ;;      manually entered global signals)
8348 ;;   3. signals from 1. and 2. form the list of visible signals
8349 ;;   4. search for if/elsif conditions containing an event (sequential code)
8350 ;;   5. scan for strings that are within syntactical regions where signals are
8351 ;;      read but not within sequential code, and that correspond to visible
8352 ;;      signals
8353 ;;   6. replace sensitivity list by list of signals from 5.
8354
8355 (defun vhdl-update-sensitivity-list-process ()
8356   "Update sensitivity list of current process."
8357   (interactive)
8358   (save-excursion
8359     (vhdl-prepare-search-2
8360      (end-of-line)
8361      ;; look whether in process
8362      (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
8363                    (equal (upcase (match-string 2)) "PROCESS")
8364                    (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
8365          (error "ERROR:  Not within a process")
8366        (message "Updating sensitivity list...")
8367        (vhdl-update-sensitivity-list)
8368        (message "Updating sensitivity list...done")))))
8369
8370 (defun vhdl-update-sensitivity-list-buffer ()
8371   "Update sensitivity list of all processes in current buffer."
8372   (interactive)
8373   (save-excursion
8374     (vhdl-prepare-search-2
8375      (goto-char (point-min))
8376      (message "Updating sensitivity lists...")
8377      (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t)
8378        (goto-char (match-beginning 0))
8379        (condition-case nil (vhdl-update-sensitivity-list) (error "")))
8380      (message "Updating sensitivity lists...done")))
8381   (when noninteractive (save-buffer)))
8382
8383 (defun vhdl-update-sensitivity-list ()
8384   "Update sensitivity list."
8385     (let ((proc-beg (point))
8386           (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
8387           (proc-mid (vhdl-re-search-backward
8388                      "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t))
8389           seq-region-list)
8390       (cond
8391        ;; error if 'begin' keyword missing
8392        ((not (match-string 2))
8393         (error "ERROR:  No 'begin' keyword found"))
8394        ;; search for wait statement (no sensitivity list allowed)
8395        ((progn (goto-char proc-mid)
8396                (vhdl-re-search-forward "\\<wait\\>" proc-end t))
8397         (error "ERROR:  Process with wait statement, sensitivity list not generated"))
8398        ;; combinational process (update sensitivity list)
8399        (t
8400         (let
8401             ;; scan for visible signals
8402             ((visible-list (vhdl-get-visible-signals))
8403              ;; define syntactic regions where signals are read
8404              (scan-regions-list
8405               '(;; right-hand side of signal/variable assignment
8406                 ;; (special case: "<=" is relational operator in a condition)
8407                 ((vhdl-re-search-forward "[<:]=" proc-end t)
8408                  (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
8409                 ;; if condition
8410                 ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t)
8411                  (vhdl-re-search-forward "\\<then\\>" proc-end t))
8412                 ;; elsif condition
8413                 ((vhdl-re-search-forward "\\<elsif\\>" proc-end t)
8414                  (vhdl-re-search-forward "\\<then\\>" proc-end t))
8415                 ;; while loop condition
8416                 ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t)
8417                  (vhdl-re-search-forward "\\<loop\\>" proc-end t))
8418                 ;; exit/next condition
8419                 ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
8420                  (vhdl-re-search-forward ";" proc-end t))
8421                 ;; assert condition
8422                 ((vhdl-re-search-forward "\\<assert\\>" proc-end t)
8423                  (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
8424                 ;; case expression
8425                 ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t)
8426                  (vhdl-re-search-forward "\\<is\\>" proc-end t))
8427                 ;; parameter list of procedure call, array index
8428                 ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t)
8429                       (1- (point)))
8430                  (progn (backward-char) (forward-sexp)
8431                         (while (looking-at "(") (forward-sexp)) (point)))))
8432              name field read-list sens-list signal-list tmp-list
8433              sens-beg sens-end beg end margin)
8434           ;; scan for signals in old sensitivity list
8435           (goto-char proc-beg)
8436           (vhdl-re-search-forward "\\<process\\>" proc-mid t)
8437           (if (not (looking-at "[ \t\n\r\f]*("))
8438               (setq sens-beg (point))
8439             (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t))
8440             (goto-char (match-end 1))
8441             (forward-sexp)
8442             (setq sens-end (1- (point)))
8443             (goto-char sens-beg)
8444             (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t)
8445                         (setq sens-list
8446                               (cons (downcase (match-string 0)) sens-list))
8447                         (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t))))
8448           (setq signal-list (append visible-list sens-list))
8449           ;; search for sequential parts
8450           (goto-char proc-mid)
8451           (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
8452             (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t))
8453             (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
8454               (goto-char end)
8455               (backward-word-strictly 1)
8456               (vhdl-forward-sexp)
8457               (push (cons end (point)) seq-region-list)
8458               (beginning-of-line)))
8459           ;; scan for signals read in process
8460           (while scan-regions-list
8461             (goto-char proc-mid)
8462             (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
8463                         (setq end (eval (nth 1 (car scan-regions-list)))))
8464               (goto-char beg)
8465               (unless (or (vhdl-in-literal)
8466                           (and seq-region-list
8467                                (let ((tmp-list seq-region-list))
8468                                  (while (and tmp-list
8469                                              (< (point) (caar tmp-list)))
8470                                    (setq tmp-list (cdr tmp-list)))
8471                                  (and tmp-list (< (point) (cdar tmp-list))))))
8472                 (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t)
8473                   (setq name (match-string 1))
8474                   ;; get array index range
8475                   (when vhdl-array-index-record-field-in-sensitivity-list
8476                     (setq field (match-string 2))
8477                     ;; not use if it includes a variable name
8478                     (save-match-data
8479                       (setq tmp-list visible-list)
8480                       (while (and field tmp-list)
8481                         (when (string-match
8482                                (concat "\\<" (car tmp-list) "\\>") field)
8483                           (setq field nil))
8484                         (setq tmp-list (cdr tmp-list)))))
8485                   (when (and (not (match-string 6)) ; not when formal parameter
8486                              (not (and (match-string 5) ; not event attribute
8487                                        (not (member (downcase (match-string 5))
8488                                                     '("event" "last_event" "transaction")))))
8489                              (member (downcase name) signal-list))
8490                     ;; not add if name or name+field already exists
8491                     (unless
8492                         (or (member-ignore-case name read-list)
8493                             (member-ignore-case (concat name field) read-list))
8494                       (push (concat name field) read-list))
8495                     (setq tmp-list read-list)
8496                     ;; remove existing name+field if name is added
8497                     (save-match-data
8498                       (while tmp-list
8499                         (when (string-match (concat "^" name field "[(.]")
8500                                             (car tmp-list))
8501                           (setq read-list (delete (car tmp-list) read-list)))
8502                         (setq tmp-list (cdr tmp-list)))))
8503                   (goto-char (match-end 1)))))
8504             (setq scan-regions-list (cdr scan-regions-list)))
8505           ;; update sensitivity list
8506           (goto-char sens-beg)
8507           (if sens-end
8508               (delete-region sens-beg sens-end)
8509             (when read-list
8510               (insert " ()") (backward-char)))
8511           (setq read-list (sort read-list 'string<))
8512           (when read-list
8513             (setq margin (current-column))
8514             (insert (car read-list))
8515             (setq read-list (cdr read-list))
8516             (while read-list
8517               (insert ",")
8518               (if (<= (+ (current-column) (length (car read-list)) 2)
8519                       end-comment-column)
8520                   (insert " ")
8521                 (insert "\n") (indent-to margin))
8522               (insert (car read-list))
8523               (setq read-list (cdr read-list)))))))))
8524
8525 (defun vhdl-get-visible-signals ()
8526   "Get all signals visible in the current block."
8527   (let (beg end signal-list entity-name file-name)
8528     (vhdl-prepare-search-2
8529      ;; get entity name
8530      (save-excursion
8531        (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
8532                     (not (equal "END" (upcase (match-string 1))))
8533                     (setq entity-name (match-string 2)))
8534          (error "ERROR:  Not within an architecture")))
8535      ;; search for signals declared in entity port clause
8536      (save-excursion
8537        (goto-char (point-min))
8538        (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
8539          (setq file-name
8540                (concat (vhdl-replace-string vhdl-entity-file-name entity-name t)
8541                        "." (file-name-extension (buffer-file-name)))))
8542        (vhdl-visit-file
8543         file-name t
8544         (vhdl-prepare-search-2
8545          (goto-char (point-min))
8546          (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
8547              (error "ERROR:  Entity \"%s\" not found:\n  --> see option `vhdl-entity-file-name'" entity-name)
8548            (when (setq beg (vhdl-re-search-forward
8549                             "\\<port[ \t\n\r\f]*("
8550                             (save-excursion
8551                               (re-search-forward "^end\\>" nil t)) t))
8552              (setq end (save-excursion
8553                          (backward-char) (forward-sexp) (point)))
8554              (vhdl-forward-syntactic-ws)
8555              (while (< (point) end)
8556                (when (looking-at "signal[ \t\n\r\f]+")
8557                  (goto-char (match-end 0)))
8558                (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+")
8559                  (setq signal-list
8560                        (cons (downcase (match-string 1)) signal-list))
8561                  (goto-char (match-end 0))
8562                  (vhdl-forward-syntactic-ws))
8563                (re-search-forward ";" end 1)
8564                (vhdl-forward-syntactic-ws)))))))
8565      ;; search for signals declared in architecture declarative part
8566      (save-excursion
8567        (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
8568                      (not (equal "END" (upcase (match-string 1))))
8569                      (setq end (re-search-forward "^begin\\>" nil t))))
8570            (error "ERROR:  No architecture declarative part found")
8571          ;; scan for all declared signal and alias names
8572          (goto-char beg)
8573          (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8574            (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8575              (if (match-string 2)
8576                  ;; scan signal name
8577                  (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)")
8578                    (setq signal-list
8579                          (cons (downcase (match-string 1)) signal-list))
8580                    (goto-char (match-end 0)))
8581                ;; scan alias name, check is alias of (declared) signal
8582                (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)")
8583                           (member (downcase (match-string 2)) signal-list))
8584                  (setq signal-list
8585                        (cons (downcase (match-string 1)) signal-list))
8586                  (goto-char (match-end 0))))
8587              (setq beg (point))))))
8588      ;; search for signals declared in surrounding block declarative parts
8589      (save-excursion
8590        (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t))
8591                                       (match-string 4))
8592                             (goto-char (match-end 4))
8593                             (vhdl-backward-sexp)
8594                             (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t))
8595                           beg)
8596                    (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
8597          ;; scan for all declared signal names
8598          (goto-char beg)
8599          (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t)
8600            (when (= 0 (nth 0 (parse-partial-sexp beg (point))))
8601              (if (match-string 2)
8602                  ;; scan signal name
8603                  (while (looking-at "[ \t\n,]+\\(\\w+\\)")
8604                    (setq signal-list
8605                          (cons (downcase (match-string 1)) signal-list))
8606                    (goto-char (match-end 0)))
8607                ;; scan alias name, check is alias of (declared) signal
8608                (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)")
8609                           (member (downcase (match-string 2)) signal-list))
8610                  (setq signal-list
8611                        (cons (downcase (match-string 1)) signal-list))
8612                  (goto-char (match-end 0))))))
8613          (goto-char beg)))
8614      signal-list)))
8615
8616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8617 ;; Generic/port clause fixing
8618
8619 (defun vhdl-fix-clause-buffer ()
8620   "Fix all generic/port clauses in current buffer."
8621   (interactive)
8622   (save-excursion
8623     (vhdl-prepare-search-2
8624      (goto-char (point-min))
8625      (message "Fixing generic/port clauses...")
8626      (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)
8627        (goto-char (match-end 0))
8628        (condition-case nil (vhdl-fix-clause) (error "")))
8629      (message "Fixing generic/port clauses...done"))))
8630
8631 (defun vhdl-fix-clause ()
8632   "Fix closing parenthesis within generic/port clause."
8633   (interactive)
8634   (save-excursion
8635     (vhdl-prepare-search-2
8636      (let ((pos (point))
8637            beg end)
8638        (end-of-line)
8639        (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t))
8640            (error "ERROR:  Not within a generic/port clause")
8641          ;; search for end of clause
8642          (goto-char (match-end 0))
8643          (setq beg (1- (point)))
8644          (vhdl-forward-syntactic-ws)
8645          (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;")
8646            (goto-char (1- (match-end 0)))
8647            (setq end (point-marker))
8648            (forward-char)
8649            (vhdl-forward-syntactic-ws))
8650          (goto-char end)
8651          (when (> pos (point-at-eol))
8652            (error "ERROR:  Not within a generic/port clause"))
8653          ;; delete closing parenthesis on separate line (not supported style)
8654          (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
8655            (vhdl-line-kill)
8656            (vhdl-backward-syntactic-ws)
8657            (setq end (point-marker))
8658            (insert ";"))
8659          ;; delete superfluous parentheses
8660          (while (progn (goto-char beg)
8661                        (condition-case () (forward-sexp)
8662                          (error (goto-char (point-max))))
8663                        (< (point) end))
8664            (delete-char -1))
8665          ;; add closing parenthesis
8666          (when (> (point) end)
8667            (goto-char end)
8668            (insert ")")))))))
8669
8670
8671 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8672 ;;; Electrification
8673 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8674
8675 (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]"
8676   "Syntax of prompt inserted by template generators.")
8677
8678 (defvar vhdl-template-invoked-by-hook nil
8679   "Indicates whether a template has been invoked by a hook or by key or menu.
8680 Used for undoing after template abortion.")
8681
8682 ;; correct different behavior of function `unread-command-events' in XEmacs
8683 (defun vhdl-character-to-event (arg))
8684 (defalias 'vhdl-character-to-event
8685   (if (fboundp 'character-to-event) 'character-to-event 'identity))
8686
8687 (defun vhdl-work-library ()
8688   "Return the working library name of the current project or \"work\" if no
8689 project is defined."
8690   (vhdl-resolve-env-variable
8691    (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project))
8692        vhdl-default-library)))
8693
8694 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8695 ;;  Enabling/disabling
8696
8697 (define-minor-mode vhdl-electric-mode
8698   "Toggle VHDL electric mode.
8699 With a prefix argument ARG, enable the mode if ARG is positive,
8700 and disable it otherwise.  If called from Lisp, enable it if ARG
8701 is omitted or nil."
8702   :global t :group 'vhdl-mode)
8703
8704 (define-minor-mode vhdl-stutter-mode
8705   "Toggle VHDL stuttering mode.
8706 With a prefix argument ARG, enable the mode if ARG is positive,
8707 and disable it otherwise.  If called from Lisp, enable it if ARG
8708 is omitted or nil."
8709   :global t :group 'vhdl-mode)
8710
8711 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8712 ;; Stuttering
8713
8714 (defun vhdl-electric-dash (count)
8715   "-- starts a comment, --- draws a horizontal line,
8716 ---- starts a display comment."
8717   (interactive "p")
8718   (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
8719       (cond
8720        ((and abbrev-start-location (= abbrev-start-location (point)))
8721         (setq abbrev-start-location nil)
8722         (goto-char last-abbrev-location)
8723         (beginning-of-line nil)
8724         (vhdl-comment-display))
8725        ((/= (preceding-char) ?-)        ; standard dash (minus)
8726         (self-insert-command count))
8727        (t (self-insert-command count)
8728           (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment")
8729           (let ((next-input (read-char)))
8730             (if (= next-input ?-)       ; triple dash
8731                 (progn
8732                   (vhdl-comment-display-line)
8733                   (message
8734                    "Enter '-' for display comment, else continue coding")
8735                   (let ((next-input (read-char)))
8736                     (if (= next-input ?-) ; four dashes
8737                         (vhdl-comment-display t)
8738                       (push (vhdl-character-to-event next-input)
8739                                         ; pushback the char
8740                             unread-command-events))))
8741               (push (vhdl-character-to-event next-input) ; pushback the char
8742                     unread-command-events)
8743               (vhdl-comment-insert)))))
8744     (self-insert-command count)))
8745
8746 (defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['"
8747   (interactive "p")
8748   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8749       (if (= (preceding-char) ?\()
8750           (progn (delete-char -1) (insert-char ?\[ 1))
8751         (insert-char ?\( 1))
8752     (self-insert-command count)))
8753
8754 (defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'"
8755   (interactive "p")
8756   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8757       (progn
8758         (if (= (preceding-char) ?\))
8759             (progn (delete-char -1) (insert-char ?\] 1))
8760           (insert-char ?\) 1))
8761         (blink-matching-open))
8762     (self-insert-command count)))
8763
8764 (defun vhdl-electric-quote (count) "\\='\\=' --> \""
8765   (interactive "p")
8766   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8767       (if (= (preceding-char) vhdl-last-input-event)
8768           (progn (delete-char -1) (insert-char ?\" 1))
8769         (insert-char ?\' 1))
8770     (self-insert-command count)))
8771
8772 (defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '"
8773   (interactive "p")
8774   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8775       (cond ((= (preceding-char) vhdl-last-input-event)
8776              (progn (delete-char -1)
8777                     (unless (eq (preceding-char) ? ) (insert " "))
8778                     (insert ": ")
8779                     (setq this-command 'vhdl-electric-colon)))
8780             ((and
8781               (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? ))
8782              (progn (delete-char -1) (insert "= ")))
8783             (t (insert-char ?\; 1)))
8784     (self-insert-command count)))
8785
8786 (defun vhdl-electric-comma (count) "`,,' --> ` <= '"
8787   (interactive "p")
8788   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8789       (cond ((= (preceding-char) vhdl-last-input-event)
8790              (progn (delete-char -1)
8791                     (unless (eq (preceding-char) ? ) (insert " "))
8792                     (insert "<= ")))
8793             (t (insert-char ?\, 1)))
8794     (self-insert-command count)))
8795
8796 (defun vhdl-electric-period (count) "`..' --> ` => '"
8797   (interactive "p")
8798   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8799       (cond ((= (preceding-char) vhdl-last-input-event)
8800              (progn (delete-char -1)
8801                     (unless (eq (preceding-char) ? ) (insert " "))
8802                     (insert "=> ")))
8803             (t (insert-char ?\. 1)))
8804     (self-insert-command count)))
8805
8806 (defun vhdl-electric-equal (count) "`==' --> ` == '"
8807   (interactive "p")
8808   (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
8809       (cond ((= (preceding-char) vhdl-last-input-event)
8810              (progn (delete-char -1)
8811                     (unless (eq (preceding-char) ? ) (insert " "))
8812                     (insert "== ")))
8813             (t (insert-char ?\= 1)))
8814     (self-insert-command count)))
8815
8816 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8817 ;;  VHDL templates
8818
8819 (defun vhdl-template-paired-parens ()
8820   "Insert a pair of round parentheses, placing point between them."
8821   (interactive)
8822   (insert "()")
8823   (backward-char))
8824
8825 (defun vhdl-template-alias ()
8826   "Insert alias declaration."
8827   (interactive)
8828   (let ((start (point)))
8829     (vhdl-insert-keyword "ALIAS ")
8830     (when (vhdl-template-field "name" nil t start (point))
8831       (insert " : ")
8832       (unless (vhdl-template-field
8833                (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8834                nil t)
8835         (delete-char -3))
8836       (vhdl-insert-keyword " IS ")
8837       (vhdl-template-field "name" ";")
8838       (vhdl-comment-insert-inline))))
8839
8840 (defun vhdl-template-architecture ()
8841   "Insert architecture."
8842   (interactive)
8843   (let ((margin (current-indentation))
8844         (start (point))
8845         arch-name)
8846     (vhdl-insert-keyword "ARCHITECTURE ")
8847     (when (setq arch-name
8848                 (vhdl-template-field "name" nil t start (point)))
8849       (vhdl-insert-keyword " OF ")
8850       (if (save-excursion
8851             (vhdl-prepare-search-1
8852              (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8853           (insert (match-string 1))
8854         (vhdl-template-field "entity name"))
8855       (vhdl-insert-keyword " IS\n")
8856       (vhdl-template-begin-end
8857        (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8858        (memq vhdl-insert-empty-lines '(unit all))))))
8859
8860 (defun vhdl-template-array (kind &optional secondary)
8861   "Insert array type definition."
8862   (interactive)
8863   (let ((start (point)))
8864     (vhdl-insert-keyword "ARRAY (")
8865     (when (or (vhdl-template-field "range" nil (not secondary) start (point))
8866               secondary)
8867       (vhdl-insert-keyword ") OF ")
8868       (vhdl-template-field (if (eq kind 'type) "type" "nature"))
8869       (vhdl-insert-keyword ";"))))
8870
8871 (defun vhdl-template-assert ()
8872   "Insert an assertion statement."
8873   (interactive)
8874   (let ((start (point)))
8875     (vhdl-insert-keyword "ASSERT ")
8876     (when vhdl-conditions-in-parenthesis (insert "("))
8877     (when (vhdl-template-field "condition (negated)" nil t start (point))
8878       (when vhdl-conditions-in-parenthesis (insert ")"))
8879       (setq start (point))
8880       (vhdl-insert-keyword " REPORT ")
8881       (unless (vhdl-template-field "string expression" nil nil nil nil t)
8882         (delete-region start (point)))
8883       (setq start (point))
8884       (vhdl-insert-keyword " SEVERITY ")
8885       (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
8886         (delete-region start (point)))
8887       (insert ";"))))
8888
8889 (defun vhdl-template-attribute ()
8890   "Insert an attribute declaration or specification."
8891   (interactive)
8892   (if (eq (vhdl-decision-query
8893            "attribute" "(d)eclaration or (s)pecification?" t) ?s)
8894       (vhdl-template-attribute-spec)
8895     (vhdl-template-attribute-decl)))
8896
8897 (defun vhdl-template-attribute-decl ()
8898   "Insert an attribute declaration."
8899   (interactive)
8900   (let ((start (point)))
8901     (vhdl-insert-keyword "ATTRIBUTE ")
8902     (when (vhdl-template-field "name" " : " t start (point))
8903       (vhdl-template-field "type" ";")
8904       (vhdl-comment-insert-inline))))
8905
8906 (defun vhdl-template-attribute-spec ()
8907   "Insert an attribute specification."
8908   (interactive)
8909   (let ((start (point)))
8910     (vhdl-insert-keyword "ATTRIBUTE ")
8911     (when (vhdl-template-field "name" nil t start (point))
8912       (vhdl-insert-keyword " OF ")
8913       (vhdl-template-field "entity names | OTHERS | ALL" " : ")
8914       (vhdl-template-field "entity class")
8915       (vhdl-insert-keyword " IS ")
8916       (vhdl-template-field "expression" ";"))))
8917
8918 (defun vhdl-template-block ()
8919   "Insert a block."
8920   (interactive)
8921   (let ((margin (current-indentation))
8922         (start (point))
8923         label)
8924     (vhdl-insert-keyword ": BLOCK ")
8925     (goto-char start)
8926     (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8)))
8927       (forward-word-strictly 1)
8928       (forward-char 1)
8929       (insert "(")
8930       (if (vhdl-template-field "[guard expression]" nil t)
8931           (insert ")")
8932         (delete-char -2))
8933       (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8934       (insert "\n")
8935       (vhdl-template-begin-end "BLOCK" label margin)
8936       (vhdl-comment-block))))
8937
8938 (defun vhdl-template-block-configuration ()
8939   "Insert a block configuration statement."
8940   (interactive)
8941   (let ((margin (current-indentation))
8942         (start (point)))
8943     (vhdl-insert-keyword "FOR ")
8944     (when (vhdl-template-field "block name" nil t start (point))
8945       (vhdl-insert-keyword "\n\n")
8946       (indent-to margin)
8947       (vhdl-insert-keyword "END FOR;")
8948       (end-of-line 0)
8949       (indent-to (+ margin vhdl-basic-offset)))))
8950
8951 (defun vhdl-template-break ()
8952   "Insert a break statement."
8953   (interactive)
8954   (let (position)
8955     (vhdl-insert-keyword "BREAK")
8956     (setq position (point))
8957     (insert " ")
8958     (while (or
8959             (progn (vhdl-insert-keyword "FOR ")
8960                    (if (vhdl-template-field "[quantity name]" " USE " t)
8961                        (progn (vhdl-template-field "quantity name" " => ") t)
8962                      (delete-region (point)
8963                                     (progn (forward-word-strictly -1) (point)))
8964                      nil))
8965             (vhdl-template-field "[quantity name]" " => " t))
8966       (vhdl-template-field "expression")
8967       (setq position (point))
8968       (insert ", "))
8969     (delete-region position (point))
8970     (unless (vhdl-sequential-statement-p)
8971       (vhdl-insert-keyword " ON ")
8972       (if (vhdl-template-field "[sensitivity list]" nil t)
8973           (setq position (point))
8974         (delete-region position (point))))
8975     (vhdl-insert-keyword " WHEN ")
8976     (when vhdl-conditions-in-parenthesis (insert "("))
8977     (if (vhdl-template-field "[condition]" nil t)
8978         (when vhdl-conditions-in-parenthesis (insert ")"))
8979       (delete-region position (point)))
8980     (insert ";")))
8981
8982 (defun vhdl-template-case (&optional kind)
8983   "Insert a case statement."
8984   (interactive)
8985   (let ((margin (current-indentation))
8986         (start (point))
8987         label)
8988     (unless kind (setq kind (if (or (vhdl-sequential-statement-p)
8989                                     (not (vhdl-standard-p 'ams))) 'is 'use)))
8990     (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
8991         (vhdl-insert-keyword "CASE ")
8992       (vhdl-insert-keyword ": CASE ")
8993       (goto-char start)
8994       (setq label (vhdl-template-field "[label]" nil t))
8995       (unless label (delete-char 2))
8996       (forward-word-strictly 1)
8997       (forward-char 1))
8998     (when (vhdl-template-field "expression" nil t start (point))
8999       (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n"))
9000       (indent-to margin)
9001       (vhdl-insert-keyword "END CASE")
9002       (when label (insert " " label))
9003       (insert ";")
9004       (forward-line -1)
9005       (indent-to (+ margin vhdl-basic-offset))
9006       (vhdl-insert-keyword "WHEN ")
9007       (let ((position (point)))
9008         (insert " => ;\n")
9009         (indent-to (+ margin vhdl-basic-offset))
9010         (vhdl-insert-keyword "WHEN OTHERS => null;")
9011         (goto-char position)))))
9012
9013 (defun vhdl-template-case-is ()
9014   "Insert a sequential case statement."
9015   (interactive)
9016   (vhdl-template-case 'is))
9017
9018 (defun vhdl-template-case-use ()
9019   "Insert a simultaneous case statement."
9020   (interactive)
9021   (vhdl-template-case 'use))
9022
9023 (defun vhdl-template-component ()
9024   "Insert a component declaration."
9025   (interactive)
9026   (vhdl-template-component-decl))
9027
9028 (defun vhdl-template-component-conf ()
9029   "Insert a component configuration (uses `vhdl-template-configuration-spec'
9030 since these are almost equivalent)."
9031   (interactive)
9032   (let ((margin (current-indentation))
9033         (result (vhdl-template-configuration-spec t)))
9034     (when result
9035       (insert "\n")
9036       (indent-to margin)
9037       (vhdl-insert-keyword "END FOR;")
9038       (when (eq result 'no-use)
9039         (end-of-line -0)))))
9040
9041 (defun vhdl-template-component-decl ()
9042   "Insert a component declaration."
9043   (interactive)
9044   (let ((margin (current-indentation))
9045         (start (point))
9046         name end-column)
9047     (vhdl-insert-keyword "COMPONENT ")
9048     (when (setq name (vhdl-template-field "name" nil t start (point)))
9049       (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9050       (insert "\n\n")
9051       (indent-to margin)
9052       (vhdl-insert-keyword "END COMPONENT")
9053       (unless (vhdl-standard-p '87) (insert " " name))
9054       (insert ";")
9055       (setq end-column (current-column))
9056       (end-of-line -0)
9057       (indent-to (+ margin vhdl-basic-offset))
9058       (vhdl-template-generic-list t t)
9059       (insert "\n")
9060       (indent-to (+ margin vhdl-basic-offset))
9061       (vhdl-template-port-list t)
9062       (beginning-of-line 2)
9063       (forward-char end-column))))
9064
9065 (defun vhdl-template-component-inst ()
9066   "Insert a component instantiation statement."
9067   (interactive)
9068   (let ((margin (current-indentation))
9069         (start (point))
9070         unit position)
9071     (when (vhdl-template-field "instance label" nil t start (point))
9072       (insert ": ")
9073       (if (not (vhdl-use-direct-instantiation))
9074           (vhdl-template-field "component name")
9075         ;; direct instantiation
9076         (setq unit (vhdl-template-field
9077                     "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
9078         (setq unit (upcase (or unit "")))
9079         (cond ((equal unit "ENTITY")
9080                (let ((begin (point)))
9081                  (vhdl-template-field "library name" "." t begin (point) nil
9082                                     (vhdl-work-library))
9083                (vhdl-template-field "entity name" "(")
9084                (if (vhdl-template-field "[architecture name]" nil t)
9085                    (insert ")")
9086                    (delete-char -1))))
9087               ((equal unit "CONFIGURATION")
9088                (vhdl-template-field "library name" "." nil nil nil nil
9089                                     (vhdl-work-library))
9090                (vhdl-template-field "configuration name"))
9091               (t (vhdl-template-field "component name"))))
9092       (insert "\n")
9093       (indent-to (+ margin vhdl-basic-offset))
9094       (setq position (point))
9095       (vhdl-insert-keyword "GENERIC ")
9096       (when (vhdl-template-map position t t)
9097         (insert "\n")
9098         (indent-to (+ margin vhdl-basic-offset)))
9099       (setq position (point))
9100       (vhdl-insert-keyword "PORT ")
9101       (unless (vhdl-template-map position t t)
9102         (delete-region (line-beginning-position) (point))
9103         (delete-char -1))
9104       (insert ";"))))
9105
9106 (defun vhdl-template-conditional-signal-asst ()
9107   "Insert a conditional signal assignment."
9108   (interactive)
9109   (when (vhdl-template-field "target signal")
9110     (insert " <= ")
9111     (let ((margin (current-column))
9112           (start (point))
9113           position)
9114       (vhdl-template-field "waveform")
9115       (setq position (point))
9116       (vhdl-insert-keyword " WHEN ")
9117       (when vhdl-conditions-in-parenthesis (insert "("))
9118       (while (and (vhdl-template-field "[condition]" nil t)
9119                   (progn
9120                     (when vhdl-conditions-in-parenthesis (insert ")"))
9121                     (setq position (point))
9122                     (vhdl-insert-keyword " ELSE")
9123                     (insert "\n")
9124                     (indent-to margin)
9125                     (vhdl-template-field "[waveform]" nil t)))
9126         (setq position (point))
9127         (vhdl-insert-keyword " WHEN ")
9128         (when vhdl-conditions-in-parenthesis (insert "(")))
9129       (delete-region position (point))
9130       (insert ";")
9131       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9132
9133 (defun vhdl-template-configuration ()
9134   "Insert a configuration specification if within an architecture,
9135 a block or component configuration if within a configuration declaration,
9136 a configuration declaration if not within a design unit."
9137   (interactive)
9138   (vhdl-prepare-search-1
9139    (cond
9140     ((and (save-excursion               ; architecture body
9141             (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
9142           (equal "ARCHITECTURE" (upcase (match-string 1))))
9143      (vhdl-template-configuration-spec))
9144     ((and (save-excursion               ; configuration declaration
9145             (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9146           (equal "CONFIGURATION" (upcase (match-string 1))))
9147      (if (eq (vhdl-decision-query
9148               "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
9149          (vhdl-template-component-conf)
9150        (vhdl-template-block-configuration)))
9151     (t (vhdl-template-configuration-decl))))) ; otherwise
9152
9153 (defun vhdl-template-configuration-spec (&optional optional-use)
9154   "Insert a configuration specification."
9155   (interactive)
9156   (let ((margin (current-indentation))
9157         (start (point))
9158         aspect position)
9159     (vhdl-insert-keyword "FOR ")
9160     (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
9161                                t start (point))
9162       (vhdl-template-field "component name" "\n")
9163       (indent-to (+ margin vhdl-basic-offset))
9164       (setq start (point))
9165       (vhdl-insert-keyword "USE ")
9166       (if (and optional-use
9167                (not (setq aspect (vhdl-template-field
9168                                   "[ENTITY | CONFIGURATION | OPEN]" " " t))))
9169           (progn (delete-region start (point)) 'no-use)
9170         (unless optional-use
9171           (setq aspect (vhdl-template-field
9172                         "ENTITY | CONFIGURATION | OPEN" " ")))
9173         (setq aspect (upcase (or aspect "")))
9174         (cond ((equal aspect "ENTITY")
9175                (vhdl-template-field "library name" "." nil nil nil nil
9176                                     (vhdl-work-library))
9177                (vhdl-template-field "entity name" "(")
9178                (if (vhdl-template-field "[architecture name]" nil t)
9179                    (insert ")")
9180                  (delete-char -1))
9181                (insert "\n")
9182                (indent-to (+ margin (* 2 vhdl-basic-offset)))
9183                (setq position (point))
9184                (vhdl-insert-keyword "GENERIC ")
9185                (when (vhdl-template-map position t t)
9186                  (insert "\n")
9187                  (indent-to (+ margin (* 2 vhdl-basic-offset))))
9188                (setq position (point))
9189                (vhdl-insert-keyword "PORT ")
9190                (unless (vhdl-template-map position t t)
9191                  (delete-region (line-beginning-position) (point))
9192                  (delete-char -1))
9193                (insert ";")
9194                t)
9195               ((equal aspect "CONFIGURATION")
9196                (vhdl-template-field "library name" "." nil nil nil nil
9197                                     (vhdl-work-library))
9198                (vhdl-template-field "configuration name" ";"))
9199               (t (delete-char -1) (insert ";") t))))))
9200
9201
9202 (defun vhdl-template-configuration-decl ()
9203   "Insert a configuration declaration."
9204   (interactive)
9205   (let ((margin (current-indentation))
9206         (start (point))
9207         entity-exists string name position)
9208     (vhdl-insert-keyword "CONFIGURATION ")
9209     (when (setq name (vhdl-template-field "name" nil t start (point)))
9210       (vhdl-insert-keyword " OF ")
9211       (save-excursion
9212         (vhdl-prepare-search-1
9213          (setq entity-exists (vhdl-re-search-backward
9214                               "\\<entity \\(\\w*\\) is\\>" nil t))
9215          (setq string (match-string 1))))
9216       (if (and entity-exists (not (equal string "")))
9217           (insert string)
9218         (vhdl-template-field "entity name"))
9219       (vhdl-insert-keyword " IS\n")
9220       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9221       (indent-to (+ margin vhdl-basic-offset))
9222       (setq position (point))
9223       (insert "\n")
9224       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9225       (indent-to margin)
9226       (vhdl-insert-keyword "END ")
9227       (unless (vhdl-standard-p '87)
9228         (vhdl-insert-keyword "CONFIGURATION "))
9229       (insert name ";")
9230       (goto-char position))))
9231
9232 (defun vhdl-template-constant ()
9233   "Insert a constant declaration."
9234   (interactive)
9235   (let ((start (point))
9236         (in-arglist (vhdl-in-argument-list-p)))
9237     (vhdl-insert-keyword "CONSTANT ")
9238     (when (vhdl-template-field "name" nil t start (point))
9239       (insert " : ")
9240       (when in-arglist (vhdl-insert-keyword "IN "))
9241       (vhdl-template-field "type")
9242       (if in-arglist
9243           (progn (insert ";")
9244                  (vhdl-comment-insert-inline))
9245         (let ((position (point)))
9246           (insert " := ")
9247           (unless (vhdl-template-field "[initialization]" nil t)
9248             (delete-region position (point)))
9249           (insert ";")
9250           (vhdl-comment-insert-inline))))))
9251
9252 (defun vhdl-template-context ()
9253   "Insert a context declaration."
9254   (interactive)
9255   (let ((margin (current-indentation))
9256         (start (point))
9257         entity-exists string name position)
9258     (vhdl-insert-keyword "CONTEXT ")
9259     (when (setq name (vhdl-template-field "name" nil t start (point)))
9260       (vhdl-insert-keyword " IS\n")
9261       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9262       (indent-to (+ margin vhdl-basic-offset))
9263       (setq position (point))
9264       (insert "\n")
9265       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9266       (indent-to margin)
9267       (vhdl-insert-keyword "END ")
9268       (unless (vhdl-standard-p '87)
9269         (vhdl-insert-keyword "CONTEXT "))
9270       (insert name ";")
9271       (goto-char position))))
9272
9273 (defun vhdl-template-default ()
9274   "Insert nothing."
9275   (interactive)
9276   (insert " ")
9277   (unexpand-abbrev)
9278   (backward-word-strictly 1)
9279   (vhdl-case-word 1)
9280   (forward-char 1))
9281
9282 (defun vhdl-template-default-indent ()
9283   "Insert nothing and indent."
9284   (interactive)
9285   (insert " ")
9286   (unexpand-abbrev)
9287   (backward-word-strictly 1)
9288   (vhdl-case-word 1)
9289   (forward-char 1)
9290   (indent-according-to-mode))
9291
9292 (defun vhdl-template-disconnect ()
9293   "Insert a disconnect statement."
9294   (interactive)
9295   (let ((start (point)))
9296     (vhdl-insert-keyword "DISCONNECT ")
9297     (when (vhdl-template-field "signal names | OTHERS | ALL"
9298                                " : " t start (point))
9299       (vhdl-template-field "type")
9300       (vhdl-insert-keyword " AFTER ")
9301       (vhdl-template-field "time expression" ";"))))
9302
9303 (defun vhdl-template-else ()
9304   "Insert an else statement."
9305   (interactive)
9306   (let (margin)
9307     (vhdl-prepare-search-1
9308      (vhdl-insert-keyword "ELSE")
9309      (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
9310               (equal "WHEN" (upcase (match-string 1))))
9311          (insert " ")
9312        (indent-according-to-mode)
9313        (setq margin (current-indentation))
9314        (insert "\n")
9315        (indent-to (+ margin vhdl-basic-offset))))))
9316
9317 (defun vhdl-template-elsif ()
9318   "Insert an elsif statement."
9319   (interactive)
9320   (let ((start (point))
9321         margin)
9322     (vhdl-insert-keyword "ELSIF ")
9323     (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
9324       (when vhdl-conditions-in-parenthesis (insert "("))
9325       (when (vhdl-template-field "condition" nil t start (point))
9326         (when vhdl-conditions-in-parenthesis (insert ")"))
9327         (indent-according-to-mode)
9328         (setq margin (current-indentation))
9329         (vhdl-insert-keyword
9330          (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
9331         (indent-to (+ margin vhdl-basic-offset))))))
9332
9333 (defun vhdl-template-entity ()
9334   "Insert an entity."
9335   (interactive)
9336   (let ((margin (current-indentation))
9337         (start (point))
9338         name end-column)
9339     (vhdl-insert-keyword "ENTITY ")
9340     (when (setq name (vhdl-template-field "name" nil t start (point)))
9341       (vhdl-insert-keyword " IS\n\n")
9342       (indent-to margin)
9343       (vhdl-insert-keyword "END ")
9344       (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
9345       (insert name ";")
9346       (setq end-column (current-column))
9347       (end-of-line -0)
9348       (indent-to (+ margin vhdl-basic-offset))
9349       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9350       (indent-to (+ margin vhdl-basic-offset))
9351       (when (vhdl-template-generic-list t)
9352         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9353       (insert "\n")
9354       (indent-to (+ margin vhdl-basic-offset))
9355       (when (vhdl-template-port-list t)
9356         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")))
9357       (beginning-of-line 2)
9358       (forward-char end-column))))
9359
9360 (defun vhdl-template-exit ()
9361   "Insert an exit statement."
9362   (interactive)
9363   (let ((start (point)))
9364     (vhdl-insert-keyword "EXIT ")
9365     (if (vhdl-template-field "[loop label]" nil t start (point))
9366         (let ((position (point)))
9367           (vhdl-insert-keyword " WHEN ")
9368           (when vhdl-conditions-in-parenthesis (insert "("))
9369           (if (vhdl-template-field "[condition]" nil t)
9370               (when vhdl-conditions-in-parenthesis (insert ")"))
9371             (delete-region position (point))))
9372       (delete-char -1))
9373     (insert ";")))
9374
9375 (defun vhdl-template-file ()
9376   "Insert a file declaration."
9377   (interactive)
9378   (let ((start (point)))
9379     (vhdl-insert-keyword "FILE ")
9380     (when (vhdl-template-field "name" nil t start (point))
9381       (insert " : ")
9382       (vhdl-template-field "type")
9383       (unless (vhdl-standard-p '87)
9384         (vhdl-insert-keyword " OPEN ")
9385         (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
9386                                      nil t)
9387           (delete-char -6)))
9388       (vhdl-insert-keyword " IS ")
9389       (when (vhdl-standard-p '87)
9390         (vhdl-template-field "[IN | OUT]" " " t))
9391       (vhdl-template-field "filename-string" nil nil nil nil t)
9392       (insert ";")
9393       (vhdl-comment-insert-inline))))
9394
9395 (defun vhdl-template-for ()
9396   "Insert a block or component configuration if within a configuration
9397 declaration, a configuration specification if within an architecture
9398 declarative part (and not within a subprogram), a for-loop if within a
9399 sequential statement part (subprogram or process), and a for-generate
9400 otherwise."
9401   (interactive)
9402   (vhdl-prepare-search-1
9403    (cond
9404     ((vhdl-sequential-statement-p)      ; sequential statement
9405      (vhdl-template-for-loop))
9406     ((and (save-excursion               ; configuration declaration
9407             (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
9408           (equal "CONFIGURATION" (upcase (match-string 1))))
9409      (if (eq (vhdl-decision-query
9410               "for" "(b)lock or (c)omponent configuration?" t) ?c)
9411          (vhdl-template-component-conf)
9412        (vhdl-template-block-configuration)))
9413     ((and (save-excursion
9414             (re-search-backward         ; architecture declarative part
9415              "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
9416           (equal "ARCHITECTURE" (upcase (match-string 1))))
9417      (vhdl-template-configuration-spec))
9418     (t (vhdl-template-for-generate))))) ; concurrent statement
9419
9420 (defun vhdl-template-for-generate ()
9421   "Insert a for-generate."
9422   (interactive)
9423   (let ((margin (current-indentation))
9424         (start (point))
9425         label position)
9426     (vhdl-insert-keyword ": FOR ")
9427     (setq position (point-marker))
9428     (goto-char start)
9429     (when (setq label (vhdl-template-field "label" nil t start position))
9430       (goto-char position)
9431       (vhdl-template-field "loop variable")
9432       (vhdl-insert-keyword " IN ")
9433       (vhdl-template-field "range")
9434       (vhdl-template-generate-body margin label))))
9435
9436 (defun vhdl-template-for-loop ()
9437   "Insert a for loop."
9438   (interactive)
9439   (let ((margin (current-indentation))
9440         (start (point))
9441         label index)
9442     (if (not (eq vhdl-optional-labels 'all))
9443         (vhdl-insert-keyword "FOR ")
9444       (vhdl-insert-keyword ": FOR ")
9445       (goto-char start)
9446       (setq label (vhdl-template-field "[label]" nil t))
9447       (unless label (delete-char 2))
9448       (forward-word-strictly 1)
9449       (forward-char 1))
9450     (when (setq index (vhdl-template-field "loop variable"
9451                                            nil t start (point)))
9452       (vhdl-insert-keyword " IN ")
9453       (vhdl-template-field "range")
9454       (vhdl-insert-keyword " LOOP\n\n")
9455       (indent-to margin)
9456       (vhdl-insert-keyword "END LOOP")
9457       (if label
9458           (insert " " label ";")
9459         (insert ";")
9460         (when vhdl-self-insert-comments (insert "  -- " index)))
9461       (forward-line -1)
9462       (indent-to (+ margin vhdl-basic-offset)))))
9463
9464 (defun vhdl-template-function (&optional kind)
9465   "Insert a function declaration or body."
9466   (interactive)
9467   (let ((margin (current-indentation))
9468         (start (point))
9469         name)
9470     (vhdl-insert-keyword "FUNCTION ")
9471     (when (setq name (vhdl-template-field "name" nil t start (point)))
9472       (vhdl-template-argument-list t)
9473       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9474       (end-of-line)
9475       (insert "\n")
9476       (indent-to (+ margin vhdl-basic-offset))
9477       (vhdl-insert-keyword "RETURN ")
9478       (vhdl-template-field "type")
9479       (if (if kind (eq kind 'body)
9480             (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9481           (progn (vhdl-insert-keyword " IS\n")
9482                  (vhdl-template-begin-end
9483                   (unless (vhdl-standard-p '87) "FUNCTION") name margin)
9484                  (vhdl-comment-block))
9485         (insert ";")))))
9486
9487 (defun vhdl-template-function-decl ()
9488   "Insert a function declaration."
9489   (interactive)
9490   (vhdl-template-function 'decl))
9491
9492 (defun vhdl-template-function-body ()
9493   "Insert a function declaration."
9494   (interactive)
9495   (vhdl-template-function 'body))
9496
9497 (defun vhdl-template-generate ()
9498   "Insert a generation scheme."
9499   (interactive)
9500   (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i)
9501       (vhdl-template-if-generate)
9502     (vhdl-template-for-generate)))
9503
9504 (defun vhdl-template-generic ()
9505   "Insert generic declaration, or generic map in instantiation statements."
9506   (interactive)
9507   (let ((start (point)))
9508     (vhdl-prepare-search-1
9509      (cond
9510       ((and (save-excursion             ; entity declaration
9511               (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9512             (equal "ENTITY" (upcase (match-string 1))))
9513        (vhdl-template-generic-list nil))
9514       ((or (save-excursion
9515              (or (beginning-of-line)
9516                  (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9517            (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9518        (vhdl-insert-keyword "GENERIC ")
9519        (vhdl-template-map start))
9520       (t (vhdl-template-generic-list nil t))))))
9521
9522 (defun vhdl-template-group ()
9523   "Insert group or group template declaration."
9524   (interactive)
9525   (let ((start (point)))
9526     (if (eq (vhdl-decision-query
9527              "group" "(d)eclaration or (t)emplate declaration?" t) ?t)
9528         (vhdl-template-group-template)
9529       (vhdl-template-group-decl))))
9530
9531 (defun vhdl-template-group-decl ()
9532   "Insert group declaration."
9533   (interactive)
9534   (let ((start (point)))
9535     (vhdl-insert-keyword "GROUP ")
9536     (when (vhdl-template-field "name" " : " t start (point))
9537       (vhdl-template-field "template name" " (")
9538       (vhdl-template-field "constituent list" ");")
9539       (vhdl-comment-insert-inline))))
9540
9541 (defun vhdl-template-group-template ()
9542   "Insert group template declaration."
9543   (interactive)
9544   (let ((start (point)))
9545     (vhdl-insert-keyword "GROUP ")
9546     (when (vhdl-template-field "template name" nil t start (point))
9547       (vhdl-insert-keyword " IS (")
9548       (vhdl-template-field "entity class list" ");")
9549       (vhdl-comment-insert-inline))))
9550
9551 (defun vhdl-template-if ()
9552   "Insert a sequential if statement or an if-generate statement."
9553   (interactive)
9554   (if (vhdl-sequential-statement-p)
9555       (vhdl-template-if-then)
9556     (if (and (vhdl-standard-p 'ams)
9557              (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u))
9558         (vhdl-template-if-use)
9559       (vhdl-template-if-generate))))
9560
9561 (defun vhdl-template-if-generate ()
9562   "Insert an if-generate."
9563   (interactive)
9564   (let ((margin (current-indentation))
9565         (start (point))
9566         label position)
9567     (vhdl-insert-keyword ": IF ")
9568     (setq position (point-marker))
9569     (goto-char start)
9570     (when (setq label (vhdl-template-field "label" nil t start position))
9571       (goto-char position)
9572       (when vhdl-conditions-in-parenthesis (insert "("))
9573       (vhdl-template-field "condition")
9574       (when vhdl-conditions-in-parenthesis (insert ")"))
9575       (vhdl-template-generate-body margin label))))
9576
9577 (defun vhdl-template-if-then-use (kind)
9578   "Insert a sequential if statement."
9579   (interactive)
9580   (let ((margin (current-indentation))
9581         (start (point))
9582         label)
9583     (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87))
9584         (vhdl-insert-keyword "IF ")
9585       (vhdl-insert-keyword ": IF ")
9586       (goto-char start)
9587       (setq label (vhdl-template-field "[label]" nil t))
9588       (unless label (delete-char 2))
9589       (forward-word-strictly 1)
9590       (forward-char 1))
9591     (when vhdl-conditions-in-parenthesis (insert "("))
9592     (when (vhdl-template-field "condition" nil t start (point))
9593       (when vhdl-conditions-in-parenthesis (insert ")"))
9594       (vhdl-insert-keyword
9595        (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n"))
9596       (indent-to margin)
9597       (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE")))
9598       (when label (insert " " label))
9599       (insert ";")
9600       (forward-line -1)
9601       (indent-to (+ margin vhdl-basic-offset)))))
9602
9603 (defun vhdl-template-if-then ()
9604   "Insert a sequential if statement."
9605   (interactive)
9606   (vhdl-template-if-then-use 'then))
9607
9608 (defun vhdl-template-if-use ()
9609   "Insert a simultaneous if statement."
9610   (interactive)
9611   (vhdl-template-if-then-use 'use))
9612
9613 (defun vhdl-template-instance ()
9614   "Insert a component instantiation statement."
9615   (interactive)
9616   (vhdl-template-component-inst))
9617
9618 (defun vhdl-template-library ()
9619   "Insert a library specification."
9620   (interactive)
9621   (let ((margin (current-indentation))
9622         (start (point))
9623         name end-pos)
9624     (vhdl-insert-keyword "LIBRARY ")
9625     (when (setq name (vhdl-template-field "names" nil t start (point)))
9626       (insert ";")
9627       (unless (string-match "," name)
9628         (setq end-pos (point))
9629         (insert "\n")
9630         (indent-to margin)
9631         (vhdl-insert-keyword "USE ")
9632         (insert name)
9633         (vhdl-insert-keyword "..ALL;")
9634         (backward-char 5)
9635         (if (vhdl-template-field "package name")
9636             (forward-char 5)
9637           (delete-region end-pos (+ (point) 5)))))))
9638
9639 (defun vhdl-template-limit ()
9640   "Insert a limit."
9641   (interactive)
9642   (let ((start (point)))
9643     (vhdl-insert-keyword "LIMIT ")
9644     (when (vhdl-template-field "quantity names | OTHERS | ALL" " : "
9645                                t start (point))
9646       (vhdl-template-field "type")
9647       (vhdl-insert-keyword " WITH ")
9648       (vhdl-template-field "real expression" ";"))))
9649
9650 (defun vhdl-template-loop ()
9651   "Insert a loop."
9652   (interactive)
9653   (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t)))
9654     (cond ((eq char ?w)
9655            (vhdl-template-while-loop))
9656           ((eq char ?f)
9657            (vhdl-template-for-loop))
9658           (t (vhdl-template-bare-loop)))))
9659
9660 (defun vhdl-template-bare-loop ()
9661   "Insert a loop."
9662   (interactive)
9663   (let ((margin (current-indentation))
9664         (start (point))
9665         label)
9666     (if (not (eq vhdl-optional-labels 'all))
9667         (vhdl-insert-keyword "LOOP ")
9668       (vhdl-insert-keyword ": LOOP ")
9669       (goto-char start)
9670       (setq label (vhdl-template-field "[label]" nil t))
9671       (unless label (delete-char 2))
9672       (forward-word-strictly 1)
9673       (delete-char 1))
9674     (insert "\n\n")
9675     (indent-to margin)
9676     (vhdl-insert-keyword "END LOOP")
9677     (insert (if label (concat " " label ";") ";"))
9678     (forward-line -1)
9679     (indent-to (+ margin vhdl-basic-offset))))
9680
9681 (defun vhdl-template-map (&optional start optional secondary)
9682   "Insert a map specification with association list."
9683   (interactive)
9684   (let ((start (or start (point)))
9685         margin end-pos)
9686     (vhdl-insert-keyword "MAP (")
9687     (if (not vhdl-association-list-with-formals)
9688         (if (vhdl-template-field
9689              (concat (and optional "[") "association list" (and optional "]"))
9690              ")" (or (not secondary) optional)
9691              (and (not secondary) start) (point))
9692             t
9693           (if (and optional secondary) (delete-region start (point)))
9694           nil)
9695       (if vhdl-argument-list-indent
9696           (setq margin (current-column))
9697         (setq margin (+ (current-indentation) vhdl-basic-offset))
9698         (insert "\n")
9699         (indent-to margin))
9700       (if (vhdl-template-field
9701            (concat (and optional "[") "formal" (and optional "]"))
9702            " => " (or (not secondary) optional)
9703            (and (not secondary) start) (point))
9704           (progn
9705             (vhdl-template-field "actual" ",")
9706             (setq end-pos (point))
9707             (insert "\n")
9708             (indent-to margin)
9709             (while (vhdl-template-field "[formal]" " => " t)
9710               (vhdl-template-field "actual" ",")
9711               (setq end-pos (point))
9712               (insert "\n")
9713               (indent-to margin))
9714             (delete-region end-pos (point))
9715             (delete-char -1)
9716             (insert ")")
9717             (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9718             t)
9719         (when (and optional secondary) (delete-region start (point)))
9720         nil))))
9721
9722 (defun vhdl-template-modify (&optional noerror)
9723   "Actualize modification date."
9724   (interactive)
9725   (vhdl-prepare-search-2
9726    (save-excursion
9727      (goto-char (point-min))
9728      (if (re-search-forward vhdl-modify-date-prefix-string nil t)
9729          (progn (delete-region (point) (progn (end-of-line) (point)))
9730                 (vhdl-template-insert-date))
9731        (unless noerror
9732          (error "ERROR:  Modification date prefix string \"%s\" not found"
9733                         vhdl-modify-date-prefix-string))))))
9734
9735
9736 (defun vhdl-template-modify-noerror ()
9737   "Call `vhdl-template-modify' with NOERROR non-nil."
9738   (vhdl-template-modify t))
9739
9740 (defun vhdl-template-nature ()
9741   "Insert a nature declaration."
9742   (interactive)
9743   (let ((start (point))
9744         name mid-pos end-pos)
9745     (vhdl-insert-keyword "NATURE ")
9746     (when (setq name (vhdl-template-field "name" nil t start (point)))
9747       (vhdl-insert-keyword " IS ")
9748       (let ((definition
9749               (upcase
9750                (or (vhdl-template-field
9751                     "across type | ARRAY | RECORD")
9752                    ""))))
9753         (cond ((equal definition "")
9754                (insert ";"))
9755               ((equal definition "ARRAY")
9756                (delete-region (point) (progn (forward-word-strictly -1)
9757                                              (point)))
9758                (vhdl-template-array 'nature t))
9759               ((equal definition "RECORD")
9760                (setq mid-pos (point-marker))
9761                (delete-region (point) (progn (forward-word-strictly -1)
9762                                              (point)))
9763                (vhdl-template-record 'nature name t))
9764               (t
9765                (vhdl-insert-keyword " ACROSS ")
9766                (vhdl-template-field "through type")
9767                (vhdl-insert-keyword " THROUGH ")
9768                (vhdl-template-field "reference name")
9769                (vhdl-insert-keyword " REFERENCE;")))
9770         (when mid-pos
9771           (setq end-pos (point-marker))
9772           (goto-char mid-pos)
9773           (end-of-line))
9774         (vhdl-comment-insert-inline)
9775         (when end-pos (goto-char end-pos))))))
9776
9777 (defun vhdl-template-next ()
9778   "Insert a next statement."
9779   (interactive)
9780   (let ((start (point)))
9781     (vhdl-insert-keyword "NEXT ")
9782     (if (vhdl-template-field "[loop label]" nil t start (point))
9783         (let ((position (point)))
9784           (vhdl-insert-keyword " WHEN ")
9785           (when vhdl-conditions-in-parenthesis (insert "("))
9786           (if (vhdl-template-field "[condition]" nil t)
9787               (when vhdl-conditions-in-parenthesis (insert ")"))
9788             (delete-region position (point))))
9789       (delete-char -1))
9790     (insert ";")))
9791
9792 (defun vhdl-template-others ()
9793   "Insert an others aggregate."
9794   (interactive)
9795   (let ((start (point)))
9796     (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
9797         (progn (unless vhdl-template-invoked-by-hook (insert "("))
9798                (vhdl-insert-keyword "OTHERS => '")
9799                (when (vhdl-template-field "value" nil t start (point))
9800                  (insert "')")))
9801       (vhdl-insert-keyword "OTHERS "))))
9802
9803 (defun vhdl-template-package (&optional kind)
9804   "Insert a package specification or body."
9805   (interactive)
9806   (let ((margin (current-indentation))
9807         (start (point))
9808         name body position)
9809     (vhdl-insert-keyword "PACKAGE ")
9810     (setq body (if kind (eq kind 'body)
9811                  (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
9812     (when body
9813       (vhdl-insert-keyword "BODY ")
9814       (when (save-excursion
9815               (vhdl-prepare-search-1
9816                (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
9817         (insert (setq name (match-string 1)))))
9818     (when (or name
9819               (setq name (vhdl-template-field "name" nil t start (point))))
9820       (vhdl-insert-keyword " IS\n")
9821       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9822       (indent-to (+ margin vhdl-basic-offset))
9823       (setq position (point))
9824       (insert "\n")
9825       (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
9826       (indent-to margin)
9827       (vhdl-insert-keyword "END ")
9828       (unless (vhdl-standard-p '87)
9829         (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY "))))
9830       (insert (or name "") ";")
9831       (goto-char position))))
9832
9833 (defun vhdl-template-package-decl ()
9834   "Insert a package specification."
9835   (interactive)
9836   (vhdl-template-package 'decl))
9837
9838 (defun vhdl-template-package-body ()
9839   "Insert a package body."
9840   (interactive)
9841   (vhdl-template-package 'body))
9842
9843 (defun vhdl-template-port ()
9844   "Insert a port declaration, or port map in instantiation statements."
9845   (interactive)
9846   (let ((start (point)))
9847     (vhdl-prepare-search-1
9848      (cond
9849       ((and (save-excursion             ; entity declaration
9850               (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
9851             (equal "ENTITY" (upcase (match-string 1))))
9852        (vhdl-template-port-list nil))
9853       ((or (save-excursion
9854              (or (beginning-of-line)
9855                  (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9856            (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9857        (vhdl-insert-keyword "PORT ")
9858        (vhdl-template-map start))
9859       (t (vhdl-template-port-list nil))))))
9860
9861 (defun vhdl-template-procedural ()
9862   "Insert a procedural."
9863   (interactive)
9864   (let ((margin (current-indentation))
9865         (start (point))
9866         (case-fold-search t)
9867         label)
9868     (vhdl-insert-keyword "PROCEDURAL ")
9869     (when (memq vhdl-optional-labels '(process all))
9870       (goto-char start)
9871       (insert ": ")
9872       (goto-char start)
9873       (setq label (vhdl-template-field "[label]" nil t))
9874       (unless label (delete-char 2))
9875       (forward-word-strictly 1)
9876       (forward-char 1))
9877     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9878     (insert "\n")
9879     (vhdl-template-begin-end "PROCEDURAL" label margin)
9880     (vhdl-comment-block)))
9881
9882 (defun vhdl-template-procedure (&optional kind)
9883   "Insert a procedure declaration or body."
9884   (interactive)
9885   (let ((margin (current-indentation))
9886         (start (point))
9887         name)
9888     (vhdl-insert-keyword "PROCEDURE ")
9889     (when (setq name (vhdl-template-field "name" nil t start (point)))
9890       (vhdl-template-argument-list)
9891       (if (if kind (eq kind 'body)
9892             (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9893           (progn (vhdl-insert-keyword " IS")
9894                  (when vhdl-auto-align
9895                    (vhdl-align-region-groups start (point) 1))
9896                  (end-of-line) (insert "\n")
9897                  (vhdl-template-begin-end
9898                   (unless (vhdl-standard-p '87) "PROCEDURE")
9899                   name margin)
9900                  (vhdl-comment-block))
9901         (insert ";")
9902         (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9903         (end-of-line)))))
9904
9905 (defun vhdl-template-procedure-decl ()
9906   "Insert a procedure declaration."
9907   (interactive)
9908   (vhdl-template-procedure 'decl))
9909
9910 (defun vhdl-template-procedure-body ()
9911   "Insert a procedure body."
9912   (interactive)
9913   (vhdl-template-procedure 'body))
9914
9915 (defun vhdl-template-process (&optional kind)
9916   "Insert a process."
9917   (interactive)
9918   (let ((margin (current-indentation))
9919         (start (point))
9920         (reset-kind vhdl-reset-kind)
9921         label seq input-signals clock reset final-pos)
9922     (setq seq (if kind (eq kind 'seq)
9923                 (eq (vhdl-decision-query
9924                      "process" "(c)ombinational or (s)equential?" t) ?s)))
9925     (vhdl-insert-keyword "PROCESS ")
9926     (when (memq vhdl-optional-labels '(process all))
9927       (goto-char start)
9928       (insert ": ")
9929       (goto-char start)
9930       (setq label (vhdl-template-field "[label]" nil t))
9931       (unless label (delete-char 2))
9932       (forward-word-strictly 1)
9933       (forward-char 1))
9934     (insert "(")
9935     (if (not seq)
9936         (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all
9937                          (progn (insert "all)") (setq input-signals "all")))
9938                     (setq input-signals
9939                           (vhdl-template-field "[sensitivity list]" ")" t)))
9940           (setq input-signals "")
9941           (delete-char -2))
9942       (setq clock (or (and (not (equal "" vhdl-clock-name))
9943                            (progn (insert vhdl-clock-name) vhdl-clock-name))
9944                       (vhdl-template-field "clock name") "<clock>"))
9945       (when (eq reset-kind 'query)
9946         (setq reset-kind
9947               (if (eq (vhdl-decision-query
9948                        "" "(a)synchronous or (s)ynchronous reset?" t) ?a)
9949                   'async
9950                 'sync)))
9951       (when (eq reset-kind 'async)
9952         (insert ", ")
9953         (setq reset (or (and (not (equal "" vhdl-reset-name))
9954                              (progn (insert vhdl-reset-name) vhdl-reset-name))
9955                         (vhdl-template-field "reset name") "<reset>")))
9956       (insert ")"))
9957     (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9958     (insert "\n")
9959     (vhdl-template-begin-end "PROCESS" label margin)
9960     (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind)))
9961     (when vhdl-prompt-for-comments
9962       (setq final-pos (point-marker))
9963       (vhdl-prepare-search-2
9964        (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9965                   (vhdl-re-search-backward "\\<process\\>" nil t))
9966          (end-of-line -0)
9967          (if (bobp)
9968              (progn (insert "\n") (forward-line -1))
9969            (insert "\n"))
9970          (indent-to margin)
9971          (insert "-- purpose: ")
9972          (if (not (vhdl-template-field "[description]" nil t))
9973              (vhdl-line-kill-entire)
9974            (insert "\n")
9975            (indent-to margin)
9976            (insert "-- type   : ")
9977            (insert (if seq "sequential" "combinational") "\n")
9978            (indent-to margin)
9979            (insert "-- inputs : ")
9980            (if (not seq)
9981                (insert input-signals)
9982              (insert clock ", ")
9983              (when reset (insert reset ", "))
9984              (unless (vhdl-template-field "[signal names]" nil t)
9985                (delete-char -2)))
9986            (insert "\n")
9987            (indent-to margin)
9988            (insert "-- outputs: ")
9989            (vhdl-template-field "[signal names]" nil t))))
9990       (goto-char final-pos))))
9991
9992 (defun vhdl-template-process-comb ()
9993   "Insert a combinational process."
9994   (interactive)
9995   (vhdl-template-process 'comb))
9996
9997 (defun vhdl-template-process-seq ()
9998   "Insert a sequential process."
9999   (interactive)
10000   (vhdl-template-process 'seq))
10001
10002 (defun vhdl-template-quantity ()
10003   "Insert a quantity declaration."
10004   (interactive)
10005   (if (vhdl-in-argument-list-p)
10006       (let ((start (point)))
10007         (vhdl-insert-keyword "QUANTITY ")
10008         (when (vhdl-template-field "names" nil t start (point))
10009           (insert " : ")
10010           (vhdl-template-field "[IN | OUT]" " " t)
10011           (vhdl-template-field "type")
10012           (insert ";")
10013           (vhdl-comment-insert-inline)))
10014     (let ((char (vhdl-decision-query
10015                  "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t)))
10016       (cond ((eq char ?f) (vhdl-template-quantity-free))
10017             ((eq char ?b) (vhdl-template-quantity-branch))
10018             ((eq char ?s) (vhdl-template-quantity-source))
10019             (t (vhdl-template-undo (point) (point)))))))
10020
10021 (defun vhdl-template-quantity-free ()
10022   "Insert a free quantity declaration."
10023   (interactive)
10024   (vhdl-insert-keyword "QUANTITY ")
10025   (vhdl-template-field "names")
10026   (insert " : ")
10027   (vhdl-template-field "type")
10028   (let ((position (point)))
10029     (insert " := ")
10030     (unless (vhdl-template-field "[initialization]" nil t)
10031       (delete-region position (point)))
10032     (insert ";")
10033     (vhdl-comment-insert-inline)))
10034
10035 (defun vhdl-template-quantity-branch ()
10036   "Insert a branch quantity declaration."
10037   (interactive)
10038   (let (position)
10039     (vhdl-insert-keyword "QUANTITY ")
10040     (when (vhdl-template-field "[across names]" " " t)
10041       (vhdl-insert-keyword "ACROSS "))
10042     (when (vhdl-template-field "[through names]" " " t)
10043       (vhdl-insert-keyword "THROUGH "))
10044     (vhdl-template-field "plus terminal name")
10045     (setq position (point))
10046     (vhdl-insert-keyword " TO ")
10047     (unless (vhdl-template-field "[minus terminal name]" nil t)
10048       (delete-region position (point)))
10049     (insert ";")
10050     (vhdl-comment-insert-inline)))
10051
10052 (defun vhdl-template-quantity-source ()
10053   "Insert a source quantity declaration."
10054   (interactive)
10055   (vhdl-insert-keyword "QUANTITY ")
10056   (vhdl-template-field "names")
10057   (insert " : ")
10058   (vhdl-template-field "type" " ")
10059   (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n)
10060       (progn (vhdl-insert-keyword "NOISE ")
10061              (vhdl-template-field "power expression"))
10062     (vhdl-insert-keyword "SPECTRUM ")
10063     (vhdl-template-field "magnitude expression" ", ")
10064     (vhdl-template-field "phase expression"))
10065   (insert ";")
10066   (vhdl-comment-insert-inline))
10067
10068 (defun vhdl-template-record (kind &optional name secondary)
10069   "Insert a record type declaration."
10070   (interactive)
10071   (let ((margin (current-indentation))
10072         (start (point))
10073         (first t))
10074     (vhdl-insert-keyword "RECORD\n")
10075     (indent-to (+ margin vhdl-basic-offset))
10076     (when (or (vhdl-template-field "element names"
10077                                    nil (not secondary) start (point))
10078               secondary)
10079       (while (or first (vhdl-template-field "[element names]" nil t))
10080         (insert " : ")
10081         (vhdl-template-field (if (eq kind 'type) "type" "nature") ";")
10082         (vhdl-comment-insert-inline)
10083         (insert "\n")
10084         (indent-to (+ margin vhdl-basic-offset))
10085         (setq first nil))
10086       (delete-region (line-beginning-position) (point))
10087       (indent-to margin)
10088       (vhdl-insert-keyword "END RECORD")
10089       (unless (vhdl-standard-p '87) (and name (insert " " name)))
10090       (insert ";")
10091       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10092
10093 (defun vhdl-template-report ()
10094   "Insert a report statement."
10095   (interactive)
10096   (let ((start (point)))
10097     (vhdl-insert-keyword "REPORT ")
10098     (if (equal "\"\"" (vhdl-template-field
10099                        "string expression" nil t start (point) t))
10100         (delete-char -2)
10101       (setq start (point))
10102       (vhdl-insert-keyword " SEVERITY ")
10103       (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
10104         (delete-region start (point)))
10105       (insert ";"))))
10106
10107 (defun vhdl-template-return ()
10108   "Insert a return statement."
10109   (interactive)
10110   (let ((start (point)))
10111     (vhdl-insert-keyword "RETURN ")
10112     (unless (vhdl-template-field "[expression]" nil t start (point))
10113       (delete-char -1))
10114     (insert ";")))
10115
10116 (defun vhdl-template-selected-signal-asst ()
10117   "Insert a selected signal assignment."
10118   (interactive)
10119   (let ((margin (current-indentation))
10120         (start (point))
10121         (choices t))
10122     (let ((position (point)))
10123       (vhdl-insert-keyword " SELECT ")
10124       (goto-char position))
10125     (vhdl-insert-keyword "WITH ")
10126     (when (vhdl-template-field "selector expression"
10127                                nil t start (+ (point) 7))
10128       (forward-word-strictly 1)
10129       (delete-char 1)
10130       (insert "\n")
10131       (indent-to (+ margin vhdl-basic-offset))
10132       (vhdl-template-field "target signal" " <= ")
10133       (insert "\n")
10134       (indent-to (+ margin vhdl-basic-offset))
10135       (vhdl-template-field "waveform")
10136       (vhdl-insert-keyword " WHEN ")
10137       (vhdl-template-field "choices" ",")
10138       (insert "\n")
10139       (indent-to (+ margin vhdl-basic-offset))
10140       (while (and choices (vhdl-template-field "[waveform]" nil t))
10141         (vhdl-insert-keyword " WHEN ")
10142         (if (setq choices (vhdl-template-field "[choices]" "," t))
10143             (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10144           (vhdl-insert-keyword "OTHERS")))
10145       (when choices
10146         (fixup-whitespace)
10147         (delete-char -2))
10148       (insert ";")
10149       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
10150
10151 (defun vhdl-template-signal ()
10152   "Insert a signal declaration."
10153   (interactive)
10154   (let ((start (point))
10155         (in-arglist (vhdl-in-argument-list-p)))
10156     (vhdl-insert-keyword "SIGNAL ")
10157     (when (vhdl-template-field "names" nil t start (point))
10158       (insert " : ")
10159       (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10160       (vhdl-template-field "type")
10161       (if in-arglist
10162           (progn (insert ";")
10163                  (vhdl-comment-insert-inline))
10164         (let ((position (point)))
10165           (insert " := ")
10166           (unless (vhdl-template-field "[initialization]" nil t)
10167             (delete-region position (point)))
10168           (insert ";")
10169           (vhdl-comment-insert-inline))))))
10170
10171 (defun vhdl-template-subnature ()
10172   "Insert a subnature declaration."
10173   (interactive)
10174   (let ((start (point))
10175         position)
10176     (vhdl-insert-keyword "SUBNATURE ")
10177     (when (vhdl-template-field "name" nil t start (point))
10178       (vhdl-insert-keyword " IS ")
10179       (vhdl-template-field "nature" " (")
10180       (if (vhdl-template-field "[index range]" nil t)
10181           (insert ")")
10182         (delete-char -2))
10183       (setq position (point))
10184       (vhdl-insert-keyword " TOLERANCE ")
10185       (if (equal "\"\"" (vhdl-template-field "[string expression]"
10186                                              nil t nil nil t))
10187           (delete-region position (point))
10188         (vhdl-insert-keyword " ACROSS ")
10189         (vhdl-template-field "string expression" nil nil nil nil t)
10190         (vhdl-insert-keyword " THROUGH"))
10191       (insert ";")
10192       (vhdl-comment-insert-inline))))
10193
10194 (defun vhdl-template-subprogram-body ()
10195   "Insert a subprogram body."
10196   (interactive)
10197   (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10198       (vhdl-template-function-body)
10199     (vhdl-template-procedure-body)))
10200
10201 (defun vhdl-template-subprogram-decl ()
10202   "Insert a subprogram declaration."
10203   (interactive)
10204   (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f)
10205       (vhdl-template-function-decl)
10206     (vhdl-template-procedure-decl)))
10207
10208 (defun vhdl-template-subtype ()
10209   "Insert a subtype declaration."
10210   (interactive)
10211   (let ((start (point)))
10212     (vhdl-insert-keyword "SUBTYPE ")
10213     (when (vhdl-template-field "name" nil t start (point))
10214       (vhdl-insert-keyword " IS ")
10215       (vhdl-template-field "type" " ")
10216       (unless
10217           (vhdl-template-field "[RANGE value range | ( index range )]" nil t)
10218         (delete-char -1))
10219       (insert ";")
10220       (vhdl-comment-insert-inline))))
10221
10222 (defun vhdl-template-terminal ()
10223   "Insert a terminal declaration."
10224   (interactive)
10225   (let ((start (point)))
10226     (vhdl-insert-keyword "TERMINAL ")
10227     (when (vhdl-template-field "names" nil t start (point))
10228       (insert " : ")
10229       (vhdl-template-field "nature")
10230       (insert ";")
10231       (vhdl-comment-insert-inline))))
10232
10233 (defun vhdl-template-type ()
10234   "Insert a type declaration."
10235   (interactive)
10236   (let ((start (point))
10237         name mid-pos end-pos)
10238     (vhdl-insert-keyword "TYPE ")
10239     (when (setq name (vhdl-template-field "name" nil t start (point)))
10240       (vhdl-insert-keyword " IS ")
10241       (let ((definition
10242               (upcase
10243                (or (vhdl-template-field
10244                     "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t)
10245                    ""))))
10246         (cond ((equal definition "")
10247                (delete-char -4)
10248                (insert ";"))
10249               ((equal definition "ARRAY")
10250                (delete-region (point) (progn (forward-word-strictly -1)
10251                                              (point)))
10252                (vhdl-template-array 'type t))
10253               ((equal definition "RECORD")
10254                (setq mid-pos (point-marker))
10255                (delete-region (point) (progn (forward-word-strictly -1)
10256                                              (point)))
10257                (vhdl-template-record 'type name t))
10258               ((equal definition "ACCESS")
10259                (insert " ")
10260                (vhdl-template-field "type" ";"))
10261               ((equal definition "FILE")
10262                (vhdl-insert-keyword " OF ")
10263                (vhdl-template-field "type" ";"))
10264               ((equal definition "ENUM")
10265                (kill-word -1)
10266                (insert "(")
10267                (setq end-pos (point-marker))
10268                (insert ");"))
10269               (t (insert ";")))
10270         (when mid-pos
10271           (setq end-pos (point-marker))
10272           (goto-char mid-pos)
10273           (end-of-line))
10274         (vhdl-comment-insert-inline)
10275         (when end-pos (goto-char end-pos))))))
10276
10277 (defun vhdl-template-use ()
10278   "Insert a use clause."
10279   (interactive)
10280   (let ((start (point)))
10281     (vhdl-prepare-search-1
10282      (vhdl-insert-keyword "USE ")
10283      (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
10284        (vhdl-insert-keyword "..ALL;")
10285        (backward-char 6)
10286        (when (vhdl-template-field "library name" nil t start (+ (point) 6))
10287          (forward-char 1)
10288          (vhdl-template-field "package name")
10289          (forward-char 5))))))
10290
10291 (defun vhdl-template-variable ()
10292   "Insert a variable declaration."
10293   (interactive)
10294   (let ((start (point))
10295         (in-arglist (vhdl-in-argument-list-p)))
10296     (vhdl-prepare-search-2
10297      (if (or (save-excursion
10298                (progn (vhdl-beginning-of-block)
10299                       (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>")))
10300              (save-excursion (backward-word-strictly 1)
10301                              (looking-at "\\<shared\\>")))
10302          (vhdl-insert-keyword "VARIABLE ")
10303        (if (vhdl-standard-p '87)
10304            (error "ERROR:  Not within sequential block")
10305          (vhdl-insert-keyword "SHARED VARIABLE "))))
10306     (when (vhdl-template-field "names" nil t start (point))
10307       (insert " : ")
10308       (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t))
10309       (vhdl-template-field "type")
10310       (if in-arglist
10311           (progn (insert ";")
10312                  (vhdl-comment-insert-inline))
10313         (let ((position (point)))
10314           (insert " := ")
10315           (unless (vhdl-template-field "[initialization]" nil t)
10316             (delete-region position (point)))
10317           (insert ";")
10318           (vhdl-comment-insert-inline))))))
10319
10320 (defun vhdl-template-wait ()
10321   "Insert a wait statement."
10322   (interactive)
10323   (vhdl-insert-keyword "WAIT ")
10324   (unless (vhdl-template-field
10325            "[ON sensitivity list] [UNTIL condition] [FOR time expression]"
10326            nil t)
10327     (delete-char -1))
10328   (insert ";"))
10329
10330 (defun vhdl-template-when ()
10331   "Indent correctly if within a case statement."
10332   (interactive)
10333   (let ((position (point))
10334         margin)
10335     (vhdl-prepare-search-2
10336      (if (and (= (current-column) (current-indentation))
10337               (vhdl-re-search-forward "\\<end\\>" nil t)
10338               (looking-at "\\s-*\\<case\\>"))
10339          (progn
10340            (setq margin (current-indentation))
10341            (goto-char position)
10342            (delete-horizontal-space)
10343            (indent-to (+ margin vhdl-basic-offset)))
10344        (goto-char position)))
10345     (vhdl-insert-keyword "WHEN ")))
10346
10347 (defun vhdl-template-while-loop ()
10348   "Insert a while loop."
10349   (interactive)
10350   (let* ((margin (current-indentation))
10351          (start (point))
10352          label)
10353     (if (not (eq vhdl-optional-labels 'all))
10354         (vhdl-insert-keyword "WHILE ")
10355       (vhdl-insert-keyword ": WHILE ")
10356       (goto-char start)
10357       (setq label (vhdl-template-field "[label]" nil t))
10358       (unless label (delete-char 2))
10359       (forward-word-strictly 1)
10360       (forward-char 1))
10361     (when vhdl-conditions-in-parenthesis (insert "("))
10362     (when (vhdl-template-field "condition" nil t start (point))
10363       (when vhdl-conditions-in-parenthesis (insert ")"))
10364       (vhdl-insert-keyword " LOOP\n\n")
10365       (indent-to margin)
10366       (vhdl-insert-keyword "END LOOP")
10367       (insert (if label (concat " " label ";") ";"))
10368       (forward-line -1)
10369       (indent-to (+ margin vhdl-basic-offset)))))
10370
10371 (defun vhdl-template-with ()
10372   "Insert a with statement (i.e. selected signal assignment)."
10373   (interactive)
10374   (vhdl-prepare-search-1
10375    (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
10376             (equal ";" (match-string 1)))
10377        (vhdl-template-selected-signal-asst)
10378      (vhdl-insert-keyword "WITH "))))
10379
10380 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10381 ;; Special templates
10382
10383 (defun vhdl-template-clocked-wait ()
10384   "Insert a wait statement for rising/falling clock edge."
10385   (interactive)
10386   (let ((start (point))
10387         clock)
10388     (vhdl-insert-keyword "WAIT UNTIL ")
10389     (when (setq clock
10390                 (or (and (not (equal "" vhdl-clock-name))
10391                          (progn (insert vhdl-clock-name) vhdl-clock-name))
10392                     (vhdl-template-field "clock name" nil t start (point))))
10393       (insert "'event")
10394       (vhdl-insert-keyword " AND ")
10395       (insert clock)
10396       (insert
10397        " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";")
10398       (vhdl-comment-insert-inline
10399        (concat (if vhdl-clock-rising-edge "rising" "falling")
10400                " clock edge")))))
10401
10402 (defun vhdl-template-seq-process (clock reset reset-kind)
10403   "Insert a template for the body of a sequential process."
10404   (let ((margin (current-indentation))
10405         position)
10406     (vhdl-insert-keyword "IF ")
10407     (when vhdl-conditions-in-parenthesis (insert "("))
10408     (when (eq reset-kind 'async)
10409       (insert reset " = "
10410               (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10411       (when vhdl-conditions-in-parenthesis (insert ")"))
10412       (vhdl-insert-keyword " THEN")
10413       (vhdl-comment-insert-inline
10414        (concat "asynchronous reset (active "
10415                (if vhdl-reset-active-high "high" "low") ")"))
10416       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10417       (setq position (point))
10418       (insert "\n") (indent-to margin)
10419       (vhdl-insert-keyword "ELSIF ")
10420       (when vhdl-conditions-in-parenthesis (insert "(")))
10421     (if (eq vhdl-clock-edge-condition 'function)
10422         (insert (if vhdl-clock-rising-edge "rising" "falling")
10423                 "_edge(" clock ")")
10424       (insert clock "'event")
10425       (vhdl-insert-keyword " AND ")
10426       (insert clock " = "
10427               (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string)))
10428     (when vhdl-conditions-in-parenthesis (insert ")"))
10429     (vhdl-insert-keyword " THEN")
10430     (vhdl-comment-insert-inline
10431      (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge"))
10432     (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10433     (when (eq reset-kind 'sync)
10434       (vhdl-insert-keyword "IF ")
10435       (when vhdl-conditions-in-parenthesis (insert "("))
10436       (setq reset (or (and (not (equal "" vhdl-reset-name))
10437                            (progn (insert vhdl-reset-name) vhdl-reset-name))
10438                       (vhdl-template-field "reset name") "<reset>"))
10439       (insert " = "
10440               (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string))
10441       (when vhdl-conditions-in-parenthesis (insert ")"))
10442       (vhdl-insert-keyword " THEN")
10443       (vhdl-comment-insert-inline
10444        (concat "synchronous reset (active "
10445                (if vhdl-reset-active-high "high" "low") ")"))
10446       (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10447       (setq position (point))
10448       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10449       (vhdl-insert-keyword "ELSE")
10450       (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset)))
10451       (insert "\n") (indent-to (+ margin vhdl-basic-offset))
10452       (vhdl-insert-keyword "END IF;"))
10453     (when (eq reset-kind 'none)
10454       (setq position (point)))
10455     (insert "\n") (indent-to margin)
10456     (vhdl-insert-keyword "END IF;")
10457     (goto-char position)
10458     reset))
10459
10460 (defun vhdl-template-standard-package (library package)
10461   "Insert specification of a standard package.  Include a library
10462 specification, if not already there."
10463   (let ((margin (current-indentation)))
10464     (unless (equal library "std")
10465       (unless (or (save-excursion
10466                     (vhdl-prepare-search-1
10467                      (and (not (bobp))
10468                           (re-search-backward
10469                            (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
10470                                    library "\\|end\\)\\>") nil t)
10471                           (match-string 2))))
10472                   (equal (downcase library) "work"))
10473         (vhdl-insert-keyword "LIBRARY ")
10474         (insert library ";")
10475         (when package
10476           (insert "\n")
10477           (indent-to margin))))
10478     (when package
10479       (vhdl-insert-keyword "USE ")
10480       (insert library "." package)
10481       (vhdl-insert-keyword ".ALL;"))))
10482
10483 (defun vhdl-template-package-numeric-bit ()
10484   "Insert specification of `numeric_bit' package."
10485   (interactive)
10486   (vhdl-template-standard-package "ieee" "numeric_bit"))
10487
10488 (defun vhdl-template-package-numeric-std ()
10489   "Insert specification of `numeric_std' package."
10490   (interactive)
10491   (vhdl-template-standard-package "ieee" "numeric_std"))
10492
10493 (defun vhdl-template-package-std-logic-1164 ()
10494   "Insert specification of `std_logic_1164' package."
10495   (interactive)
10496   (vhdl-template-standard-package "ieee" "std_logic_1164"))
10497
10498 (defun vhdl-template-package-std-logic-arith ()
10499   "Insert specification of `std_logic_arith' package."
10500   (interactive)
10501   (vhdl-template-standard-package "ieee" "std_logic_arith"))
10502
10503 (defun vhdl-template-package-std-logic-misc ()
10504   "Insert specification of `std_logic_misc' package."
10505   (interactive)
10506   (vhdl-template-standard-package "ieee" "std_logic_misc"))
10507
10508 (defun vhdl-template-package-std-logic-signed ()
10509   "Insert specification of `std_logic_signed' package."
10510   (interactive)
10511   (vhdl-template-standard-package "ieee" "std_logic_signed"))
10512
10513 (defun vhdl-template-package-std-logic-textio ()
10514   "Insert specification of `std_logic_textio' package."
10515   (interactive)
10516   (vhdl-template-standard-package "ieee" "std_logic_textio"))
10517
10518 (defun vhdl-template-package-std-logic-unsigned ()
10519   "Insert specification of `std_logic_unsigned' package."
10520   (interactive)
10521   (vhdl-template-standard-package "ieee" "std_logic_unsigned"))
10522
10523 (defun vhdl-template-package-textio ()
10524   "Insert specification of `textio' package."
10525   (interactive)
10526   (vhdl-template-standard-package "std" "textio"))
10527
10528 (defun vhdl-template-package-fundamental-constants ()
10529   "Insert specification of `fundamental_constants' package."
10530   (interactive)
10531   (vhdl-template-standard-package "ieee" "fundamental_constants"))
10532
10533 (defun vhdl-template-package-material-constants ()
10534   "Insert specification of `material_constants' package."
10535   (interactive)
10536   (vhdl-template-standard-package "ieee" "material_constants"))
10537
10538 (defun vhdl-template-package-energy-systems ()
10539   "Insert specification of `energy_systems' package."
10540   (interactive)
10541   (vhdl-template-standard-package "ieee" "energy_systems"))
10542
10543 (defun vhdl-template-package-electrical-systems ()
10544   "Insert specification of `electrical_systems' package."
10545   (interactive)
10546   (vhdl-template-standard-package "ieee" "electrical_systems"))
10547
10548 (defun vhdl-template-package-mechanical-systems ()
10549   "Insert specification of `mechanical_systems' package."
10550   (interactive)
10551   (vhdl-template-standard-package "ieee" "mechanical_systems"))
10552
10553 (defun vhdl-template-package-radiant-systems ()
10554   "Insert specification of `radiant_systems' package."
10555   (interactive)
10556   (vhdl-template-standard-package "ieee" "radiant_systems"))
10557
10558 (defun vhdl-template-package-thermal-systems ()
10559   "Insert specification of `thermal_systems' package."
10560   (interactive)
10561   (vhdl-template-standard-package "ieee" "thermal_systems"))
10562
10563 (defun vhdl-template-package-fluidic-systems ()
10564   "Insert specification of `fluidic_systems' package."
10565   (interactive)
10566   (vhdl-template-standard-package "ieee" "fluidic_systems"))
10567
10568 (defun vhdl-template-package-math-complex ()
10569   "Insert specification of `math_complex' package."
10570   (interactive)
10571   (vhdl-template-standard-package "ieee" "math_complex"))
10572
10573 (defun vhdl-template-package-math-real ()
10574   "Insert specification of `math_real' package."
10575   (interactive)
10576   (vhdl-template-standard-package "ieee" "math_real"))
10577
10578 (defun vhdl-template-directive (directive)
10579   "Insert directive."
10580   (unless (= (current-indentation) (current-column))
10581     (delete-horizontal-space)
10582     (insert "  "))
10583   (insert "-- pragma " directive))
10584
10585 (defun vhdl-template-directive-translate-on ()
10586   "Insert directive `translate_on'."
10587   (interactive)
10588   (vhdl-template-directive "translate_on"))
10589
10590 (defun vhdl-template-directive-translate-off ()
10591   "Insert directive `translate_off'."
10592   (interactive)
10593   (vhdl-template-directive "translate_off"))
10594
10595 (defun vhdl-template-directive-synthesis-on ()
10596   "Insert directive `synthesis_on'."
10597   (interactive)
10598   (vhdl-template-directive "synthesis_on"))
10599
10600 (defun vhdl-template-directive-synthesis-off ()
10601   "Insert directive `synthesis_off'."
10602   (interactive)
10603   (vhdl-template-directive "synthesis_off"))
10604
10605 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10606 ;; Header and footer templates
10607
10608 (defun vhdl-template-header (&optional file-title)
10609   "Insert a VHDL file header."
10610   (interactive)
10611   (unless (equal vhdl-file-header "")
10612     (let (pos)
10613       (save-excursion
10614         (goto-char (point-min))
10615         (vhdl-insert-string-or-file vhdl-file-header)
10616         (setq pos (point-marker)))
10617       (vhdl-template-replace-header-keywords
10618        (point-min-marker) pos file-title))))
10619
10620 (defun vhdl-template-footer ()
10621   "Insert a VHDL file footer."
10622   (interactive)
10623   (unless (equal vhdl-file-footer "")
10624     (let (pos)
10625       (save-excursion
10626         (goto-char (point-max))
10627         (setq pos (point-marker))
10628         (vhdl-insert-string-or-file vhdl-file-footer)
10629         (unless (= (preceding-char) ?\n)
10630           (insert "\n")))
10631       (vhdl-template-replace-header-keywords pos (point-max-marker)))))
10632
10633 (defun vhdl-template-replace-header-keywords (beg end &optional file-title
10634                                                   is-model)
10635   "Replace keywords in header and footer."
10636   (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project))
10637                            ""))
10638         (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project))
10639                           ""))
10640         pos)
10641     (vhdl-prepare-search-2
10642      (save-excursion
10643        (goto-char beg)
10644        (while (search-forward "<projectdesc>" end t)
10645          (replace-match project-desc t t))
10646        (goto-char beg)
10647        (while (search-forward "<filename>" end t)
10648          (replace-match (buffer-name) t t))
10649        (goto-char beg)
10650        (while (search-forward "<copyright>" end t)
10651          (replace-match vhdl-copyright-string t t))
10652        (goto-char beg)
10653        (while (search-forward "<author>" end t)
10654          (replace-match "" t t)
10655          (insert (user-full-name))
10656          (when user-mail-address (insert "  <" user-mail-address ">")))
10657        (goto-char beg)
10658        (while (search-forward "<authorfull>" end t)
10659          (replace-match (user-full-name) t t))
10660        (goto-char beg)
10661        (while (search-forward "<login>" end t)
10662          (replace-match (user-login-name) t t))
10663        (goto-char beg)
10664        (while (search-forward "<project>" end t)
10665          (replace-match project-title t t))
10666        (goto-char beg)
10667        (while (search-forward "<company>" end t)
10668          (replace-match vhdl-company-name t t))
10669        (goto-char beg)
10670        (while (search-forward "<platform>" end t)
10671          (replace-match vhdl-platform-spec t t))
10672        (goto-char beg)
10673        (while (search-forward "<standard>" end t)
10674          (replace-match
10675           (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
10676                                ((vhdl-standard-p '93) "'93/02")
10677                                ((vhdl-standard-p '08) "'08"))
10678                   (when (vhdl-standard-p 'ams) ", VHDL-AMS")
10679                   (when (vhdl-standard-p 'math) ", Math Packages")) t t))
10680        (goto-char beg)
10681        ;; Replace <RCS> with $, so that RCS for the source is
10682        ;; not over-enthusiastic with replacements
10683        (while (search-forward "<RCS>" end t)
10684          (replace-match "$" nil t))
10685        (goto-char beg)
10686        (while (search-forward "<date>" end t)
10687          (replace-match "" t t)
10688          (vhdl-template-insert-date))
10689        (goto-char beg)
10690        (while (search-forward "<year>" end t)
10691          (replace-match (format-time-string "%Y" nil) t t))
10692        (goto-char beg)
10693        (when file-title
10694          (while (search-forward "<title string>" end t)
10695            (replace-match file-title t t))
10696          (goto-char beg))
10697        (let (string)
10698          (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
10699            (save-match-data
10700              (setq string (read-string (concat (match-string 1) ": "))))
10701            (replace-match string t t)))
10702        (goto-char beg)
10703        (when (and (not is-model) (search-forward "<cursor>" end t))
10704          (replace-match "" t t)
10705          (setq pos (point))))
10706      (when pos (goto-char pos))
10707      (unless is-model
10708        (when (or (not project-title) (equal project-title ""))
10709          (message "You can specify a project title in user option `vhdl-project-alist'"))
10710        (when (or (not project-desc) (equal project-desc ""))
10711          (message "You can specify a project description in user option `vhdl-project-alist'"))
10712        (when (equal vhdl-platform-spec "")
10713          (message "You can specify a platform in user option `vhdl-platform-spec'"))
10714        (when (equal vhdl-company-name "")
10715          (message "You can specify a company name in user option `vhdl-company-name'"))))))
10716
10717 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10718 ;; Comment templates and functions
10719
10720 (defun vhdl-comment-indent ()
10721   "Indent comments."
10722   (let* ((position (point))
10723          (col
10724           (progn
10725             (forward-line -1)
10726             (if (re-search-forward "--" position t)
10727                 (- (current-column) 2)  ; existing comment at bol stays there
10728               (goto-char position)
10729               (skip-chars-backward " \t")
10730               (max comment-column       ; else indent to comment column
10731                    (1+ (current-column))))))) ; except leave at least one space
10732     (goto-char position)
10733     col))
10734
10735 (defun vhdl-comment-insert ()
10736   "Start a comment at the end of the line.
10737 If on line with code, indent at least `comment-column'.
10738 If starting after end-comment-column, start a new line."
10739   (interactive)
10740   (when (> (current-column) end-comment-column) (newline-and-indent))
10741   (if (or (looking-at "\\s-*$") ; end of line
10742           (and (not unread-command-events) ; called with key binding or menu
10743                (not (end-of-line))))
10744       (let (margin)
10745         (while (= (preceding-char) ?-) (delete-char -1))
10746         (setq margin (current-column))
10747         (delete-horizontal-space)
10748         (if (bolp)
10749             (progn (indent-to margin) (insert "--"))
10750           (insert "  ")
10751           (indent-to comment-column)
10752           (insert "--"))
10753         (if (not unread-command-events) (insert " ")))
10754     ;; else code following current point implies commenting out code
10755     (let (next-input code)
10756       (while (= (preceding-char) ?-) (delete-char -2))
10757       (while (= (setq next-input (read-char)) 13) ; CR
10758         (insert "--") ; or have a space after it?
10759         (forward-char -2)
10760         (forward-line 1)
10761         (message "Enter CR if commenting out a line of code.")
10762         (setq code t))
10763       (unless code
10764         (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
10765       (push (vhdl-character-to-event next-input) ; pushback the char
10766             unread-command-events))))
10767
10768 (defun vhdl-comment-display (&optional line-exists)
10769   "Add 2 comment lines at the current indent, making a display comment."
10770   (interactive)
10771   (let ((margin (current-indentation)))
10772     (unless line-exists (vhdl-comment-display-line))
10773     (insert "\n") (indent-to margin)
10774     (insert "\n") (indent-to margin)
10775     (vhdl-comment-display-line)
10776     (end-of-line -0)
10777     (insert "-- ")))
10778
10779 (defun vhdl-comment-display-line ()
10780   "Displays one line of dashes."
10781   (interactive)
10782   (while (= (preceding-char) ?-) (delete-char -2))
10783   (insert "--")
10784   (let* ((col (current-column))
10785          (len (- end-comment-column col)))
10786     (insert-char vhdl-comment-display-line-char len)))
10787
10788 (defun vhdl-comment-append-inline ()
10789   "Append empty inline comment to current line."
10790   (interactive)
10791   (end-of-line)
10792   (delete-horizontal-space)
10793   (insert "  ")
10794   (indent-to comment-column)
10795   (insert "-- "))
10796
10797 (defun vhdl-comment-insert-inline (&optional string always-insert)
10798   "Insert inline comment."
10799   (when (or (and string (or vhdl-self-insert-comments always-insert))
10800             (and (not string) vhdl-prompt-for-comments))
10801     (let ((position (point)))
10802       (insert "  ")
10803       (indent-to comment-column)
10804       (insert "-- ")
10805       (if (not (or (and string (progn (insert string) t))
10806                    (vhdl-template-field "[comment]" nil t)))
10807           (delete-region position (point))
10808         (while (= (preceding-char) ?\ ) (delete-char -1))))))
10809
10810 (defun vhdl-comment-block ()
10811   "Insert comment for code block."
10812   (when vhdl-prompt-for-comments
10813     (let ((final-pos (point-marker)))
10814       (vhdl-prepare-search-2
10815        (when (and (re-search-backward "^\\s-*begin\\>" nil t)
10816                   (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
10817          (let (margin)
10818            (back-to-indentation)
10819            (setq margin (current-column))
10820            (end-of-line -0)
10821            (if (bobp)
10822                (progn (insert "\n") (forward-line -1))
10823              (insert "\n"))
10824            (indent-to margin)
10825            (insert "-- purpose: ")
10826            (unless (vhdl-template-field "[description]" nil t)
10827              (vhdl-line-kill-entire)))))
10828       (goto-char final-pos))))
10829
10830 (defun vhdl-comment-uncomment-region (beg end &optional arg)
10831   "Comment out region if not commented out, uncomment otherwise."
10832   (interactive "r\nP")
10833   (save-excursion
10834     (goto-char (1- end))
10835     (end-of-line)
10836     (setq end (point-marker))
10837     (goto-char beg)
10838     (beginning-of-line)
10839     (setq beg (point))
10840     (if (looking-at (concat "\\s-*" comment-start))
10841         (comment-region beg end '(4))
10842       (comment-region beg end))))
10843
10844 (defun vhdl-comment-uncomment-line (&optional arg)
10845   "Comment out line if not commented out, uncomment otherwise."
10846   (interactive "p")
10847   (save-excursion
10848     (beginning-of-line)
10849     (let ((position (point)))
10850       (forward-line (or arg 1))
10851       (vhdl-comment-uncomment-region position (point)))))
10852
10853 (defun vhdl-comment-kill-region (beg end)
10854   "Kill comments in region."
10855   (interactive "r")
10856   (save-excursion
10857     (goto-char end)
10858     (setq end (point-marker))
10859     (goto-char beg)
10860     (beginning-of-line)
10861     (while (< (point) end)
10862       (if (looking-at "^\\(\\s-*--.*\n\\)")
10863           (progn (delete-region (match-beginning 1) (match-end 1)))
10864         (beginning-of-line 2)))))
10865
10866 (defun vhdl-comment-kill-inline-region (beg end)
10867   "Kill inline comments in region."
10868   (interactive "r")
10869   (save-excursion
10870     (goto-char end)
10871     (setq end (point-marker))
10872     (goto-char beg)
10873     (beginning-of-line)
10874     (while (< (point) end)
10875       (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$")
10876         (delete-region (match-beginning 1) (match-end 1)))
10877       (beginning-of-line 2))))
10878
10879 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10880 ;; Subtemplates
10881
10882 (defun vhdl-template-begin-end (construct name margin &optional empty-lines)
10883   "Insert a begin ... end pair with optional name after the end.
10884 Point is left between them."
10885   (let (position)
10886     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10887     (indent-to margin)
10888     (vhdl-insert-keyword "BEGIN")
10889     (when (and (or construct name) vhdl-self-insert-comments)
10890       (insert "  --")
10891       (when construct (insert " ") (vhdl-insert-keyword construct))
10892       (when name (insert " " name)))
10893     (insert "\n")
10894     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10895     (indent-to (+ margin vhdl-basic-offset))
10896     (setq position (point))
10897     (insert "\n")
10898     (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
10899     (indent-to margin)
10900     (vhdl-insert-keyword "END")
10901     (when construct (insert " ") (vhdl-insert-keyword construct))
10902     (insert (if name (concat " " name) "") ";")
10903     (goto-char position)))
10904
10905 (defun vhdl-template-argument-list (&optional is-function)
10906   "Read from user a procedure or function argument list."
10907   (insert " (")
10908   (let ((margin (current-column))
10909         (start (point))
10910         (end-pos (point))
10911         not-empty interface semicolon-pos)
10912     (unless vhdl-argument-list-indent
10913       (setq margin (+ (current-indentation) vhdl-basic-offset))
10914       (insert "\n")
10915       (indent-to margin))
10916     (setq interface (vhdl-template-field
10917                      (concat "[CONSTANT | SIGNAL"
10918                              (unless is-function " | VARIABLE") "]") " " t))
10919     (while (vhdl-template-field "[names]" nil t)
10920       (setq not-empty t)
10921       (insert " : ")
10922       (unless is-function
10923         (if (and interface (equal (upcase interface) "CONSTANT"))
10924             (vhdl-insert-keyword "IN ")
10925           (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
10926       (vhdl-template-field "type")
10927       (setq semicolon-pos (point))
10928       (insert ";")
10929       (vhdl-comment-insert-inline)
10930       (setq end-pos (point))
10931       (insert "\n")
10932       (indent-to margin)
10933       (setq interface (vhdl-template-field
10934                        (concat "[CONSTANT | SIGNAL"
10935                                (unless is-function " | VARIABLE") "]") " " t)))
10936     (delete-region end-pos (point))
10937     (when semicolon-pos (goto-char semicolon-pos))
10938     (if not-empty
10939         (progn (delete-char 1) (insert ")"))
10940       (delete-char -2))))
10941
10942 (defun vhdl-template-generic-list (optional &optional no-value)
10943   "Read from user a generic spec argument list."
10944   (let (margin
10945         (start (point)))
10946     (vhdl-insert-keyword "GENERIC (")
10947     (setq margin (current-column))
10948     (unless vhdl-argument-list-indent
10949       (let ((position (point)))
10950         (back-to-indentation)
10951         (setq margin (+ (current-column) vhdl-basic-offset))
10952         (goto-char position)
10953         (insert "\n")
10954         (indent-to margin)))
10955     (let ((vhdl-generics (vhdl-template-field
10956                           (concat (and optional "[") "name"
10957                                   (and no-value "s") (and optional "]"))
10958                           nil optional)))
10959       (if (not vhdl-generics)
10960           (if optional
10961               (progn (vhdl-line-kill-entire) (end-of-line -0)
10962                      (unless vhdl-argument-list-indent
10963                        (vhdl-line-kill-entire) (end-of-line -0)))
10964             (vhdl-template-undo start (point))
10965             nil )
10966         (insert " : ")
10967         (let (semicolon-pos end-pos)
10968           (while vhdl-generics
10969             (vhdl-template-field "type")
10970             (if no-value
10971                 (progn (setq semicolon-pos (point))
10972                        (insert ";"))
10973               (insert " := ")
10974               (unless (vhdl-template-field "[value]" nil t)
10975                 (delete-char -4))
10976               (setq semicolon-pos (point))
10977               (insert ";"))
10978             (vhdl-comment-insert-inline)
10979             (setq end-pos (point))
10980             (insert "\n")
10981             (indent-to margin)
10982             (setq vhdl-generics (vhdl-template-field
10983                                  (concat "[name" (and no-value "s") "]")
10984                                  " : " t)))
10985           (delete-region end-pos (point))
10986           (goto-char semicolon-pos)
10987           (insert ")")
10988           (end-of-line)
10989           (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10990           t)))))
10991
10992 (defun vhdl-template-port-list (optional)
10993   "Read from user a port spec argument list."
10994   (let ((start (point))
10995         margin vhdl-ports object)
10996     (vhdl-insert-keyword "PORT (")
10997     (setq margin (current-column))
10998     (unless vhdl-argument-list-indent
10999       (let ((position (point)))
11000         (back-to-indentation)
11001         (setq margin (+ (current-column) vhdl-basic-offset))
11002         (goto-char position)
11003         (insert "\n")
11004         (indent-to margin)))
11005     (when (vhdl-standard-p 'ams)
11006       (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11007                                         " " t)))
11008     (setq vhdl-ports (vhdl-template-field
11009                       (concat (and optional "[") "names" (and optional "]"))
11010                       nil optional))
11011     (if (not vhdl-ports)
11012         (if optional
11013             (progn (vhdl-line-kill-entire) (end-of-line -0)
11014                    (unless vhdl-argument-list-indent
11015                      (vhdl-line-kill-entire) (end-of-line -0)))
11016           (vhdl-template-undo start (point))
11017           nil)
11018       (insert " : ")
11019       (let (semicolon-pos end-pos)
11020         (while vhdl-ports
11021           (cond ((or (null object) (equal "SIGNAL" (upcase object)))
11022                  (vhdl-template-field "IN | OUT | INOUT" " "))
11023                 ((equal "QUANTITY" (upcase object))
11024                  (vhdl-template-field "[IN | OUT]" " " t)))
11025           (vhdl-template-field
11026            (if (and object (equal "TERMINAL" (upcase object)))
11027                     "nature" "type"))
11028           (setq semicolon-pos (point))
11029           (insert ";")
11030           (vhdl-comment-insert-inline)
11031           (setq end-pos (point))
11032           (insert "\n")
11033           (indent-to margin)
11034           (when (vhdl-standard-p 'ams)
11035             (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]"
11036                                               " " t)))
11037           (setq vhdl-ports (vhdl-template-field "[names]" " : " t)))
11038         (delete-region end-pos (point))
11039         (goto-char semicolon-pos)
11040         (insert ")")
11041         (end-of-line)
11042         (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
11043         t))))
11044
11045 (defun vhdl-template-generate-body (margin label)
11046   "Insert body for generate template."
11047   (vhdl-insert-keyword " GENERATE")
11048   (insert "\n\n")
11049   (indent-to margin)
11050   (vhdl-insert-keyword "END GENERATE ")
11051   (insert label ";")
11052   (end-of-line 0)
11053   (indent-to (+ margin vhdl-basic-offset)))
11054
11055 (defun vhdl-template-insert-date ()
11056   "Insert date in appropriate format."
11057   (interactive)
11058   (insert
11059    (cond
11060     ;; 'american, 'european, 'scientific kept for backward compatibility
11061     ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
11062     ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
11063     ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
11064     (t (format-time-string vhdl-date-format nil)))))
11065
11066 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11067 ;; Help functions
11068
11069 (defun vhdl-electric-space (count)
11070   "Expand abbreviations and self-insert space(s), do indent-new-comment-line
11071 if in comment and past end-comment-column."
11072   (interactive "p")
11073   (cond ((vhdl-in-comment-p)
11074          (self-insert-command count)
11075          (cond ((>= (current-column) (+ 2 end-comment-column))
11076                 (backward-char 1)
11077                 (skip-chars-backward "^ \t\n\r\f")
11078                 (indent-new-comment-line)
11079                 (skip-chars-forward "^ \t\n\r\f")
11080                 (forward-char 1))
11081                ((>= (current-column) end-comment-column)
11082                 (indent-new-comment-line))
11083                (t nil)))
11084         ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
11085              (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
11086          (vhdl-prepare-search-1
11087           (or (expand-abbrev) (vhdl-fix-case-word -1)))
11088          (self-insert-command count))
11089         (t (self-insert-command count))))
11090
11091 (defun vhdl-template-field (prompt &optional follow-string optional
11092                                    begin end is-string default)
11093   "Prompt for string and insert it in buffer with optional FOLLOW-STRING.
11094 If OPTIONAL is nil, the prompt is left if an empty string is inserted.  If
11095 an empty string is inserted, return nil and call `vhdl-template-undo' for
11096 the region between BEGIN and END.  IS-STRING indicates whether a string
11097 with double-quotes is to be inserted.  DEFAULT specifies a default string."
11098   (let ((position (point))
11099         string)
11100     (insert "<" prompt ">")
11101     (setq string
11102           (condition-case ()
11103               (read-from-minibuffer (concat prompt ": ")
11104                                     (or (and is-string '("\"\"" . 2)) default)
11105                                     vhdl-minibuffer-local-map)
11106             (quit (if (and optional begin end)
11107                       (progn (beep) "")
11108                     (keyboard-quit)))))
11109     (when (or (not (equal string "")) optional)
11110       (delete-region position (point)))
11111     (when (and (equal string "") optional begin end)
11112       (vhdl-template-undo begin end)
11113       (message "Template aborted"))
11114     (unless (equal string "")
11115       (insert string)
11116       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
11117                               vhdl-keywords-regexp)
11118       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
11119                               vhdl-types-regexp)
11120       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
11121                               (concat "'" vhdl-attributes-regexp))
11122       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
11123                               vhdl-enum-values-regexp)
11124       (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants
11125                               vhdl-constants-regexp))
11126     (when (or (not (equal string "")) (not optional))
11127       (insert (or follow-string "")))
11128     (if (equal string "") nil string)))
11129
11130 (defun vhdl-decision-query (string prompt &optional optional)
11131   "Query a decision from the user."
11132   (let ((start (point)))
11133     (when string (vhdl-insert-keyword (concat string " ")))
11134     (message "%s" (or prompt ""))
11135     (let ((char (read-char)))
11136       (delete-region start (point))
11137       (if (and optional (eq char ?\r))
11138           (progn (insert " ")
11139                  (unexpand-abbrev)
11140                  (throw 'abort "ERROR:  Template aborted"))
11141         char))))
11142
11143 (defun vhdl-insert-keyword (keyword)
11144   "Insert KEYWORD and adjust case."
11145   (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))))
11146
11147 (defun vhdl-case-keyword (keyword)
11148   "Adjust case of KEYWORD."
11149   (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
11150
11151 (defun vhdl-case-word (num)
11152   "Adjust case of following NUM words."
11153   (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
11154
11155 (defun vhdl-minibuffer-tab (&optional prefix-arg)
11156   "If preceding character is part of a word or a paren then hippie-expand,
11157 else insert tab (used for word completion in VHDL minibuffer)."
11158   (interactive "P")
11159   (cond
11160    ;; expand word
11161    ((= (char-syntax (preceding-char)) ?w)
11162     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11163           (case-replace nil)
11164           (hippie-expand-only-buffers
11165            (or (and (boundp 'hippie-expand-only-buffers)
11166                     hippie-expand-only-buffers)
11167                '(vhdl-mode))))
11168       (vhdl-expand-abbrev prefix-arg)))
11169    ;; expand parenthesis
11170    ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
11171     (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
11172           (case-replace nil))
11173       (vhdl-expand-paren prefix-arg)))
11174    ;; insert tab
11175    (t (insert-tab))))
11176
11177 (defun vhdl-template-search-prompt ()
11178   "Search for left out template prompts and query again."
11179   (interactive)
11180   (vhdl-prepare-search-2
11181    (when (or (re-search-forward
11182               (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
11183              (re-search-backward
11184               (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
11185      (let ((string (match-string 1)))
11186        (replace-match "")
11187        (vhdl-template-field string)))))
11188
11189 (defun vhdl-template-undo (begin end)
11190   "Undo aborted template by deleting region and unexpanding the keyword."
11191   (cond (vhdl-template-invoked-by-hook
11192          (goto-char end)
11193          (insert " ")
11194          (delete-region begin end)
11195          (unexpand-abbrev))
11196         (t (delete-region begin end))))
11197
11198 (defun vhdl-insert-string-or-file (string)
11199   "Insert STRING or file contents if STRING is an existing file name."
11200   (unless (equal string "")
11201     (let ((file-name
11202            (progn (string-match "^\\([^\n]+\\)" string)
11203                   (vhdl-resolve-env-variable (match-string 1 string)))))
11204       (if (file-exists-p file-name)
11205            (forward-char (cadr (insert-file-contents file-name)))
11206         (insert string)))))
11207
11208 (defun vhdl-beginning-of-block ()
11209   "Move cursor to the beginning of the enclosing block."
11210   (let (pos)
11211     (vhdl-prepare-search-2
11212      (save-excursion
11213        (beginning-of-line)
11214        ;; search backward for block beginning or end
11215        (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))
11216                               ;; not consider subprogram declarations
11217                               (or (and (match-string 5)
11218                                        (save-match-data
11219                                          (save-excursion
11220                                            (goto-char (match-end 5))
11221                                            (forward-word-strictly 1)
11222                                            (vhdl-forward-syntactic-ws)
11223                                            (when (looking-at "(")
11224                                              (forward-sexp))
11225                                            (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11226                                          (match-string 1)))
11227                                   ;; not consider configuration specifications
11228                                   (and (match-string 6)
11229                                        (save-match-data
11230                                          (save-excursion
11231                                            (vhdl-end-of-block)
11232                                            (beginning-of-line)
11233                                            (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11234                   (match-string 2))
11235          ;; skip subblock if block end found
11236          (vhdl-beginning-of-block))))
11237     (when pos (goto-char pos))))
11238
11239 (defun vhdl-end-of-block ()
11240   "Move cursor to the end of the enclosing block."
11241   (let (pos)
11242     (vhdl-prepare-search-2
11243      (save-excursion
11244        (end-of-line)
11245        ;; search forward for block beginning or end
11246        (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))
11247                               ;; not consider subprogram declarations
11248                               (or (and (match-string 5)
11249                                        (save-match-data
11250                                          (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
11251                                          (match-string 1)))
11252                                   ;; not consider configuration specifications
11253                                   (and (match-string 6)
11254                                        (save-match-data
11255                                          (save-excursion
11256                                            (vhdl-end-of-block)
11257                                            (beginning-of-line)
11258                                            (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
11259                   (not (match-string 2)))
11260          ;; skip subblock if block beginning found
11261          (vhdl-end-of-block))))
11262     (when pos (goto-char pos))))
11263
11264 (defun vhdl-sequential-statement-p ()
11265   "Check if point is within sequential statement part."
11266   (let ((start (point)))
11267     (save-excursion
11268       (vhdl-prepare-search-2
11269        ;; is sequential statement if ...
11270        (and (re-search-backward "^\\s-*begin\\>" nil t)
11271             ;; ... point is between "begin" and "end" of ...
11272             (progn (vhdl-end-of-block)
11273                    (< start (point)))
11274             ;; ... a sequential block
11275             (progn (vhdl-beginning-of-block)
11276                    (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\\)\\)\\>")))))))
11277
11278 (defun vhdl-in-argument-list-p ()
11279   "Check if within an argument list."
11280   (save-excursion
11281     (vhdl-prepare-search-2
11282      (or (string-match "arglist"
11283                        (format "%s" (caar (vhdl-get-syntactic-context))))
11284          (progn (beginning-of-line)
11285                 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
11286
11287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11288 ;; Abbrev hooks
11289
11290 (defun vhdl-hooked-abbrev (func)
11291   "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
11292 but not if inside a comment or quote."
11293   (if (or (vhdl-in-literal)
11294           (save-excursion
11295             (forward-word-strictly -1)
11296             (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
11297       (progn
11298         (insert " ")
11299         (unexpand-abbrev)
11300         (backward-word-strictly 1)
11301         (vhdl-case-word 1)
11302         (delete-char 1))
11303     (if (not vhdl-electric-mode)
11304         (progn
11305           (insert " ")
11306           (unexpand-abbrev)
11307           (backward-word-strictly 1)
11308           (vhdl-case-word 1)
11309           (delete-char 1))
11310       (let ((invoke-char vhdl-last-input-event)
11311             (abbrev-mode -1)
11312             (vhdl-template-invoked-by-hook t))
11313         (let ((caught (catch 'abort
11314                         (funcall func))))
11315           (when (stringp caught) (message "%s" caught)))
11316         (when (= invoke-char ?-) (setq abbrev-start-location (point)))
11317         ;; delete CR which is still in event queue
11318         (if (fboundp 'enqueue-eval-event)
11319             (enqueue-eval-event 'delete-char -1)
11320           (push (vhdl-character-to-event ?\177) ; push back a delete char
11321                 unread-command-events))))))
11322
11323 (defun vhdl-template-alias-hook ()
11324   (vhdl-hooked-abbrev 'vhdl-template-alias))
11325 (defun vhdl-template-architecture-hook ()
11326   (vhdl-hooked-abbrev 'vhdl-template-architecture))
11327 (defun vhdl-template-assert-hook ()
11328   (vhdl-hooked-abbrev 'vhdl-template-assert))
11329 (defun vhdl-template-attribute-hook ()
11330   (vhdl-hooked-abbrev 'vhdl-template-attribute))
11331 (defun vhdl-template-block-hook ()
11332   (vhdl-hooked-abbrev 'vhdl-template-block))
11333 (defun vhdl-template-break-hook ()
11334   (vhdl-hooked-abbrev 'vhdl-template-break))
11335 (defun vhdl-template-case-hook ()
11336   (vhdl-hooked-abbrev 'vhdl-template-case))
11337 (defun vhdl-template-component-hook ()
11338   (vhdl-hooked-abbrev 'vhdl-template-component))
11339 (defun vhdl-template-instance-hook ()
11340   (vhdl-hooked-abbrev 'vhdl-template-instance))
11341 (defun vhdl-template-conditional-signal-asst-hook ()
11342   (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
11343 (defun vhdl-template-configuration-hook ()
11344   (vhdl-hooked-abbrev 'vhdl-template-configuration))
11345 (defun vhdl-template-constant-hook ()
11346   (vhdl-hooked-abbrev 'vhdl-template-constant))
11347 (defun vhdl-template-context-hook ()
11348   (vhdl-hooked-abbrev 'vhdl-template-context))
11349 (defun vhdl-template-disconnect-hook ()
11350   (vhdl-hooked-abbrev 'vhdl-template-disconnect))
11351 (defun vhdl-template-display-comment-hook ()
11352   (vhdl-hooked-abbrev 'vhdl-comment-display))
11353 (defun vhdl-template-else-hook ()
11354   (vhdl-hooked-abbrev 'vhdl-template-else))
11355 (defun vhdl-template-elsif-hook ()
11356   (vhdl-hooked-abbrev 'vhdl-template-elsif))
11357 (defun vhdl-template-entity-hook ()
11358   (vhdl-hooked-abbrev 'vhdl-template-entity))
11359 (defun vhdl-template-exit-hook ()
11360   (vhdl-hooked-abbrev 'vhdl-template-exit))
11361 (defun vhdl-template-file-hook ()
11362   (vhdl-hooked-abbrev 'vhdl-template-file))
11363 (defun vhdl-template-for-hook ()
11364   (vhdl-hooked-abbrev 'vhdl-template-for))
11365 (defun vhdl-template-function-hook ()
11366   (vhdl-hooked-abbrev 'vhdl-template-function))
11367 (defun vhdl-template-generic-hook ()
11368   (vhdl-hooked-abbrev 'vhdl-template-generic))
11369 (defun vhdl-template-group-hook ()
11370   (vhdl-hooked-abbrev 'vhdl-template-group))
11371 (defun vhdl-template-library-hook ()
11372   (vhdl-hooked-abbrev 'vhdl-template-library))
11373 (defun vhdl-template-limit-hook ()
11374   (vhdl-hooked-abbrev 'vhdl-template-limit))
11375 (defun vhdl-template-if-hook ()
11376   (vhdl-hooked-abbrev 'vhdl-template-if))
11377 (defun vhdl-template-bare-loop-hook ()
11378   (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
11379 (defun vhdl-template-map-hook ()
11380   (vhdl-hooked-abbrev 'vhdl-template-map))
11381 (defun vhdl-template-nature-hook ()
11382   (vhdl-hooked-abbrev 'vhdl-template-nature))
11383 (defun vhdl-template-next-hook ()
11384   (vhdl-hooked-abbrev 'vhdl-template-next))
11385 (defun vhdl-template-others-hook ()
11386   (vhdl-hooked-abbrev 'vhdl-template-others))
11387 (defun vhdl-template-package-hook ()
11388   (vhdl-hooked-abbrev 'vhdl-template-package))
11389 (defun vhdl-template-port-hook ()
11390   (vhdl-hooked-abbrev 'vhdl-template-port))
11391 (defun vhdl-template-procedural-hook ()
11392   (vhdl-hooked-abbrev 'vhdl-template-procedural))
11393 (defun vhdl-template-procedure-hook ()
11394   (vhdl-hooked-abbrev 'vhdl-template-procedure))
11395 (defun vhdl-template-process-hook ()
11396   (vhdl-hooked-abbrev 'vhdl-template-process))
11397 (defun vhdl-template-quantity-hook ()
11398   (vhdl-hooked-abbrev 'vhdl-template-quantity))
11399 (defun vhdl-template-report-hook ()
11400   (vhdl-hooked-abbrev 'vhdl-template-report))
11401 (defun vhdl-template-return-hook ()
11402   (vhdl-hooked-abbrev 'vhdl-template-return))
11403 (defun vhdl-template-selected-signal-asst-hook ()
11404   (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
11405 (defun vhdl-template-signal-hook ()
11406   (vhdl-hooked-abbrev 'vhdl-template-signal))
11407 (defun vhdl-template-subnature-hook ()
11408   (vhdl-hooked-abbrev 'vhdl-template-subnature))
11409 (defun vhdl-template-subtype-hook ()
11410   (vhdl-hooked-abbrev 'vhdl-template-subtype))
11411 (defun vhdl-template-terminal-hook ()
11412   (vhdl-hooked-abbrev 'vhdl-template-terminal))
11413 (defun vhdl-template-type-hook ()
11414   (vhdl-hooked-abbrev 'vhdl-template-type))
11415 (defun vhdl-template-use-hook ()
11416   (vhdl-hooked-abbrev 'vhdl-template-use))
11417 (defun vhdl-template-variable-hook ()
11418   (vhdl-hooked-abbrev 'vhdl-template-variable))
11419 (defun vhdl-template-wait-hook ()
11420   (vhdl-hooked-abbrev 'vhdl-template-wait))
11421 (defun vhdl-template-when-hook ()
11422   (vhdl-hooked-abbrev 'vhdl-template-when))
11423 (defun vhdl-template-while-loop-hook ()
11424   (vhdl-hooked-abbrev 'vhdl-template-while-loop))
11425 (defun vhdl-template-with-hook ()
11426   (vhdl-hooked-abbrev 'vhdl-template-with))
11427 (defun vhdl-template-and-hook ()
11428   (vhdl-hooked-abbrev 'vhdl-template-and))
11429 (defun vhdl-template-or-hook ()
11430   (vhdl-hooked-abbrev 'vhdl-template-or))
11431 (defun vhdl-template-nand-hook ()
11432   (vhdl-hooked-abbrev 'vhdl-template-nand))
11433 (defun vhdl-template-nor-hook ()
11434   (vhdl-hooked-abbrev 'vhdl-template-nor))
11435 (defun vhdl-template-xor-hook ()
11436   (vhdl-hooked-abbrev 'vhdl-template-xor))
11437 (defun vhdl-template-xnor-hook ()
11438   (vhdl-hooked-abbrev 'vhdl-template-xnor))
11439 (defun vhdl-template-not-hook ()
11440   (vhdl-hooked-abbrev 'vhdl-template-not))
11441
11442 (defun vhdl-template-default-hook ()
11443   (vhdl-hooked-abbrev 'vhdl-template-default))
11444 (defun vhdl-template-default-indent-hook ()
11445   (vhdl-hooked-abbrev 'vhdl-template-default-indent))
11446
11447 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11448 ;; Template insertion from completion list
11449
11450 (defun vhdl-template-insert-construct (name)
11451   "Insert the built-in construct template with NAME."
11452   (interactive
11453    (list (let ((completion-ignore-case t))
11454            (completing-read "Construct name: "
11455                             vhdl-template-construct-alist nil t))))
11456   (vhdl-template-insert-fun
11457    (cadr (assoc name vhdl-template-construct-alist))))
11458
11459 (defun vhdl-template-insert-package (name)
11460   "Insert the built-in package template with NAME."
11461   (interactive
11462    (list (let ((completion-ignore-case t))
11463            (completing-read "Package name: "
11464                             vhdl-template-package-alist nil t))))
11465   (vhdl-template-insert-fun
11466    (cadr (assoc name vhdl-template-package-alist))))
11467
11468 (defun vhdl-template-insert-directive (name)
11469   "Insert the built-in directive template with NAME."
11470   (interactive
11471    (list (let ((completion-ignore-case t))
11472            (completing-read "Directive name: "
11473                             vhdl-template-directive-alist nil t))))
11474   (vhdl-template-insert-fun
11475    (cadr (assoc name vhdl-template-directive-alist))))
11476
11477 (defun vhdl-template-insert-fun (fun)
11478   "Call FUN to insert a built-in template."
11479   (let ((caught (catch 'abort (when fun (funcall fun)))))
11480     (when (stringp caught) (message "%s" caught))))
11481
11482
11483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11484 ;;; Models
11485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11486
11487 (defun vhdl-model-insert (model-name)
11488   "Insert the user model with name MODEL-NAME."
11489   (interactive
11490    (let ((completion-ignore-case t))
11491      (list (completing-read "Model name: " vhdl-model-alist))))
11492   (indent-according-to-mode)
11493   (let ((start (point-marker))
11494         (margin (current-indentation))
11495         model position prompt string end)
11496     (vhdl-prepare-search-2
11497      (when (setq model (assoc model-name vhdl-model-alist))
11498        ;; insert model
11499        (beginning-of-line)
11500        (delete-horizontal-space)
11501        (goto-char start)
11502        (vhdl-insert-string-or-file (nth 1 model))
11503        (setq end (point-marker))
11504        ;; indent code
11505        (goto-char start)
11506        (beginning-of-line)
11507        (while (< (point) end)
11508          (unless (looking-at "^$")
11509            (insert-char ?  margin))
11510          (beginning-of-line 2))
11511        (goto-char start)
11512        ;; insert clock
11513        (unless (equal "" vhdl-clock-name)
11514          (while (re-search-forward "<clock>" end t)
11515            (replace-match vhdl-clock-name)))
11516        (goto-char start)
11517        ;; insert reset
11518        (unless (equal "" vhdl-reset-name)
11519          (while (re-search-forward "<reset>" end t)
11520            (replace-match vhdl-reset-name)))
11521        ;; replace header prompts
11522        (vhdl-template-replace-header-keywords start end nil t)
11523        (goto-char start)
11524        ;; query other prompts
11525        (while (re-search-forward
11526                (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
11527          (unless (equal "cursor" (match-string 1))
11528            (setq position (match-beginning 1))
11529            (setq prompt (match-string 1))
11530            (replace-match "")
11531            (setq string (vhdl-template-field prompt nil t))
11532            ;; replace occurrences of same prompt
11533            (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
11534              (replace-match (or string "")))
11535            (goto-char position)))
11536        (goto-char start)
11537        ;; goto final position
11538        (if (re-search-forward "<cursor>" end t)
11539            (replace-match "")
11540          (goto-char end))))))
11541
11542 (defun vhdl-model-defun ()
11543   "Define help and hook functions for user models."
11544   (let ((model-alist vhdl-model-alist)
11545         model-name model-keyword)
11546     (while model-alist
11547       ;; define functions for user models that can be invoked from menu and key
11548       ;; bindings and which themselves call `vhdl-model-insert' with the model
11549       ;; name as argument
11550       (setq model-name (nth 0 (car model-alist)))
11551       (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
11552                ,(concat "Insert model for \"" model-name "\".")
11553                (interactive)
11554                (vhdl-model-insert ,model-name)))
11555       ;; define hooks for user models that are invoked from keyword abbrevs
11556       (setq model-keyword (nth 3 (car model-alist)))
11557       (unless (equal model-keyword "")
11558         (eval `(defun
11559                  ,(vhdl-function-name
11560                    "vhdl-model" model-name "hook") ()
11561                  (vhdl-hooked-abbrev
11562                   ',(vhdl-function-name "vhdl-model" model-name)))))
11563       (setq model-alist (cdr model-alist)))))
11564
11565 (vhdl-model-defun)
11566
11567
11568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11569 ;;; Port translation
11570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11571
11572 (defvar vhdl-port-list nil
11573   "Variable to hold last port map parsed.")
11574 ;; structure: (parenthesized expression means list of such entries)
11575 ;; (ent-name
11576 ;;  ((generic-names) generic-type generic-init generic-comment group-comment)
11577 ;;  ((port-names) port-object port-direct port-type port-comment group-comment)
11578 ;;  (lib-name pack-key))
11579
11580 (defun vhdl-parse-string (string &optional optional)
11581   "Check that the text following point matches the regexp in STRING."
11582   (if (looking-at string)
11583       (progn (goto-char (match-end 0))
11584              (when (vhdl-in-literal)
11585                (end-of-line))
11586              (point))
11587     (unless optional
11588       (throw 'parse (format "ERROR:  Syntax error near line %s, expecting \"%s\""
11589                             (vhdl-current-line) string)))
11590     nil))
11591
11592 (defun vhdl-replace-string (regexp-cons string &optional adjust-case)
11593   "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
11594   (vhdl-prepare-search-1
11595    (if (string-match (car regexp-cons) string)
11596        (if adjust-case
11597            (funcall vhdl-file-name-case
11598                     (replace-match (cdr regexp-cons) t nil string))
11599          (replace-match (cdr regexp-cons) t nil string))
11600      string)))
11601
11602 (defun vhdl-parse-group-comment ()
11603   "Parse comment and empty lines between groups of lines."
11604   (let ((start (point))
11605         string)
11606     (vhdl-forward-comment (point-max))
11607     (setq string (buffer-substring-no-properties start (point)))
11608     (vhdl-forward-syntactic-ws)
11609     ;; strip off leading blanks and first newline
11610     (while (string-match "^\\(\\s-+\\)" string)
11611       (setq string (concat (substring string 0 (match-beginning 1))
11612                            (substring string (match-end 1)))))
11613     (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
11614         (substring string 1)
11615       string)))
11616
11617 (defun vhdl-paste-group-comment (string indent)
11618   "Paste comment and empty lines from STRING between groups of lines
11619 with INDENT."
11620   (let ((pos (point-marker)))
11621     (when (> indent 0)
11622       (while (string-match "^\\(--\\)" string)
11623         (setq string (concat (substring string 0 (match-beginning 1))
11624                              (make-string indent ? )
11625                              (substring string (match-beginning 1))))))
11626     (beginning-of-line)
11627     (insert string)
11628     (goto-char pos)))
11629
11630 (defvar vhdl-port-flattened nil
11631   "Indicates whether a port has been flattened.")
11632
11633 (defun vhdl-port-flatten (&optional as-alist)
11634   "Flatten port list so that only one generic/port exists per line.
11635 This operation is performed on an internally stored port and is only
11636 reflected in a subsequent paste operation."
11637   (interactive)
11638   (if (not vhdl-port-list)
11639       (error "ERROR:  No port has been read")
11640     (message "Flattening port for next paste...")
11641     (let ((new-vhdl-port-list (list (car vhdl-port-list)))
11642           (old-vhdl-port-list (cdr vhdl-port-list))
11643           old-port-list new-port-list old-port new-port names)
11644       ;; traverse port list and flatten entries
11645       (while (cdr old-vhdl-port-list)
11646         (setq old-port-list (car old-vhdl-port-list))
11647         (setq new-port-list nil)
11648         (while old-port-list
11649           (setq old-port (car old-port-list))
11650           (setq names (car old-port))
11651           (while names
11652             (setq new-port (cons (if as-alist (car names) (list (car names)))
11653                                  (cdr old-port)))
11654             (setq new-port-list (append new-port-list (list new-port)))
11655             (setq names (cdr names)))
11656           (setq old-port-list (cdr old-port-list)))
11657         (setq old-vhdl-port-list (cdr old-vhdl-port-list))
11658         (setq new-vhdl-port-list (append new-vhdl-port-list
11659                                          (list new-port-list))))
11660       (setq vhdl-port-list
11661             (append new-vhdl-port-list (list old-vhdl-port-list))
11662             vhdl-port-flattened t)
11663       (message "Flattening port for next paste...done"))))
11664
11665 (defvar vhdl-port-reversed-direction nil
11666   "Indicates whether port directions are reversed.")
11667
11668 (defun vhdl-port-reverse-direction ()
11669   "Reverse direction for all ports (useful in testbenches).
11670 This operation is performed on an internally stored port and is only
11671 reflected in a subsequent paste operation."
11672   (interactive)
11673   (if (not vhdl-port-list)
11674       (error "ERROR:  No port has been read")
11675     (message "Reversing port directions for next paste...")
11676     (let ((port-list (nth 2 vhdl-port-list))
11677           port-dir-car port-dir)
11678       ;; traverse port list and reverse directions
11679       (while port-list
11680         (setq port-dir-car (cddr (car port-list))
11681               port-dir (car port-dir-car))
11682         (setcar port-dir-car
11683                 (cond ((equal port-dir "in") "out")
11684                       ((equal port-dir "IN") "OUT")
11685                       ((equal port-dir "out") "in")
11686                       ((equal port-dir "OUT") "IN")
11687                       (t port-dir)))
11688         (setq port-list (cdr port-list)))
11689       (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
11690       (message "Reversing port directions for next paste...done"))))
11691
11692 (defun vhdl-port-copy ()
11693   "Get generic and port information from an entity or component declaration."
11694   (interactive)
11695   (save-excursion
11696     (let (parse-error end-of-list
11697           decl-type name generic-list port-list context-clause
11698           object names direct type init comment group-comment)
11699       (vhdl-prepare-search-2
11700        (setq
11701         parse-error
11702         (catch 'parse
11703           ;; check if within entity or component declaration
11704           (end-of-line)
11705           (when (or (not (re-search-backward
11706                           "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
11707                     (equal "END" (upcase (match-string 1))))
11708             (throw 'parse "ERROR:  Not within an entity or component declaration"))
11709           (setq decl-type (downcase (match-string-no-properties 1)))
11710           (forward-word-strictly 1)
11711           (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
11712           (setq name (match-string-no-properties 1))
11713           (message "Reading port of %s \"%s\"..." decl-type name)
11714           (vhdl-forward-syntactic-ws)
11715           ;; parse generic clause
11716           (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t)
11717             ;; parse group comment and spacing
11718             (setq group-comment (vhdl-parse-group-comment))
11719             (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11720             (while (not end-of-list)
11721               ;; parse names (accept extended identifiers)
11722               (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11723               (setq names (list (match-string-no-properties 1)))
11724               (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11725                 (setq names
11726                       (append names (list (match-string-no-properties 1)))))
11727               ;; parse type
11728               (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)")
11729               (setq type (match-string-no-properties 1))
11730               (when (vhdl-in-comment-p) ; if stuck in comment
11731                 (setq type (concat type (and (vhdl-parse-string ".*")
11732                                              (match-string-no-properties 0)))))
11733               (setq comment nil)
11734               (while (looking-at "(")
11735                 (setq type
11736                       (concat type
11737                               (buffer-substring-no-properties
11738                                (point) (progn (forward-sexp) (point)))
11739                               (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11740                                    (match-string-no-properties 1)))))
11741               ;; special case: closing parenthesis is on separate line
11742               (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11743                 (setq comment (substring type (match-beginning 2)))
11744                 (setq type (substring type 0 (match-beginning 1))))
11745               ;; strip of trailing group-comment
11746               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11747               (setq type (substring type 0 (match-end 1)))
11748               ;; parse initialization expression
11749               (setq init nil)
11750               (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
11751                 (vhdl-parse-string "\\([^();\n]*\\)")
11752                 (setq init (match-string-no-properties 1))
11753                 (while (looking-at "(")
11754                   (setq init
11755                         (concat init
11756                                 (buffer-substring-no-properties
11757                                  (point) (progn (forward-sexp) (point)))
11758                                 (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11759                                      (match-string-no-properties 1))))))
11760               ;; special case: closing parenthesis is on separate line
11761               (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11762                 (setq comment (substring init (match-beginning 2)))
11763                 (setq init (substring init 0 (match-beginning 1)))
11764                 (vhdl-forward-syntactic-ws))
11765               (skip-chars-forward " \t")
11766               ;; parse inline comment, special case: as above, no initial.
11767               (unless comment
11768                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11769                                    (match-string-no-properties 1))))
11770               (vhdl-forward-syntactic-ws)
11771               (setq end-of-list (vhdl-parse-string ")" t))
11772               (vhdl-parse-string "\\s-*;\\s-*")
11773               ;; parse inline comment
11774               (unless comment
11775                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11776                                    (match-string-no-properties 1))))
11777               ;; save everything in list
11778               (setq generic-list (append generic-list
11779                                          (list (list names type init
11780                                                      comment group-comment))))
11781               ;; parse group comment and spacing
11782               (setq group-comment (vhdl-parse-group-comment))))
11783           ;; parse port clause
11784           (when (vhdl-parse-string "port[ \t\n\r\f]*(" t)
11785             ;; parse group comment and spacing
11786             (setq group-comment (vhdl-parse-group-comment))
11787             (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t))
11788             (while (not end-of-list)
11789               ;; parse object
11790               (setq object
11791                     (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t)
11792                          (match-string-no-properties 1)))
11793               ;; parse names (accept extended identifiers)
11794               (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
11795               (setq names (list (match-string-no-properties 1)))
11796               (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
11797                 (setq names (append names (list (match-string-no-properties 1)))))
11798               ;; parse direction
11799               (vhdl-parse-string ":[ \t\n\r\f]*")
11800               (setq direct
11801                     (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t)
11802                          (match-string-no-properties 1)))
11803               ;; parse type
11804               (vhdl-parse-string "\\([^();\n]+\\)")
11805               (setq type (match-string-no-properties 1))
11806               (when (vhdl-in-comment-p) ; if stuck in comment
11807                 (setq type (concat type (and (vhdl-parse-string ".*")
11808                                              (match-string-no-properties 0)))))
11809               (setq comment nil)
11810               (while (looking-at "(")
11811                 (setq type (concat type
11812                                    (buffer-substring-no-properties
11813                                     (point) (progn (forward-sexp) (point)))
11814                                    (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11815                                         (match-string-no-properties 1)))))
11816               ;; special case: closing parenthesis is on separate line
11817               (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11818                 (setq comment (substring type (match-beginning 2)))
11819                 (setq type (substring type 0 (match-beginning 1))))
11820               ;; strip of trailing group-comment
11821               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11822               (setq type (substring type 0 (match-end 1)))
11823               (vhdl-forward-syntactic-ws)
11824               (setq end-of-list (vhdl-parse-string ")" t))
11825               (vhdl-parse-string "\\s-*;\\s-*")
11826               ;; parse inline comment
11827               (unless comment
11828                 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11829                                    (match-string-no-properties 1))))
11830               ;; save everything in list
11831               (setq port-list (append port-list
11832                                       (list (list names object direct type
11833                                                   comment group-comment))))
11834               ;; parse group comment and spacing
11835               (setq group-comment (vhdl-parse-group-comment))))
11836           ;; parse context clause
11837           (setq context-clause (vhdl-scan-context-clause))
11838 ;         ;; add surrounding package to context clause
11839 ;         (when (and (equal decl-type "component")
11840 ;                    (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
11841 ;           (setq context-clause
11842 ;                 (append context-clause
11843 ;                         (list (cons (vhdl-work-library)
11844 ;                                     (match-string-no-properties 1))))))
11845           (message "Reading port of %s \"%s\"...done" decl-type name)
11846           nil)))
11847       ;; finish parsing
11848       (if parse-error
11849           (error parse-error)
11850         (setq vhdl-port-list (list name generic-list port-list context-clause)
11851               vhdl-port-reversed-direction nil
11852               vhdl-port-flattened nil)))))
11853
11854 (defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
11855   "Paste a context clause."
11856   (let ((margin (current-indentation))
11857         (clause-list (nth 3 vhdl-port-list))
11858         clause)
11859     (while clause-list
11860       (setq clause (car clause-list))
11861       (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
11862                                                 (downcase exclude-pack-name)))
11863                   (save-excursion
11864                     (re-search-backward
11865                      (concat "^\\s-*use\\s-+" (car clause)
11866                              "." (cdr clause) "\\>") nil t)))
11867         (vhdl-template-standard-package (car clause) (cdr clause))
11868         (insert "\n"))
11869       (setq clause-list (cdr clause-list)))))
11870
11871 (defun vhdl-port-paste-generic (&optional no-init)
11872   "Paste a generic clause."
11873   (let ((margin (current-indentation))
11874         (generic-list (nth 1 vhdl-port-list))
11875         list-margin start names generic)
11876     ;; paste generic clause
11877     (when generic-list
11878       (setq start (point))
11879       (vhdl-insert-keyword "GENERIC (")
11880       (unless vhdl-argument-list-indent
11881         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11882       (setq list-margin (current-column))
11883       (while generic-list
11884         (setq generic (car generic-list))
11885         ;; paste group comment and spacing
11886         (when (memq vhdl-include-group-comments '(decl always))
11887           (vhdl-paste-group-comment (nth 4 generic) list-margin))
11888         ;; paste names
11889         (setq names (nth 0 generic))
11890         (while names
11891           (insert (car names))
11892           (setq names (cdr names))
11893           (when names (insert ", ")))
11894         ;; paste type
11895         (insert " : " (nth 1 generic))
11896         ;; paste initialization
11897         (when (and (not no-init) (nth 2 generic))
11898           (insert " := " (nth 2 generic)))
11899         (unless (cdr generic-list) (insert ")"))
11900         (insert ";")
11901         ;; paste comment
11902         (when (and vhdl-include-port-comments (nth 3 generic))
11903           (vhdl-comment-insert-inline (nth 3 generic) t))
11904         (setq generic-list (cdr generic-list))
11905         (when generic-list (insert "\n") (indent-to list-margin)))
11906       ;; align generic clause
11907       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
11908
11909 (defun vhdl-port-paste-port ()
11910   "Paste a port clause."
11911   (let ((margin (current-indentation))
11912         (port-list (nth 2 vhdl-port-list))
11913         list-margin start names port)
11914     ;; paste port clause
11915     (when port-list
11916       (setq start (point))
11917       (vhdl-insert-keyword "PORT (")
11918       (unless vhdl-argument-list-indent
11919         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11920       (setq list-margin (current-column))
11921       (while port-list
11922         (setq port (car port-list))
11923         ;; paste group comment and spacing
11924         (when (memq vhdl-include-group-comments '(decl always))
11925           (vhdl-paste-group-comment (nth 5 port) list-margin))
11926         ;; paste object
11927         (when (nth 1 port) (insert (nth 1 port) " "))
11928         ;; paste names
11929         (setq names (nth 0 port))
11930         (while names
11931           (insert (car names))
11932           (setq names (cdr names))
11933           (when names (insert ", ")))
11934         ;; paste direction
11935         (insert " : ")
11936         (when (nth 2 port) (insert (nth 2 port) " "))
11937         ;; paste type
11938         (insert (nth 3 port))
11939         (unless (cdr port-list) (insert ")"))
11940         (insert ";")
11941         ;; paste comment
11942         (when (and vhdl-include-port-comments (nth 4 port))
11943           (vhdl-comment-insert-inline (nth 4 port) t))
11944         (setq port-list (cdr port-list))
11945         (when port-list (insert "\n") (indent-to list-margin)))
11946       ;; align port clause
11947       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11948
11949 (defun vhdl-port-paste-declaration (kind &optional no-indent)
11950   "Paste as an entity or component declaration."
11951   (unless no-indent (indent-according-to-mode))
11952   (let ((margin (current-indentation))
11953         (name (nth 0 vhdl-port-list)))
11954     (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11955     (insert name)
11956     (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11957         (vhdl-insert-keyword " IS"))
11958     ;; paste generic and port clause
11959     (when (nth 1 vhdl-port-list)
11960       (insert "\n")
11961       (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11962         (insert "\n"))
11963       (indent-to (+ margin vhdl-basic-offset))
11964       (vhdl-port-paste-generic (eq kind 'component)))
11965     (when (nth 2 vhdl-port-list)
11966       (insert "\n")
11967       (when (and (memq vhdl-insert-empty-lines '(unit all))
11968                  (eq kind 'entity))
11969         (insert "\n"))
11970       (indent-to (+ margin vhdl-basic-offset)))
11971     (vhdl-port-paste-port)
11972     (insert "\n")
11973     (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
11974       (insert "\n"))
11975     (indent-to margin)
11976     (vhdl-insert-keyword "END")
11977     (if (eq kind 'entity)
11978         (progn
11979           (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
11980           (insert " " name))
11981       (vhdl-insert-keyword " COMPONENT")
11982       (unless (vhdl-standard-p '87) (insert " " name)))
11983     (insert ";")))
11984
11985 (defun vhdl-port-paste-entity (&optional no-indent)
11986   "Paste as an entity declaration."
11987   (interactive)
11988   (if (not vhdl-port-list)
11989       (error "ERROR:  No port read")
11990     (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11991     (vhdl-port-paste-declaration 'entity no-indent)
11992     (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11993
11994 (defun vhdl-port-paste-component (&optional no-indent)
11995   "Paste as a component declaration."
11996   (interactive)
11997   (if (not vhdl-port-list)
11998       (error "ERROR:  No port read")
11999     (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
12000     (vhdl-port-paste-declaration 'component no-indent)
12001     (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
12002
12003 (defun vhdl-port-paste-generic-map (&optional secondary no-constants)
12004   "Paste as a generic map."
12005   (interactive)
12006   (unless secondary (indent-according-to-mode))
12007   (let ((margin (current-indentation))
12008         list-margin start generic
12009         (generic-list (nth 1 vhdl-port-list)))
12010     (when generic-list
12011       (setq start (point))
12012       (vhdl-insert-keyword "GENERIC MAP (")
12013       (if (not vhdl-association-list-with-formals)
12014           ;; paste list of actual generics
12015           (while generic-list
12016             (insert (if no-constants
12017                       (car (nth 0 (car generic-list)))
12018                     (or (nth 2 (car generic-list)) " ")))
12019             (setq generic-list (cdr generic-list))
12020             (insert (if generic-list ", " ")"))
12021             (when (and (not generic-list) secondary
12022                        (null (nth 2 vhdl-port-list)))
12023               (insert ";")))
12024         (unless vhdl-argument-list-indent
12025           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12026         (setq list-margin (current-column))
12027         (while generic-list
12028           (setq generic (car generic-list))
12029           ;; paste group comment and spacing
12030           (when (eq vhdl-include-group-comments 'always)
12031             (vhdl-paste-group-comment (nth 4 generic) list-margin))
12032           ;; paste formal and actual generic
12033           (insert (car (nth 0 generic)) " => "
12034                   (if no-constants
12035                       (vhdl-replace-string vhdl-actual-generic-name
12036                                            (car (nth 0 generic)))
12037                     (or (nth 2 generic) "")))
12038           (setq generic-list (cdr generic-list))
12039           (insert (if generic-list "," ")"))
12040           (when (and (not generic-list) secondary
12041                      (null (nth 2 vhdl-port-list)))
12042             (insert ";"))
12043           ;; paste comment
12044           (when (or vhdl-include-type-comments
12045                     (and vhdl-include-port-comments (nth 3 generic)))
12046             (vhdl-comment-insert-inline
12047              (concat
12048               (when vhdl-include-type-comments
12049                 (concat "[" (nth 1 generic) "] "))
12050               (when vhdl-include-port-comments (nth 3 generic))) t))
12051           (when generic-list (insert "\n") (indent-to list-margin)))
12052         ;; align generic map
12053         (when vhdl-auto-align
12054           (vhdl-align-region-groups start (point) 1 t))))))
12055
12056 (defun vhdl-port-paste-port-map ()
12057   "Paste as a port map."
12058   (let ((margin (current-indentation))
12059         list-margin start port
12060         (port-list (nth 2 vhdl-port-list)))
12061     (when port-list
12062       (setq start (point))
12063       (vhdl-insert-keyword "PORT MAP (")
12064       (if (not vhdl-association-list-with-formals)
12065           ;; paste list of actual ports
12066           (while port-list
12067             (insert (vhdl-replace-string vhdl-actual-port-name
12068                                          (car (nth 0 (car port-list)))))
12069             (setq port-list (cdr port-list))
12070             (insert (if port-list ", " ")")))
12071         (unless vhdl-argument-list-indent
12072           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12073         (setq list-margin (current-column))
12074         (while port-list
12075           (setq port (car port-list))
12076           ;; paste group comment and spacing
12077           (when (eq vhdl-include-group-comments 'always)
12078             (vhdl-paste-group-comment (nth 5 port) list-margin))
12079           ;; paste formal and actual port
12080           (insert (car (nth 0 port)) " => ")
12081           (insert (vhdl-replace-string vhdl-actual-port-name
12082                                        (car (nth 0 port))))
12083           (setq port-list (cdr port-list))
12084           (insert (if port-list "," ");"))
12085           ;; paste comment
12086           (when (or (and vhdl-include-direction-comments (nth 2 port))
12087                     vhdl-include-type-comments
12088                     (and vhdl-include-port-comments (nth 4 port)))
12089             (vhdl-comment-insert-inline
12090              (concat
12091               (cond ((and vhdl-include-direction-comments
12092                           vhdl-include-type-comments)
12093                      (concat "[" (format "%-4s" (concat (nth 2 port) " "))
12094                              (nth 3 port) "] "))
12095                     ((and vhdl-include-direction-comments (nth 2 port))
12096                      (format "%-6s" (concat "[" (nth 2 port) "] ")))
12097                     (vhdl-include-direction-comments "      ")
12098                     (vhdl-include-type-comments
12099                      (concat "[" (nth 3 port) "] ")))
12100               (when vhdl-include-port-comments (nth 4 port))) t))
12101           (when port-list (insert "\n") (indent-to list-margin)))
12102         ;; align port clause
12103         (when vhdl-auto-align
12104           (vhdl-align-region-groups start (point) 1))))))
12105
12106 (defun vhdl-port-paste-instance (&optional name no-indent title)
12107   "Paste as an instantiation."
12108   (interactive)
12109   (if (not vhdl-port-list)
12110       (error "ERROR:  No port read")
12111     (let ((orig-vhdl-port-list vhdl-port-list))
12112       ;; flatten local copy of port list (must be flat for port mapping)
12113       (vhdl-port-flatten)
12114       (unless no-indent (indent-according-to-mode))
12115       (let ((margin (current-indentation)))
12116         ;; paste instantiation
12117         (cond (name
12118                (insert name))
12119               ((equal (cdr vhdl-instance-name) "")
12120                (setq name (vhdl-template-field "instance name")))
12121               ((string-match "%d" (cdr vhdl-instance-name))
12122                (let ((n 1))
12123                  (while (save-excursion
12124                           (setq name (format (vhdl-replace-string
12125                                               vhdl-instance-name
12126                                               (nth 0 vhdl-port-list)) n))
12127                           (goto-char (point-min))
12128                           (vhdl-re-search-forward name nil t))
12129                    (setq n (1+ n)))
12130                  (insert name)))
12131               (t (insert (vhdl-replace-string vhdl-instance-name
12132                                               (nth 0 vhdl-port-list)))))
12133         (message "Pasting port as instantiation \"%s\"..." name)
12134         (insert ": ")
12135         (when title
12136           (save-excursion
12137             (beginning-of-line)
12138             (indent-to vhdl-basic-offset)
12139             (insert "-- instance \"" name "\"\n")))
12140         (if (not (vhdl-use-direct-instantiation))
12141             (insert (nth 0 vhdl-port-list))
12142           (vhdl-insert-keyword "ENTITY ")
12143           (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
12144         (when (nth 1 vhdl-port-list)
12145           (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12146           (vhdl-port-paste-generic-map t t))
12147         (when (nth 2 vhdl-port-list)
12148           (insert "\n") (indent-to (+ margin vhdl-basic-offset))
12149           (vhdl-port-paste-port-map))
12150         (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list))
12151           (insert ";"))
12152         (message "Pasting port as instantiation \"%s\"...done" name))
12153       (setq vhdl-port-list orig-vhdl-port-list))))
12154
12155 (defun vhdl-port-paste-constants (&optional no-indent)
12156   "Paste generics as constants."
12157   (interactive)
12158   (if (not vhdl-port-list)
12159       (error "ERROR:  No port read")
12160     (let ((orig-vhdl-port-list vhdl-port-list))
12161       (message "Pasting port as constants...")
12162       ;; flatten local copy of port list (must be flat for constant initial.)
12163       (vhdl-port-flatten)
12164       (unless no-indent (indent-according-to-mode))
12165       (let ((margin (current-indentation))
12166             start generic name
12167             (generic-list (nth 1 vhdl-port-list)))
12168         (when generic-list
12169           (setq start (point))
12170           (while generic-list
12171             (setq generic (car generic-list))
12172             ;; paste group comment and spacing
12173             (when (memq vhdl-include-group-comments '(decl always))
12174               (vhdl-paste-group-comment (nth 4 generic) margin))
12175             (vhdl-insert-keyword "CONSTANT ")
12176             ;; paste generic constants
12177             (setq name (nth 0 generic))
12178             (when name
12179               (insert (vhdl-replace-string vhdl-actual-generic-name (car name)))
12180               ;; paste type
12181               (insert " : " (nth 1 generic))
12182               ;; paste initialization
12183               (when (nth 2 generic)
12184                 (insert " := " (nth 2 generic)))
12185               (insert ";")
12186               ;; paste comment
12187               (when (and vhdl-include-port-comments (nth 3 generic))
12188                 (vhdl-comment-insert-inline (nth 3 generic) t))
12189               (setq generic-list (cdr generic-list))
12190               (when generic-list (insert "\n") (indent-to margin))))
12191             ;; align signal list
12192           (when vhdl-auto-align
12193             (vhdl-align-region-groups start (point) 1))))
12194       (message "Pasting port as constants...done")
12195       (setq vhdl-port-list orig-vhdl-port-list))))
12196
12197 (defun vhdl-port-paste-signals (&optional initialize no-indent)
12198   "Paste ports as internal signals."
12199   (interactive)
12200   (if (not vhdl-port-list)
12201       (error "ERROR:  No port read")
12202     (message "Pasting port as signals...")
12203     (unless no-indent (indent-according-to-mode))
12204     (let ((margin (current-indentation))
12205           start port names type generic-list port-name constant-name pos
12206           (port-list (nth 2 vhdl-port-list)))
12207       (when port-list
12208         (setq start (point))
12209         (while port-list
12210           (setq port (car port-list))
12211           ;; paste group comment and spacing
12212           (when (memq vhdl-include-group-comments '(decl always))
12213             (vhdl-paste-group-comment (nth 5 port) margin))
12214           ;; paste object
12215           (if (nth 1 port)
12216               (insert (nth 1 port) " ")
12217             (vhdl-insert-keyword "SIGNAL "))
12218           ;; paste actual port signals
12219           (setq names (nth 0 port))
12220           (while names
12221             (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
12222             (setq names (cdr names))
12223             (when names (insert ", ")))
12224           ;; paste type
12225           (setq type (nth 3 port))
12226           (setq generic-list (nth 1 vhdl-port-list))
12227           (vhdl-prepare-search-1
12228            (setq pos 0)
12229            ;; replace formal by actual generics
12230            (while generic-list
12231              (setq port-name (car (nth 0 (car generic-list))))
12232              (while (string-match (concat "\\<" port-name "\\>") type pos)
12233                (setq constant-name
12234                      (save-match-data (vhdl-replace-string
12235                                        vhdl-actual-generic-name port-name)))
12236                (setq type (replace-match constant-name t nil type))
12237                (setq pos (match-end 0)))
12238              (setq generic-list (cdr generic-list))))
12239           (insert " : " type)
12240           ;; paste initialization (inputs only)
12241           (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port))))
12242             (insert " := "
12243                     (cond ((string-match "integer" (nth 3 port)) "0")
12244                           ((string-match "natural" (nth 3 port)) "0")
12245                           ((string-match "positive" (nth 3 port)) "0")
12246                           ((string-match "real" (nth 3 port)) "0.0")
12247                           ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12248                           (t "'0'"))))
12249           (insert ";")
12250           ;; paste comment
12251           (when (or (and vhdl-include-direction-comments (nth 2 port))
12252                     (and vhdl-include-port-comments (nth 4 port)))
12253             (vhdl-comment-insert-inline
12254              (concat
12255               (cond ((and vhdl-include-direction-comments (nth 2 port))
12256                      (format "%-6s" (concat "[" (nth 2 port) "] ")))
12257                     (vhdl-include-direction-comments "      "))
12258               (when vhdl-include-port-comments (nth 4 port))) t))
12259           (setq port-list (cdr port-list))
12260           (when port-list (insert "\n") (indent-to margin)))
12261         ;; align signal list
12262         (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12263     (message "Pasting port as signals...done")))
12264
12265 (defun vhdl-port-paste-initializations (&optional no-indent)
12266   "Paste ports as signal initializations."
12267   (interactive)
12268   (if (not vhdl-port-list)
12269       (error "ERROR:  No port read")
12270     (let ((orig-vhdl-port-list vhdl-port-list))
12271       (message "Pasting port as initializations...")
12272       ;; flatten local copy of port list (must be flat for signal initial.)
12273       (vhdl-port-flatten)
12274       (unless no-indent (indent-according-to-mode))
12275       (let ((margin (current-indentation))
12276             start port name
12277             (port-list (nth 2 vhdl-port-list)))
12278         (when port-list
12279           (setq start (point))
12280           (while port-list
12281             (setq port (car port-list))
12282             ;; paste actual port signal (inputs only)
12283             (when (equal "IN" (upcase (nth 2 port)))
12284               (setq name (car (nth 0 port)))
12285               (insert (vhdl-replace-string vhdl-actual-port-name name))
12286               ;; paste initialization
12287               (insert " <= "
12288                       (cond ((string-match "integer" (nth 3 port)) "0")
12289                             ((string-match "natural" (nth 3 port)) "0")
12290                             ((string-match "positive" (nth 3 port)) "0")
12291                             ((string-match "real" (nth 3 port)) "0.0")
12292                             ((string-match "(.+)" (nth 3 port)) "(others => '0')")
12293                             (t "'0'"))
12294                       ";"))
12295             (setq port-list (cdr port-list))
12296             (when (and port-list
12297                        (equal "IN" (upcase (nth 2 (car port-list)))))
12298               (insert "\n") (indent-to margin)))
12299           ;; align signal list
12300           (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
12301       (message "Pasting port as initializations...done")
12302       (setq vhdl-port-list orig-vhdl-port-list))))
12303
12304 (defun vhdl-port-paste-testbench ()
12305   "Paste as a bare-bones testbench."
12306   (interactive)
12307   (if (not vhdl-port-list)
12308       (error "ERROR:  No port read")
12309     (let ((case-fold-search t)
12310           (ent-name (vhdl-replace-string vhdl-testbench-entity-name
12311                                          (nth 0 vhdl-port-list)))
12312           (source-buffer (current-buffer))
12313           arch-name config-name ent-file-name arch-file-name
12314           ent-buffer arch-buffer position)
12315       ;; open entity file
12316       (unless (eq vhdl-testbench-create-files 'none)
12317         (setq ent-file-name
12318               (concat (vhdl-replace-string vhdl-testbench-entity-file-name
12319                                            ent-name t)
12320                       "." (file-name-extension (buffer-file-name))))
12321         (if (file-exists-p ent-file-name)
12322             (if (y-or-n-p
12323                  (concat "File \"" ent-file-name "\" exists; overwrite? "))
12324                 (progn (find-file ent-file-name)
12325                        (erase-buffer)
12326                        (set-buffer-modified-p nil))
12327               (if (eq vhdl-testbench-create-files 'separate)
12328                   (setq ent-file-name nil)
12329                 (error "ERROR:  Pasting port as testbench...aborted")))
12330           (find-file ent-file-name)))
12331       (unless (and (eq vhdl-testbench-create-files 'separate)
12332                    (null ent-file-name))
12333         ;; paste entity header
12334         (if vhdl-testbench-include-header
12335             (progn (vhdl-template-header
12336                     (concat "Testbench for design \""
12337                             (nth 0 vhdl-port-list) "\""))
12338                    (goto-char (point-max)))
12339           (vhdl-comment-display-line) (insert "\n\n"))
12340         ;; paste std_logic_1164 package
12341         (when vhdl-testbench-include-library
12342           (vhdl-template-package-std-logic-1164)
12343           (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
12344         ;; paste entity declaration
12345         (vhdl-insert-keyword "ENTITY ")
12346         (insert ent-name)
12347         (vhdl-insert-keyword " IS")
12348         (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
12349         (insert "\n")
12350         (vhdl-insert-keyword "END ")
12351         (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
12352         (insert ent-name ";")
12353         (insert "\n\n")
12354         (vhdl-comment-display-line) (insert "\n"))
12355       ;; get architecture name
12356       (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
12357                           (read-from-minibuffer "architecture name: "
12358                                                 nil vhdl-minibuffer-local-map)
12359                         (vhdl-replace-string vhdl-testbench-architecture-name
12360                                              (nth 0 vhdl-port-list))))
12361       (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
12362       ;; open architecture file
12363       (if (not (eq vhdl-testbench-create-files 'separate))
12364           (insert "\n")
12365         (setq ent-buffer (current-buffer))
12366         (setq arch-file-name
12367               (concat (vhdl-replace-string vhdl-testbench-architecture-file-name
12368                                            (concat ent-name " " arch-name) t)
12369                       "." (file-name-extension (buffer-file-name))))
12370         (when (and (file-exists-p arch-file-name)
12371                    (not (y-or-n-p (concat "File \"" arch-file-name
12372                                           "\" exists; overwrite? "))))
12373           (error "ERROR:  Pasting port as testbench...aborted"))
12374         (find-file arch-file-name)
12375         (erase-buffer)
12376         (set-buffer-modified-p nil)
12377         ;; paste architecture header
12378         (if vhdl-testbench-include-header
12379             (progn (vhdl-template-header
12380                     (concat "Testbench architecture for design \""
12381                             (nth 0 vhdl-port-list) "\""))
12382                    (goto-char (point-max)))
12383           (vhdl-comment-display-line) (insert "\n\n")))
12384       ;; paste architecture body
12385       (vhdl-insert-keyword "ARCHITECTURE ")
12386       (insert arch-name)
12387       (vhdl-insert-keyword " OF ")
12388       (insert ent-name)
12389       (vhdl-insert-keyword " IS")
12390       (insert "\n\n") (indent-to vhdl-basic-offset)
12391       ;; paste component declaration
12392       (unless (vhdl-use-direct-instantiation)
12393         (vhdl-port-paste-component t)
12394         (insert "\n\n") (indent-to vhdl-basic-offset))
12395       ;; paste constants
12396       (when (nth 1 vhdl-port-list)
12397         (insert "-- component generics\n") (indent-to vhdl-basic-offset)
12398         (vhdl-port-paste-constants t)
12399         (insert "\n\n") (indent-to vhdl-basic-offset))
12400       ;; paste internal signals
12401       (insert "-- component ports\n") (indent-to vhdl-basic-offset)
12402       (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
12403       (insert "\n")
12404       ;; paste custom declarations
12405       (unless (equal "" vhdl-testbench-declarations)
12406         (insert "\n")
12407         (setq position (point))
12408         (vhdl-insert-string-or-file vhdl-testbench-declarations)
12409         (vhdl-indent-region position (point)))
12410       (setq position (point))
12411       (insert "\n\n")
12412       (vhdl-comment-display-line) (insert "\n")
12413       (when vhdl-testbench-include-configuration
12414         (setq config-name (vhdl-replace-string
12415                            vhdl-testbench-configuration-name
12416                            (concat ent-name " " arch-name)))
12417         (insert "\n")
12418         (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
12419         (vhdl-insert-keyword " OF ") (insert ent-name)
12420         (vhdl-insert-keyword " IS\n")
12421         (indent-to vhdl-basic-offset)
12422         (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
12423         (indent-to vhdl-basic-offset)
12424         (vhdl-insert-keyword "END FOR;\n")
12425         (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
12426         (vhdl-comment-display-line) (insert "\n"))
12427       (goto-char position)
12428       (vhdl-template-begin-end
12429        (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
12430       ;; paste instantiation
12431       (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
12432       (vhdl-port-paste-instance
12433        (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
12434       (insert "\n")
12435       ;; paste custom statements
12436       (unless (equal "" vhdl-testbench-statements)
12437         (insert "\n")
12438         (setq position (point))
12439         (vhdl-insert-string-or-file vhdl-testbench-statements)
12440         (vhdl-indent-region position (point)))
12441       (insert "\n")
12442       (indent-to vhdl-basic-offset)
12443       (unless (eq vhdl-testbench-create-files 'none)
12444         (setq arch-buffer (current-buffer))
12445         (when ent-buffer (set-buffer ent-buffer) (save-buffer))
12446         (set-buffer arch-buffer) (save-buffer))
12447       (message "%s"
12448        (concat (format "Pasting port as testbench \"%s(%s)\"...done"
12449                        ent-name arch-name)
12450                (and ent-file-name
12451                     (format "\n  File created: \"%s\"" ent-file-name))
12452                (and arch-file-name
12453                     (format "\n  File created: \"%s\"" arch-file-name)))))))
12454
12455
12456 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12457 ;;; Subprogram interface translation
12458 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12459
12460 (defvar vhdl-subprog-list nil
12461   "Variable to hold last subprogram interface parsed.")
12462 ;; structure: (parenthesized expression means list of such entries)
12463 ;; (subprog-name kind
12464 ;;  ((names) object direct type init comment group-comment)
12465 ;;  return-type return-comment group-comment)
12466
12467 (defvar vhdl-subprog-flattened nil
12468   "Indicates whether an subprogram interface has been flattened.")
12469
12470 (defun vhdl-subprog-flatten ()
12471   "Flatten interface list so that only one parameter exists per line."
12472   (interactive)
12473   (if (not vhdl-subprog-list)
12474       (error "ERROR:  No subprogram interface has been read")
12475     (message "Flattening subprogram interface...")
12476     (let ((old-subprog-list (nth 2 vhdl-subprog-list))
12477           new-subprog-list old-subprog new-subprog names)
12478       ;; traverse parameter list and flatten entries
12479       (while old-subprog-list
12480         (setq old-subprog (car old-subprog-list))
12481         (setq names (car old-subprog))
12482         (while names
12483           (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
12484           (setq new-subprog-list (append new-subprog-list (list new-subprog)))
12485           (setq names (cdr names)))
12486         (setq old-subprog-list (cdr old-subprog-list)))
12487       (setq vhdl-subprog-list
12488             (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
12489                   new-subprog-list (nth 3 vhdl-subprog-list)
12490                   (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
12491             vhdl-subprog-flattened t)
12492     (message "Flattening subprogram interface...done"))))
12493
12494 (defun vhdl-subprog-copy ()
12495   "Get interface information from a subprogram specification."
12496   (interactive)
12497   (save-excursion
12498     (let (parse-error pos end-of-list
12499           name kind param-list object names direct type init
12500           comment group-comment
12501           return-type return-comment return-group-comment)
12502       (vhdl-prepare-search-2
12503        (setq
12504         parse-error
12505         (catch 'parse
12506           ;; check if within function declaration
12507           (setq pos (point))
12508           (end-of-line)
12509           (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
12510           (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
12511                        (goto-char (match-end 0))
12512                        (save-excursion (backward-char)
12513                                     (forward-sexp)
12514                                     (<= pos (point))))
12515             (throw 'parse "ERROR:  Not within a subprogram specification"))
12516           (setq name (match-string-no-properties 5))
12517           (setq kind (if (match-string 2) 'procedure 'function))
12518           (setq end-of-list (not (match-string 7)))
12519           (message "Reading interface of subprogram \"%s\"..." name)
12520           ;; parse parameter list
12521           (setq group-comment (vhdl-parse-group-comment))
12522           (setq end-of-list (or end-of-list
12523                                 (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
12524           (while (not end-of-list)
12525             ;; parse object
12526             (setq object
12527                   (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
12528                          (match-string-no-properties 1)))
12529             ;; parse names (accept extended identifiers)
12530             (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
12531             (setq names (list (match-string-no-properties 1)))
12532             (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
12533               (setq names (append names (list (match-string-no-properties 1)))))
12534             ;; parse direction
12535             (vhdl-parse-string ":[ \t\n\r\f]*")
12536             (setq direct
12537                   (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t)
12538                        (match-string-no-properties 1)))
12539             ;; parse type
12540             (vhdl-parse-string "\\([^():;\n]+\\)")
12541             (setq type (match-string-no-properties 1))
12542             (setq comment nil)
12543             (while (looking-at "(")
12544               (setq type
12545                     (concat type
12546                             (buffer-substring-no-properties
12547                              (point) (progn (forward-sexp) (point)))
12548                             (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
12549                                  (match-string-no-properties 1)))))
12550             ;; special case: closing parenthesis is on separate line
12551             (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
12552               (setq comment (substring type (match-beginning 2)))
12553               (setq type (substring type 0 (match-beginning 1))))
12554             ;; strip off trailing group-comment
12555             (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
12556             (setq type (substring type 0 (match-end 1)))
12557             ;; parse initialization expression
12558             (setq init nil)
12559             (when (vhdl-parse-string ":=[ \t\n\r\f]*" t)
12560               (vhdl-parse-string "\\([^();\n]*\\)")
12561               (setq init (match-string-no-properties 1))
12562               (while (looking-at "(")
12563                 (setq init
12564                       (concat init
12565                               (buffer-substring-no-properties
12566                                (point) (progn (forward-sexp) (point)))
12567                               (and (vhdl-parse-string "\\([^();\n]*\\)" t)
12568                                    (match-string-no-properties 1))))))
12569             ;; special case: closing parenthesis is on separate line
12570             (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
12571               (setq comment (substring init (match-beginning 2)))
12572               (setq init (substring init 0 (match-beginning 1)))
12573               (vhdl-forward-syntactic-ws))
12574             (skip-chars-forward " \t")
12575             ;; parse inline comment, special case: as above, no initial.
12576             (unless comment
12577               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12578                                  (match-string-no-properties 1))))
12579             (vhdl-forward-syntactic-ws)
12580             (setq end-of-list (vhdl-parse-string ")\\s-*" t))
12581             ;; parse inline comment
12582             (unless comment
12583               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12584                                  (match-string-no-properties 1))))
12585             (setq return-group-comment (vhdl-parse-group-comment))
12586             (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
12587             ;; parse return type
12588             (when (match-string 3)
12589               (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*")
12590               (setq return-type (match-string-no-properties 1))
12591               (when (and return-type
12592                          (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
12593                 (setq return-comment (substring return-type (match-beginning 2)))
12594                 (setq return-type (substring return-type 0 (match-beginning 1))))
12595               ;; strip of trailing group-comment
12596               (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
12597               (setq return-type (substring return-type 0 (match-end 1)))
12598               ;; parse return comment
12599               (unless return-comment
12600                 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12601                                           (match-string-no-properties 1)))))
12602             ;; parse inline comment
12603             (unless comment
12604               (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
12605                                  (match-string-no-properties 1))))
12606             ;; save everything in list
12607             (setq param-list (append param-list
12608                                      (list (list names object direct type init
12609                                                  comment group-comment))))
12610             ;; parse group comment and spacing
12611             (setq group-comment (vhdl-parse-group-comment)))
12612           (message "Reading interface of subprogram \"%s\"...done" name)
12613           nil)))
12614       ;; finish parsing
12615       (if parse-error
12616           (error parse-error)
12617         (setq vhdl-subprog-list
12618               (list name kind param-list return-type return-comment
12619                     return-group-comment)
12620               vhdl-subprog-flattened nil)))))
12621
12622 (defun vhdl-subprog-paste-specification (kind)
12623   "Paste as a subprogram specification."
12624   (indent-according-to-mode)
12625   (let ((margin (current-column))
12626         (param-list (nth 2 vhdl-subprog-list))
12627         list-margin start names param)
12628     ;; paste keyword and name
12629     (vhdl-insert-keyword
12630      (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
12631     (insert (nth 0 vhdl-subprog-list))
12632     (if (not param-list)
12633         (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12634       (setq start (point))
12635       ;; paste parameter list
12636       (insert " (")
12637       (unless vhdl-argument-list-indent
12638         (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12639       (setq list-margin (current-column))
12640       (while param-list
12641         (setq param (car param-list))
12642         ;; paste group comment and spacing
12643         (when (memq vhdl-include-group-comments (list kind 'always))
12644           (vhdl-paste-group-comment (nth 6 param) list-margin))
12645         ;; paste object
12646         (when (nth 1 param) (insert (nth 1 param) " "))
12647         ;; paste names
12648         (setq names (nth 0 param))
12649         (while names
12650           (insert (car names))
12651           (setq names (cdr names))
12652           (when names (insert ", ")))
12653         ;; paste direction
12654         (insert " : ")
12655         (when (nth 2 param) (insert (nth 2 param) " "))
12656         ;; paste type
12657         (insert (nth 3 param))
12658         ;; paste initialization
12659         (when (nth 4 param) (insert " := " (nth 4 param)))
12660         ;; terminate line
12661         (if (cdr param-list)
12662             (insert ";")
12663           (insert ")")
12664           (when (null (nth 3 vhdl-subprog-list))
12665             (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
12666         ;; paste comment
12667         (when (and vhdl-include-port-comments (nth 5 param))
12668           (vhdl-comment-insert-inline (nth 5 param) t))
12669         (setq param-list (cdr param-list))
12670         (when param-list (insert "\n") (indent-to list-margin)))
12671       (when (nth 3 vhdl-subprog-list)
12672         (insert "\n") (indent-to list-margin)
12673         ;; paste group comment and spacing
12674         (when (memq vhdl-include-group-comments (list kind 'always))
12675           (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
12676         ;; paste return type
12677         (insert "return " (nth 3 vhdl-subprog-list))
12678         (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
12679         (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
12680           (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
12681       ;; align parameter list
12682       (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
12683     ;; paste body
12684     (when (eq kind 'body)
12685       (insert "\n")
12686       (vhdl-template-begin-end
12687        (unless (vhdl-standard-p '87)
12688          (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
12689        (nth 0 vhdl-subprog-list) margin))))
12690
12691 (defun vhdl-subprog-paste-declaration ()
12692   "Paste as a subprogram declaration."
12693   (interactive)
12694   (if (not vhdl-subprog-list)
12695       (error "ERROR:  No subprogram interface read")
12696     (message "Pasting interface as subprogram declaration \"%s\"..."
12697              (car vhdl-subprog-list))
12698     ;; paste specification
12699     (vhdl-subprog-paste-specification 'decl)
12700     (message "Pasting interface as subprogram declaration \"%s\"...done"
12701              (car vhdl-subprog-list))))
12702
12703 (defun vhdl-subprog-paste-body ()
12704   "Paste as a subprogram body."
12705   (interactive)
12706   (if (not vhdl-subprog-list)
12707       (error "ERROR:  No subprogram interface read")
12708     (message "Pasting interface as subprogram body \"%s\"..."
12709              (car vhdl-subprog-list))
12710     ;; paste specification and body
12711     (vhdl-subprog-paste-specification 'body)
12712     (message "Pasting interface as subprogram body \"%s\"...done"
12713              (car vhdl-subprog-list))))
12714
12715 (defun vhdl-subprog-paste-call ()
12716   "Paste as a subprogram call."
12717   (interactive)
12718   (if (not vhdl-subprog-list)
12719       (error "ERROR:  No subprogram interface read")
12720     (let ((orig-vhdl-subprog-list vhdl-subprog-list)
12721           param-list margin list-margin param start)
12722       ;; flatten local copy of interface list (must be flat for parameter mapping)
12723       (vhdl-subprog-flatten)
12724       (setq param-list (nth 2 vhdl-subprog-list))
12725       (indent-according-to-mode)
12726       (setq margin (current-indentation))
12727       (message "Pasting interface as subprogram call \"%s\"..."
12728                (car vhdl-subprog-list))
12729       ;; paste name
12730       (insert (nth 0 vhdl-subprog-list))
12731       (if (not param-list)
12732           (insert ";")
12733         (setq start (point))
12734         ;; paste parameter list
12735         (insert " (")
12736         (unless vhdl-argument-list-indent
12737           (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
12738         (setq list-margin (current-column))
12739         (while param-list
12740           (setq param (car param-list))
12741           ;; paste group comment and spacing
12742           (when (eq vhdl-include-group-comments 'always)
12743             (vhdl-paste-group-comment (nth 6 param) list-margin))
12744           ;; paste formal port
12745           (insert (car (nth 0 param)) " => ")
12746           (setq param-list (cdr param-list))
12747           (insert (if param-list "," ");"))
12748           ;; paste comment
12749           (when (and vhdl-include-port-comments (nth 5 param))
12750             (vhdl-comment-insert-inline (nth 5 param)))
12751           (when param-list (insert "\n") (indent-to list-margin)))
12752         ;; align parameter list
12753         (when vhdl-auto-align
12754           (vhdl-align-region-groups start (point) 1)))
12755       (message "Pasting interface as subprogram call \"%s\"...done"
12756                (car vhdl-subprog-list))
12757       (setq vhdl-subprog-list orig-vhdl-subprog-list))))
12758
12759
12760 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12761 ;;; Miscellaneous
12762 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12763
12764 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12765 ;; Hippie expand customization
12766
12767 (defvar vhdl-expand-upper-case nil)
12768
12769 (defun vhdl-try-expand-abbrev (old)
12770   "Try expanding abbreviations from `vhdl-abbrev-list'."
12771   (unless old
12772     (he-init-string (he-dabbrev-beg) (point))
12773     (setq he-expand-list
12774           (let ((abbrev-list vhdl-abbrev-list)
12775                 (sel-abbrev-list '()))
12776             (while abbrev-list
12777               (when (or (not (stringp (car abbrev-list)))
12778                         (string-match
12779                          (concat "^" he-search-string) (car abbrev-list)))
12780                 (setq sel-abbrev-list
12781                       (cons (car abbrev-list) sel-abbrev-list)))
12782               (setq abbrev-list (cdr abbrev-list)))
12783             (nreverse sel-abbrev-list))))
12784   (while (and he-expand-list
12785               (or (not (stringp (car he-expand-list)))
12786                   (he-string-member (car he-expand-list) he-tried-table t)))
12787     (unless (stringp (car he-expand-list))
12788       (setq vhdl-expand-upper-case (car he-expand-list)))
12789     (setq he-expand-list (cdr he-expand-list)))
12790   (if (null he-expand-list)
12791       (progn (when old (he-reset-string))
12792              nil)
12793     (he-substitute-string
12794      (if vhdl-expand-upper-case
12795          (upcase (car he-expand-list))
12796        (car he-expand-list))
12797      t)
12798     (setq he-expand-list (cdr he-expand-list))
12799     t))
12800
12801 (defun vhdl-he-list-beg ()
12802   "Also looks at the word before `(' in order to better match parenthesized
12803 expressions (e.g. for index ranges of types and signals)."
12804   (save-excursion
12805     (condition-case ()
12806         (progn (backward-up-list 1)
12807                (skip-syntax-backward "w_")) ; crashes in `viper-mode'
12808       (error ()))
12809     (point)))
12810
12811 ;; override `he-list-beg' from `hippie-exp'
12812 (unless (and (boundp 'viper-mode) viper-mode)
12813  (defalias 'he-list-beg 'vhdl-he-list-beg))
12814
12815 ;; function for expanding abbrevs and dabbrevs
12816 (defalias 'vhdl-expand-abbrev (make-hippie-expand-function
12817                                '(try-expand-dabbrev
12818                                  try-expand-dabbrev-all-buffers
12819                                  vhdl-try-expand-abbrev)))
12820
12821 ;; function for expanding parenthesis
12822 (defalias 'vhdl-expand-paren (make-hippie-expand-function
12823                               '(try-expand-list
12824                                 try-expand-list-all-buffers)))
12825
12826 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12827 ;; Line handling functions
12828
12829 (defun vhdl-current-line ()
12830   "Return the line number of the line containing point."
12831   (save-restriction
12832     (widen)
12833     (1+ (count-lines (point-min) (point-at-bol)))))
12834
12835 (defun vhdl-line-kill-entire (&optional arg)
12836   "Delete entire line."
12837   (interactive "p")
12838   (beginning-of-line)
12839   (kill-line (or arg 1)))
12840
12841 (defun vhdl-line-kill (&optional arg)
12842   "Kill current line."
12843   (interactive "p")
12844   (vhdl-line-kill-entire arg))
12845
12846 (defun vhdl-line-copy (&optional arg)
12847   "Copy current line."
12848   (interactive "p")
12849   (save-excursion
12850     (let ((position (point-at-bol)))
12851       (forward-line (or arg 1))
12852       (copy-region-as-kill position (point)))))
12853
12854 (defun vhdl-line-yank ()
12855   "Yank entire line."
12856   (interactive)
12857   (beginning-of-line)
12858   (yank))
12859
12860 (defun vhdl-line-expand (&optional prefix-arg)
12861   "Hippie-expand current line."
12862   (interactive "P")
12863   (require 'hippie-exp)
12864   (let ((case-fold-search t) (case-replace nil)
12865         (hippie-expand-try-functions-list
12866          '(try-expand-line try-expand-line-all-buffers)))
12867     (hippie-expand prefix-arg)))
12868
12869 (defun vhdl-line-transpose-next (&optional arg)
12870   "Interchange this line with next line."
12871   (interactive "p")
12872   (forward-line 1)
12873   (transpose-lines (or arg 1))
12874   (forward-line -1))
12875
12876 (defun vhdl-line-transpose-previous (&optional arg)
12877   "Interchange this line with previous line."
12878   (interactive "p")
12879   (forward-line 1)
12880   (transpose-lines (- 0 (or arg 0)))
12881   (forward-line -1))
12882
12883 (defun vhdl-line-open ()
12884   "Open a new line and indent."
12885   (interactive)
12886   (end-of-line -0)
12887   (newline-and-indent))
12888
12889 (defun vhdl-delete-indentation ()
12890   "Join lines.  That is, call `delete-indentation' with `fill-prefix' so that
12891 it works within comments too."
12892   (interactive)
12893   (let ((fill-prefix "-- "))
12894     (delete-indentation)))
12895
12896 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12897 ;; Move functions
12898
12899 (defun vhdl-forward-same-indent ()
12900   "Move forward to next line with same indent."
12901   (interactive)
12902   (let ((pos (point))
12903         (indent (current-indentation)))
12904     (beginning-of-line 2)
12905     (while (and (not (eobp))
12906                 (or (looking-at "^\\s-*\\(--.*\\)?$")
12907                     (> (current-indentation) indent)))
12908       (beginning-of-line 2))
12909     (if (= (current-indentation) indent)
12910         (back-to-indentation)
12911       (message "No following line with same indent found in this block")
12912       (goto-char pos)
12913       nil)))
12914
12915 (defun vhdl-backward-same-indent ()
12916   "Move backward to previous line with same indent."
12917   (interactive)
12918   (let ((pos (point))
12919         (indent (current-indentation)))
12920     (beginning-of-line -0)
12921     (while (and (not (bobp))
12922                 (or (looking-at "^\\s-*\\(--.*\\)?$")
12923                     (> (current-indentation) indent)))
12924       (beginning-of-line -0))
12925     (if (= (current-indentation) indent)
12926         (back-to-indentation)
12927       (message "No preceding line with same indent found in this block")
12928       (goto-char pos)
12929       nil)))
12930
12931 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12932 ;; Statistics
12933
12934 (defun vhdl-statistics-buffer ()
12935   "Get some file statistics."
12936   (interactive)
12937   (let ((no-stats 0)
12938         (no-code-lines 0)
12939         (no-empty-lines 0)
12940         (no-comm-lines 0)
12941         (no-comments 0)
12942         (no-lines (count-lines (point-min) (point-max))))
12943     (save-excursion
12944       ;; count statements
12945       (goto-char (point-min))
12946       (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12947         (if (match-string 1)
12948             (goto-char (match-end 1))
12949           (setq no-stats (1+ no-stats))))
12950       ;; count code lines
12951       (goto-char (point-min))
12952       (while (not (eobp))
12953         (unless (looking-at "^\\s-*\\(--.*\\)?$")
12954           (setq no-code-lines (1+ no-code-lines)))
12955         (beginning-of-line 2))
12956       ;; count empty lines
12957       (goto-char (point-min))
12958       (while (and (re-search-forward "^\\s-*$" nil t)
12959                   (not (eq (point) (point-max))))
12960         (if (match-string 1)
12961             (goto-char (match-end 1))
12962           (setq no-empty-lines (1+ no-empty-lines))
12963           (unless (eq (point) (point-max))
12964             (forward-char))))
12965       ;; count comment-only lines
12966       (goto-char (point-min))
12967       (while (re-search-forward "^\\s-*--.*" nil t)
12968         (if (match-string 1)
12969             (goto-char (match-end 1))
12970           (setq no-comm-lines (1+ no-comm-lines))))
12971       ;; count comments
12972       (goto-char (point-min))
12973       (while (re-search-forward "--.*" nil t)
12974         (if (match-string 1)
12975             (goto-char (match-end 1))
12976           (setq no-comments (1+ no-comments)))))
12977     ;; print results
12978     (message "\n\
12979 File statistics: \"%s\"\n\
12980 -----------------------\n\
12981 # statements    : %5d\n\
12982 # code lines    : %5d\n\
12983 # empty lines   : %5d\n\
12984 # comment lines : %5d\n\
12985 # comments      : %5d\n\
12986 # total lines   : %5d\n"
12987              (buffer-file-name) no-stats no-code-lines no-empty-lines
12988              no-comm-lines no-comments no-lines)
12989     (unless vhdl-emacs-21 (vhdl-show-messages))))
12990
12991 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12992 ;; Help functions
12993
12994 (defun vhdl-re-search-forward (regexp &optional bound noerror count)
12995   "Like `re-search-forward', but does not match within literals."
12996   (let (pos)
12997     (save-excursion
12998       (while (and (setq pos (re-search-forward regexp bound noerror count))
12999                   (vhdl-in-literal))))
13000     (when pos (goto-char pos))
13001     pos))
13002
13003 (defun vhdl-re-search-backward (regexp &optional bound noerror count)
13004   "Like `re-search-backward', but does not match within literals."
13005   (let (pos)
13006     (save-excursion
13007       (while (and (setq pos (re-search-backward regexp bound noerror count))
13008                   (vhdl-in-literal))))
13009     (when pos (goto-char pos))
13010     pos))
13011
13012
13013 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13014 ;;; Project
13015 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13016
13017 (defun vhdl-set-project (name)
13018   "Set current project to NAME."
13019   (interactive
13020    (list (let ((completion-ignore-case t))
13021            (completing-read "Project name: " vhdl-project-alist nil t))))
13022   (cond ((equal name "")
13023          (setq vhdl-project nil)
13024          (message "Current VHDL project: None"))
13025         ((assoc name vhdl-project-alist)
13026          (setq vhdl-project name)
13027          (message "Current VHDL project: \"%s\"" name))
13028         (t
13029          (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
13030   (vhdl-speedbar-update-current-project))
13031
13032 (defun vhdl-set-default-project ()
13033   "Set current project as default on startup."
13034   (interactive)
13035   (customize-set-variable 'vhdl-project vhdl-project)
13036   (customize-save-customized))
13037
13038 (defun vhdl-toggle-project (name token indent)
13039   "Set current project to NAME or unset if NAME is current project."
13040   (vhdl-set-project (if (equal name vhdl-project) "" name)))
13041
13042 (defun vhdl-export-project (file-name)
13043   "Write project setup for current project."
13044   (interactive
13045    (let ((name (vhdl-resolve-env-variable
13046                 (vhdl-replace-string
13047                  (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13048                  (concat (subst-char-in-string
13049                           ?  ?_ (or (vhdl-project-p)
13050                                     (error "ERROR:  No current project")))
13051                          " " (user-login-name))))))
13052      (list (read-file-name
13053             "Write project file: "
13054             (when (file-name-absolute-p name) "") nil nil name))))
13055   (setq file-name (abbreviate-file-name file-name))
13056   (let ((orig-buffer (current-buffer)))
13057     (unless (file-exists-p (file-name-directory file-name))
13058       (make-directory (file-name-directory file-name) t))
13059     (if (not (file-writable-p file-name))
13060         (error "ERROR:  File not writable: \"%s\"" file-name)
13061       (set-buffer (find-file-noselect file-name t t))
13062       (erase-buffer)
13063       (insert ";; -*- Emacs-Lisp -*-\n\n"
13064               ";;; " (file-name-nondirectory file-name)
13065               " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
13066               ";; Project : " vhdl-project "\n"
13067               ";; Saved   : " (format-time-string "%Y-%m-%d %T ")
13068               (user-login-name) "\n\n\n"
13069               ";; project name\n"
13070               "(setq vhdl-project \"" vhdl-project "\")\n\n"
13071               ";; project setup\n"
13072               "(vhdl-aput 'vhdl-project-alist vhdl-project\n'")
13073       (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer))
13074       (insert ")\n")
13075       (save-buffer)
13076       (kill-buffer (current-buffer))
13077       (set-buffer orig-buffer))))
13078
13079 (defun vhdl-import-project (file-name &optional auto not-make-current)
13080   "Read project setup and set current project."
13081   (interactive
13082    (let ((name (vhdl-resolve-env-variable
13083                 (vhdl-replace-string
13084                  (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
13085                  (concat "" " " (user-login-name))))))
13086      (list (read-file-name
13087             "Read project file: " (when (file-name-absolute-p name) "") nil t
13088             (file-name-directory name)))))
13089   (when (file-exists-p file-name)
13090     (condition-case ()
13091         (let ((current-project vhdl-project))
13092           (load-file file-name)
13093           (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10)
13094             (vhdl-adelete 'vhdl-project-alist vhdl-project)
13095             (error ""))
13096           (if not-make-current
13097               (setq vhdl-project current-project)
13098             (setq vhdl-compiler
13099                   (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project)))))
13100           (vhdl-update-mode-menu)
13101           (vhdl-speedbar-refresh)
13102           (unless not-make-current
13103             (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s"
13104                      vhdl-project vhdl-compiler (if auto " (auto-loaded)" ""))))
13105       (error (vhdl-warning
13106               (format "ERROR:  Invalid project setup file: \"%s\"" file-name))))))
13107
13108 (defun vhdl-duplicate-project ()
13109   "Duplicate setup of current project."
13110   (interactive)
13111   (let ((new-name (read-from-minibuffer "New project name: "))
13112         (project-entry (vhdl-aget vhdl-project-alist vhdl-project)))
13113     (setq vhdl-project-alist
13114           (append vhdl-project-alist
13115                   (list (cons new-name project-entry))))
13116     (vhdl-update-mode-menu)))
13117
13118 (defun vhdl-auto-load-project ()
13119   "Automatically load project setup at startup."
13120   (let ((file-name-list vhdl-project-file-name)
13121         file-list list-length)
13122     (while file-name-list
13123       (setq file-list
13124             (append file-list
13125                     (file-expand-wildcards
13126                      (vhdl-resolve-env-variable
13127                       (vhdl-replace-string
13128                        (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
13129                        (concat "* " (user-login-name)))))))
13130       (setq list-length (or list-length (length file-list)))
13131       (setq file-name-list (cdr file-name-list)))
13132     (while file-list
13133       (vhdl-import-project (expand-file-name (car file-list)) t
13134                            (not (> list-length 0)))
13135       (setq list-length (1- list-length))
13136       (setq file-list (cdr file-list)))))
13137
13138 ;; automatically load project setup when idle after startup
13139 (when (memq 'startup vhdl-project-auto-load)
13140   (if noninteractive
13141       (vhdl-auto-load-project)
13142     (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project)))
13143
13144
13145 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13146 ;;; Hideshow
13147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13148 ;; (using `hideshow.el')
13149
13150 (defconst vhdl-hs-start-regexp
13151   (concat
13152    "\\(^\\)\\s-*\\("
13153    ;; generic/port clause
13154    "\\(generic\\|port\\)[ \t\n\r\f]*(\\|"
13155    ;; component
13156    "component\\>\\|"
13157    ;; component instantiation
13158    "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*"
13159    "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13160    "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*"
13161    "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|"
13162    ;; subprogram
13163    "\\(function\\|procedure\\)\\>\\|"
13164    ;; process, block
13165    "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|"
13166    ;; configuration declaration
13167    "configuration\\>"
13168    "\\)")
13169   "Regexp to match start of construct to hide.")
13170
13171 (defun vhdl-hs-forward-sexp-func (count)
13172   "Find end of construct to hide (for hideshow).  Only searches forward."
13173   (let ((pos (point)))
13174     (vhdl-prepare-search-2
13175      (beginning-of-line)
13176      (cond
13177       ;; generic/port clause
13178       ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(")
13179        (goto-char (match-end 0))
13180        (backward-char)
13181        (forward-sexp))
13182       ;; component declaration
13183       ((looking-at "^\\s-*component\\>")
13184        (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
13185       ;; component instantiation
13186       ((looking-at
13187         (concat
13188          "^\\s-*\\w+\\s-*:[ \t\n\r\f]*"
13189          "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?"
13190          "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*"
13191          "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*("))
13192        (goto-char (match-end 0))
13193        (backward-char)
13194        (forward-sexp)
13195        (setq pos (point))
13196        (vhdl-forward-syntactic-ws)
13197        (when (looking-at "port\\s-+map[ \t\n\r\f]*(")
13198          (goto-char (match-end 0))
13199          (backward-char)
13200          (forward-sexp)
13201          (setq pos (point)))
13202        (goto-char pos))
13203       ;; subprogram declaration/body
13204       ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
13205        (goto-char (match-end 0))
13206        (vhdl-forward-syntactic-ws)
13207        (when (looking-at "(")
13208          (forward-sexp))
13209        (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
13210                    (vhdl-in-literal)))
13211        ;; subprogram body
13212        (when (match-string 2)
13213          (re-search-forward "^\\s-*\\<begin\\>" nil t)
13214          (backward-word-strictly 1)
13215          (vhdl-forward-sexp)))
13216       ;; block (recursive)
13217       ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
13218        (goto-char (match-end 0))
13219        (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
13220                    (match-beginning 2))
13221          (vhdl-hs-forward-sexp-func count)))
13222       ;; process
13223       ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
13224        (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
13225       ;; configuration declaration
13226       ((looking-at "^\\s-*configuration\\>")
13227        (forward-word-strictly 4)
13228        (vhdl-forward-sexp))
13229       (t (goto-char pos))))))
13230
13231 (defun vhdl-hideshow-init ()
13232   "Initialize `hideshow'."
13233   (when vhdl-hideshow-menu
13234     (vhdl-hs-minor-mode 1)))
13235
13236 (defun vhdl-hs-minor-mode (&optional arg)
13237   "Toggle hideshow minor mode and update menu bar."
13238   (interactive "P")
13239   (require 'hideshow)
13240   ;; check for hideshow version 5.x
13241   (if (not (boundp 'hs-block-start-mdata-select))
13242       (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
13243     ;; initialize hideshow
13244     (unless (assoc 'vhdl-mode hs-special-modes-alist)
13245       (setq hs-special-modes-alist
13246             (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
13247                         'vhdl-hs-forward-sexp-func nil)
13248                   hs-special-modes-alist)))
13249     (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
13250     (if vhdl-hide-all-init
13251         (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t)
13252       (remove-hook 'hs-minor-mode-hook 'hs-hide-all t))
13253     (hs-minor-mode arg)
13254     (force-mode-line-update)))          ; hack to update menu bar
13255
13256
13257 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13258 ;;; Font locking
13259 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13260 ;; (using `font-lock.el')
13261
13262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13263 ;; Help functions
13264
13265 (defun vhdl-within-translate-off ()
13266   "Return point if within translate-off region, else nil."
13267   (and (save-excursion
13268          (re-search-backward
13269           "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t))
13270        (equal "off" (match-string 1))
13271        (point)))
13272
13273 (defun vhdl-start-translate-off (limit)
13274   "Return point before translate-off pragma if before LIMIT, else nil."
13275   (when (re-search-forward
13276          "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t)
13277     (match-beginning 0)))
13278
13279 (defun vhdl-end-translate-off (limit)
13280   "Return point after translate-on pragma if before LIMIT, else nil."
13281   (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t))
13282
13283 (defun vhdl-match-translate-off (limit)
13284   "Match a translate-off block, setting match-data and returning t, else nil."
13285   (when (< (point) limit)
13286     (let ((start (or (vhdl-within-translate-off)
13287                      (vhdl-start-translate-off limit)))
13288           (case-fold-search t))
13289       (when start
13290         (let ((end (or (vhdl-end-translate-off limit) limit)))
13291           (set-match-data (list start end))
13292           (goto-char end))))))
13293
13294 (defun vhdl-font-lock-match-item (limit)
13295   "Match, and move over, any declaration item after point.  Adapted from
13296 `font-lock-match-c-style-declaration-item-and-skip-to-next'."
13297   (condition-case nil
13298       (save-restriction
13299         (narrow-to-region (point-min) limit)
13300         ;; match item
13301         (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
13302           (save-match-data
13303             (goto-char (match-end 1))
13304             ;; move to next item
13305             (if (looking-at "\\(\\s-*,\\)")
13306                 (goto-char (match-end 1))
13307               (end-of-line) t))))
13308     (error t)))
13309
13310 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13311 ;; Syntax definitions
13312
13313 (defconst vhdl-font-lock-syntactic-keywords
13314   '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\'))))
13315   "Mark single quotes as having string quote syntax in `c' instances.")
13316
13317 (defvar vhdl-font-lock-keywords nil
13318   "Regular expressions to highlight in VHDL Mode.")
13319
13320 (defvar vhdl-font-lock-keywords-0
13321   ;; set in `vhdl-font-lock-init' because dependent on user options
13322   "For consideration as a value of `vhdl-font-lock-keywords'.
13323 This does highlighting of template prompts and directives (pragmas).")
13324
13325 (defvar vhdl-font-lock-keywords-1 nil
13326   ;; set in `vhdl-font-lock-init' because dependent on user options
13327   "For consideration as a value of `vhdl-font-lock-keywords'.
13328 This does highlighting of keywords and standard identifiers.")
13329
13330 (defconst vhdl-font-lock-keywords-2
13331   (list
13332    ;; highlight names of units, subprograms, and components when declared
13333    (list
13334     (concat
13335      "^\\s-*\\("
13336      "architecture\\|configuration\\|context\\|entity\\|package"
13337      "\\(\\s-+body\\)?\\|"
13338      "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
13339      "\\)\\s-+\\(\\w+\\)")
13340     5 'font-lock-function-name-face)
13341
13342    ;; highlight entity names of architectures and configurations
13343    (list
13344     "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)"
13345     2 'font-lock-function-name-face)
13346
13347    ;; highlight labels of common constructs
13348    (list
13349     (concat
13350      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\("
13351      "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
13352      "postponed\\|process\\|"
13353      (when (vhdl-standard-p 'ams) "procedural\\|")
13354      "with\\|while"
13355      "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)")
13356     1 'font-lock-function-name-face)
13357
13358    ;; highlight label and component name of component instantiations
13359    (list
13360     (concat
13361      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*"
13362      "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>")
13363     '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
13364
13365    ;; highlight label and instantiated unit of component instantiations
13366    (list
13367     (concat
13368      "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*"
13369      "\\(component\\|configuration\\|entity\\)\\s-+"
13370      "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
13371     '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
13372     '(5 font-lock-function-name-face nil t)
13373     '(7 font-lock-function-name-face nil t))
13374
13375    ;; highlight names and labels at end of constructs
13376    (list
13377     (concat
13378      "^\\s-*end\\s-+\\(\\("
13379      "architecture\\|block\\|case\\|component\\|configuration\\|context\\|"
13380      "entity\\|for\\|function\\|generate\\|if\\|loop\\|package"
13381      "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|"
13382      (when (vhdl-standard-p 'ams) "procedural\\|")
13383      "units"
13384      "\\)\\s-+\\)?\\(\\w*\\)")
13385     5 'font-lock-function-name-face)
13386
13387    ;; highlight labels in exit and next statements
13388    (list
13389     (concat
13390      "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)")
13391     3 'font-lock-function-name-face)
13392
13393    ;; highlight entity name in attribute specifications
13394    (list
13395     (concat
13396      "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
13397     1 'font-lock-function-name-face)
13398
13399    ;; highlight labels in block and component specifications
13400    (list
13401     (concat
13402      "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
13403      "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)")
13404     '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
13405
13406    ;; highlight names in library clauses
13407    (list "^\\s-*library\\>"
13408          '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
13409
13410    ;; highlight names in use clauses
13411    (list
13412     (concat
13413      "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
13414      "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
13415     '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t)
13416     '(8 font-lock-function-name-face nil t))
13417
13418    ;; highlight attribute name in attribute declarations/specifications
13419    (list
13420     (concat
13421      "^\\s-*attribute\\s-+\\(\\w+\\)")
13422     1 'vhdl-font-lock-attribute-face)
13423
13424    ;; highlight type/nature name in (sub)type/(sub)nature declarations
13425    (list
13426     (concat
13427      "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)")
13428     5 'font-lock-type-face)
13429
13430    ;; highlight signal/variable/constant declaration names
13431    (list "\\(:[^=]\\)"
13432          '(vhdl-font-lock-match-item
13433            (progn (goto-char (match-beginning 1))
13434                   (skip-syntax-backward " ")
13435                   (skip-syntax-backward "w_")
13436                   (skip-syntax-backward " ")
13437                   (while (= (preceding-char) ?,)
13438                     (backward-char 1)
13439                     (skip-syntax-backward " ")
13440                     (skip-syntax-backward "w_")
13441                     (skip-syntax-backward " ")))
13442            (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13443
13444    ;; highlight formal parameters in component instantiations and subprogram
13445    ;; calls
13446    (list "\\(=>\\)"
13447          '(vhdl-font-lock-match-item
13448            (progn (goto-char (match-beginning 1))
13449                   (skip-syntax-backward " ")
13450                   (while (= (preceding-char) ?\)) (backward-sexp))
13451                   (skip-syntax-backward "w_")
13452                   (skip-syntax-backward " ")
13453                   (when (memq (preceding-char) '(?n ?N ?|))
13454                     (goto-char (point-max))))
13455            (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
13456
13457    ;; highlight alias/group/quantity declaration names and for-loop/-generate
13458    ;; variables
13459    (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
13460          '(vhdl-font-lock-match-item
13461            (progn (goto-char (match-end 1)) (match-beginning 2))
13462            nil (1 font-lock-variable-name-face)))
13463
13464    ;; highlight tool directives
13465    (list
13466     (concat
13467      "^\\s-*\\(`\\w+\\)")
13468     1 'font-lock-preprocessor-face)
13469    )
13470   "For consideration as a value of `vhdl-font-lock-keywords'.
13471 This does context sensitive highlighting of names and labels.")
13472
13473 (defvar vhdl-font-lock-keywords-3 nil
13474   ;; set in `vhdl-font-lock-init' because dependent on user options
13475   "For consideration as a value of `vhdl-font-lock-keywords'.
13476 This does highlighting of words with special syntax.")
13477
13478 (defvar vhdl-font-lock-keywords-4 nil
13479   ;; set in `vhdl-font-lock-init' because dependent on user options
13480   "For consideration as a value of `vhdl-font-lock-keywords'.
13481 This does highlighting of additional reserved words.")
13482
13483 (defconst vhdl-font-lock-keywords-5
13484   ;; background highlight translate-off regions
13485   '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append)))
13486   "For consideration as a value of `vhdl-font-lock-keywords'.
13487 This does background highlighting of translate-off regions.")
13488
13489 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13490 ;; Font and color definitions
13491
13492 (defvar vhdl-font-lock-prompt-face         'vhdl-font-lock-prompt-face
13493   "Face name to use for prompts.")
13494
13495 (defvar vhdl-font-lock-attribute-face      'vhdl-font-lock-attribute-face
13496   "Face name to use for standardized attributes.")
13497
13498 (defvar vhdl-font-lock-enumvalue-face      'vhdl-font-lock-enumvalue-face
13499   "Face name to use for standardized enumeration values.")
13500
13501 (defvar vhdl-font-lock-function-face       'vhdl-font-lock-function-face
13502   "Face name to use for standardized functions and packages.")
13503
13504 (defvar vhdl-font-lock-directive-face      'vhdl-font-lock-directive-face
13505   "Face name to use for directives.")
13506
13507 (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face
13508   "Face name to use for additional reserved words.")
13509
13510 (defvar vhdl-font-lock-translate-off-face  'vhdl-font-lock-translate-off-face
13511   "Face name to use for translate-off regions.")
13512
13513 ;; face names to use for words with special syntax.
13514 (let ((syntax-alist vhdl-special-syntax-alist)
13515       name)
13516   (while syntax-alist
13517     (setq name (vhdl-function-name
13518                 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face"))
13519     (eval `(defvar ,name ',name
13520              ,(concat "Face name to use for "
13521                       (nth 0 (car syntax-alist)) ".")))
13522     (setq syntax-alist (cdr syntax-alist))))
13523
13524 (defgroup vhdl-highlight-faces nil
13525   "Faces for highlighting."
13526   :group 'vhdl-highlight)
13527
13528 ;; add faces used from `font-lock'
13529 (custom-add-to-group
13530  'vhdl-highlight-faces 'font-lock-comment-face 'custom-face)
13531 (custom-add-to-group
13532  'vhdl-highlight-faces 'font-lock-string-face 'custom-face)
13533 (custom-add-to-group
13534  'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face)
13535 (custom-add-to-group
13536  'vhdl-highlight-faces 'font-lock-type-face 'custom-face)
13537 (custom-add-to-group
13538  'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face)
13539 (custom-add-to-group
13540  'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
13541
13542 (defface vhdl-font-lock-prompt-face
13543   '((((min-colors 88) (class color) (background light))
13544      (:foreground "Red1" :bold t))
13545     (((class color) (background light)) (:foreground "Red" :bold t))
13546     (((class color) (background dark)) (:foreground "Pink" :bold t))
13547     (t (:inverse-video t)))
13548   "Font lock mode face used to highlight prompts."
13549   :group 'vhdl-highlight-faces)
13550
13551 (defface vhdl-font-lock-attribute-face
13552   '((((class color) (background light)) (:foreground "Orchid"))
13553     (((class color) (background dark)) (:foreground "LightSteelBlue"))
13554     (t (:italic t :bold t)))
13555   "Font lock mode face used to highlight standardized attributes."
13556   :group 'vhdl-highlight-faces)
13557
13558 (defface vhdl-font-lock-enumvalue-face
13559   '((((class color) (background light)) (:foreground "SaddleBrown"))
13560     (((class color) (background dark)) (:foreground "BurlyWood"))
13561     (t (:italic t :bold t)))
13562   "Font lock mode face used to highlight standardized enumeration values."
13563   :group 'vhdl-highlight-faces)
13564
13565 (defface vhdl-font-lock-function-face
13566   '((((class color) (background light)) (:foreground "Cyan4"))
13567     (((class color) (background dark)) (:foreground "Orchid1"))
13568     (t (:italic t :bold t)))
13569   "Font lock mode face used to highlight standardized functions and packages."
13570   :group 'vhdl-highlight-faces)
13571
13572 (defface vhdl-font-lock-directive-face
13573   '((((class color) (background light)) (:foreground "CadetBlue"))
13574     (((class color) (background dark)) (:foreground "Aquamarine"))
13575     (t (:italic t :bold t)))
13576   "Font lock mode face used to highlight directives."
13577   :group 'vhdl-highlight-faces)
13578
13579 (defface vhdl-font-lock-reserved-words-face
13580   '((((class color) (background light)) (:foreground "Orange" :bold t))
13581     (((min-colors 88) (class color) (background dark))
13582      (:foreground "Yellow1" :bold t))
13583     (((class color) (background dark)) (:foreground "Yellow" :bold t))
13584     (t ()))
13585   "Font lock mode face used to highlight additional reserved words."
13586   :group 'vhdl-highlight-faces)
13587
13588 (defface vhdl-font-lock-translate-off-face
13589   '((((class color) (background light)) (:background "LightGray"))
13590     (((class color) (background dark)) (:background "DimGray"))
13591     (t ()))
13592   "Font lock mode face used to background highlight translate-off regions."
13593   :group 'vhdl-highlight-faces)
13594
13595 ;; font lock mode faces used to highlight words with special syntax.
13596 (let ((syntax-alist vhdl-special-syntax-alist))
13597   (while syntax-alist
13598     (eval `(defface ,(vhdl-function-name
13599                       "vhdl-font-lock" (caar syntax-alist) "face")
13600              '((((class color) (background light))
13601                 (:foreground ,(nth 2 (car syntax-alist))))
13602                (((class color) (background dark))
13603                 (:foreground ,(nth 3 (car syntax-alist))))
13604                (t ()))
13605              ,(concat "Font lock mode face used to highlight "
13606                       (nth 0 (car syntax-alist)) ".")
13607              :group 'vhdl-highlight-faces))
13608     (setq syntax-alist (cdr syntax-alist))))
13609
13610 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13611 ;; Font lock initialization
13612
13613 (defun vhdl-font-lock-init ()
13614   "Initialize fontification."
13615   ;; highlight template prompts and directives
13616   (setq vhdl-font-lock-keywords-0
13617         (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
13618                             vhdl-template-prompt-syntax ">\\)")
13619                     2 'vhdl-font-lock-prompt-face t)
13620               (list (concat "--\\s-*"
13621                             vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
13622                     2 'vhdl-font-lock-directive-face t)
13623               ;; highlight c-preprocessor directives
13624               (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?"
13625                     '(1 font-lock-builtin-face)
13626                     '(3 font-lock-variable-name-face nil t))))
13627   ;; highlight keywords and standardized types, attributes, enumeration
13628   ;; values, and subprograms
13629   (setq vhdl-font-lock-keywords-1
13630         (list
13631          (list (concat "'" vhdl-attributes-regexp)
13632                1 'vhdl-font-lock-attribute-face)
13633          (list vhdl-types-regexp       1 'font-lock-type-face)
13634          (list vhdl-functions-regexp   1 'vhdl-font-lock-function-face)
13635          (list vhdl-packages-regexp    1 'vhdl-font-lock-function-face)
13636          (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face)
13637          (list vhdl-constants-regexp   1 'font-lock-constant-face)
13638          (list vhdl-keywords-regexp    1 'font-lock-keyword-face)))
13639   ;; highlight words with special syntax.
13640   (setq vhdl-font-lock-keywords-3
13641         (let ((syntax-alist vhdl-special-syntax-alist)
13642               keywords)
13643           (while syntax-alist
13644             (setq keywords
13645                   (cons
13646                    (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1
13647                          (vhdl-function-name
13648                           "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")
13649                          (nth 4 (car syntax-alist)))
13650                    keywords))
13651             (setq syntax-alist (cdr syntax-alist)))
13652           keywords))
13653   ;; highlight additional reserved words
13654   (setq vhdl-font-lock-keywords-4
13655         (list (list vhdl-reserved-words-regexp 1
13656                     'vhdl-font-lock-reserved-words-face)))
13657   ;; highlight everything together
13658   (setq vhdl-font-lock-keywords
13659         (append
13660          vhdl-font-lock-keywords-0
13661          (when vhdl-highlight-keywords vhdl-font-lock-keywords-1)
13662          (when (or vhdl-highlight-forbidden-words
13663                    vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4)
13664          (when vhdl-highlight-special-words vhdl-font-lock-keywords-3)
13665          (when vhdl-highlight-names vhdl-font-lock-keywords-2)
13666          (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5))))
13667
13668 ;; initialize fontification for VHDL Mode
13669 (vhdl-font-lock-init)
13670
13671 (defun vhdl-fontify-buffer ()
13672   "Re-initialize fontification and fontify buffer."
13673   (interactive)
13674   (setq font-lock-defaults
13675         `(vhdl-font-lock-keywords
13676           nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
13677           beginning-of-line))
13678   (when (fboundp 'font-lock-unset-defaults)
13679     (font-lock-unset-defaults))         ; not implemented in XEmacs
13680   (font-lock-set-defaults)
13681   (font-lock-mode nil)
13682   (font-lock-mode t))
13683
13684 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13685 ;; Initialization for PostScript printing
13686
13687 (defun vhdl-ps-print-settings ()
13688   "Initialize custom face and page settings for PostScript printing."
13689   ;; define custom face settings
13690   (unless (or (not vhdl-print-customize-faces)
13691               ps-print-color-p)
13692     (set (make-local-variable 'ps-bold-faces)
13693          '(font-lock-keyword-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-italic-faces)
13699          '(font-lock-comment-face
13700            font-lock-function-name-face
13701            font-lock-type-face
13702            vhdl-font-lock-attribute-face
13703            vhdl-font-lock-enumvalue-face
13704            vhdl-font-lock-directive-face))
13705     (set (make-local-variable 'ps-underlined-faces)
13706          '(font-lock-string-face))
13707     (setq ps-always-build-face-reference t))
13708   ;; define page settings, so that a line containing 79 characters (default)
13709   ;; fits into one column
13710   (when vhdl-print-two-column
13711     (set (make-local-variable 'ps-landscape-mode) t)
13712     (set (make-local-variable 'ps-number-of-columns) 2)
13713     (set (make-local-variable 'ps-font-size) 7.0)
13714     (set (make-local-variable 'ps-header-title-font-size) 10.0)
13715     (set (make-local-variable 'ps-header-font-size) 9.0)
13716     (set (make-local-variable 'ps-header-offset) 12.0)
13717     (when (eq ps-paper-type 'letter)
13718       (set (make-local-variable 'ps-inter-column) 40.0)
13719       (set (make-local-variable 'ps-left-margin) 40.0)
13720       (set (make-local-variable 'ps-right-margin) 40.0))))
13721
13722 (defun vhdl-ps-print-init ()
13723   "Initialize PostScript printing."
13724   (if (featurep 'xemacs)
13725       (when (boundp 'ps-print-color-p)
13726         (vhdl-ps-print-settings))
13727     (if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
13728     (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t)))
13729
13730
13731 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13732 ;;; Hierarchy browser (using `speedbar.el')
13733 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13734 ;; Allows displaying the hierarchy of all VHDL design units contained in a
13735 ;; directory by using the speedbar.
13736
13737 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13738 ;; Variables
13739
13740 (defvar vhdl-entity-alist nil
13741   "Cache with entities and corresponding architectures for each
13742 project/directory.")
13743 ;; structure: (parenthesized expression means list of such entries)
13744 ;; (cache-key
13745 ;;   (ent-key ent-name ent-file ent-line
13746 ;;     (arch-key arch-name arch-file arch-line
13747 ;;       (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
13748 ;;                 inst-arch-key inst-conf-key inst-lib-key inst-path)
13749 ;;       (lib-name pack-key))
13750 ;;     mra-key (lib-name pack-key))
13751
13752 (defvar vhdl-config-alist nil
13753   "Cache with configurations for each project/directory.")
13754 ;; structure: (parenthesized expression means list of such entries)
13755 ;; (cache-key
13756 ;;   (conf-key conf-name conf-file conf-line ent-key arch-key
13757 ;;     (inst-key inst-comp-name inst-ent-key inst-arch-key
13758 ;;               inst-conf-key inst-lib-key)
13759 ;;     (lib-name pack-key)))
13760
13761 (defvar vhdl-package-alist nil
13762   "Cache with packages for each project/directory.")
13763 ;; structure: (parenthesized expression means list of such entries)
13764 ;; (cache-key
13765 ;;   (pack-key pack-name pack-file pack-line
13766 ;;     (comp-key comp-name comp-file comp-line)
13767 ;;     (func-key func-name func-file func-line)
13768 ;;     (lib-name pack-key)
13769 ;;     pack-body-file pack-body-line
13770 ;;     (func-key func-name func-body-file func-body-line)
13771 ;;     (lib-name pack-key)))
13772
13773 (defvar vhdl-ent-inst-alist nil
13774   "Cache with instantiated entities for each project/directory.")
13775 ;; structure: (parenthesized expression means list of such entries)
13776 ;; (cache-key (inst-ent-key))
13777
13778 (defvar vhdl-file-alist nil
13779   "Cache with design units in each file for each project/directory.")
13780 ;; structure: (parenthesized expression means list of such entries)
13781 ;; (cache-key
13782 ;;   (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
13783 ;;              (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
13784
13785 (defvar vhdl-directory-alist nil
13786   "Cache with source directories for each project.")
13787 ;; structure: (parenthesized expression means list of such entries)
13788 ;; (cache-key (directory))
13789
13790 (defvar vhdl-speedbar-shown-unit-alist nil
13791   "Alist of design units simultaneously open in the current speedbar for each
13792 directory and project.")
13793
13794 (defvar vhdl-speedbar-shown-project-list nil
13795   "List of projects simultaneously open in the current speedbar.")
13796
13797 (defvar vhdl-updated-project-list nil
13798   "List of projects and directories with updated files.")
13799
13800 (defvar vhdl-modified-file-list nil
13801   "List of modified files to be rescanned for hierarchy updating.")
13802
13803 (defvar vhdl-speedbar-hierarchy-depth 0
13804   "Depth of instantiation hierarchy to display.")
13805
13806 (defvar vhdl-speedbar-show-projects nil
13807   "Non-nil means project hierarchy is displayed in speedbar, directory
13808 hierarchy otherwise.")
13809
13810 (defun vhdl-get-end-of-unit ()
13811   "Return position of end of current unit."
13812   (let ((pos (point)))
13813     (save-excursion
13814       (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1)
13815                   (save-excursion
13816                     (goto-char (match-beginning 0))
13817                     (vhdl-backward-syntactic-ws)
13818                     (and (/= (preceding-char) ?\;) (not (bobp))))))
13819       (re-search-backward "^[ \t]*end\\>" pos 1)
13820       (point))))
13821
13822 (defun vhdl-match-string-downcase (num &optional string)
13823   "Like `match-string-no-properties' with down-casing."
13824   (let ((match (match-string-no-properties num string)))
13825     (and match (downcase match))))
13826
13827
13828 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13829 ;; Scan functions
13830
13831 (defun vhdl-scan-context-clause ()
13832   "Scan the context clause that precedes a design unit."
13833   (let (lib-alist)
13834     (save-excursion
13835       (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t)
13836         (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
13837                     (equal "USE" (upcase (match-string 1))))
13838           (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
13839             (push (cons (match-string-no-properties 1)
13840                                         (vhdl-match-string-downcase 2))
13841                   lib-alist)))))
13842     lib-alist))
13843
13844 (defun vhdl-scan-directory-contents (name &optional project update num-string
13845                                           non-final)
13846   "Scan contents of VHDL files in directory or file pattern NAME."
13847   (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
13848   (let* ((dir-name (match-string 1 name))
13849          (file-pattern (match-string 2 name))
13850          (is-directory (= 0 (length file-pattern)))
13851          (file-list
13852           (if update
13853               (list name)
13854             (if is-directory
13855                 (vhdl-get-source-files t dir-name)
13856               (vhdl-directory-files
13857                dir-name t (wildcard-to-regexp file-pattern)))))
13858          (key (or project dir-name))
13859          (file-exclude-regexp
13860           (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
13861          (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
13862          (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
13863          (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
13864          ent-alist conf-alist pack-alist ent-inst-list file-alist
13865          tmp-list tmp-entry no-files files-exist big-files)
13866     (when (or project update)
13867       (setq ent-alist (vhdl-aget vhdl-entity-alist key)
13868             conf-alist (vhdl-aget vhdl-config-alist key)
13869             pack-alist (vhdl-aget vhdl-package-alist key)
13870             ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key))
13871             file-alist (vhdl-aget vhdl-file-alist key)))
13872     (when (and (not is-directory) (null file-list))
13873       (message "No such file: \"%s\"" name))
13874     (setq files-exist file-list)
13875     (when file-list
13876       (setq no-files (length file-list))
13877       (message "Scanning %s %s\"%s\"..."
13878                (if is-directory "directory" "files") (or num-string "") name)
13879       ;; exclude files
13880       (unless (equal file-exclude-regexp "")
13881         (let ((case-fold-search nil)
13882               file-tmp-list)
13883           (while file-list
13884             (unless (string-match file-exclude-regexp (car file-list))
13885               (push (car file-list) file-tmp-list))
13886             (setq file-list (cdr file-list)))
13887           (setq file-list (nreverse file-tmp-list))))
13888       ;; do for all files
13889       (while file-list
13890         (unless noninteractive
13891           (message "Scanning %s %s\"%s\"... (%2d%%)"
13892                    (if is-directory "directory" "files")
13893                    (or num-string "") name
13894                    (floor (* 100.0 (- no-files (length file-list))) no-files)))
13895         (let ((file-name (abbreviate-file-name (car file-list)))
13896               ent-list arch-list arch-ent-list conf-list
13897               pack-list pack-body-list inst-list inst-ent-list)
13898           ;; scan file
13899           (vhdl-visit-file
13900            file-name nil
13901            (vhdl-prepare-search-2
13902             (save-excursion
13903               ;; scan for design units
13904               (if (and limit-design-file-size
13905                        (< limit-design-file-size (buffer-size)))
13906                   (progn (message "WARNING:  Scan limit (design units: file size) reached in file:\n  \"%s\"" file-name)
13907                          (setq big-files t))
13908                 ;; scan for entities
13909                 (goto-char (point-min))
13910                 (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
13911                   (let* ((ent-name (match-string-no-properties 1))
13912                          (ent-key (downcase ent-name))
13913                          (ent-entry (vhdl-aget ent-alist ent-key))
13914                          (lib-alist (vhdl-scan-context-clause)))
13915                     (if (nth 1 ent-entry)
13916                         (vhdl-warning-when-idle
13917                          "Entity declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13918                          ent-name  (nth 1 ent-entry) (nth 2 ent-entry)
13919                          file-name (vhdl-current-line))
13920                       (push ent-key ent-list)
13921                       (vhdl-aput 'ent-alist ent-key
13922                                  (list ent-name file-name (vhdl-current-line)
13923                                        (nth 3 ent-entry) (nth 4 ent-entry)
13924                                        lib-alist)))))
13925                 ;; scan for architectures
13926                 (goto-char (point-min))
13927                 (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)
13928                   (let* ((arch-name (match-string-no-properties 1))
13929                          (arch-key (downcase arch-name))
13930                          (ent-name (match-string-no-properties 2))
13931                          (ent-key (downcase ent-name))
13932                          (ent-entry (vhdl-aget ent-alist ent-key))
13933                          (arch-alist (nth 3 ent-entry))
13934                          (arch-entry (vhdl-aget arch-alist arch-key))
13935                          (lib-arch-alist (vhdl-scan-context-clause)))
13936                     (if arch-entry
13937                         (vhdl-warning-when-idle
13938                          "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13939                          arch-name ent-name (nth 1 arch-entry)
13940                          (nth 2 arch-entry) file-name (vhdl-current-line))
13941                       (setq arch-list (cons arch-key arch-list)
13942                             arch-ent-list (cons ent-key arch-ent-list))
13943                       (vhdl-aput 'arch-alist arch-key
13944                                  (list arch-name file-name (vhdl-current-line)
13945                                        nil lib-arch-alist))
13946                       (vhdl-aput 'ent-alist ent-key
13947                                  (list (or (nth 0 ent-entry) ent-name)
13948                                        (nth 1 ent-entry) (nth 2 ent-entry)
13949                                        (vhdl-sort-alist arch-alist)
13950                                        arch-key (nth 5 ent-entry))))))
13951                 ;; scan for configurations
13952                 (goto-char (point-min))
13953                 (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)
13954                   (let* ((conf-name (match-string-no-properties 1))
13955                          (conf-key (downcase conf-name))
13956                          (conf-entry (vhdl-aget conf-alist conf-key))
13957                          (ent-name (match-string-no-properties 2))
13958                          (ent-key (downcase ent-name))
13959                          (lib-alist (vhdl-scan-context-clause))
13960                          (conf-line (vhdl-current-line))
13961                          (end-of-unit (vhdl-get-end-of-unit))
13962                          arch-key comp-conf-list inst-key-list
13963                          inst-comp-key inst-ent-key inst-arch-key
13964                          inst-conf-key inst-lib-key)
13965                     (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)")
13966                       (setq arch-key (vhdl-match-string-downcase 1)))
13967                     (if conf-entry
13968                         (vhdl-warning-when-idle
13969                          "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13970                          conf-name ent-name (nth 1 conf-entry)
13971                          (nth 2 conf-entry) file-name conf-line)
13972                       (push conf-key conf-list)
13973                       ;; scan for subconfigurations and subentities
13974                       (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)
13975                         (setq inst-comp-key (vhdl-match-string-downcase 3)
13976                               inst-key-list (split-string
13977                                              (vhdl-match-string-downcase 1)
13978                                              "[ \t\n\r\f]*,[ \t\n\r\f]*"))
13979                         (vhdl-forward-syntactic-ws)
13980                         (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?")
13981                           (setq
13982                            inst-lib-key (vhdl-match-string-downcase 3)
13983                            inst-ent-key (and (match-string 2)
13984                                              (vhdl-match-string-downcase 4))
13985                            inst-arch-key (and (match-string 2)
13986                                               (vhdl-match-string-downcase 6))
13987                            inst-conf-key (and (not (match-string 2))
13988                                               (vhdl-match-string-downcase 4)))
13989                           (while inst-key-list
13990                             (setq comp-conf-list
13991                                   (cons (list (car inst-key-list)
13992                                               inst-comp-key inst-ent-key
13993                                               inst-arch-key inst-conf-key
13994                                               inst-lib-key)
13995                                         comp-conf-list))
13996                             (setq inst-key-list (cdr inst-key-list)))))
13997                       (vhdl-aput 'conf-alist conf-key
13998                                  (list conf-name file-name conf-line ent-key
13999                                        arch-key comp-conf-list lib-alist)))))
14000                 ;; scan for packages
14001                 (goto-char (point-min))
14002                 (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
14003                   (let* ((pack-name (match-string-no-properties 2))
14004                          (pack-key (downcase pack-name))
14005                          (is-body (match-string-no-properties 1))
14006                          (pack-entry (vhdl-aget pack-alist pack-key))
14007                          (pack-line (vhdl-current-line))
14008                          (end-of-unit (vhdl-get-end-of-unit))
14009                          comp-name func-name comp-alist func-alist lib-alist)
14010                     (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14011                         (vhdl-warning-when-idle
14012                          "Package%s declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
14013                          (if is-body " body" "") pack-name
14014                          (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
14015                          (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
14016                          file-name (vhdl-current-line))
14017                       ;; scan for context clauses
14018                       (setq lib-alist (vhdl-scan-context-clause))
14019                       ;; scan for component and subprogram declarations/bodies
14020                       (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
14021                         (if (equal (upcase (match-string 1)) "COMPONENT")
14022                             (setq comp-name (match-string-no-properties 2)
14023                                   comp-alist
14024                                   (cons (list (downcase comp-name) comp-name
14025                                               file-name (vhdl-current-line))
14026                                         comp-alist))
14027                           (setq func-name (match-string-no-properties 2)
14028                                 func-alist
14029                                 (cons (list (downcase func-name) func-name
14030                                             file-name (vhdl-current-line))
14031                                       func-alist))))
14032                       (setq func-alist (nreverse func-alist))
14033                       (setq comp-alist (nreverse comp-alist))
14034                       (if is-body
14035                           (push pack-key pack-body-list)
14036                         (push pack-key pack-list))
14037                       (vhdl-aput
14038                        'pack-alist pack-key
14039                        (if is-body
14040                            (list (or (nth 0 pack-entry) pack-name)
14041                                  (nth 1 pack-entry) (nth 2 pack-entry)
14042                                  (nth 3 pack-entry) (nth 4 pack-entry)
14043                                  (nth 5 pack-entry)
14044                                  file-name pack-line func-alist lib-alist)
14045                          (list pack-name file-name pack-line
14046                                comp-alist func-alist lib-alist
14047                                (nth 6 pack-entry) (nth 7 pack-entry)
14048                                (nth 8 pack-entry) (nth 9 pack-entry))))))))
14049               ;; scan for hierarchy
14050               (if (and limit-hier-file-size
14051                        (< limit-hier-file-size (buffer-size)))
14052                   (progn (message "WARNING:  Scan limit (hierarchy: file size) reached in file:\n  \"%s\"" file-name)
14053                          (setq big-files t))
14054                 ;; scan for architectures
14055                 (goto-char (point-min))
14056                 (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)
14057                   (let* ((ent-name (match-string-no-properties 2))
14058                          (ent-key (downcase ent-name))
14059                          (arch-name (match-string-no-properties 1))
14060                          (arch-key (downcase arch-name))
14061                          (ent-entry (vhdl-aget ent-alist ent-key))
14062                          (arch-alist (nth 3 ent-entry))
14063                          (arch-entry (vhdl-aget arch-alist arch-key))
14064                          (beg-of-unit (point))
14065                          (end-of-unit (vhdl-get-end-of-unit))
14066                          (inst-no 0)
14067                          inst-alist inst-path)
14068                     ;; scan for contained instantiations
14069                     (while (and (re-search-forward
14070                                  (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
14071                                          "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|"
14072                                          "component[ \t\n\r\f]+\\(\\w+\\)\\|"
14073                                          "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|"
14074                                          "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|"
14075                                          "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t)
14076                                 (or (not limit-hier-inst-no)
14077                                     (<= (if (or (match-string 14)
14078                                                 (match-string 16))
14079                                             inst-no
14080                                           (setq inst-no (1+ inst-no)))
14081                                         limit-hier-inst-no)))
14082                       (cond
14083                        ;; block/generate beginning found
14084                        ((match-string 14)
14085                         (setq inst-path
14086                               (cons (match-string-no-properties 1) inst-path)))
14087                        ;; block/generate end found
14088                        ((match-string 16)
14089                         (setq inst-path (cdr inst-path)))
14090                        ;; instantiation found
14091                        (t
14092                         (let* ((inst-name (match-string-no-properties 1))
14093                                (inst-key (downcase inst-name))
14094                                (inst-comp-name
14095                                 (or (match-string-no-properties 3)
14096                                     (match-string-no-properties 6)))
14097                                (inst-ent-key
14098                                 (or (and (match-string 8)
14099                                          (vhdl-match-string-downcase 11))
14100                                     (and inst-comp-name
14101                                          (downcase inst-comp-name))))
14102                                (inst-arch-key (vhdl-match-string-downcase 13))
14103                                (inst-conf-key
14104                                 (and (not (match-string 8))
14105                                      (vhdl-match-string-downcase 11)))
14106                                (inst-lib-key (vhdl-match-string-downcase 10)))
14107                           (goto-char (match-end 1))
14108                           (setq inst-list (cons inst-key inst-list)
14109                                 inst-ent-list
14110                                 (cons inst-ent-key inst-ent-list))
14111                           (setq inst-alist
14112                                 (append
14113                                  inst-alist
14114                                  (list (list inst-key inst-name file-name
14115                                              (vhdl-current-line) inst-comp-name
14116                                              inst-ent-key inst-arch-key
14117                                              inst-conf-key inst-lib-key
14118                                              (reverse inst-path)))))))))
14119                     ;; scan for contained configuration specifications
14120                     (goto-char beg-of-unit)
14121                     (while (re-search-forward
14122                             (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]*\\)*"
14123                                     "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t)
14124                       (let* ((inst-comp-name (match-string-no-properties 3))
14125                              (inst-ent-key
14126                               (and (match-string 6)
14127                                    (vhdl-match-string-downcase 9)))
14128                              (inst-arch-key (vhdl-match-string-downcase 11))
14129                              (inst-conf-key
14130                               (and (not (match-string 6))
14131                                    (vhdl-match-string-downcase 9)))
14132                              (inst-lib-key (vhdl-match-string-downcase 8))
14133                              (inst-key-list
14134                               (split-string (vhdl-match-string-downcase 1)
14135                                             "[ \t\n\r\f]*,[ \t\n\r\f]*"))
14136                              (tmp-inst-alist inst-alist)
14137                              inst-entry)
14138                         (while tmp-inst-alist
14139                           (when (and (or (equal "all" (car inst-key-list))
14140                                          (member (nth 0 (car tmp-inst-alist))
14141                                                  inst-key-list))
14142                                      (equal
14143                                       (downcase
14144                                        (or (nth 4 (car tmp-inst-alist)) ""))
14145                                       (downcase inst-comp-name)))
14146                             (setq inst-entry (car tmp-inst-alist))
14147                             (setq inst-ent-list
14148                                   (cons (or inst-ent-key (nth 5 inst-entry))
14149                                         (vhdl-delete
14150                                          (nth 5 inst-entry) inst-ent-list)))
14151                             (setq inst-entry
14152                                   (list (nth 0 inst-entry) (nth 1 inst-entry)
14153                                         (nth 2 inst-entry) (nth 3 inst-entry)
14154                                         (nth 4 inst-entry)
14155                                         (or inst-ent-key (nth 5 inst-entry))
14156                                         (or inst-arch-key (nth 6 inst-entry))
14157                                         inst-conf-key inst-lib-key))
14158                             (setcar tmp-inst-alist inst-entry))
14159                           (setq tmp-inst-alist (cdr tmp-inst-alist)))))
14160                     ;; save in cache
14161                     (vhdl-aput 'arch-alist arch-key
14162                                (list (nth 0 arch-entry) (nth 1 arch-entry)
14163                                      (nth 2 arch-entry) inst-alist
14164                                      (nth 4 arch-entry)))
14165                     (vhdl-aput 'ent-alist ent-key
14166                                (list (nth 0 ent-entry) (nth 1 ent-entry)
14167                                      (nth 2 ent-entry)
14168                                      (vhdl-sort-alist arch-alist)
14169                                      (nth 4 ent-entry) (nth 5 ent-entry)))
14170                     (when (and limit-hier-inst-no
14171                                (> inst-no limit-hier-inst-no))
14172                       (message "WARNING:  Scan limit (hierarchy: instances per architecture) reached in file:\n  \"%s\"" file-name)
14173                       (setq big-files t))
14174                     (goto-char end-of-unit))))
14175               ;; remember design units for this file
14176               (vhdl-aput 'file-alist file-name
14177                          (list ent-list arch-list arch-ent-list conf-list
14178                                pack-list pack-body-list
14179                                inst-list inst-ent-list))
14180               (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
14181         (setq file-list (cdr file-list))))
14182     (when (or (and (not project) files-exist)
14183               (and project (not non-final)))
14184       ;; consistency checks:
14185       ;; check whether each architecture has a corresponding entity
14186       (setq tmp-list ent-alist)
14187       (while tmp-list
14188         (when (null (nth 2 (car tmp-list)))
14189           (setq tmp-entry (car (nth 4 (car tmp-list))))
14190           (vhdl-warning-when-idle
14191            "Architecture of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14192            (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
14193            (nth 3 tmp-entry)))
14194         (setq tmp-list (cdr tmp-list)))
14195       ;; check whether configuration has a corresponding entity/architecture
14196       (setq tmp-list conf-alist)
14197       (while tmp-list
14198         (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list))))
14199             (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)))
14200               (setq tmp-entry (car tmp-list))
14201               (vhdl-warning-when-idle
14202                "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n  in \"%s\" (line %d)"
14203                (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
14204                (nth 2 tmp-entry) (nth 3 tmp-entry)))
14205           (setq tmp-entry (car tmp-list))
14206           (vhdl-warning-when-idle
14207            "Configuration of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
14208            (nth 1 tmp-entry) (nth 4 tmp-entry)
14209            (nth 2 tmp-entry) (nth 3 tmp-entry)))
14210         (setq tmp-list (cdr tmp-list)))
14211       ;; check whether each package body has a package declaration
14212       (setq tmp-list pack-alist)
14213       (while tmp-list
14214         (when (null (nth 2 (car tmp-list)))
14215           (setq tmp-entry (car tmp-list))
14216           (vhdl-warning-when-idle
14217            "Package body of non-existing package: \"%s\"\n  in \"%s\" (line %d)"
14218            (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
14219         (setq tmp-list (cdr tmp-list)))
14220       ;; sort lists
14221       (setq ent-alist (vhdl-sort-alist ent-alist))
14222       (setq conf-alist (vhdl-sort-alist conf-alist))
14223       (setq pack-alist (vhdl-sort-alist pack-alist))
14224       ;; remember updated directory/project
14225       (add-to-list 'vhdl-updated-project-list (or project dir-name)))
14226     ;; clear directory alists
14227     (unless project
14228       (vhdl-adelete 'vhdl-entity-alist key)
14229       (vhdl-adelete 'vhdl-config-alist key)
14230       (vhdl-adelete 'vhdl-package-alist key)
14231       (vhdl-adelete 'vhdl-ent-inst-alist key)
14232       (vhdl-adelete 'vhdl-file-alist key))
14233     ;; put directory contents into cache
14234     (vhdl-aput 'vhdl-entity-alist key ent-alist)
14235     (vhdl-aput 'vhdl-config-alist key conf-alist)
14236     (vhdl-aput 'vhdl-package-alist key pack-alist)
14237     (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list))
14238     (vhdl-aput 'vhdl-file-alist key file-alist)
14239     ;; final messages
14240     (message "Scanning %s %s\"%s\"...done"
14241              (if is-directory "directory" "files") (or num-string "") name)
14242     (unless project (message "Scanning directory...done"))
14243     (when big-files
14244       (vhdl-warning-when-idle "Scanning is incomplete.\n  --> see user option `vhdl-speedbar-scan-limit'"))
14245     ;; save cache when scanned non-interactively
14246     (when (or (not project) (not non-final))
14247       (when (and noninteractive vhdl-speedbar-save-cache)
14248         (vhdl-save-cache key)))
14249     t))
14250
14251 (defun vhdl-scan-project-contents (project)
14252   "Scan the contents of all VHDL files found in the directories and files
14253 of PROJECT."
14254   (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '("")))
14255         (default-dir (vhdl-resolve-env-variable
14256                       (nth 1 (vhdl-aget vhdl-project-alist project))))
14257         (file-exclude-regexp
14258          (or (nth 3 (vhdl-aget vhdl-project-alist project)) ""))
14259         dir-list-tmp dir dir-name num-dir act-dir recursive)
14260     ;; clear project alists
14261     (vhdl-adelete 'vhdl-entity-alist project)
14262     (vhdl-adelete 'vhdl-config-alist project)
14263     (vhdl-adelete 'vhdl-package-alist project)
14264     (vhdl-adelete 'vhdl-ent-inst-alist project)
14265     (vhdl-adelete 'vhdl-file-alist project)
14266     ;; expand directory names by default-directory
14267     (message "Collecting source files...")
14268     (while dir-list
14269       (setq dir (vhdl-resolve-env-variable (car dir-list)))
14270       (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
14271       (setq recursive (match-string 1 dir)
14272             dir-name (match-string 3 dir))
14273       (setq dir-list-tmp
14274             (cons (concat recursive
14275                           (if (file-name-absolute-p dir-name) "" default-dir)
14276                           dir-name)
14277                   dir-list-tmp))
14278       (setq dir-list (cdr dir-list)))
14279     ;; resolve path wildcards
14280     (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
14281     ;; expand directories
14282     (while dir-list-tmp
14283       (setq dir (car dir-list-tmp))
14284       ;; get subdirectories
14285       (if (string-match "-r \\(.*[/\\]\\)" dir)
14286           (setq dir-list (append dir-list (vhdl-get-subdirs
14287                                            (match-string 1 dir))))
14288         (setq dir-list (append dir-list (list dir))))
14289       (setq dir-list-tmp (cdr dir-list-tmp)))
14290     ;; exclude files
14291     (unless (equal file-exclude-regexp "")
14292       (let ((case-fold-search nil))
14293         (while dir-list
14294           (unless (string-match file-exclude-regexp (car dir-list))
14295             (push (car dir-list) dir-list-tmp))
14296           (setq dir-list (cdr dir-list)))
14297         (setq dir-list (nreverse dir-list-tmp))))
14298     (message "Collecting source files...done")
14299     ;; scan for design units for each directory in DIR-LIST
14300     (setq dir-list-tmp nil
14301           num-dir (length dir-list)
14302           act-dir 1)
14303     (while dir-list
14304       (setq dir-name (abbreviate-file-name
14305                       (expand-file-name (car dir-list))))
14306       (vhdl-scan-directory-contents dir-name project nil
14307                                     (format "(%s/%s) " act-dir num-dir)
14308                                     (cdr dir-list))
14309       (add-to-list 'dir-list-tmp (file-name-directory dir-name))
14310       (setq dir-list (cdr dir-list)
14311             act-dir (1+ act-dir)))
14312     (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
14313     (message "Scanning project \"%s\"...done" project)))
14314
14315 (defun vhdl-update-file-contents (file-name)
14316   "Update hierarchy information by contents of current buffer."
14317   (setq file-name (abbreviate-file-name file-name))
14318   (let* ((dir-name (file-name-directory file-name))
14319          (directory-alist vhdl-directory-alist)
14320          updated)
14321     (while directory-alist
14322       (when (member dir-name (nth 1 (car directory-alist)))
14323         (let* ((vhdl-project (nth 0 (car directory-alist)))
14324                (project (vhdl-project-p))
14325                (ent-alist (vhdl-aget vhdl-entity-alist
14326                                      (or project dir-name)))
14327                (conf-alist (vhdl-aget vhdl-config-alist
14328                                       (or project dir-name)))
14329                (pack-alist (vhdl-aget vhdl-package-alist
14330                                       (or project dir-name)))
14331                (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist
14332                                          (or project dir-name))))
14333                (file-alist (vhdl-aget vhdl-file-alist (or project dir-name)))
14334                (file-entry (vhdl-aget file-alist file-name))
14335                (ent-list (nth 0 file-entry))
14336                (arch-list (nth 1 file-entry))
14337                (arch-ent-list (nth 2 file-entry))
14338                (conf-list (nth 3 file-entry))
14339                (pack-list (nth 4 file-entry))
14340                (pack-body-list (nth 5 file-entry))
14341                (inst-ent-list (nth 7 file-entry))
14342                (cache-key (or project dir-name))
14343                arch-alist key ent-key entry)
14344           ;; delete design units previously contained in this file:
14345           ;; entities
14346           (while ent-list
14347             (setq key (car ent-list)
14348                   entry (vhdl-aget ent-alist key))
14349             (when (equal file-name (nth 1 entry))
14350               (if (nth 3 entry)
14351                   (vhdl-aput 'ent-alist key
14352                              (list (nth 0 entry) nil nil (nth 3 entry) nil))
14353                 (vhdl-adelete 'ent-alist key)))
14354             (setq ent-list (cdr ent-list)))
14355           ;; architectures
14356           (while arch-list
14357             (setq key (car arch-list)
14358                   ent-key (car arch-ent-list)
14359                   entry (vhdl-aget ent-alist ent-key)
14360                   arch-alist (nth 3 entry))
14361             (when (equal file-name (nth 1 (vhdl-aget arch-alist key)))
14362               (vhdl-adelete 'arch-alist key)
14363               (if (or (nth 1 entry) arch-alist)
14364                   (vhdl-aput 'ent-alist ent-key
14365                              (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14366                                    arch-alist (nth 4 entry) (nth 5 entry)))
14367                 (vhdl-adelete 'ent-alist ent-key)))
14368             (setq arch-list (cdr arch-list)
14369                   arch-ent-list (cdr arch-ent-list)))
14370           ;; configurations
14371           (while conf-list
14372             (setq key (car conf-list))
14373             (when (equal file-name (nth 1 (vhdl-aget conf-alist key)))
14374               (vhdl-adelete 'conf-alist key))
14375             (setq conf-list (cdr conf-list)))
14376           ;; package declarations
14377           (while pack-list
14378             (setq key (car pack-list)
14379                   entry (vhdl-aget pack-alist key))
14380             (when (equal file-name (nth 1 entry))
14381               (if (nth 6 entry)
14382                   (vhdl-aput 'pack-alist key
14383                              (list (nth 0 entry) nil nil nil nil nil
14384                                    (nth 6 entry) (nth 7 entry) (nth 8 entry)
14385                                    (nth 9 entry)))
14386                 (vhdl-adelete 'pack-alist key)))
14387             (setq pack-list (cdr pack-list)))
14388           ;; package bodies
14389           (while pack-body-list
14390             (setq key (car pack-body-list)
14391                   entry (vhdl-aget pack-alist key))
14392             (when (equal file-name (nth 6 entry))
14393               (if (nth 1 entry)
14394                   (vhdl-aput 'pack-alist key
14395                              (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
14396                                    (nth 3 entry) (nth 4 entry) (nth 5 entry)
14397                                    nil nil nil nil))
14398                 (vhdl-adelete 'pack-alist key)))
14399             (setq pack-body-list (cdr pack-body-list)))
14400           ;; instantiated entities
14401           (while inst-ent-list
14402             (setq ent-inst-list
14403                   (vhdl-delete (car inst-ent-list) ent-inst-list))
14404             (setq inst-ent-list (cdr inst-ent-list)))
14405           ;; update caches
14406           (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist)
14407           (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist)
14408           (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist)
14409           (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
14410           ;; scan file
14411           (vhdl-scan-directory-contents file-name project t)
14412           (when (or (and vhdl-speedbar-show-projects project)
14413                     (and (not vhdl-speedbar-show-projects) (not project)))
14414             (vhdl-speedbar-refresh project))
14415           (setq updated t)))
14416       (setq directory-alist (cdr directory-alist)))
14417     updated))
14418
14419 (defun vhdl-update-hierarchy ()
14420   "Update directory and hierarchy information in speedbar."
14421   (let ((file-list (reverse vhdl-modified-file-list))
14422         updated)
14423     (when (and vhdl-speedbar-update-on-saving file-list)
14424       (while file-list
14425         (setq updated
14426               (or (vhdl-update-file-contents (car file-list))
14427                   updated))
14428         (setq file-list (cdr file-list)))
14429       (setq vhdl-modified-file-list nil)
14430       (vhdl-speedbar-update-current-unit)
14431       (when updated (message "Updating hierarchy...done")))))
14432
14433 ;; structure (parenthesized expression means list of such entries)
14434 ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
14435 ;;  comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
14436 ;;  comp-lib-name level)
14437 (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
14438                                      conf-inst-alist level indent
14439                                      &optional include-top ent-hier)
14440   "Get instantiation hierarchy beginning in architecture ARCH-KEY of
14441 entity ENT-KEY."
14442   (let* ((ent-entry (vhdl-aget ent-alist ent-key))
14443          (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key)
14444                        (cdar (last (nth 3 ent-entry)))))
14445          (inst-alist (nth 3 arch-entry))
14446          inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
14447          hier-list subcomp-list tmp-list inst-key inst-comp-name
14448          inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
14449     (when (= level 0) (message "Extract design hierarchy..."))
14450     (when include-top
14451       (setq level (1+ level)))
14452     (when (member ent-key ent-hier)
14453       (error "ERROR:  Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
14454     ;; process all instances
14455     (while inst-alist
14456       (setq inst-entry (car inst-alist)
14457             inst-key (nth 0 inst-entry)
14458             inst-comp-name (nth 4 inst-entry)
14459             inst-conf-key (nth 7 inst-entry))
14460       ;; search entry in configuration's instantiations list
14461       (setq tmp-list conf-inst-alist)
14462       (while (and tmp-list
14463                   (not (and (member (nth 0 (car tmp-list))
14464                                     (list "all" inst-key))
14465                             (equal (nth 1 (car tmp-list))
14466                                    (downcase (or inst-comp-name ""))))))
14467         (setq tmp-list (cdr tmp-list)))
14468       (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
14469       (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key))
14470       (when (and inst-conf-key (not inst-conf-entry))
14471         (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
14472       ;; determine entity
14473       (setq inst-ent-key
14474             (or (nth 2 (car tmp-list))  ; from configuration
14475                 (nth 3 inst-conf-entry) ; from subconfiguration
14476                 (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry)))
14477                                         ; from configuration spec.
14478                 (nth 5 inst-entry)))    ; from direct instantiation
14479       (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key))
14480       ;; determine architecture
14481       (setq inst-arch-key
14482             (or (nth 3 (car tmp-list))          ; from configuration
14483                 (nth 4 inst-conf-entry)         ; from subconfiguration
14484                 (nth 6 inst-entry)              ; from direct instantiation
14485                 (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry)))
14486                                                 ; from configuration spec.
14487                 (nth 4 inst-ent-entry)          ; MRA
14488                 (caar (nth 3 inst-ent-entry)))) ; first alphabetically
14489       (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key))
14490       ;; set library
14491       (setq inst-lib-key
14492             (or (nth 5 (car tmp-list))          ; from configuration
14493                 (nth 8 inst-entry)))            ; from direct instantiation
14494       ;; gather information for this instance
14495       (setq comp-entry
14496             (list (nth 1 inst-entry)
14497                   (cons (nth 2 inst-entry) (nth 3 inst-entry))
14498                   (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
14499                   (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
14500                   (or (nth 0 inst-arch-entry) inst-arch-key)
14501                   (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
14502                   (or (nth 0 inst-conf-entry) inst-conf-key)
14503                   (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
14504                   inst-lib-key level))
14505       ;; get subcomponent hierarchy
14506       (setq subcomp-list (vhdl-get-hierarchy
14507                           ent-alist conf-alist
14508                           inst-ent-key inst-arch-key inst-conf-key
14509                           (nth 5 inst-conf-entry)
14510                           (1+ level) indent nil (cons ent-key ent-hier)))
14511       ;; add to list
14512       (setq hier-list (append hier-list (list comp-entry) subcomp-list))
14513       (setq inst-alist (cdr inst-alist)))
14514     (when include-top
14515       (setq hier-list
14516             (cons (list nil nil (nth 0 ent-entry)
14517                         (cons (nth 1 ent-entry) (nth 2 ent-entry))
14518                         (nth 0 arch-entry)
14519                         (cons (nth 1 arch-entry) (nth 2 arch-entry))
14520                         nil nil
14521                         nil (1- level))
14522                   hier-list)))
14523     (when (or (= level 0) (and include-top (= level 1))) (message ""))
14524     hier-list))
14525
14526 (defun vhdl-get-instantiations (ent-key indent)
14527   "Get all instantiations of entity ENT-KEY."
14528   (let ((ent-alist (vhdl-aget vhdl-entity-alist
14529                               (vhdl-speedbar-line-key indent)))
14530         arch-alist inst-alist ent-inst-list
14531         ent-entry arch-entry inst-entry)
14532     (while ent-alist
14533       (setq ent-entry (car ent-alist))
14534       (setq arch-alist (nth 4 ent-entry))
14535       (while arch-alist
14536         (setq arch-entry (car arch-alist))
14537         (setq inst-alist (nth 4 arch-entry))
14538         (while inst-alist
14539           (setq inst-entry (car inst-alist))
14540           (when (equal ent-key (nth 5 inst-entry))
14541             (setq ent-inst-list
14542                   (cons (list (nth 1 inst-entry)
14543                               (cons (nth 2 inst-entry) (nth 3 inst-entry))
14544                               (nth 1 ent-entry)
14545                               (cons (nth 2 ent-entry) (nth 3 ent-entry))
14546                               (nth 1 arch-entry)
14547                               (cons (nth 2 arch-entry) (nth 3 arch-entry)))
14548                         ent-inst-list)))
14549           (setq inst-alist (cdr inst-alist)))
14550         (setq arch-alist (cdr arch-alist)))
14551       (setq ent-alist (cdr ent-alist)))
14552     (nreverse ent-inst-list)))
14553
14554 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14555 ;; Caching in file
14556
14557 (defun vhdl-save-caches ()
14558   "Save all updated hierarchy caches to file."
14559   (interactive)
14560   (condition-case nil
14561       (when vhdl-speedbar-save-cache
14562         ;; update hierarchy
14563         (vhdl-update-hierarchy)
14564         (let ((project-list vhdl-updated-project-list))
14565           (message "Saving hierarchy caches...")
14566           ;; write updated project caches
14567           (while project-list
14568             (vhdl-save-cache (car project-list))
14569             (setq project-list (cdr project-list)))
14570           (message "Saving hierarchy caches...done")))
14571     (error (progn (vhdl-warning "ERROR:  An error occurred while saving the hierarchy caches")
14572                   (sit-for 2)))))
14573
14574 (defun vhdl-save-cache (key)
14575   "Save current hierarchy cache to file."
14576   (let* ((orig-buffer (current-buffer))
14577          (vhdl-project key)
14578          (project (vhdl-project-p))
14579          (default-directory key)
14580          (directory (abbreviate-file-name (vhdl-default-directory)))
14581          (file-name (vhdl-resolve-env-variable
14582                      (vhdl-replace-string
14583                       (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14584                       (concat
14585                        (subst-char-in-string ?  ?_ (or project "dir"))
14586                        " " (user-login-name)))))
14587          (file-dir-name (expand-file-name file-name directory))
14588          (cache-key (or project directory))
14589          (key (if project "project" "directory")))
14590     (unless (file-exists-p (file-name-directory file-dir-name))
14591       (make-directory (file-name-directory file-dir-name) t))
14592     (if (not (file-writable-p file-dir-name))
14593         (progn (vhdl-warning (format "File not writable: \"%s\""
14594                                      (abbreviate-file-name file-dir-name)))
14595                (sit-for 2))
14596       (message "Saving cache: \"%s\"" file-dir-name)
14597       (set-buffer (find-file-noselect file-dir-name t t))
14598       (erase-buffer)
14599       (insert ";; -*- Emacs-Lisp -*-\n\n"
14600               ";;; " (file-name-nondirectory file-name)
14601               " - design hierarchy cache file for Emacs VHDL Mode "
14602               vhdl-version "\n")
14603       (insert "\n;; " (if project "Project  " "Directory") " : ")
14604       (if project (insert project) (prin1 directory (current-buffer)))
14605       (insert "\n;; Saved     : " (format-time-string "%Y-%m-%d %T ")
14606               (user-login-name) "\n\n"
14607               "\n;; version number\n"
14608               "(setq vhdl-cache-version \"" vhdl-version "\")\n"
14609               "\n;; " (if project "project" "directory") " name"
14610               "\n(setq " key " ")
14611       (prin1 (or project directory) (current-buffer))
14612       (insert ")\n")
14613       (when (member 'hierarchy vhdl-speedbar-save-cache)
14614         (insert "\n;; entity and architecture cache\n"
14615                 "(vhdl-aput 'vhdl-entity-alist " key " '")
14616         (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer))
14617         (insert ")\n\n;; configuration cache\n"
14618                 "(vhdl-aput 'vhdl-config-alist " key " '")
14619         (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer))
14620         (insert ")\n\n;; package cache\n"
14621                 "(vhdl-aput 'vhdl-package-alist " key " '")
14622         (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer))
14623         (insert ")\n\n;; instantiated entities cache\n"
14624                 "(vhdl-aput 'vhdl-ent-inst-alist " key " '")
14625         (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer))
14626         (insert ")\n\n;; design units per file cache\n"
14627                 "(vhdl-aput 'vhdl-file-alist " key " '")
14628         (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer))
14629         (when project
14630           (insert ")\n\n;; source directories in project cache\n"
14631                   "(vhdl-aput 'vhdl-directory-alist " key " '")
14632           (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer)))
14633         (insert ")\n"))
14634       (when (member 'display vhdl-speedbar-save-cache)
14635         (insert "\n;; shown design units cache\n"
14636                 "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '")
14637         (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key)
14638                (current-buffer))
14639         (insert ")\n"))
14640       (setq vhdl-updated-project-list
14641             (delete cache-key vhdl-updated-project-list))
14642       (save-buffer)
14643       (kill-buffer (current-buffer))
14644       (set-buffer orig-buffer))))
14645
14646 (defun vhdl-load-cache (key)
14647   "Load hierarchy cache information from file."
14648   (let* ((vhdl-project key)
14649          (default-directory key)
14650          (directory (vhdl-default-directory))
14651          (file-name (vhdl-resolve-env-variable
14652                      (vhdl-replace-string
14653                       (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
14654                       (concat
14655                        (subst-char-in-string ?  ?_ (or (vhdl-project-p) "dir"))
14656                        " " (user-login-name)))))
14657          (file-dir-name (expand-file-name file-name directory))
14658          vhdl-cache-version)
14659     (unless (memq 'vhdl-save-caches kill-emacs-hook)
14660       (add-hook 'kill-emacs-hook 'vhdl-save-caches))
14661     (when (file-exists-p file-dir-name)
14662       (condition-case ()
14663           (progn (load-file file-dir-name)
14664                  (string< (mapconcat
14665                            (lambda (a) (format "%3d" (string-to-number a)))
14666                            (split-string "3.33" "\\.") "")
14667                           (mapconcat
14668                            (lambda (a) (format "%3d" (string-to-number a)))
14669                            (split-string vhdl-cache-version "\\.") "")))
14670         (error (progn (vhdl-warning (format "ERROR:  Corrupted cache file: \"%s\"" file-dir-name))
14671                       nil))))))
14672
14673 (defun vhdl-require-hierarchy-info ()
14674   "Make sure that hierarchy information is available.  Load cache or scan files
14675 if required."
14676   (if (vhdl-project-p)
14677       (unless (or (assoc vhdl-project vhdl-file-alist)
14678                   (vhdl-load-cache vhdl-project))
14679         (vhdl-scan-project-contents vhdl-project))
14680     (let ((directory (abbreviate-file-name default-directory)))
14681       (unless (or (assoc directory vhdl-file-alist)
14682                   (vhdl-load-cache directory))
14683         (vhdl-scan-directory-contents directory)))))
14684
14685 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14686 ;; Add hierarchy browser functionality to speedbar
14687
14688 (defvar vhdl-speedbar-mode-map nil
14689   "Keymap used when in the VHDL hierarchy browser mode.")
14690
14691 (defvar vhdl-speedbar-menu-items nil
14692   "Additional menu-items to add to speedbar frame.")
14693
14694 (declare-function speedbar-add-supported-extension "speedbar" (extension))
14695 (declare-function speedbar-add-mode-functions-list "speedbar" (new-list))
14696 (declare-function speedbar-make-specialized-keymap "speedbar" ())
14697 (declare-function speedbar-change-initial-expansion-list "speedbar"
14698                   (new-default))
14699 (declare-function speedbar-add-expansion-list "speedbar" (new-list))
14700
14701 (defun vhdl-speedbar-initialize ()
14702   "Initialize speedbar."
14703   ;; general settings
14704   ;; VHDL file extensions (extracted from `auto-mode-alist')
14705   (let ((mode-alist auto-mode-alist))
14706     (while mode-alist
14707       (when (eq (cdar mode-alist) 'vhdl-mode)
14708         (speedbar-add-supported-extension (caar mode-alist)))
14709       (setq mode-alist (cdr mode-alist))))
14710   ;; hierarchy browser settings
14711   (when (boundp 'speedbar-mode-functions-list)
14712     ;; special functions
14713     (speedbar-add-mode-functions-list
14714      '("vhdl directory"
14715        (speedbar-item-info . vhdl-speedbar-item-info)
14716        (speedbar-line-directory . speedbar-files-line-path)))
14717     (speedbar-add-mode-functions-list
14718      '("vhdl project"
14719        (speedbar-item-info . vhdl-speedbar-item-info)
14720        (speedbar-line-directory . vhdl-speedbar-line-project)))
14721     ;; keymap
14722     (unless vhdl-speedbar-mode-map
14723       (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap))
14724       (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line)
14725       (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line)
14726       (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line)
14727       (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line)
14728       (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level)
14729       (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all)
14730       (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy)
14731       (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component)
14732       (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration)
14733       (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra)
14734       (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design)
14735       (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy)
14736       (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches)
14737       (let ((key 0))
14738         (while (<= key 9)
14739           (define-key vhdl-speedbar-mode-map (int-to-string key)
14740             `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
14741           (setq key (1+ key)))))
14742     (define-key speedbar-mode-map "h"
14743       (lambda () (interactive)
14744         (speedbar-change-initial-expansion-list "vhdl directory")))
14745     (define-key speedbar-mode-map "H"
14746       (lambda () (interactive)
14747         (speedbar-change-initial-expansion-list "vhdl project")))
14748     ;; menu
14749     (unless vhdl-speedbar-menu-items
14750       (setq
14751        vhdl-speedbar-menu-items
14752        `(["Edit" speedbar-edit-line t]
14753          ["Expand" speedbar-expand-line
14754           (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
14755          ["Contract" vhdl-speedbar-contract-level t]
14756          ["Expand All" vhdl-speedbar-expand-all t]
14757          ["Contract All" vhdl-speedbar-contract-all t]
14758          ,(let ((key 0) (menu-list '("Hierarchy Depth")))
14759             (while (<= key 9)
14760               (setq menu-list
14761                     (cons `[,(if (= key 0) "All" (int-to-string key))
14762                             (vhdl-speedbar-set-depth ,key)
14763                             :style radio
14764                             :selected (= vhdl-speedbar-hierarchy-depth ,key)
14765                             :keys ,(int-to-string key)]
14766                           menu-list))
14767               (setq key (1+ key)))
14768             (nreverse menu-list))
14769          "--"
14770          ["Copy Port/Subprogram" vhdl-speedbar-port-copy
14771           (or (vhdl-speedbar-check-unit 'entity)
14772               (vhdl-speedbar-check-unit 'subprogram))]
14773          ["Place Component" vhdl-speedbar-place-component
14774           (vhdl-speedbar-check-unit 'entity)]
14775          ["Generate Configuration" vhdl-speedbar-configuration
14776           (vhdl-speedbar-check-unit 'architecture)]
14777          ["Select as MRA" vhdl-speedbar-select-mra
14778           (vhdl-speedbar-check-unit 'architecture)]
14779          ["Make" vhdl-speedbar-make-design
14780           (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
14781          ["Generate Makefile" vhdl-speedbar-generate-makefile
14782           (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
14783          ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
14784           :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14785           ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)]
14786          ["Rescan Project" vhdl-speedbar-rescan-hierarchy
14787           :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
14788           ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects]
14789          ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
14790     ;; hook-ups
14791     (speedbar-add-expansion-list
14792      '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14793        vhdl-speedbar-display-directory))
14794     (speedbar-add-expansion-list
14795      '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map
14796        vhdl-speedbar-display-projects))
14797     (setq speedbar-stealthy-function-list
14798           (append
14799            '(("vhdl directory" vhdl-speedbar-update-current-unit)
14800              ("vhdl project" vhdl-speedbar-update-current-project
14801               vhdl-speedbar-update-current-unit))
14802            speedbar-stealthy-function-list))
14803     (when (eq vhdl-speedbar-display-mode 'directory)
14804       (setq speedbar-initial-expansion-list-name "vhdl directory"))
14805     (when (eq vhdl-speedbar-display-mode 'project)
14806       (setq speedbar-initial-expansion-list-name "vhdl project"))
14807     (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
14808
14809 (defun vhdl-speedbar (&optional arg)
14810   "Open/close speedbar."
14811   (interactive)
14812   (if (not (fboundp 'speedbar))
14813       (error "WARNING:  Speedbar is not available or not installed")
14814     (condition-case ()
14815         (speedbar-frame-mode arg)
14816       (error (error "WARNING:  An error occurred while opening speedbar")))))
14817
14818 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14819 ;; Display functions
14820
14821 (defvar vhdl-speedbar-last-selected-project nil
14822   "Name of last selected project.")
14823
14824 ;; macros must be defined in the file they are used (copied from `speedbar.el')
14825 ;;; (defmacro speedbar-with-writable (&rest forms)
14826 ;;;   "Allow the buffer to be writable and evaluate FORMS."
14827 ;;;   (list 'let '((inhibit-read-only t))
14828 ;;;     (cons 'progn forms)))
14829 ;;; (put 'speedbar-with-writable 'lisp-indent-function 0)
14830
14831 (declare-function speedbar-extension-list-to-regex "speedbar" (extlist))
14832 (declare-function speedbar-directory-buttons "speedbar" (directory _index))
14833 (declare-function speedbar-file-lists "speedbar" (directory))
14834
14835 (defun vhdl-speedbar-display-directory (directory depth &optional rescan)
14836   "Display directory and hierarchy information in speedbar."
14837   (setq vhdl-speedbar-show-projects nil)
14838   (setq speedbar-ignored-directory-regexp
14839         (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))
14840   (setq directory (abbreviate-file-name (file-name-as-directory directory)))
14841   (setq speedbar-last-selected-file nil)
14842   (speedbar-with-writable
14843     (condition-case nil
14844         (progn
14845           ;; insert directory path
14846           (speedbar-directory-buttons directory depth)
14847           ;; insert subdirectories
14848           (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
14849           ;; scan and insert hierarchy of current directory
14850           (vhdl-speedbar-insert-dir-hierarchy directory depth
14851                                               speedbar-power-click)
14852           ;; expand subdirectories
14853           (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
14854       (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly")))))
14855
14856 (defun vhdl-speedbar-display-projects (project depth &optional rescan)
14857   "Display projects and hierarchy information in speedbar."
14858   (setq vhdl-speedbar-show-projects t)
14859   (setq speedbar-ignored-directory-regexp ".")
14860   (setq speedbar-last-selected-file nil)
14861   (setq vhdl-speedbar-last-selected-project nil)
14862   (speedbar-with-writable
14863     (condition-case nil
14864         ;; insert projects
14865         (vhdl-speedbar-insert-projects)
14866       (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly"))))
14867   (setq speedbar-full-text-cache nil)) ; prevent caching
14868
14869 (declare-function speedbar-make-tag-line "speedbar"
14870                   (type char func data tag tfunc tdata tface depth))
14871
14872 (defun vhdl-speedbar-insert-projects ()
14873   "Insert all projects in speedbar."
14874   (vhdl-speedbar-make-title-line "Projects:")
14875   (let ((project-alist (if vhdl-project-sort
14876                            (vhdl-sort-alist (copy-alist vhdl-project-alist))
14877                          vhdl-project-alist))
14878         (vhdl-speedbar-update-current-unit nil))
14879     ;; insert projects
14880     (while project-alist
14881       (speedbar-make-tag-line
14882        'angle ?+ 'vhdl-speedbar-expand-project
14883        (caar project-alist) (caar project-alist)
14884        'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
14885       (setq project-alist (cdr project-alist)))
14886     (setq project-alist vhdl-project-alist)
14887     ;; expand projects
14888     (while project-alist
14889       (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
14890         (goto-char (point-min))
14891         (when (re-search-forward
14892                (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
14893           (goto-char (match-end 1))
14894           (speedbar-do-function-pointer)))
14895       (setq project-alist (cdr project-alist)))))
14896
14897 (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
14898   "Insert hierarchy of PROJECT.  Rescan directories if RESCAN is non-nil,
14899 otherwise use cached data."
14900   (when (or rescan (and (not (assoc project vhdl-file-alist))
14901                         (not (vhdl-load-cache project))))
14902     (vhdl-scan-project-contents project))
14903   ;; insert design hierarchy
14904   (vhdl-speedbar-insert-hierarchy
14905    (vhdl-aget vhdl-entity-alist project)
14906    (vhdl-aget vhdl-config-alist project)
14907    (vhdl-aget vhdl-package-alist project)
14908    (car (vhdl-aget vhdl-ent-inst-alist project)) indent)
14909   (insert (int-to-string indent) ":\n")
14910   (put-text-property (- (point) 3) (1- (point)) 'invisible t)
14911   (put-text-property (1- (point)) (point) 'invisible nil)
14912   ;; expand design units
14913   (vhdl-speedbar-expand-units project))
14914
14915 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
14916   "Insert hierarchy of DIRECTORY.  Rescan directory if RESCAN is non-nil,
14917 otherwise use cached data."
14918   (when (or rescan (and (not (assoc directory vhdl-file-alist))
14919                         (not (vhdl-load-cache directory))))
14920     (vhdl-scan-directory-contents directory))
14921   ;; insert design hierarchy
14922   (vhdl-speedbar-insert-hierarchy
14923    (vhdl-aget vhdl-entity-alist directory)
14924    (vhdl-aget vhdl-config-alist directory)
14925    (vhdl-aget vhdl-package-alist directory)
14926    (car (vhdl-aget vhdl-ent-inst-alist directory)) depth)
14927   ;; expand design units
14928   (vhdl-speedbar-expand-units directory)
14929   (vhdl-aput 'vhdl-directory-alist directory (list (list directory))))
14930
14931 (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
14932                                                  ent-inst-list depth)
14933   "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
14934   (if (not (or ent-alist conf-alist pack-alist))
14935       (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
14936     (let (ent-entry conf-entry pack-entry)
14937       ;; insert entities
14938       (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
14939       (while ent-alist
14940         (setq ent-entry (car ent-alist))
14941         (speedbar-make-tag-line
14942          'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
14943          (nth 1 ent-entry) 'vhdl-speedbar-find-file
14944          (cons (nth 2 ent-entry) (nth 3 ent-entry))
14945          'vhdl-speedbar-entity-face depth)
14946         (unless (nth 2 ent-entry)
14947           (end-of-line 0) (insert "!") (forward-char 1))
14948         (unless (member (nth 0 ent-entry) ent-inst-list)
14949           (end-of-line 0) (insert " (top)") (forward-char 1))
14950         (setq ent-alist (cdr ent-alist)))
14951       ;; insert configurations
14952       (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
14953       (while conf-alist
14954         (setq conf-entry (car conf-alist))
14955         (speedbar-make-tag-line
14956          'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
14957          (nth 1 conf-entry) 'vhdl-speedbar-find-file
14958          (cons (nth 2 conf-entry) (nth 3 conf-entry))
14959          'vhdl-speedbar-configuration-face depth)
14960         (setq conf-alist (cdr conf-alist)))
14961       ;; insert packages
14962       (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
14963       (while pack-alist
14964         (setq pack-entry (car pack-alist))
14965         (vhdl-speedbar-make-pack-line
14966          (nth 0 pack-entry) (nth 1 pack-entry)
14967          (cons (nth 2 pack-entry) (nth 3 pack-entry))
14968          (cons (nth 7 pack-entry) (nth 8 pack-entry))
14969          depth)
14970         (setq pack-alist (cdr pack-alist))))))
14971
14972 (declare-function speedbar-line-directory "speedbar" (&optional depth))
14973
14974 (defun vhdl-speedbar-rescan-hierarchy ()
14975   "Rescan hierarchy for the directory or project under the cursor."
14976   (interactive)
14977   (let (key path)
14978     (cond
14979      ;; current project
14980      (vhdl-speedbar-show-projects
14981       (setq key (vhdl-speedbar-line-project))
14982       (vhdl-scan-project-contents key))
14983      ;; top-level directory
14984      ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14985       (re-search-forward "[0-9]+:" nil t)
14986       (vhdl-scan-directory-contents
14987        (abbreviate-file-name (speedbar-line-directory))))
14988      ;; current directory
14989      (t (setq path (speedbar-line-directory))
14990         (string-match "^\\(.+[/\\]\\)" path)
14991         (vhdl-scan-directory-contents
14992          (abbreviate-file-name (match-string 1 path)))))
14993     (vhdl-speedbar-refresh key)))
14994
14995 (declare-function speedbar-goto-this-file "speedbar" (file))
14996
14997 (defun vhdl-speedbar-expand-dirs (directory)
14998   "Expand subdirectories in DIRECTORY according to
14999  `speedbar-shown-directories'."
15000   ;; (nicked from `speedbar-default-directory-list')
15001   (let ((sf (cdr (reverse speedbar-shown-directories)))
15002         (vhdl-speedbar-update-current-unit nil))
15003     (setq speedbar-shown-directories
15004           (list (expand-file-name default-directory)))
15005     (while sf
15006       (when (speedbar-goto-this-file (car sf))
15007         (beginning-of-line)
15008         (when (looking-at "[0-9]+:\\s-*<")
15009           (goto-char (match-end 0))
15010           (speedbar-do-function-pointer)))
15011       (setq sf (cdr sf))))
15012   (vhdl-speedbar-update-current-unit nil t))
15013
15014 (defun vhdl-speedbar-expand-units (key)
15015   "Expand design units in directory/project KEY according to
15016 `vhdl-speedbar-shown-unit-alist'."
15017   (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15018         (vhdl-speedbar-update-current-unit nil)
15019         vhdl-updated-project-list)
15020     (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15021     (vhdl-prepare-search-1
15022      (while unit-alist                  ; expand units
15023        (vhdl-speedbar-goto-this-unit key (caar unit-alist))
15024        (beginning-of-line)
15025        (let ((arch-alist (nth 1 (car unit-alist)))
15026              position)
15027          (when (looking-at "^[0-9]+:\\s-*\\[")
15028            (goto-char (match-end 0))
15029            (setq position (point))
15030            (speedbar-do-function-pointer)
15031            (select-frame speedbar-frame)
15032            (while arch-alist            ; expand architectures
15033              (goto-char position)
15034              (when (re-search-forward
15035                     (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
15036                             (car arch-alist) "\\>\\)") nil t)
15037                (beginning-of-line)
15038                (when (looking-at "^[0-9]+:\\s-*{")
15039                  (goto-char (match-end 0))
15040                  (speedbar-do-function-pointer)
15041                  (select-frame speedbar-frame)))
15042              (setq arch-alist (cdr arch-alist))))
15043          (setq unit-alist (cdr unit-alist))))))
15044   (vhdl-speedbar-update-current-unit nil t))
15045
15046 (declare-function speedbar-center-buffer-smartly "speedbar" ())
15047
15048 (defun vhdl-speedbar-contract-level ()
15049   "Contract current level in current directory/project."
15050   (interactive)
15051   (when (or (save-excursion
15052               (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
15053             (and (save-excursion
15054                    (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
15055                  (re-search-backward
15056                   (format "^[0-%d]:\\s-*[[{<]-"
15057                           (max (1- (string-to-number (match-string 1))) 0)) nil t)))
15058     (goto-char (match-end 0))
15059     (speedbar-do-function-pointer)
15060     (speedbar-center-buffer-smartly)))
15061
15062 (defun vhdl-speedbar-contract-all ()
15063   "Contract all expanded design units in current directory/project."
15064   (interactive)
15065   (if (and vhdl-speedbar-show-projects
15066            (save-excursion (beginning-of-line) (looking-at "^0:")))
15067       (progn (setq vhdl-speedbar-shown-project-list nil)
15068              (vhdl-speedbar-refresh))
15069     (let ((key (vhdl-speedbar-line-key)))
15070       (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)
15071       (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
15072       (when (memq 'display vhdl-speedbar-save-cache)
15073         (add-to-list 'vhdl-updated-project-list key)))))
15074
15075 (defun vhdl-speedbar-expand-all ()
15076   "Expand all design units in current directory/project."
15077   (interactive)
15078   (let* ((key (vhdl-speedbar-line-key))
15079          (ent-alist (vhdl-aget vhdl-entity-alist key))
15080          (conf-alist (vhdl-aget vhdl-config-alist key))
15081          (pack-alist (vhdl-aget vhdl-package-alist key))
15082          arch-alist unit-alist subunit-alist)
15083     (add-to-list 'vhdl-speedbar-shown-project-list key)
15084     (while ent-alist
15085       (setq arch-alist (nth 4 (car ent-alist)))
15086       (setq subunit-alist nil)
15087       (while arch-alist
15088         (push (caar arch-alist) subunit-alist)
15089         (setq arch-alist (cdr arch-alist)))
15090       (push (list (caar ent-alist) subunit-alist) unit-alist)
15091       (setq ent-alist (cdr ent-alist)))
15092     (while conf-alist
15093       (push (list (caar conf-alist)) unit-alist)
15094       (setq conf-alist (cdr conf-alist)))
15095     (while pack-alist
15096       (push (list (caar pack-alist)) unit-alist)
15097       (setq pack-alist (cdr pack-alist)))
15098     (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15099     (vhdl-speedbar-refresh)
15100     (when (memq 'display vhdl-speedbar-save-cache)
15101       (add-to-list 'vhdl-updated-project-list key))))
15102
15103 (declare-function speedbar-change-expand-button-char "speedbar" (char))
15104 (declare-function speedbar-delete-subblock "speedbar" (indent))
15105
15106 (defun vhdl-speedbar-expand-project (text token indent)
15107   "Expand/contract the project under the cursor."
15108   (cond
15109    ((string-match "+" text)             ; expand project
15110     (speedbar-change-expand-button-char ?-)
15111     (unless (member token vhdl-speedbar-shown-project-list)
15112       (setq vhdl-speedbar-shown-project-list
15113             (cons token vhdl-speedbar-shown-project-list)))
15114     (speedbar-with-writable
15115       (save-excursion
15116         (end-of-line) (forward-char 1)
15117         (vhdl-speedbar-insert-project-hierarchy token (1+ indent)
15118                                                 speedbar-power-click))))
15119    ((string-match "-" text)             ; contract project
15120     (speedbar-change-expand-button-char ?+)
15121     (setq vhdl-speedbar-shown-project-list
15122           (delete token vhdl-speedbar-shown-project-list))
15123     (speedbar-delete-subblock indent))
15124    (t (error "Nothing to display")))
15125   (when (equal (selected-frame) speedbar-frame)
15126     (speedbar-center-buffer-smartly)))
15127
15128 (defun vhdl-speedbar-expand-entity (text token indent)
15129   "Expand/contract the entity under the cursor."
15130   (cond
15131    ((string-match "+" text)             ; expand entity
15132     (let* ((key (vhdl-speedbar-line-key indent))
15133            (ent-alist (vhdl-aget vhdl-entity-alist key))
15134            (ent-entry (vhdl-aget ent-alist token))
15135            (arch-alist (nth 3 ent-entry))
15136            (inst-alist (vhdl-get-instantiations token indent))
15137            (subpack-alist (nth 5 ent-entry))
15138            (multiple-arch (> (length arch-alist) 1))
15139            arch-entry inst-entry)
15140       (if (not (or arch-alist inst-alist subpack-alist))
15141           (speedbar-change-expand-button-char ??)
15142         (speedbar-change-expand-button-char ?-)
15143         ;; add entity to `vhdl-speedbar-shown-unit-alist'
15144         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15145           (vhdl-aput 'unit-alist token nil)
15146           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15147         (speedbar-with-writable
15148          (save-excursion
15149            (end-of-line) (forward-char 1)
15150            ;; insert architectures
15151            (when arch-alist
15152              (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
15153            (while arch-alist
15154              (setq arch-entry (car arch-alist))
15155              (speedbar-make-tag-line
15156               'curly ?+ 'vhdl-speedbar-expand-architecture
15157               (cons token (nth 0 arch-entry))
15158               (nth 1 arch-entry) 'vhdl-speedbar-find-file
15159               (cons (nth 2 arch-entry) (nth 3 arch-entry))
15160               'vhdl-speedbar-architecture-face (1+ indent))
15161              (when (and multiple-arch
15162                         (equal (nth 0 arch-entry) (nth 4 ent-entry)))
15163                (end-of-line 0) (insert " (mra)") (forward-char 1))
15164              (setq arch-alist (cdr arch-alist)))
15165            ;; insert instantiations
15166            (when inst-alist
15167              (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
15168            (while inst-alist
15169              (setq inst-entry (car inst-alist))
15170              (vhdl-speedbar-make-inst-line
15171               (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
15172               (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
15173               nil nil nil (1+ indent) 0 " in ")
15174              (setq inst-alist (cdr inst-alist)))
15175            ;; insert required packages
15176            (vhdl-speedbar-insert-subpackages
15177             subpack-alist (1+ indent) indent)))
15178         (when (memq 'display vhdl-speedbar-save-cache)
15179           (add-to-list 'vhdl-updated-project-list key))
15180         (vhdl-speedbar-update-current-unit t t))))
15181    ((string-match "-" text)             ; contract entity
15182     (speedbar-change-expand-button-char ?+)
15183     ;; remove entity from `vhdl-speedbar-shown-unit-alist'
15184     (let* ((key (vhdl-speedbar-line-key indent))
15185            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15186       (vhdl-adelete 'unit-alist token)
15187       (if unit-alist
15188           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15189         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15190       (speedbar-delete-subblock indent)
15191       (when (memq 'display vhdl-speedbar-save-cache)
15192         (add-to-list 'vhdl-updated-project-list key))))
15193    (t (error "Nothing to display")))
15194   (when (equal (selected-frame) speedbar-frame)
15195     (speedbar-center-buffer-smartly)))
15196
15197 (defun vhdl-speedbar-expand-architecture (text token indent)
15198   "Expand/contract the architecture under the cursor."
15199   (cond
15200    ((string-match "+" text)             ; expand architecture
15201     (let* ((key (vhdl-speedbar-line-key (1- indent)))
15202            (ent-alist (vhdl-aget vhdl-entity-alist key))
15203            (conf-alist (vhdl-aget vhdl-config-alist key))
15204            (hier-alist (vhdl-get-hierarchy
15205                         ent-alist conf-alist (car token) (cdr token) nil nil
15206                         0 (1- indent)))
15207            (ent-entry (vhdl-aget ent-alist (car token)))
15208            (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token)))
15209            (subpack-alist (nth 4 arch-entry))
15210            entry)
15211       (if (not (or hier-alist subpack-alist))
15212           (speedbar-change-expand-button-char ??)
15213         (speedbar-change-expand-button-char ?-)
15214         ;; add architecture to `vhdl-speedbar-shown-unit-alist'
15215         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15216                (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15217           (vhdl-aput 'unit-alist (car token)
15218                      (list (cons (cdr token) arch-alist)))
15219           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15220         (speedbar-with-writable
15221           (save-excursion
15222             (end-of-line) (forward-char 1)
15223             ;; insert instance hierarchy
15224             (when hier-alist
15225               (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
15226                                              (1+ indent)))
15227             (while hier-alist
15228               (setq entry (car hier-alist))
15229               (when (or (= vhdl-speedbar-hierarchy-depth 0)
15230                         (< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15231                 (vhdl-speedbar-make-inst-line
15232                  (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15233                  (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15234                  (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
15235               (setq hier-alist (cdr hier-alist)))
15236             ;; insert required packages
15237             (vhdl-speedbar-insert-subpackages
15238              subpack-alist (1+ indent) (1- indent))))
15239         (when (memq 'display vhdl-speedbar-save-cache)
15240           (add-to-list 'vhdl-updated-project-list key))
15241         (vhdl-speedbar-update-current-unit t t))))
15242    ((string-match "-" text)             ; contract architecture
15243     (speedbar-change-expand-button-char ?+)
15244     ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
15245     (let* ((key (vhdl-speedbar-line-key (1- indent)))
15246            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))
15247            (arch-alist (nth 0 (vhdl-aget unit-alist (car token)))))
15248       (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
15249       (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15250       (speedbar-delete-subblock indent)
15251       (when (memq 'display vhdl-speedbar-save-cache)
15252         (add-to-list 'vhdl-updated-project-list key))))
15253    (t (error "Nothing to display")))
15254   (when (equal (selected-frame) speedbar-frame)
15255     (speedbar-center-buffer-smartly)))
15256
15257 (defun vhdl-speedbar-expand-config (text token indent)
15258   "Expand/contract the configuration under the cursor."
15259   (cond
15260    ((string-match "+" text)             ; expand configuration
15261     (let* ((key (vhdl-speedbar-line-key indent))
15262            (conf-alist (vhdl-aget vhdl-config-alist key))
15263            (conf-entry (vhdl-aget conf-alist token))
15264            (ent-alist (vhdl-aget vhdl-entity-alist key))
15265            (hier-alist (vhdl-get-hierarchy
15266                         ent-alist conf-alist (nth 3 conf-entry)
15267                         (nth 4 conf-entry) token (nth 5 conf-entry)
15268                         0 indent t))
15269            (subpack-alist (nth 6 conf-entry))
15270            entry)
15271       (if (not (or hier-alist subpack-alist))
15272           (speedbar-change-expand-button-char ??)
15273         (speedbar-change-expand-button-char ?-)
15274         ;; add configuration to `vhdl-speedbar-shown-unit-alist'
15275         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15276           (vhdl-aput 'unit-alist token nil)
15277           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15278         (speedbar-with-writable
15279          (save-excursion
15280            (end-of-line) (forward-char 1)
15281            ;; insert instance hierarchy
15282            (when hier-alist
15283              (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
15284            (while hier-alist
15285              (setq entry (car hier-alist))
15286              (when (or (= vhdl-speedbar-hierarchy-depth 0)
15287                        (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
15288                (vhdl-speedbar-make-inst-line
15289                 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
15290                 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
15291                 (nth 8 entry) (1+ indent) (nth 9 entry) ": "))
15292              (setq hier-alist (cdr hier-alist)))
15293            ;; insert required packages
15294            (vhdl-speedbar-insert-subpackages
15295             subpack-alist (1+ indent) indent)))
15296         (when (memq 'display vhdl-speedbar-save-cache)
15297           (add-to-list 'vhdl-updated-project-list key))
15298         (vhdl-speedbar-update-current-unit t t))))
15299    ((string-match "-" text)             ; contract configuration
15300     (speedbar-change-expand-button-char ?+)
15301     ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
15302     (let* ((key (vhdl-speedbar-line-key indent))
15303            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15304       (vhdl-adelete 'unit-alist token)
15305       (if unit-alist
15306           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15307         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15308       (speedbar-delete-subblock indent)
15309       (when (memq 'display vhdl-speedbar-save-cache)
15310         (add-to-list 'vhdl-updated-project-list key))))
15311    (t (error "Nothing to display")))
15312   (when (equal (selected-frame) speedbar-frame)
15313     (speedbar-center-buffer-smartly)))
15314
15315 (defun vhdl-speedbar-expand-package (text token indent)
15316   "Expand/contract the package under the cursor."
15317   (cond
15318    ((string-match "+" text)             ; expand package
15319     (let* ((key (vhdl-speedbar-line-key indent))
15320            (pack-alist (vhdl-aget vhdl-package-alist key))
15321            (pack-entry (vhdl-aget pack-alist token))
15322            (comp-alist (nth 3 pack-entry))
15323            (func-alist (nth 4 pack-entry))
15324            (func-body-alist (nth 8 pack-entry))
15325            (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
15326            comp-entry func-entry func-body-entry)
15327       (if (not (or comp-alist func-alist subpack-alist))
15328           (speedbar-change-expand-button-char ??)
15329         (speedbar-change-expand-button-char ?-)
15330         ;; add package to `vhdl-speedbar-shown-unit-alist'
15331         (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15332           (vhdl-aput 'unit-alist token nil)
15333           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
15334         (speedbar-with-writable
15335           (save-excursion
15336             (end-of-line) (forward-char 1)
15337             ;; insert components
15338             (when comp-alist
15339               (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
15340             (while comp-alist
15341               (setq comp-entry (car comp-alist))
15342               (speedbar-make-tag-line
15343                nil nil nil
15344                (cons token (nth 0 comp-entry))
15345                (nth 1 comp-entry) 'vhdl-speedbar-find-file
15346                (cons (nth 2 comp-entry) (nth 3 comp-entry))
15347                'vhdl-speedbar-entity-face (1+ indent))
15348               (setq comp-alist (cdr comp-alist)))
15349             ;; insert subprograms
15350             (when func-alist
15351               (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
15352             (while func-alist
15353               (setq func-entry (car func-alist)
15354                     func-body-entry (vhdl-aget func-body-alist
15355                                                (car func-entry)))
15356               (when (nth 2 func-entry)
15357                 (vhdl-speedbar-make-subprogram-line
15358                  (nth 1 func-entry)
15359                  (cons (nth 2 func-entry) (nth 3 func-entry))
15360                  (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
15361                  (1+ indent)))
15362               (setq func-alist (cdr func-alist)))
15363            ;; insert required packages
15364            (vhdl-speedbar-insert-subpackages
15365             subpack-alist (1+ indent) indent)))
15366         (when (memq 'display vhdl-speedbar-save-cache)
15367           (add-to-list 'vhdl-updated-project-list key))
15368         (vhdl-speedbar-update-current-unit t t))))
15369    ((string-match "-" text)             ; contract package
15370     (speedbar-change-expand-button-char ?+)
15371     ;; remove package from `vhdl-speedbar-shown-unit-alist'
15372     (let* ((key (vhdl-speedbar-line-key indent))
15373            (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)))
15374       (vhdl-adelete 'unit-alist token)
15375       (if unit-alist
15376           (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
15377         (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key))
15378       (speedbar-delete-subblock indent)
15379       (when (memq 'display vhdl-speedbar-save-cache)
15380         (add-to-list 'vhdl-updated-project-list key))))
15381    (t (error "Nothing to display")))
15382   (when (equal (selected-frame) speedbar-frame)
15383     (speedbar-center-buffer-smartly)))
15384
15385 (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
15386   "Insert required packages."
15387   (let* ((pack-alist (vhdl-aget vhdl-package-alist
15388                                 (vhdl-speedbar-line-key dir-indent)))
15389          pack-key lib-name pack-entry)
15390     (when subpack-alist
15391       (vhdl-speedbar-make-title-line "Packages Used:" indent))
15392     (while subpack-alist
15393       (setq pack-key (cdar subpack-alist)
15394             lib-name (caar subpack-alist))
15395       (setq pack-entry (vhdl-aget pack-alist pack-key))
15396       (vhdl-speedbar-make-subpack-line
15397        (or (nth 0 pack-entry) pack-key) lib-name
15398        (cons (nth 1 pack-entry) (nth 2 pack-entry))
15399        (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent)
15400       (setq subpack-alist (cdr subpack-alist)))))
15401
15402 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15403 ;; Display help functions
15404
15405 (defvar vhdl-speedbar-update-current-unit t
15406   "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
15407
15408 (defun vhdl-speedbar-update-current-project ()
15409   "Highlight project that is currently active."
15410   (when (and vhdl-speedbar-show-projects
15411              (not (equal vhdl-speedbar-last-selected-project vhdl-project))
15412              (and (boundp 'speedbar-frame)
15413                   (frame-live-p speedbar-frame)))
15414     (let ((last-frame (selected-frame))
15415           (project-alist vhdl-project-alist)
15416           pos)
15417       (select-frame speedbar-frame)
15418       (speedbar-with-writable
15419        (save-excursion
15420          (while project-alist
15421            (goto-char (point-min))
15422            (when (re-search-forward
15423                   (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
15424              (put-text-property (match-beginning 1) (match-end 1) 'face
15425                                 (if (equal (caar project-alist) vhdl-project)
15426                                     'speedbar-selected-face
15427                                   'speedbar-directory-face))
15428              (when (equal (caar project-alist) vhdl-project)
15429                (setq pos (1- (match-beginning 1)))))
15430            (setq project-alist (cdr project-alist))))
15431        (when pos (goto-char pos)))
15432       (select-frame last-frame)
15433       (setq vhdl-speedbar-last-selected-project vhdl-project)))
15434   t)
15435
15436 (declare-function speedbar-position-cursor-on-line "speedbar" ())
15437
15438 (defun vhdl-speedbar-update-current-unit (&optional no-position always)
15439   "Highlight all design units that are contained in the current file.
15440 NO-POSITION non-nil means do not re-position cursor."
15441   (let ((last-frame (selected-frame))
15442         (project-list vhdl-speedbar-shown-project-list)
15443         file-alist pos file-name)
15444     ;; get current file name
15445     (if (fboundp 'speedbar-select-attached-frame)
15446         (speedbar-select-attached-frame)
15447       (select-frame speedbar-attached-frame))
15448     (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
15449     (when (and vhdl-speedbar-update-current-unit
15450                (or always (not (equal file-name speedbar-last-selected-file))))
15451       (if vhdl-speedbar-show-projects
15452           (while project-list
15453             (setq file-alist (append file-alist
15454                                      (vhdl-aget vhdl-file-alist
15455                                                 (car project-list))))
15456             (setq project-list (cdr project-list)))
15457         (setq file-alist
15458               (vhdl-aget vhdl-file-alist
15459                          (abbreviate-file-name default-directory))))
15460       (select-frame speedbar-frame)
15461       (set-buffer speedbar-buffer)
15462       (speedbar-with-writable
15463        (vhdl-prepare-search-1
15464         (save-excursion
15465           ;; unhighlight last units
15466           (let* ((file-entry (vhdl-aget file-alist
15467                                         speedbar-last-selected-file)))
15468             (vhdl-speedbar-update-units
15469              "\\[.] " (nth 0 file-entry)
15470              speedbar-last-selected-file 'vhdl-speedbar-entity-face)
15471             (vhdl-speedbar-update-units
15472              "{.} " (nth 1 file-entry)
15473              speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
15474             (vhdl-speedbar-update-units
15475              "\\[.] " (nth 3 file-entry)
15476              speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
15477             (vhdl-speedbar-update-units
15478              "[]>] " (nth 4 file-entry)
15479              speedbar-last-selected-file 'vhdl-speedbar-package-face)
15480             (vhdl-speedbar-update-units
15481              "\\[.].+(" '("body")
15482              speedbar-last-selected-file 'vhdl-speedbar-package-face)
15483             (vhdl-speedbar-update-units
15484              "> " (nth 6 file-entry)
15485              speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
15486           ;; highlight current units
15487           (let* ((file-entry (vhdl-aget file-alist file-name)))
15488             (setq
15489              pos (vhdl-speedbar-update-units
15490                   "\\[.] " (nth 0 file-entry)
15491                   file-name 'vhdl-speedbar-entity-selected-face pos)
15492              pos (vhdl-speedbar-update-units
15493                   "{.} " (nth 1 file-entry)
15494                   file-name 'vhdl-speedbar-architecture-selected-face pos)
15495              pos (vhdl-speedbar-update-units
15496                   "\\[.] " (nth 3 file-entry)
15497                   file-name 'vhdl-speedbar-configuration-selected-face pos)
15498              pos (vhdl-speedbar-update-units
15499                   "[]>] " (nth 4 file-entry)
15500                   file-name 'vhdl-speedbar-package-selected-face pos)
15501              pos (vhdl-speedbar-update-units
15502                   "\\[.].+(" '("body")
15503                   file-name 'vhdl-speedbar-package-selected-face pos)
15504              pos (vhdl-speedbar-update-units
15505                   "> " (nth 6 file-entry)
15506                   file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
15507       ;; move speedbar so the first highlighted unit is visible
15508       (when (and pos (not no-position))
15509         (goto-char pos)
15510         (speedbar-center-buffer-smartly)
15511         (speedbar-position-cursor-on-line))
15512       (setq speedbar-last-selected-file file-name))
15513     (select-frame last-frame)
15514     t))
15515
15516 (defun vhdl-speedbar-update-units (text unit-list file-name face
15517                                         &optional pos)
15518   "Help function to highlight design units."
15519   (while unit-list
15520     (goto-char (point-min))
15521     (while (re-search-forward
15522             (concat text "\\(" (car unit-list) "\\)\\>") nil t)
15523       (when (equal file-name (car (get-text-property
15524                                    (match-beginning 1) 'speedbar-token)))
15525         (setq pos (or pos (point-marker)))
15526         (put-text-property (match-beginning 1) (match-end 1) 'face face)))
15527     (setq unit-list (cdr unit-list)))
15528   pos)
15529
15530 (declare-function speedbar-make-button "speedbar"
15531                   (start end face mouse function &optional token))
15532
15533 (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
15534                                                ent-name ent-file-marker
15535                                                arch-name arch-file-marker
15536                                                conf-name conf-file-marker
15537                                                lib-name depth offset delimiter)
15538   "Insert instantiation entry."
15539   (let ((start (point))
15540         visible-start)
15541     (insert (int-to-string depth) ":")
15542     (put-text-property start (point) 'invisible t)
15543     (setq visible-start (point))
15544     (insert-char ?  (* depth speedbar-indentation-width))
15545     (while (> offset 0)
15546       (insert "|")
15547       (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
15548       (setq offset (1- offset)))
15549     (put-text-property visible-start (point) 'invisible nil)
15550     (setq start (point))
15551     (insert ">")
15552     (speedbar-make-button start (point) nil nil nil)
15553     (setq visible-start (point))
15554     (insert " ")
15555     (setq start (point))
15556     (if (not inst-name)
15557         (insert "(top)")
15558       (insert inst-name)
15559       (speedbar-make-button
15560        start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
15561        'vhdl-speedbar-find-file inst-file-marker))
15562     (insert delimiter)
15563     (when ent-name
15564       (setq start (point))
15565       (insert ent-name)
15566       (speedbar-make-button
15567        start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
15568        'vhdl-speedbar-find-file ent-file-marker)
15569       (when arch-name
15570         (insert " (")
15571         (setq start (point))
15572         (insert arch-name)
15573         (speedbar-make-button
15574          start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
15575          'vhdl-speedbar-find-file arch-file-marker)
15576         (insert ")"))
15577       (when conf-name
15578         (insert " (")
15579         (setq start (point))
15580         (insert conf-name)
15581         (speedbar-make-button
15582          start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
15583          'vhdl-speedbar-find-file conf-file-marker)
15584         (insert ")")))
15585     (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
15586       (setq start (point))
15587       (insert " (" lib-name ")")
15588       (put-text-property (+ 2 start) (1- (point)) 'face
15589                          'vhdl-speedbar-library-face))
15590     (insert-char ?\n 1)
15591     (put-text-property visible-start (point) 'invisible nil)))
15592
15593 (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
15594                                               body-file-marker depth)
15595   "Insert package entry."
15596   (let ((start (point))
15597         visible-start)
15598     (insert (int-to-string depth) ":")
15599     (put-text-property start (point) 'invisible t)
15600     (setq visible-start (point))
15601     (insert-char ?  (* depth speedbar-indentation-width))
15602     (put-text-property visible-start (point) 'invisible nil)
15603     (setq start (point))
15604     (insert "[+]")
15605     (speedbar-make-button
15606      start (point) 'speedbar-button-face 'speedbar-highlight-face
15607      'vhdl-speedbar-expand-package pack-key)
15608     (setq visible-start (point))
15609     (insert-char ?  1 nil)
15610     (setq start (point))
15611     (insert pack-name)
15612     (speedbar-make-button
15613      start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15614      'vhdl-speedbar-find-file pack-file-marker)
15615     (unless (car pack-file-marker)
15616       (insert "!"))
15617     (when (car body-file-marker)
15618       (insert " (")
15619       (setq start (point))
15620       (insert "body")
15621       (speedbar-make-button
15622        start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15623        'vhdl-speedbar-find-file body-file-marker)
15624       (insert ")"))
15625     (insert-char ?\n 1)
15626     (put-text-property visible-start (point) 'invisible nil)))
15627
15628 (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
15629                                                   pack-body-file-marker depth)
15630   "Insert used package entry."
15631   (let ((start (point))
15632         visible-start)
15633     (insert (int-to-string depth) ":")
15634     (put-text-property start (point) 'invisible t)
15635     (setq visible-start (point))
15636     (insert-char ?  (* depth speedbar-indentation-width))
15637     (put-text-property visible-start (point) 'invisible nil)
15638     (setq start (point))
15639     (insert ">")
15640     (speedbar-make-button start (point) nil nil nil)
15641     (setq visible-start (point))
15642     (insert " ")
15643     (setq start (point))
15644     (insert pack-name)
15645     (speedbar-make-button
15646      start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15647      'vhdl-speedbar-find-file pack-file-marker)
15648     (when (car pack-body-file-marker)
15649       (insert " (")
15650       (setq start (point))
15651       (insert "body")
15652       (speedbar-make-button
15653        start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
15654        'vhdl-speedbar-find-file pack-body-file-marker)
15655       (insert ")"))
15656     (setq start (point))
15657     (insert " (" lib-name ")")
15658     (put-text-property (+ 2 start) (1- (point)) 'face
15659                        'vhdl-speedbar-library-face)
15660     (insert-char ?\n 1)
15661     (put-text-property visible-start (point) 'invisible nil)))
15662
15663 (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
15664                                                      func-body-file-marker
15665                                                      depth)
15666   "Insert subprogram entry."
15667   (let ((start (point))
15668         visible-start)
15669     (insert (int-to-string depth) ":")
15670     (put-text-property start (point) 'invisible t)
15671     (setq visible-start (point))
15672     (insert-char ?  (* depth speedbar-indentation-width))
15673     (put-text-property visible-start (point) 'invisible nil)
15674     (setq start (point))
15675     (insert ">")
15676     (speedbar-make-button start (point) nil nil nil)
15677     (setq visible-start (point))
15678     (insert " ")
15679     (setq start (point))
15680     (insert func-name)
15681     (speedbar-make-button
15682      start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15683      'vhdl-speedbar-find-file func-file-marker)
15684     (when (car func-body-file-marker)
15685       (insert " (")
15686       (setq start (point))
15687       (insert "body")
15688       (speedbar-make-button
15689        start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
15690        'vhdl-speedbar-find-file func-body-file-marker)
15691       (insert ")"))
15692     (insert-char ?\n 1)
15693     (put-text-property visible-start (point) 'invisible nil)))
15694
15695 (defun vhdl-speedbar-make-title-line (text &optional depth)
15696   "Insert design unit title entry."
15697   (let ((start (point))
15698         visible-start)
15699     (when depth
15700       (insert (int-to-string depth) ":")
15701       (put-text-property start (point) 'invisible t))
15702     (setq visible-start (point))
15703     (insert-char ?  (* (or depth 0) speedbar-indentation-width))
15704     (setq start (point))
15705     (insert text)
15706     (speedbar-make-button start (point) nil nil nil nil)
15707     (insert-char ?\n 1)
15708     (put-text-property visible-start (point) 'invisible nil)))
15709
15710 (defun vhdl-speedbar-insert-dirs (files level)
15711   "Insert subdirectories."
15712   (let ((dirs (car files)))
15713     (while dirs
15714       (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs)
15715                               (car dirs) 'speedbar-dir-follow nil
15716                               'speedbar-directory-face level)
15717       (setq dirs (cdr dirs)))))
15718
15719 (declare-function speedbar-reset-scanners "speedbar" ())
15720
15721 (defun vhdl-speedbar-dired (text token indent)
15722   "Speedbar click handler for directory expand button in hierarchy mode."
15723   (cond ((string-match "+" text)        ; we have to expand this dir
15724          (setq speedbar-shown-directories
15725                (cons (expand-file-name
15726                       (concat (speedbar-line-directory indent) token "/"))
15727                      speedbar-shown-directories))
15728          (speedbar-change-expand-button-char ?-)
15729          (speedbar-reset-scanners)
15730          (speedbar-with-writable
15731            (save-excursion
15732              (end-of-line) (forward-char 1)
15733              (vhdl-speedbar-insert-dirs
15734               (speedbar-file-lists
15735                (concat (speedbar-line-directory indent) token "/"))
15736               (1+ indent))
15737              (speedbar-reset-scanners)
15738              (vhdl-speedbar-insert-dir-hierarchy
15739               (abbreviate-file-name
15740                (concat (speedbar-line-directory indent) token "/"))
15741               (1+ indent) speedbar-power-click)))
15742          (vhdl-speedbar-update-current-unit t t))
15743         ((string-match "-" text)        ; we have to contract this node
15744          (speedbar-reset-scanners)
15745          (let ((oldl speedbar-shown-directories)
15746                (newl nil)
15747                (td (expand-file-name
15748                     (concat (speedbar-line-directory indent) token))))
15749            (while oldl
15750              (if (not (string-match (concat "^" (regexp-quote td)) (car oldl)))
15751                  (push (car oldl) newl))
15752              (setq oldl (cdr oldl)))
15753            (setq speedbar-shown-directories (nreverse newl)))
15754          (speedbar-change-expand-button-char ?+)
15755          (speedbar-delete-subblock indent))
15756         (t (error "Nothing to display")))
15757   (when (equal (selected-frame) speedbar-frame)
15758     (speedbar-center-buffer-smartly)))
15759
15760 (declare-function speedbar-files-item-info "speedbar" ())
15761
15762 (defun vhdl-speedbar-item-info ()
15763   "Derive and display information about this line item."
15764   (save-excursion
15765     (beginning-of-line)
15766     ;; skip invisible number info
15767     (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
15768     (cond
15769      ;; project/directory entry
15770      ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
15771       (if vhdl-speedbar-show-projects
15772           (message "Project \"%s\"" (match-string-no-properties 1))
15773         (speedbar-files-item-info)))
15774      ;; design unit entry
15775      ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
15776       (goto-char (match-end 1))
15777       (let ((face (get-text-property (point) 'face)))
15778         (message
15779          "%s \"%s\" in \"%s\""
15780          ;; design unit kind
15781          (cond ((or (eq face 'vhdl-speedbar-entity-face)
15782                     (eq face 'vhdl-speedbar-entity-selected-face))
15783                 (if (equal (match-string 2) ">") "Component" "Entity"))
15784                ((or (eq face 'vhdl-speedbar-architecture-face)
15785                     (eq face 'vhdl-speedbar-architecture-selected-face))
15786                 "Architecture")
15787                ((or (eq face 'vhdl-speedbar-configuration-face)
15788                     (eq face 'vhdl-speedbar-configuration-selected-face))
15789                 "Configuration")
15790                ((or (eq face 'vhdl-speedbar-package-face)
15791                     (eq face 'vhdl-speedbar-package-selected-face))
15792                 "Package")
15793                ((or (eq face 'vhdl-speedbar-instantiation-face)
15794                     (eq face 'vhdl-speedbar-instantiation-selected-face))
15795                 "Instantiation")
15796                ((eq face 'vhdl-speedbar-subprogram-face)
15797                 "Subprogram")
15798                (t ""))
15799          ;; design unit name
15800          (buffer-substring-no-properties
15801           (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
15802           (match-end 1))
15803          ;; file name
15804          (file-relative-name
15805           (or (car (get-text-property (point) 'speedbar-token))
15806               "?")
15807           (vhdl-default-directory)))))
15808      (t (message "")))))
15809
15810 (declare-function speedbar-line-text "speedbar" (&optional p))
15811
15812 (defun vhdl-speedbar-line-text ()
15813   "Calls `speedbar-line-text' and removes text properties."
15814   (let ((string (speedbar-line-text)))
15815     (set-text-properties 0 (length string) nil string)
15816     string))
15817
15818 (defun vhdl-speedbar-higher-text ()
15819   "Get speedbar-line-text of higher level."
15820   (let (depth string)
15821     (save-excursion
15822       (beginning-of-line)
15823       (looking-at "^\\([0-9]+\\):")
15824       (setq depth (string-to-number (match-string 1)))
15825       (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t)
15826         (setq string (match-string 1))
15827         (set-text-properties 0 (length string) nil string)
15828         string))))
15829
15830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15831 ;; Help functions
15832
15833 (defun vhdl-speedbar-line-key (&optional indent)
15834   "Get currently displayed directory of project name."
15835   (if vhdl-speedbar-show-projects
15836       (vhdl-speedbar-line-project)
15837     (abbreviate-file-name
15838      (file-name-as-directory (speedbar-line-directory indent)))))
15839
15840 (defun vhdl-speedbar-line-project (&optional indent)
15841   "Get currently displayed project name."
15842   (and vhdl-speedbar-show-projects
15843        (save-excursion
15844          (end-of-line)
15845          (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
15846          (match-string-no-properties 1))))
15847
15848 (defun vhdl-add-modified-file ()
15849   "Add file to `vhdl-modified-file-list'."
15850   (when vhdl-file-alist
15851     (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
15852   nil)
15853
15854 (defun vhdl-resolve-paths (path-list)
15855   "Resolve path wildcards in PATH-LIST."
15856   (let (path-list-1 path-list-2 path-beg path-end dir)
15857     ;; eliminate non-existent directories
15858     (while path-list
15859       (setq dir (car path-list))
15860       (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
15861       (if (file-directory-p (match-string 2 dir))
15862           (push dir path-list-1)
15863         (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
15864       (setq path-list (cdr path-list)))
15865     ;; resolve path wildcards
15866     (while path-list-1
15867       (setq dir (car path-list-1))
15868       (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
15869           (progn
15870             (setq path-beg (match-string 1 dir)
15871                   path-end (match-string 5 dir))
15872             (setq path-list-1
15873                   (append
15874                    (mapcar
15875                     (function
15876                      (lambda (var) (concat path-beg var path-end)))
15877                     (let ((all-list (vhdl-directory-files
15878                                      (match-string 2 dir) t
15879                                      (concat "\\<" (wildcard-to-regexp
15880                                                     (match-string 4 dir)))))
15881                           dir-list)
15882                       (while all-list
15883                         (when (file-directory-p (car all-list))
15884                           (push (car all-list) dir-list))
15885                         (setq all-list (cdr all-list)))
15886                       dir-list))
15887                    (cdr path-list-1))))
15888         (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
15889         (when (file-directory-p (match-string 2 dir))
15890           (push dir path-list-2))
15891         (setq path-list-1 (cdr path-list-1))))
15892     (nreverse path-list-2)))
15893
15894 (defun vhdl-speedbar-goto-this-unit (directory unit)
15895   "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
15896   (let ((dest (point)))
15897     (if (and (if vhdl-speedbar-show-projects
15898                  (progn (goto-char (point-min)) t)
15899                (speedbar-goto-this-file directory))
15900              (re-search-forward (concat "[]}] " unit "\\>") nil t))
15901         (progn (speedbar-position-cursor-on-line)
15902                t)
15903       (goto-char dest)
15904       nil)))
15905
15906 (declare-function speedbar-find-file-in-frame "speedbar" (file))
15907 (declare-function speedbar-set-timer "speedbar" (timeout))
15908 ;; speedbar loads dframe at runtime.
15909 (declare-function dframe-maybee-jump-to-attached-frame "dframe" ())
15910
15911 (defun vhdl-speedbar-find-file (text token indent)
15912   "When user clicks on TEXT, load file with name and position in TOKEN.
15913 Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
15914 is already shown in a buffer."
15915   (if (not (car token))
15916       (error "ERROR:  File cannot be found")
15917     (let ((buffer (get-file-buffer (car token))))
15918       (speedbar-find-file-in-frame (car token))
15919       (when (or vhdl-speedbar-jump-to-unit buffer)
15920         (goto-char (point-min))
15921         (forward-line (1- (cdr token)))
15922         (recenter))
15923       (vhdl-speedbar-update-current-unit t t)
15924       (speedbar-set-timer dframe-update-speed)
15925       (dframe-maybee-jump-to-attached-frame))))
15926
15927 (defun vhdl-speedbar-port-copy ()
15928   "Copy the port of the entity/component or subprogram under the cursor."
15929   (interactive)
15930   (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
15931     (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
15932         (error "ERROR:  No entity/component or subprogram under cursor")
15933       (beginning-of-line)
15934       (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
15935           (condition-case info
15936               (let ((token (get-text-property
15937                             (match-beginning 3) 'speedbar-token)))
15938                 (vhdl-visit-file (car token) t
15939                                  (progn (goto-char (point-min))
15940                                         (forward-line (1- (cdr token)))
15941                                         (end-of-line)
15942                                         (if is-entity
15943                                             (vhdl-port-copy)
15944                                           (vhdl-subprog-copy)))))
15945             (error (error "ERROR:  %s not scanned successfully\n  (%s)"
15946                           (if is-entity "Port" "Interface") (cadr info))))
15947         (error "ERROR:  No entity/component or subprogram on current line")))))
15948
15949 (defun vhdl-speedbar-place-component ()
15950   "Place the entity/component under the cursor as component."
15951   (interactive)
15952   (if (not (vhdl-speedbar-check-unit 'entity))
15953       (error "ERROR:  No entity/component under cursor")
15954     (vhdl-speedbar-port-copy)
15955     (if (fboundp 'speedbar-select-attached-frame)
15956         (speedbar-select-attached-frame)
15957       (select-frame speedbar-attached-frame))
15958     (vhdl-compose-place-component)
15959     (select-frame speedbar-frame)))
15960
15961 (defun vhdl-speedbar-configuration ()
15962   "Generate configuration for the architecture under the cursor."
15963   (interactive)
15964   (if (not (vhdl-speedbar-check-unit 'architecture))
15965       (error "ERROR:  No architecture under cursor")
15966     (let ((arch-name (vhdl-speedbar-line-text))
15967           (ent-name (vhdl-speedbar-higher-text)))
15968       (if (fboundp 'speedbar-select-attached-frame)
15969           (speedbar-select-attached-frame)
15970         (select-frame speedbar-attached-frame))
15971       (vhdl-compose-configuration ent-name arch-name))))
15972
15973 (defun vhdl-speedbar-select-mra ()
15974   "Select the architecture under the cursor as MRA."
15975   (interactive)
15976   (if (not (vhdl-speedbar-check-unit 'architecture))
15977       (error "ERROR:  No architecture under cursor")
15978     (let* ((arch-key (downcase (vhdl-speedbar-line-text)))
15979            (ent-key (downcase (vhdl-speedbar-higher-text)))
15980            (ent-alist (vhdl-aget
15981                        vhdl-entity-alist
15982                        (or (vhdl-project-p)
15983                            (abbreviate-file-name default-directory))))
15984            (ent-entry (vhdl-aget ent-alist ent-key)))
15985       (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry)
15986       (speedbar-refresh))))
15987
15988 (declare-function speedbar-line-file "speedbar" (&optional p))
15989
15990 (defun vhdl-speedbar-make-design ()
15991   "Make (compile) design unit or directory/project under the cursor."
15992   (interactive)
15993   (if (not (save-excursion (beginning-of-line)
15994                            (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
15995       (error "ERROR:  No primary design unit or directory/project under cursor")
15996     (let ((is-unit (match-string 2))
15997           (unit-name (vhdl-speedbar-line-text))
15998           (vhdl-project (vhdl-speedbar-line-project))
15999           (directory (file-name-as-directory
16000                       (or (speedbar-line-file) (speedbar-line-directory)))))
16001       (if (fboundp 'speedbar-select-attached-frame)
16002           (speedbar-select-attached-frame)
16003         (select-frame speedbar-attached-frame))
16004       (let ((default-directory directory))
16005         (vhdl-make (and is-unit unit-name))))))
16006
16007 (defun vhdl-speedbar-generate-makefile ()
16008   "Generate Makefile for directory/project under the cursor."
16009   (interactive)
16010   (let ((vhdl-project (vhdl-speedbar-line-project))
16011         (default-directory (file-name-as-directory
16012                             (or (speedbar-line-file) (speedbar-line-directory)))))
16013     (vhdl-generate-makefile)))
16014
16015 (defun vhdl-speedbar-check-unit (design-unit)
16016   "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
16017 expansion function)."
16018     (save-excursion
16019       (speedbar-position-cursor-on-line)
16020       (cond ((eq design-unit 'entity)
16021              (memq (get-text-property (match-end 0) 'face)
16022                    '(vhdl-speedbar-entity-face
16023                      vhdl-speedbar-entity-selected-face)))
16024             ((eq design-unit 'architecture)
16025              (memq (get-text-property (match-end 0) 'face)
16026                    '(vhdl-speedbar-architecture-face
16027                      vhdl-speedbar-architecture-selected-face)))
16028             ((eq design-unit 'subprogram)
16029              (eq (get-text-property (match-end 0) 'face)
16030                  'vhdl-speedbar-subprogram-face))
16031             (t nil))))
16032
16033 (defun vhdl-speedbar-set-depth (depth)
16034   "Set hierarchy display depth to DEPTH and refresh speedbar."
16035   (setq vhdl-speedbar-hierarchy-depth depth)
16036   (speedbar-refresh))
16037
16038 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16039 ;; Fontification
16040
16041 (defface vhdl-speedbar-entity-face
16042   '((((class color) (background light)) (:foreground "ForestGreen"))
16043     (((class color) (background dark)) (:foreground "PaleGreen")))
16044   "Face used for displaying entity names."
16045   :group 'speedbar-faces)
16046
16047 (defface vhdl-speedbar-architecture-face
16048   '((((min-colors 88) (class color) (background light)) (:foreground "Blue1"))
16049     (((class color) (background light)) (:foreground "Blue"))
16050
16051     (((class color) (background dark)) (:foreground "LightSkyBlue")))
16052   "Face used for displaying architecture names."
16053   :group 'speedbar-faces)
16054
16055 (defface vhdl-speedbar-configuration-face
16056   '((((class color) (background light)) (:foreground "DarkGoldenrod"))
16057     (((class color) (background dark)) (:foreground "Salmon")))
16058   "Face used for displaying configuration names."
16059   :group 'speedbar-faces)
16060
16061 (defface vhdl-speedbar-package-face
16062   '((((class color) (background light)) (:foreground "Grey50"))
16063     (((class color) (background dark)) (:foreground "Grey80")))
16064   "Face used for displaying package names."
16065   :group 'speedbar-faces)
16066
16067 (defface vhdl-speedbar-library-face
16068   '((((class color) (background light)) (:foreground "Purple"))
16069     (((class color) (background dark)) (:foreground "Orchid1")))
16070   "Face used for displaying library names."
16071   :group 'speedbar-faces)
16072
16073 (defface vhdl-speedbar-instantiation-face
16074   '((((class color) (background light)) (:foreground "Brown"))
16075     (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1"))
16076     (((class color) (background dark)) (:foreground "Yellow")))
16077   "Face used for displaying instantiation names."
16078   :group 'speedbar-faces)
16079
16080 (defface vhdl-speedbar-subprogram-face
16081   '((((class color) (background light)) (:foreground "Orchid4"))
16082     (((class color) (background dark)) (:foreground "BurlyWood2")))
16083   "Face used for displaying subprogram names."
16084   :group 'speedbar-faces)
16085
16086 (defface vhdl-speedbar-entity-selected-face
16087   '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
16088     (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
16089   "Face used for displaying entity names."
16090   :group 'speedbar-faces)
16091
16092 (defface vhdl-speedbar-architecture-selected-face
16093   '((((min-colors 88) (class color) (background light)) (:foreground
16094   "Blue1" :underline t))
16095     (((class color) (background light)) (:foreground "Blue" :underline t))
16096     (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t)))
16097   "Face used for displaying architecture names."
16098   :group 'speedbar-faces)
16099
16100 (defface vhdl-speedbar-configuration-selected-face
16101   '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t))
16102     (((class color) (background dark)) (:foreground "Salmon" :underline t)))
16103   "Face used for displaying configuration names."
16104   :group 'speedbar-faces)
16105
16106 (defface vhdl-speedbar-package-selected-face
16107   '((((class color) (background light)) (:foreground "Grey50" :underline t))
16108     (((class color) (background dark)) (:foreground "Grey80" :underline t)))
16109   "Face used for displaying package names."
16110   :group 'speedbar-faces)
16111
16112 (defface vhdl-speedbar-instantiation-selected-face
16113   '((((class color) (background light)) (:foreground "Brown" :underline t))
16114     (((class color) (background dark)) (:foreground "Yellow" :underline t)))
16115   "Face used for displaying instantiation names."
16116   :group 'speedbar-faces)
16117
16118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16119 ;; Initialization
16120
16121 ;; add speedbar
16122 (when (fboundp 'speedbar)
16123   (let ((current-frame (selected-frame)))
16124     (condition-case ()
16125         (when (and vhdl-speedbar-auto-open
16126                    (not (and (boundp 'speedbar-frame)
16127                              (frame-live-p speedbar-frame))))
16128           (speedbar-frame-mode 1))
16129       (error (vhdl-warning-when-idle "ERROR:  An error occurred while opening speedbar")))
16130     (select-frame current-frame)))
16131
16132 ;; initialize speedbar
16133 (if (not (boundp 'speedbar-frame))
16134     (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
16135   (vhdl-speedbar-initialize)
16136   (when speedbar-frame (vhdl-speedbar-refresh)))
16137
16138
16139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16140 ;;; Structural composition
16141 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16142
16143 (defun vhdl-get-components-package-name ()
16144   "Return the name of the components package."
16145   (let ((project (vhdl-project-p)))
16146     (if project
16147         (vhdl-replace-string (car vhdl-components-package-name)
16148                              (subst-char-in-string ?  ?_ project))
16149       (cdr vhdl-components-package-name))))
16150
16151 (defun vhdl-compose-new-component ()
16152   "Create entity and architecture for new component."
16153   (interactive)
16154   (let* ((case-fold-search t)
16155          (ent-name (read-from-minibuffer "entity name: "
16156                                          nil vhdl-minibuffer-local-map))
16157          (arch-name
16158           (if (equal (cdr vhdl-compose-architecture-name) "")
16159               (read-from-minibuffer "architecture name: "
16160                                     nil vhdl-minibuffer-local-map)
16161             (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
16162          ent-file-name arch-file-name ent-buffer arch-buffer project end-pos)
16163     (message "Creating component \"%s(%s)\"..." ent-name arch-name)
16164     ;; open entity file
16165     (unless (eq vhdl-compose-create-files 'none)
16166       (setq ent-file-name
16167             (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16168                     "." (file-name-extension (buffer-file-name))))
16169       (when (and (file-exists-p ent-file-name)
16170                  (not (y-or-n-p (concat "File \"" ent-file-name
16171                                         "\" exists; overwrite? "))))
16172         (error "ERROR:  Creating component...aborted"))
16173       (find-file ent-file-name)
16174       (erase-buffer)
16175       (set-buffer-modified-p nil))
16176     ;; insert header
16177     (if vhdl-compose-include-header
16178         (progn (vhdl-template-header)
16179                (setq end-pos (point))
16180                (goto-char (point-max)))
16181       (vhdl-comment-display-line) (insert "\n\n"))
16182     ;; insert library clause
16183     (vhdl-template-package-std-logic-1164)
16184     (when vhdl-use-components-package
16185       (insert "\n")
16186       (vhdl-template-standard-package (vhdl-work-library)
16187                                       (vhdl-get-components-package-name)))
16188     (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
16189     ;; insert entity declaration
16190     (vhdl-insert-keyword "ENTITY ") (insert ent-name)
16191     (vhdl-insert-keyword " IS\n")
16192     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16193     (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
16194     (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16195     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16196     (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
16197     (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
16198     (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
16199     (vhdl-insert-keyword "END ")
16200     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
16201     (insert ent-name ";\n\n")
16202     (vhdl-comment-display-line) (insert "\n")
16203     ;; open architecture file
16204     (if (not (eq vhdl-compose-create-files 'separate))
16205         (insert "\n")
16206       (goto-char (or end-pos (point-min)))
16207       (setq ent-buffer (current-buffer))
16208       (setq arch-file-name
16209             (concat (vhdl-replace-string vhdl-architecture-file-name
16210                                          (concat ent-name " " arch-name) t)
16211                     "." (file-name-extension (buffer-file-name))))
16212       (when (and (file-exists-p arch-file-name)
16213                  (not (y-or-n-p (concat "File \"" arch-file-name
16214                                         "\" exists; overwrite? "))))
16215         (error "ERROR:  Creating component...aborted"))
16216       (find-file arch-file-name)
16217       (erase-buffer)
16218       (set-buffer-modified-p nil)
16219       ;; insert header
16220       (if vhdl-compose-include-header
16221           (progn (vhdl-template-header)
16222                  (goto-char (point-max)))
16223         (vhdl-comment-display-line) (insert "\n\n")))
16224     ;; insert architecture body
16225     (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
16226     (vhdl-insert-keyword " OF ") (insert ent-name)
16227     (vhdl-insert-keyword " IS\n\n")
16228     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16229     (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
16230     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16231     (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
16232       (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16233       (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16234       (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
16235     (vhdl-insert-keyword "BEGIN")
16236     (when vhdl-self-insert-comments
16237       (insert "  -- ")
16238       (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16239       (insert arch-name))
16240     (insert "\n\n")
16241     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16242     (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
16243     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16244     (vhdl-insert-keyword "END ")
16245     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
16246     (insert arch-name ";\n\n")
16247     ;; insert footer and save
16248     (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16249         (vhdl-template-footer)
16250       (vhdl-comment-display-line) (insert "\n"))
16251     (goto-char (or end-pos (point-min)))
16252     (setq arch-buffer (current-buffer))
16253     (when ent-buffer (set-buffer ent-buffer) (save-buffer))
16254     (set-buffer arch-buffer) (save-buffer)
16255     (message "%s"
16256      (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
16257              (and ent-file-name
16258                   (format "\n  File created: \"%s\"" ent-file-name))
16259              (and arch-file-name
16260                   (format "\n  File created: \"%s\"" arch-file-name))))))
16261
16262 (defun vhdl-compose-place-component ()
16263   "Place new component by pasting current port as component declaration and
16264 component instantiation."
16265   (interactive)
16266   (if (not vhdl-port-list)
16267       (error "ERROR:  No port has been read")
16268     (save-excursion
16269       (vhdl-prepare-search-2
16270        (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)
16271                    (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))
16272          (error "ERROR:  No architecture found"))
16273        (let* ((ent-name (match-string 1))
16274               (ent-file-name
16275                (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16276                        "." (file-name-extension (buffer-file-name))))
16277               (orig-buffer (current-buffer)))
16278          (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
16279          ;; place component declaration
16280          (unless (or vhdl-use-components-package
16281                      (vhdl-use-direct-instantiation)
16282                      (save-excursion
16283                        (re-search-forward
16284                         (concat "^\\s-*component\\s-+"
16285                                 (car vhdl-port-list) "\\>") nil t)))
16286            (re-search-forward "^begin\\>" nil)
16287            (beginning-of-line)
16288            (skip-chars-backward " \t\n\r\f")
16289            (insert "\n\n") (indent-to vhdl-basic-offset)
16290            (vhdl-port-paste-component t))
16291          ;; place component instantiation
16292          (re-search-forward "^end\\>" nil)
16293          (beginning-of-line)
16294          (skip-chars-backward " \t\n\r\f")
16295          (insert "\n\n") (indent-to vhdl-basic-offset)
16296          (vhdl-port-paste-instance nil t t)
16297          ;; place use clause for used packages
16298          (when (nth 3 vhdl-port-list)
16299            ;; open entity file
16300            (when (file-exists-p ent-file-name)
16301              (find-file ent-file-name))
16302            (goto-char (point-min))
16303            (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16304              (error "ERROR:  Entity not found: \"%s\"" ent-name))
16305            (goto-char (match-beginning 0))
16306            (if (and (save-excursion
16307                       (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
16308                     (match-string 1))
16309                (progn (goto-char (match-end 0))
16310                       (beginning-of-line 2))
16311              (insert "\n")
16312              (backward-char))
16313            (vhdl-port-paste-context-clause)
16314            (switch-to-buffer orig-buffer))
16315          (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
16316
16317 (defun vhdl-compose-wire-components ()
16318   "Connect components."
16319   (interactive)
16320   (save-excursion
16321     (vhdl-prepare-search-2
16322      (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)
16323                  (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))
16324        (error "ERROR:  No architecture found"))
16325      (let* ((ent-name (match-string 1))
16326             (ent-file-name
16327              (concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
16328                      "." (file-name-extension (buffer-file-name))))
16329             (arch-decl-pos (point-marker))
16330             (arch-stat-pos (re-search-forward "^begin\\>" nil))
16331             (arch-end-pos (re-search-forward "^end\\>" nil))
16332             (pack-name (vhdl-get-components-package-name))
16333             (pack-file-name
16334              (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16335                      "." (file-name-extension (buffer-file-name))))
16336             inst-name comp-name comp-ent-name comp-ent-file-name has-generic
16337             port-alist generic-alist inst-alist
16338             signal-name signal-entry signal-alist local-list written-list
16339             single-in-list multi-in-list single-out-list multi-out-list
16340             constant-name constant-entry constant-alist single-list multi-list
16341             port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
16342             generic-beg-pos generic-pos generic-inst-pos generic-end-pos
16343             signal-beg-pos signal-pos
16344             constant-temp-pos port-temp-pos signal-temp-pos)
16345        (message "Wiring components...")
16346        ;; process all instances
16347        (goto-char arch-stat-pos)
16348        (while (re-search-forward
16349                (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
16350                        "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
16351                        "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
16352                        "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
16353                        "[ \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)
16354          (setq inst-name (match-string-no-properties 1)
16355                comp-name (match-string-no-properties 4)
16356                comp-ent-name (match-string-no-properties 12)
16357                has-generic (or (match-string 7) (match-string 17)))
16358          ;; get port ...
16359          (if comp-name
16360              ;; ... from component declaration
16361              (vhdl-visit-file
16362               (when vhdl-use-components-package pack-file-name) t
16363               (save-excursion
16364                 (goto-char (point-min))
16365                 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
16366                   (error "ERROR:  Component declaration not found: \"%s\"" comp-name))
16367                 (vhdl-port-copy)))
16368            ;; ... from entity declaration (direct instantiation)
16369            (setq comp-ent-file-name
16370                  (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
16371                          "." (file-name-extension (buffer-file-name))))
16372            (vhdl-visit-file
16373             comp-ent-file-name t
16374             (save-excursion
16375               (goto-char (point-min))
16376               (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
16377                 (error "ERROR:  Entity declaration not found: \"%s\"" comp-ent-name))
16378               (vhdl-port-copy))))
16379          (vhdl-port-flatten t)
16380          (setq generic-alist (nth 1 vhdl-port-list)
16381                port-alist (nth 2 vhdl-port-list)
16382                vhdl-port-list nil)
16383          (setq constant-alist nil
16384                signal-alist nil)
16385          (when has-generic
16386            ;; process all constants in generic map
16387            (vhdl-forward-syntactic-ws)
16388            (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16389              (setq constant-name (match-string-no-properties 3))
16390              (setq constant-entry
16391                    (cons constant-name
16392                          (if (match-string 1)
16393                              (or (vhdl-aget generic-alist (match-string 2))
16394                                  (error "ERROR:  Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16395                            (cdar generic-alist))))
16396              (push constant-entry constant-alist)
16397              (setq constant-name (downcase constant-name))
16398              (if (or (member constant-name single-list)
16399                      (member constant-name multi-list))
16400                  (progn (setq single-list (delete constant-name single-list))
16401                         (add-to-list 'multi-list constant-name))
16402                (add-to-list 'single-list constant-name))
16403              (unless (match-string 1)
16404                (setq generic-alist (cdr generic-alist)))
16405              (vhdl-forward-syntactic-ws))
16406            (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
16407          ;; process all signals in port map
16408          (vhdl-forward-syntactic-ws)
16409          (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
16410            (setq signal-name (match-string-no-properties 3))
16411            (setq signal-entry
16412                  (cons signal-name
16413                        (if (match-string 1)
16414                            (or (vhdl-aget port-alist (match-string 2))
16415                                (error "ERROR:  Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
16416                          (cdar port-alist))))
16417            (push signal-entry signal-alist)
16418            (setq signal-name (downcase signal-name))
16419            (if (equal (upcase (nth 2 signal-entry)) "IN")
16420                ;; input signal
16421                (cond
16422                 ((member signal-name local-list)
16423                  nil)
16424                 ((or (member signal-name single-out-list)
16425                      (member signal-name multi-out-list))
16426                  (setq single-out-list (delete signal-name single-out-list))
16427                  (setq multi-out-list (delete signal-name multi-out-list))
16428                  (add-to-list 'local-list signal-name))
16429                 ((member signal-name single-in-list)
16430                  (setq single-in-list (delete signal-name single-in-list))
16431                  (add-to-list 'multi-in-list signal-name))
16432                 ((not (member signal-name multi-in-list))
16433                  (add-to-list 'single-in-list signal-name)))
16434              ;; output signal
16435              (cond
16436               ((member signal-name local-list)
16437                nil)
16438               ((or (member signal-name single-in-list)
16439                    (member signal-name multi-in-list))
16440                (setq single-in-list (delete signal-name single-in-list))
16441                (setq multi-in-list (delete signal-name multi-in-list))
16442                (add-to-list 'local-list signal-name))
16443               ((member signal-name single-out-list)
16444                (setq single-out-list (delete signal-name single-out-list))
16445                (add-to-list 'multi-out-list signal-name))
16446               ((not (member signal-name multi-out-list))
16447                (add-to-list 'single-out-list signal-name))))
16448            (unless (match-string 1)
16449              (setq port-alist (cdr port-alist)))
16450            (vhdl-forward-syntactic-ws))
16451          (push (list inst-name (nreverse constant-alist)
16452                      (nreverse signal-alist)) inst-alist))
16453        ;; prepare signal insertion
16454        (vhdl-goto-marker arch-decl-pos)
16455        (forward-line 1)
16456        (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
16457        (setq signal-pos (point-marker))
16458        (while (progn (vhdl-forward-syntactic-ws)
16459                      (looking-at "signal\\>"))
16460          (beginning-of-line 2)
16461          (delete-region signal-pos (point)))
16462        (setq signal-beg-pos signal-pos)
16463        ;; open entity file
16464        (when (file-exists-p ent-file-name)
16465          (find-file ent-file-name))
16466        (goto-char (point-min))
16467        (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
16468          (error "ERROR:  Entity not found: \"%s\"" ent-name))
16469        ;; prepare generic clause insertion
16470        (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16471                     (match-string 1))
16472          (goto-char (match-beginning 0))
16473          (indent-to vhdl-basic-offset)
16474          (insert "generic ();\n\n")
16475          (backward-char 4))
16476        (backward-char)
16477        (setq generic-pos (point-marker))
16478        (forward-sexp) (end-of-line)
16479        (delete-region generic-pos (point)) (delete-char 1)
16480        (insert "(\n")
16481        (when multi-list
16482          (insert "\n")
16483          (indent-to (* 2 vhdl-basic-offset))
16484          (insert "-- global generics\n"))
16485        (setq generic-beg-pos (point-marker) generic-pos (point-marker)
16486              generic-inst-pos (point-marker) generic-end-pos (point-marker))
16487        ;; prepare port clause insertion
16488        (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
16489                     (match-string 1))
16490          (goto-char (match-beginning 0))
16491          (indent-to vhdl-basic-offset)
16492          (insert "port ();\n\n")
16493          (backward-char 4))
16494        (backward-char)
16495        (setq port-in-pos (point-marker))
16496        (forward-sexp) (end-of-line)
16497        (delete-region port-in-pos (point)) (delete-char 1)
16498        (insert "(\n")
16499        (when (or multi-in-list multi-out-list)
16500          (insert "\n")
16501          (indent-to (* 2 vhdl-basic-offset))
16502          (insert "-- global ports\n"))
16503        (setq port-beg-pos (point-marker) port-in-pos (point-marker)
16504              port-out-pos (point-marker) port-inst-pos (point-marker)
16505              port-end-pos (point-marker))
16506        ;; insert generics, ports and signals
16507        (setq inst-alist (nreverse inst-alist))
16508        (while inst-alist
16509          (setq inst-name (nth 0 (car inst-alist))
16510                constant-alist (nth 1 (car inst-alist))
16511                signal-alist (nth 2 (car inst-alist))
16512                constant-temp-pos generic-inst-pos
16513                port-temp-pos port-inst-pos
16514                signal-temp-pos signal-pos)
16515          ;; generics
16516          (while constant-alist
16517            (setq constant-name (downcase (caar constant-alist))
16518                  constant-entry (car constant-alist))
16519            (unless (string-match "^[0-9]+" constant-name)
16520            (cond ((member constant-name written-list)
16521                   nil)
16522                  ((member constant-name multi-list)
16523                   (vhdl-goto-marker generic-pos)
16524                   (setq generic-end-pos
16525                         (vhdl-max-marker
16526                          generic-end-pos
16527                          (vhdl-compose-insert-generic constant-entry)))
16528                   (setq generic-pos (point-marker))
16529                   (add-to-list 'written-list constant-name))
16530                  (t
16531                   (vhdl-goto-marker
16532                    (vhdl-max-marker generic-inst-pos generic-pos))
16533                   (setq generic-end-pos
16534                         (vhdl-compose-insert-generic constant-entry))
16535                   (setq generic-inst-pos (point-marker))
16536                     (add-to-list 'written-list constant-name))))
16537            (setq constant-alist (cdr constant-alist)))
16538          (when (/= constant-temp-pos generic-inst-pos)
16539            (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
16540            (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16541            (insert "-- generics for \"" inst-name "\"\n")
16542            (vhdl-goto-marker generic-inst-pos))
16543          ;; ports and signals
16544          (while signal-alist
16545            (setq signal-name (downcase (caar signal-alist))
16546                  signal-entry (car signal-alist))
16547            (cond ((member signal-name written-list)
16548                   nil)
16549                  ((member signal-name multi-in-list)
16550                   (vhdl-goto-marker 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-in-pos (point-marker))
16555                   (add-to-list 'written-list signal-name))
16556                  ((member signal-name multi-out-list)
16557                   (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
16558                   (setq port-end-pos
16559                         (vhdl-max-marker
16560                          port-end-pos (vhdl-compose-insert-port signal-entry)))
16561                   (setq port-out-pos (point-marker))
16562                   (add-to-list 'written-list signal-name))
16563                  ((or (member signal-name single-in-list)
16564                       (member signal-name single-out-list))
16565                   (vhdl-goto-marker
16566                    (vhdl-max-marker
16567                     port-inst-pos
16568                     (vhdl-max-marker port-out-pos port-in-pos)))
16569                   (setq port-end-pos (vhdl-compose-insert-port signal-entry))
16570                   (setq port-inst-pos (point-marker))
16571                   (add-to-list 'written-list signal-name))
16572                  ((equal (upcase (nth 2 signal-entry)) "OUT")
16573                   (vhdl-goto-marker signal-pos)
16574                   (vhdl-compose-insert-signal signal-entry)
16575                   (setq signal-pos (point-marker))
16576                   (add-to-list 'written-list signal-name)))
16577            (setq signal-alist (cdr signal-alist)))
16578          (when (/= port-temp-pos port-inst-pos)
16579            (vhdl-goto-marker
16580             (vhdl-max-marker port-temp-pos
16581                              (vhdl-max-marker port-in-pos port-out-pos)))
16582            (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16583            (insert "-- ports to \"" inst-name "\"\n")
16584            (vhdl-goto-marker port-inst-pos))
16585          (when (/= signal-temp-pos signal-pos)
16586            (vhdl-goto-marker signal-temp-pos)
16587            (insert "\n") (indent-to vhdl-basic-offset)
16588            (insert "-- outputs of \"" inst-name "\"\n")
16589            (vhdl-goto-marker signal-pos))
16590          (setq inst-alist (cdr inst-alist)))
16591        ;; finalize generic/port clause
16592        (vhdl-goto-marker generic-end-pos) (backward-char)
16593        (when (= generic-beg-pos generic-end-pos)
16594          (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16595          (insert ";") (backward-char))
16596        (insert ")")
16597        (vhdl-goto-marker port-end-pos) (backward-char)
16598        (when (= port-beg-pos port-end-pos)
16599          (insert "\n") (indent-to (* 2 vhdl-basic-offset))
16600          (insert ";") (backward-char))
16601        (insert ")")
16602        ;; align everything
16603        (when vhdl-auto-align
16604          (vhdl-goto-marker generic-beg-pos)
16605          (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
16606          (vhdl-align-region-groups port-beg-pos port-end-pos 1)
16607          (vhdl-goto-marker signal-beg-pos)
16608          (vhdl-align-region-groups signal-beg-pos signal-pos))
16609        (switch-to-buffer (marker-buffer signal-beg-pos))
16610        (message "Wiring components...done")))))
16611
16612 (defun vhdl-compose-insert-generic (entry)
16613   "Insert ENTRY as generic declaration."
16614   (let (pos)
16615     (indent-to (* 2 vhdl-basic-offset))
16616     (insert (nth 0 entry) " : " (nth 1 entry))
16617     (when (nth 2 entry)
16618       (insert " := " (nth 2 entry)))
16619     (insert ";")
16620     (setq pos (point-marker))
16621     (when (and vhdl-include-port-comments (nth 3 entry))
16622       (vhdl-comment-insert-inline (nth 3 entry) t))
16623     (insert "\n")
16624     pos))
16625
16626 (defun vhdl-compose-insert-port (entry)
16627   "Insert ENTRY as port declaration."
16628   (let (pos)
16629     (indent-to (* 2 vhdl-basic-offset))
16630     (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
16631     (setq pos (point-marker))
16632     (when (and vhdl-include-port-comments (nth 4 entry))
16633       (vhdl-comment-insert-inline (nth 4 entry) t))
16634     (insert "\n")
16635     pos))
16636
16637 (defun vhdl-compose-insert-signal (entry)
16638   "Insert ENTRY as signal declaration."
16639   (indent-to vhdl-basic-offset)
16640   (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
16641   (when (and vhdl-include-port-comments (nth 4 entry))
16642     (vhdl-comment-insert-inline (nth 4 entry) t))
16643   (insert "\n"))
16644
16645 (defun vhdl-compose-components-package ()
16646   "Generate a package containing component declarations for all entities in the
16647 current project/directory."
16648   (interactive)
16649   (vhdl-require-hierarchy-info)
16650   (let* ((project (vhdl-project-p))
16651          (pack-name (vhdl-get-components-package-name))
16652          (pack-file-name
16653           (concat (vhdl-replace-string vhdl-package-file-name pack-name t)
16654                   "." (file-name-extension (buffer-file-name))))
16655          (ent-alist (vhdl-aget vhdl-entity-alist
16656                                (or project
16657                                    (abbreviate-file-name default-directory))))
16658          (lazy-lock-minimum-size 0)
16659          clause-pos component-pos)
16660     (message "Generating components package \"%s\"..." pack-name)
16661     ;; open package file
16662     (when (and (file-exists-p pack-file-name)
16663                (not (y-or-n-p (concat "File \"" pack-file-name
16664                                       "\" exists; overwrite? "))))
16665       (error "ERROR:  Generating components package...aborted"))
16666     (find-file pack-file-name)
16667     (erase-buffer)
16668     ;; insert header
16669     (if vhdl-compose-include-header
16670         (progn (vhdl-template-header
16671                 (concat "Components package (generated by Emacs VHDL Mode "
16672                         vhdl-version ")"))
16673                (goto-char (point-max)))
16674       (vhdl-comment-display-line) (insert "\n\n"))
16675     ;; insert std_logic_1164 package
16676     (vhdl-template-package-std-logic-1164)
16677     (insert "\n") (setq clause-pos (point-marker))
16678     (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
16679     ;; insert package declaration
16680     (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
16681     (vhdl-insert-keyword " IS\n\n")
16682     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
16683     (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
16684     (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
16685     (indent-to vhdl-basic-offset)
16686     (setq component-pos (point-marker))
16687     (insert "\n\n") (vhdl-insert-keyword "END ")
16688     (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
16689     (insert pack-name ";\n\n")
16690     ;; insert footer
16691     (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16692         (vhdl-template-footer)
16693       (vhdl-comment-display-line) (insert "\n"))
16694     ;; insert component declarations
16695     (while ent-alist
16696       (vhdl-visit-file (nth 2 (car ent-alist)) nil
16697                        (progn (goto-char (point-min))
16698                               (forward-line (1- (nth 3 (car ent-alist))))
16699                               (end-of-line)
16700                               (vhdl-port-copy)))
16701       (goto-char component-pos)
16702       (vhdl-port-paste-component t)
16703       (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
16704       (setq component-pos (point-marker))
16705       (goto-char clause-pos)
16706       (vhdl-port-paste-context-clause pack-name)
16707       (setq clause-pos (point-marker))
16708       (setq ent-alist (cdr ent-alist)))
16709     (goto-char (point-min))
16710     (save-buffer)
16711     (message "Generating components package \"%s\"...done\n  File created: \"%s\""
16712              pack-name pack-file-name)))
16713
16714 (defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist
16715                                                          conf-alist inst-alist
16716                                                          &optional insert-conf)
16717   "Generate block configuration for architecture."
16718   (let ((margin (current-indentation))
16719         (beg (point-at-bol))
16720         ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
16721     ;; insert block configuration (for architecture)
16722     (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
16723     (setq margin (+ margin vhdl-basic-offset))
16724     ;; process all instances
16725     (while inst-alist
16726       (setq inst-entry (car inst-alist))
16727       ;; is component?
16728       (when (nth 4 inst-entry)
16729         (setq insert-conf t)
16730         (setq inst-path (nth 9 inst-entry))
16731         ;; skip common path with previous instance
16732         (while (and inst-path (equal (car inst-path) (car inst-prev-path)))
16733           (setq inst-path (cdr inst-path)
16734                 inst-prev-path (cdr inst-prev-path)))
16735         ;; insert block configuration end (for previous block/generate)
16736         (while inst-prev-path
16737           (setq margin (- margin vhdl-basic-offset))
16738           (indent-to margin)
16739           (vhdl-insert-keyword "END FOR;\n")
16740           (setq inst-prev-path (cdr inst-prev-path)))
16741         ;; insert block configuration beginning (for current block/generate)
16742         (indent-to margin)
16743         (while inst-path
16744           (setq margin (+ margin vhdl-basic-offset))
16745           (vhdl-insert-keyword "FOR ")
16746           (insert (car inst-path) "\n")
16747           (indent-to margin)
16748           (setq inst-path (cdr inst-path)))
16749         ;; insert component configuration beginning
16750         (vhdl-insert-keyword "FOR ")
16751         (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n")
16752         ;; find subconfiguration
16753         (setq conf-key (nth 7 inst-entry))
16754         (setq tmp-alist conf-alist)
16755         ;; use first configuration found for instance's entity
16756         (while (and tmp-alist (null conf-key))
16757           (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
16758             (setq conf-key (nth 0 (car tmp-alist))))
16759           (setq tmp-alist (cdr tmp-alist)))
16760         (setq conf-entry (vhdl-aget conf-alist conf-key))
16761         ;; insert binding indication ...
16762         ;; ... with subconfiguration (if exists)
16763         (if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
16764             (progn
16765               (indent-to (+ margin vhdl-basic-offset))
16766               (vhdl-insert-keyword "USE CONFIGURATION ")
16767               (insert (vhdl-work-library) "." (nth 0 conf-entry))
16768               (insert ";\n"))
16769           ;; ... with entity (if exists)
16770           (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry)))
16771           (when ent-entry
16772             (indent-to (+ margin vhdl-basic-offset))
16773             (vhdl-insert-keyword "USE ENTITY ")
16774             (insert (vhdl-work-library) "." (nth 0 ent-entry))
16775             ;; insert architecture name (if architecture exists)
16776             (when (nth 3 ent-entry)
16777               (setq arch-name
16778                     ;; choose architecture name a) from configuration,
16779                     ;; b) from mra, or c) from first architecture
16780                     (or (nth 0 (vhdl-aget (nth 3 ent-entry)
16781                                           (or (nth 6 inst-entry)
16782                                               (nth 4 ent-entry))))
16783                         (nth 1 (car (nth 3 ent-entry)))))
16784               (insert "(" arch-name ")"))
16785             (insert ";\n")
16786             ;; insert block configuration (for architecture of subcomponent)
16787             (when (and vhdl-compose-configuration-hierarchical
16788                        (nth 3 ent-entry))
16789               (indent-to (+ margin vhdl-basic-offset))
16790               (vhdl-compose-configuration-architecture
16791                (nth 0 ent-entry) arch-name ent-alist conf-alist
16792                (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name)))))))
16793         ;; insert component configuration end
16794         (indent-to margin)
16795         (vhdl-insert-keyword "END FOR;\n")
16796         (setq inst-prev-path (nth 9 inst-entry)))
16797       (setq inst-alist (cdr inst-alist)))
16798     ;; insert block configuration end (for block/generate)
16799     (while inst-prev-path
16800       (setq margin (- margin vhdl-basic-offset))
16801       (indent-to margin)
16802       (vhdl-insert-keyword "END FOR;\n")
16803       (setq inst-prev-path (cdr inst-prev-path)))
16804     (indent-to (- margin vhdl-basic-offset))
16805     ;; insert block configuration end or remove beginning (for architecture)
16806     (if insert-conf
16807         (vhdl-insert-keyword "END FOR;\n")
16808       (delete-region beg (point)))))
16809
16810 (defun vhdl-compose-configuration (&optional ent-name arch-name)
16811   "Generate configuration declaration."
16812   (interactive)
16813   (vhdl-require-hierarchy-info)
16814   (let ((ent-alist (vhdl-aget vhdl-entity-alist
16815                               (or (vhdl-project-p)
16816                                   (abbreviate-file-name default-directory))))
16817         (conf-alist (vhdl-aget vhdl-config-alist
16818                                (or (vhdl-project-p)
16819                                    (abbreviate-file-name default-directory))))
16820         (from-speedbar ent-name)
16821         inst-alist conf-name conf-file-name pos)
16822     (vhdl-prepare-search-2
16823      ;; get entity and architecture name
16824      (unless ent-name
16825        (save-excursion
16826          (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
16827                       (not (equal "END" (upcase (match-string 1))))
16828                       (setq ent-name (match-string-no-properties 3))
16829                       (setq arch-name (match-string-no-properties 2)))
16830            (error "ERROR:  Not within an architecture"))))
16831      (setq conf-name (vhdl-replace-string
16832                       vhdl-compose-configuration-name
16833                       (concat ent-name " " arch-name)))
16834      (setq inst-alist
16835            (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name)))
16836                              (downcase arch-name)))))
16837      (message "Generating configuration \"%s\"..." conf-name)
16838      (if vhdl-compose-configuration-create-file
16839          ;; open configuration file
16840          (progn
16841            (setq conf-file-name
16842                  (concat (vhdl-replace-string vhdl-configuration-file-name
16843                                               conf-name t)
16844                          "." (file-name-extension (buffer-file-name))))
16845            (when (and (file-exists-p conf-file-name)
16846                       (not (y-or-n-p (concat "File \"" conf-file-name
16847                                              "\" exists; overwrite? "))))
16848              (error "ERROR:  Creating configuration...aborted"))
16849            (find-file conf-file-name)
16850            (erase-buffer)
16851            (set-buffer-modified-p nil)
16852            ;; insert header
16853            (if vhdl-compose-include-header
16854                (progn (vhdl-template-header
16855                        (concat "Configuration declaration for design \""
16856                                ent-name "(" arch-name ")\""))
16857                       (goto-char (point-max)))
16858              (vhdl-comment-display-line) (insert "\n\n")))
16859        ;; goto end of architecture
16860        (unless from-speedbar
16861          (re-search-forward "^end\\>" nil)
16862          (end-of-line) (insert "\n\n")
16863          (vhdl-comment-display-line) (insert "\n\n")))
16864      ;; insert library clause
16865      (setq pos (point))
16866      (vhdl-template-standard-package (vhdl-work-library) nil)
16867      (when (/= pos (point))
16868        (insert "\n\n"))
16869      ;; insert configuration
16870      (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name)
16871      (vhdl-insert-keyword " OF ") (insert ent-name)
16872      (vhdl-insert-keyword " IS\n")
16873      (indent-to vhdl-basic-offset)
16874      ;; insert block configuration (for architecture)
16875      (vhdl-compose-configuration-architecture
16876       ent-name arch-name ent-alist conf-alist inst-alist t)
16877      (vhdl-insert-keyword "END ") (insert conf-name ";")
16878      (when conf-file-name
16879        ;; insert footer and save
16880        (insert "\n\n")
16881        (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
16882            (vhdl-template-footer)
16883          (vhdl-comment-display-line) (insert "\n"))
16884        (save-buffer))
16885      (message "%s"
16886       (concat (format "Generating configuration \"%s\"...done" conf-name)
16887               (and conf-file-name
16888                    (format "\n  File created: \"%s\"" conf-file-name))))))
16889
16890
16891 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16892 ;;; Compilation / Makefile generation
16893 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16894 ;; (using `compile.el')
16895
16896 (defvar vhdl-compile-post-command ""
16897   "String appended to compile command after file name.")
16898
16899 (defun vhdl-makefile-name ()
16900   "Return the Makefile name of the current project or the current compiler if
16901 no project is defined."
16902   (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project))
16903         (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler)))
16904     (vhdl-replace-string
16905      (cons "\\(.*\\)\n\\(.*\\)"
16906            (or (nth 8 project-alist) (nth 8 compiler-alist)))
16907      (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
16908
16909 (defun vhdl-compile-directory ()
16910   "Return the directory where compilation/make should be run."
16911   (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t)))
16912          (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
16913          (directory (vhdl-resolve-env-variable
16914                      (if project
16915                          (vhdl-replace-string
16916                           (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
16917                        (nth 6 compiler)))))
16918     (file-name-as-directory
16919      (if (file-name-absolute-p directory)
16920          directory
16921        (expand-file-name directory (vhdl-default-directory))))))
16922
16923 (defun vhdl-uniquify (in-list)
16924   "Remove duplicate elements from IN-LIST."
16925   (let (out-list)
16926     (while in-list
16927       (add-to-list 'out-list (car in-list))
16928       (setq in-list (cdr in-list)))
16929     out-list))
16930
16931 (defun vhdl-set-compiler (name)
16932   "Set current compiler to NAME."
16933   (interactive
16934    (list (let ((completion-ignore-case t))
16935            (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
16936   (if (assoc name vhdl-compiler-alist)
16937       (progn (setq vhdl-compiler name)
16938              (message "Current compiler: \"%s\"" vhdl-compiler))
16939     (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
16940
16941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16942 ;; Compilation
16943
16944 (defun vhdl-compile-init ()
16945   "Initialize for compilation."
16946   (when (and (not vhdl-emacs-22)
16947              (or (null compilation-error-regexp-alist)
16948                  (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
16949                              compilation-error-regexp-alist))))
16950     ;; `compilation-error-regexp-alist'
16951     (let ((commands-alist vhdl-compiler-alist)
16952           regexp-alist sublist)
16953       (while commands-alist
16954         (setq sublist (nth 11 (car commands-alist)))
16955         (unless (or (equal "" (car sublist))
16956                     (assoc (car sublist) regexp-alist))
16957           (push (list (nth 0 sublist)
16958                       (if (and (featurep 'xemacs) (not (nth 1 sublist)))
16959                           9
16960                                            (nth 1 sublist))
16961                                          (nth 2 sublist) (nth 3 sublist))
16962                 regexp-alist))
16963         (setq commands-alist (cdr commands-alist)))
16964       (setq compilation-error-regexp-alist
16965             (append compilation-error-regexp-alist (nreverse regexp-alist))))
16966     ;; `compilation-file-regexp-alist'
16967     (let ((commands-alist vhdl-compiler-alist)
16968           regexp-alist sublist)
16969       ;; matches vhdl-mode file name output
16970       (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
16971       (while commands-alist
16972         (setq sublist (nth 12 (car commands-alist)))
16973         (unless (or (equal "" (car sublist))
16974                     (assoc (car sublist) regexp-alist))
16975           (push sublist regexp-alist))
16976         (setq commands-alist (cdr commands-alist)))
16977       (setq compilation-file-regexp-alist
16978             (append compilation-file-regexp-alist (nreverse regexp-alist))))))
16979
16980 (defvar vhdl-compile-file-name nil
16981   "Name of file to be compiled.")
16982
16983 (defun vhdl-compile-print-file-name ()
16984   "Function called within `compile' to print out file name for compilers that
16985 do not print any file names."
16986   (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
16987
16988 (defun vhdl-get-compile-options (project compiler file-name
16989                                          &optional file-options-only)
16990   "Get compiler options.  Returning nil means do not compile this file."
16991   (let* ((compiler-options (nth 1 compiler))
16992          (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
16993          (project-options (nth 0 project-entry))
16994          (exception-list (and file-name (nth 2 project-entry)))
16995          (work-library (vhdl-work-library))
16996          (case-fold-search nil)
16997          file-options)
16998     (while (and exception-list
16999                 (not (string-match (caar exception-list) file-name)))
17000       (setq exception-list (cdr exception-list)))
17001     (if (and exception-list (not (cdar exception-list)))
17002         nil
17003       (if (and file-options-only (not exception-list))
17004           'default
17005         (setq file-options (cdar exception-list))
17006         ;; insert library name in compiler-specific options
17007         (setq compiler-options
17008               (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
17009                                    work-library))
17010         ;; insert compiler-specific options in project-specific options
17011         (when project-options
17012           (setq project-options
17013                 (vhdl-replace-string
17014                  (cons "\\(.*\\)\n\\(.*\\)" project-options)
17015                  (concat work-library "\n" compiler-options))))
17016         ;; insert project-specific options in file-specific options
17017         (when file-options
17018           (setq file-options
17019                 (vhdl-replace-string
17020                  (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
17021                  (concat work-library "\n" compiler-options "\n"
17022                          project-options))))
17023         ;; return options
17024         (or file-options project-options compiler-options)))))
17025
17026 (defun vhdl-get-make-options (project compiler)
17027   "Get make options."
17028   (let* ((compiler-options (nth 3 compiler))
17029          (project-entry (vhdl-aget (nth 4 project) vhdl-compiler))
17030          (project-options (nth 1 project-entry))
17031          (makefile-name (vhdl-makefile-name)))
17032     ;; insert Makefile name in compiler-specific options
17033     (setq compiler-options
17034           (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
17035                                makefile-name))
17036     ;; insert compiler-specific options in project-specific options
17037     (when project-options
17038       (setq project-options
17039             (vhdl-replace-string
17040              (cons "\\(.*\\)\n\\(.*\\)" project-options)
17041              (concat makefile-name "\n" compiler-options))))
17042     ;; return options
17043     (or project-options compiler-options)))
17044
17045 (defun vhdl-compile ()
17046   "Compile current buffer using the VHDL compiler specified in
17047 `vhdl-compiler'."
17048   (interactive)
17049   (vhdl-compile-init)
17050   (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17051          (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17052                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17053          (command (nth 0 compiler))
17054          (default-directory (vhdl-compile-directory))
17055          (file-name (if vhdl-compile-absolute-path
17056                         (buffer-file-name)
17057                       (file-relative-name (buffer-file-name))))
17058          (options (vhdl-get-compile-options project compiler file-name))
17059          compilation-process-setup-function)
17060     (unless (file-directory-p default-directory)
17061       (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17062     ;; put file name into quotes if it contains spaces
17063     (when (string-match " " file-name)
17064       (setq file-name (concat "\"" file-name "\"")))
17065     ;; print out file name if compiler does not
17066     (setq vhdl-compile-file-name (if vhdl-compile-absolute-path
17067                                      (buffer-file-name)
17068                                    (file-relative-name (buffer-file-name))))
17069     (when (and (= 0 (nth 1 (nth 10 compiler)))
17070                (= 0 (nth 1 (nth 11 compiler))))
17071       (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
17072     ;; run compilation
17073     (if options
17074         (when command
17075           (compile (concat command " " options " " file-name
17076                            (unless (equal vhdl-compile-post-command "")
17077                              (concat " " vhdl-compile-post-command)))))
17078       (vhdl-warning "Your project settings tell me not to compile this file"))))
17079
17080 (defvar vhdl-make-target "all"
17081   "Default target for `vhdl-make' command.")
17082
17083 (defun vhdl-make (&optional target)
17084   "Call make command for compilation of all updated source files (requires
17085 `Makefile').  Optional argument TARGET allows you to compile the design
17086 specified by a target."
17087   (interactive)
17088   (setq vhdl-make-target
17089         (or target (read-from-minibuffer "Target: " vhdl-make-target
17090                                          vhdl-minibuffer-local-map)))
17091   (vhdl-compile-init)
17092   (let* ((project (vhdl-aget vhdl-project-alist vhdl-project))
17093          (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17094                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17095          (command (nth 2 compiler))
17096          (options (vhdl-get-make-options project compiler))
17097          (default-directory (vhdl-compile-directory)))
17098     (unless (file-directory-p default-directory)
17099       (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
17100     ;; run make
17101     (compile (concat (if (equal command "") "make" command)
17102                      " " options " " vhdl-make-target))))
17103
17104 ;; Emacs 22+ setup
17105 (defvar vhdl-error-regexp-emacs-alist
17106   ;; Get regexps from `vhdl-compiler-alist'
17107   (let ((compiler-alist vhdl-compiler-alist)
17108         (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1))))
17109    (while compiler-alist
17110      ;; only add regexps for currently selected compiler
17111      (when (or (not vhdl-compile-use-local-error-regexp)
17112                (equal vhdl-compiler (nth 0 (car compiler-alist))))
17113        ;; add error message regexps
17114        (setq error-regexp-alist
17115              (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))))))
17116                            (nth 11 (car compiler-alist)))
17117                    error-regexp-alist))
17118        ;; add filename regexps
17119        (when (/= 0 (nth 1 (nth 12 (car compiler-alist))))
17120          (setq error-regexp-alist
17121                (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ?  ?- (downcase (nth 0 (car compiler-alist)))) "-file")))
17122                              (nth 12 (car compiler-alist)))
17123                      error-regexp-alist))))
17124      (setq compiler-alist (cdr compiler-alist)))
17125    error-regexp-alist)
17126   "List of regexps for VHDL compilers.  For Emacs 22+.")
17127
17128 ;; Add error regexps using compilation-mode-hook.
17129 (defun vhdl-error-regexp-add-emacs ()
17130   "Set up Emacs compile for VHDL."
17131   (interactive)
17132   (when (and (boundp 'compilation-error-regexp-alist-alist)
17133              (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist)))
17134     ;; remove all other compilers
17135     (when vhdl-compile-use-local-error-regexp
17136       (setq compilation-error-regexp-alist nil))
17137     ;; add VHDL compilers
17138     (mapcar
17139      (lambda (item)
17140        (push (car item) compilation-error-regexp-alist)
17141        (push item compilation-error-regexp-alist-alist))
17142      vhdl-error-regexp-emacs-alist)))
17143
17144 (when vhdl-emacs-22
17145   (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs))
17146
17147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17148 ;; Makefile generation
17149
17150 (defun vhdl-generate-makefile ()
17151   "Generate `Makefile'."
17152   (interactive)
17153   (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler)
17154                        (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
17155          (command (nth 4 compiler)))
17156     ;; generate makefile
17157     (if command
17158         (let ((default-directory (vhdl-compile-directory)))
17159           (compile (vhdl-replace-string
17160                     (cons "\\(.*\\) \\(.*\\)" command)
17161                     (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
17162       (vhdl-generate-makefile-1))))
17163
17164 (defun vhdl-get-packages (lib-alist work-library)
17165   "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
17166   (let (pack-list)
17167     (while lib-alist
17168       (when (equal (downcase (caar lib-alist)) (downcase work-library))
17169         (push (cdar lib-alist) pack-list))
17170       (setq lib-alist (cdr lib-alist)))
17171     pack-list))
17172
17173 (defun vhdl-generate-makefile-1 ()
17174   "Generate Makefile for current project or directory."
17175   ;; scan hierarchy if required
17176   (if (vhdl-project-p)
17177       (unless (or (assoc vhdl-project vhdl-file-alist)
17178                   (vhdl-load-cache vhdl-project))
17179         (vhdl-scan-project-contents vhdl-project))
17180     (let ((directory (abbreviate-file-name default-directory)))
17181       (unless (or (assoc directory vhdl-file-alist)
17182                   (vhdl-load-cache directory))
17183         (vhdl-scan-directory-contents directory))))
17184   (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
17185          (project (vhdl-project-p))
17186          (ent-alist (vhdl-aget vhdl-entity-alist (or project directory)))
17187          (conf-alist (vhdl-aget vhdl-config-alist (or project directory)))
17188          (pack-alist (vhdl-aget vhdl-package-alist (or project directory)))
17189          (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17190                           '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd"
17191                             "\\1.vhd" "\\1_body.vhd" identity)))
17192          (mapping-exist
17193           (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil))
17194          (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list)))
17195          (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
17196          (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list)))
17197          (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list)))
17198          (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list)))
17199          (adjust-case (nth 5 regexp-list))
17200          (work-library (downcase (vhdl-work-library)))
17201          (compile-directory (expand-file-name (vhdl-compile-directory)
17202                                               default-directory))
17203          (makefile-name (vhdl-makefile-name))
17204          rule-alist arch-alist inst-alist
17205          target-list depend-list unit-list prim-list second-list subcomp-list
17206          lib-alist lib-body-alist pack-list all-pack-list
17207          ent-key ent-file-name arch-key arch-file-name ent-arch-key
17208          conf-key conf-file-name pack-key pack-file-name
17209          ent-entry arch-entry conf-entry pack-entry inst-entry
17210          pack-body-key pack-body-file-name inst-ent-key inst-conf-key
17211          tmp-key tmp-list rule)
17212     ;; check prerequisites
17213     (unless (file-exists-p compile-directory)
17214       (make-directory compile-directory t))
17215     (unless mapping-exist
17216       (vhdl-warning
17217        (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\""
17218                vhdl-compiler vhdl-compiler) t))
17219     (message "Generating makefile \"%s\"..." makefile-name)
17220     ;; rules for all entities
17221     (setq tmp-list ent-alist)
17222     (while ent-alist
17223       (setq ent-entry (car ent-alist)
17224             ent-key (nth 0 ent-entry))
17225       (when (nth 2 ent-entry)
17226         (setq ent-file-name (if vhdl-compile-absolute-path
17227                                 (nth 2 ent-entry)
17228                               (file-relative-name (nth 2 ent-entry)
17229                                                   compile-directory))
17230               arch-alist (nth 4 ent-entry)
17231               lib-alist (nth 6 ent-entry)
17232               rule (vhdl-aget rule-alist ent-file-name)
17233               target-list (nth 0 rule)
17234               depend-list (nth 1 rule)
17235               second-list nil
17236               subcomp-list nil)
17237         (setq tmp-key (vhdl-replace-string
17238                        ent-regexp
17239                        (funcall adjust-case
17240                                 (concat ent-key "  " work-library))))
17241         (push (cons ent-key tmp-key) unit-list)
17242         ;; rule target for this entity
17243         (push ent-key target-list)
17244         ;; rule dependencies for all used packages
17245         (setq pack-list (vhdl-get-packages lib-alist work-library))
17246         (setq depend-list (append depend-list pack-list))
17247         (setq all-pack-list pack-list)
17248         ;; add rule
17249         (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list))
17250         ;; rules for all corresponding architectures
17251         (while arch-alist
17252           (setq arch-entry (car arch-alist)
17253                 arch-key (nth 0 arch-entry)
17254                 ent-arch-key (concat ent-key "-" arch-key)
17255                 arch-file-name (if vhdl-compile-absolute-path
17256                                    (nth 2 arch-entry)
17257                                  (file-relative-name (nth 2 arch-entry)
17258                                                      compile-directory))
17259                 inst-alist (nth 4 arch-entry)
17260                 lib-alist (nth 5 arch-entry)
17261                 rule (vhdl-aget rule-alist arch-file-name)
17262                 target-list (nth 0 rule)
17263                 depend-list (nth 1 rule))
17264           (setq tmp-key (vhdl-replace-string
17265                          arch-regexp
17266                          (funcall adjust-case
17267                                   (concat arch-key " " ent-key " "
17268                                           work-library))))
17269           (setq unit-list
17270                 (cons (cons ent-arch-key tmp-key) unit-list))
17271           (push ent-arch-key second-list)
17272           ;; rule target for this architecture
17273           (push ent-arch-key target-list)
17274           ;; rule dependency for corresponding entity
17275           (push ent-key depend-list)
17276           ;; rule dependencies for contained component instantiations
17277           (while inst-alist
17278             (setq inst-entry (car inst-alist))
17279             (when (or (null (nth 8 inst-entry))
17280                       (equal (downcase (nth 8 inst-entry)) work-library))
17281               (setq inst-ent-key (or (nth 7 inst-entry)
17282                                      (nth 5 inst-entry)))
17283               (setq depend-list (cons inst-ent-key depend-list)
17284                     subcomp-list (cons inst-ent-key subcomp-list)))
17285             (setq inst-alist (cdr inst-alist)))
17286           ;; rule dependencies for all used packages
17287           (setq pack-list (vhdl-get-packages lib-alist work-library))
17288           (setq depend-list (append depend-list pack-list))
17289           (setq all-pack-list (append all-pack-list pack-list))
17290           ;; add rule
17291           (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list))
17292           (setq arch-alist (cdr arch-alist)))
17293         (push (list ent-key second-list (append subcomp-list all-pack-list))
17294               prim-list))
17295       (setq ent-alist (cdr ent-alist)))
17296     (setq ent-alist tmp-list)
17297     ;; rules for all configurations
17298     (setq tmp-list conf-alist)
17299     (while conf-alist
17300       (setq conf-entry (car conf-alist)
17301             conf-key (nth 0 conf-entry)
17302             conf-file-name (if vhdl-compile-absolute-path
17303                                (nth 2 conf-entry)
17304                              (file-relative-name (nth 2 conf-entry)
17305                                                  compile-directory))
17306             ent-key (nth 4 conf-entry)
17307             arch-key (nth 5 conf-entry)
17308             inst-alist (nth 6 conf-entry)
17309             lib-alist (nth 7 conf-entry)
17310             rule (vhdl-aget rule-alist conf-file-name)
17311             target-list (nth 0 rule)
17312             depend-list (nth 1 rule)
17313             subcomp-list (list ent-key))
17314       (setq tmp-key (vhdl-replace-string
17315                      conf-regexp
17316                      (funcall adjust-case
17317                               (concat conf-key "  " work-library))))
17318       (push (cons conf-key tmp-key) unit-list)
17319       ;; rule target for this configuration
17320       (push conf-key target-list)
17321       ;; rule dependency for corresponding entity and architecture
17322       (setq depend-list
17323             (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
17324       ;; rule dependencies for used packages
17325       (setq pack-list (vhdl-get-packages lib-alist work-library))
17326       (setq depend-list (append depend-list pack-list))
17327       ;; rule dependencies for contained component configurations
17328       (while inst-alist
17329         (setq inst-entry (car inst-alist))
17330         (setq inst-ent-key (nth 2 inst-entry)
17331               inst-conf-key (nth 4 inst-entry))
17332         (when (equal (downcase (nth 5 inst-entry)) work-library)
17333           (when inst-ent-key
17334             (setq depend-list (cons inst-ent-key depend-list)
17335                   subcomp-list (cons inst-ent-key subcomp-list)))
17336           (when inst-conf-key
17337             (setq depend-list (cons inst-conf-key depend-list)
17338                   subcomp-list (cons inst-conf-key subcomp-list))))
17339         (setq inst-alist (cdr inst-alist)))
17340       ;; add rule
17341       (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list))
17342       (push (list conf-key nil (append subcomp-list pack-list)) prim-list)
17343       (setq conf-alist (cdr conf-alist)))
17344     (setq conf-alist tmp-list)
17345     ;; rules for all packages
17346     (setq tmp-list pack-alist)
17347     (while pack-alist
17348       (setq pack-entry (car pack-alist)
17349             pack-key (nth 0 pack-entry)
17350             pack-body-key nil)
17351       (when (nth 2 pack-entry)
17352         (setq pack-file-name (if vhdl-compile-absolute-path
17353                                  (nth 2 pack-entry)
17354                                (file-relative-name (nth 2 pack-entry)
17355                                                    compile-directory))
17356               lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
17357               rule (vhdl-aget rule-alist pack-file-name)
17358               target-list (nth 0 rule) depend-list (nth 1 rule))
17359         (setq tmp-key (vhdl-replace-string
17360                        pack-regexp
17361                        (funcall adjust-case
17362                                 (concat pack-key "  " work-library))))
17363         (push (cons pack-key tmp-key) unit-list)
17364         ;; rule target for this package
17365         (push pack-key target-list)
17366         ;; rule dependencies for all used packages
17367         (setq pack-list (vhdl-get-packages lib-alist work-library))
17368         (setq depend-list (append depend-list pack-list))
17369         (setq all-pack-list pack-list)
17370         ;; add rule
17371         (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list))
17372         ;; rules for this package's body
17373         (when (nth 7 pack-entry)
17374           (setq pack-body-key (concat pack-key "-body")
17375                 pack-body-file-name (if vhdl-compile-absolute-path
17376                                         (nth 7 pack-entry)
17377                                       (file-relative-name (nth 7 pack-entry)
17378                                                           compile-directory))
17379                 rule (vhdl-aget rule-alist pack-body-file-name)
17380                 target-list (nth 0 rule)
17381                 depend-list (nth 1 rule))
17382           (setq tmp-key (vhdl-replace-string
17383                          pack-body-regexp
17384                          (funcall adjust-case
17385                                   (concat pack-key "  " work-library))))
17386           (setq unit-list
17387                 (cons (cons pack-body-key tmp-key) unit-list))
17388           ;; rule target for this package's body
17389           (push pack-body-key target-list)
17390           ;; rule dependency for corresponding package declaration
17391           (push pack-key depend-list)
17392           ;; rule dependencies for all used packages
17393           (setq pack-list (vhdl-get-packages lib-body-alist work-library))
17394           (setq depend-list (append depend-list pack-list))
17395           (setq all-pack-list (append all-pack-list pack-list))
17396           ;; add rule
17397           (vhdl-aput 'rule-alist pack-body-file-name
17398                      (list target-list depend-list)))
17399         (setq prim-list
17400               (cons (list pack-key (when pack-body-key (list pack-body-key))
17401                           all-pack-list)
17402                     prim-list)))
17403       (setq pack-alist (cdr pack-alist)))
17404     (setq pack-alist tmp-list)
17405     ;; generate Makefile
17406     (let* ((project (vhdl-aget vhdl-project-alist project))
17407            (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler))
17408            (compiler-id (nth 9 compiler))
17409            (library-directory
17410             (vhdl-resolve-env-variable
17411              (vhdl-replace-string
17412               (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
17413               compiler-id)))
17414            (makefile-path-name (expand-file-name
17415                                 makefile-name compile-directory))
17416            (orig-buffer (current-buffer))
17417            cell second-list subcomp-list options unit-key unit-name)
17418       ;; sort lists
17419       (setq unit-list (vhdl-sort-alist unit-list))
17420       (setq prim-list (vhdl-sort-alist prim-list))
17421       (setq tmp-list rule-alist)
17422       (while tmp-list                   ; pre-sort rule targets
17423         (setq cell (cdar tmp-list))
17424         (setcar cell (sort (car cell) 'string<))
17425         (setq tmp-list (cdr tmp-list)))
17426       (setq rule-alist                  ; sort by first rule target
17427             (sort rule-alist
17428                   (function (lambda (a b)
17429                               (string< (car (cadr a)) (car (cadr b)))))))
17430       ;; open and clear Makefile
17431       (set-buffer (find-file-noselect makefile-path-name t t))
17432       (erase-buffer)
17433       (insert "# -*- Makefile -*-\n"
17434               "### " (file-name-nondirectory makefile-name)
17435               " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
17436               "\n")
17437       (if project
17438           (insert "\n# Project   : " (nth 0 project))
17439         (insert "\n# Directory : \"" directory "\""))
17440       (insert "\n# Platform  : " vhdl-compiler
17441               "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
17442               (user-login-name) "\n")
17443       ;; insert compile and option variable settings
17444       (insert "\n\n# Define compilation command and options\n"
17445               "\nCOMPILE = " (nth 0 compiler)
17446               "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
17447               (if (equal vhdl-compile-post-command "") ""
17448                 (concat "\nPOST-COMPILE = " vhdl-compile-post-command))
17449               "\n")
17450       ;; insert library paths
17451       (setq library-directory
17452             (directory-file-name
17453              (if (file-name-absolute-p library-directory)
17454                  library-directory
17455                (file-relative-name
17456                 (expand-file-name library-directory directory)
17457                 compile-directory))))
17458       (insert "\n\n# Define library paths\n"
17459               "\nLIBRARY-" work-library " = " library-directory "\n")
17460       (unless mapping-exist
17461         (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library
17462                 ")/make" "\n"))
17463       ;; insert variable definitions for all library unit files
17464       (insert "\n\n# Define library unit files\n")
17465       (setq tmp-list unit-list)
17466       (while unit-list
17467         (insert "\nUNIT-" work-library "-" (caar unit-list)
17468                 " = \\\n\t$(LIBRARY-" work-library
17469                 (if mapping-exist "" "-make") ")/" (cdar unit-list))
17470         (setq unit-list (cdr unit-list)))
17471       ;; insert variable definition for list of all library unit files
17472       (insert "\n\n\n# Define list of all library unit files\n"
17473               "\nALL_UNITS =")
17474       (setq unit-list tmp-list)
17475       (while unit-list
17476         (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
17477         (setq unit-list (cdr unit-list)))
17478       (insert "\n")
17479       (setq unit-list tmp-list)
17480       ;; insert `make all' rule
17481       (insert "\n\n\n# Rule for compiling entire design\n"
17482               "\n" (nth 0 vhdl-makefile-default-targets) " :"
17483               " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)
17484               " \\\n\t\t$(ALL_UNITS)\n")
17485       ;; insert `make clean' rule
17486       (insert "\n\n# Rule for cleaning entire design\n"
17487               "\n" (nth 1 vhdl-makefile-default-targets) " : "
17488               "\n\t-rm -f $(ALL_UNITS)\n")
17489       ;; insert `make library' rule
17490       (insert "\n\n# Rule for creating library directory\n"
17491               "\n" (nth 2 vhdl-makefile-default-targets) " :"
17492               " \\\n\t\t$(LIBRARY-" work-library ")"
17493               (if mapping-exist ""
17494                 (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n"))
17495               "\n"
17496               "\n$(LIBRARY-" work-library ") :"
17497               "\n\t"
17498               (vhdl-replace-string
17499                (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
17500                (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
17501               "\n")
17502       (unless mapping-exist
17503         (insert "\n$(LIBRARY-" work-library "-make) :"
17504                 "\n\t"
17505                 "mkdir -p $(LIBRARY-" work-library "-make)\n"))
17506       ;; insert '.PHONY' declaration
17507       (insert "\n\n.PHONY : "
17508               (nth 0 vhdl-makefile-default-targets) " "
17509               (nth 1 vhdl-makefile-default-targets) " "
17510               (nth 2 vhdl-makefile-default-targets) "\n")
17511       ;; insert rule for each library unit
17512       (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
17513       (while prim-list
17514         (setq second-list (sort (nth 1 (car prim-list)) 'string<))
17515         (setq subcomp-list
17516               (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
17517         (setq unit-key (caar prim-list)
17518               unit-name (or (nth 0 (vhdl-aget ent-alist unit-key))
17519                             (nth 0 (vhdl-aget conf-alist unit-key))
17520                             (nth 0 (vhdl-aget pack-alist unit-key))))
17521         (insert "\n" unit-key)
17522         (unless (equal unit-key unit-name)
17523           (insert " \\\n" unit-name))
17524         (insert " :"
17525                 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets))
17526         (while subcomp-list
17527           (when (and (assoc (car subcomp-list) unit-list)
17528                      (not (equal unit-key (car subcomp-list))))
17529             (insert " \\\n\t\t" (car subcomp-list)))
17530           (setq subcomp-list (cdr subcomp-list)))
17531         (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
17532         (while second-list
17533           (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
17534           (setq second-list (cdr second-list)))
17535         (insert "\n")
17536         (setq prim-list (cdr prim-list)))
17537       ;; insert rule for each library unit file
17538       (insert "\n\n# Rules for compiling single library unit files\n")
17539       (while rule-alist
17540         (setq rule (car rule-alist))
17541         ;; get compiler options for this file
17542         (setq options
17543               (vhdl-get-compile-options project compiler (nth 0 rule) t))
17544         ;; insert rule if file is supposed to be compiled
17545         (setq target-list (nth 1 rule)
17546               depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
17547         ;; insert targets
17548         (setq tmp-list target-list)
17549         (while target-list
17550           (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
17551                   (if (cdr target-list) " \\" " :"))
17552           (setq target-list (cdr target-list)))
17553         (setq target-list tmp-list)
17554         ;; insert file name as first dependency
17555         (insert " \\\n\t\t" (nth 0 rule))
17556         ;; insert dependencies (except if also target or unit does not exist)
17557         (while depend-list
17558           (when (and (not (member (car depend-list) target-list))
17559                      (assoc (car depend-list) unit-list))
17560             (insert " \\\n\t\t"
17561                     "$(UNIT-" work-library "-" (car depend-list) ")"))
17562           (setq depend-list (cdr depend-list)))
17563         ;; insert compile command
17564         (if options
17565             (insert "\n\t$(COMPILE) "
17566                     (if (eq options 'default) "$(OPTIONS)" options) " "
17567                     (nth 0 rule)
17568                     (if (equal vhdl-compile-post-command "") ""
17569                       " $(POST-COMPILE)") "\n")
17570           (insert "\n"))
17571         (unless (and options mapping-exist)
17572           (setq tmp-list target-list)
17573           (while target-list
17574             (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n")
17575             (setq target-list (cdr target-list)))
17576           (setq target-list tmp-list))
17577         (setq rule-alist (cdr rule-alist)))
17578
17579       (insert "\n\n### " makefile-name " ends here\n")
17580       ;; run Makefile generation hook
17581       (run-hooks 'vhdl-makefile-generation-hook)
17582       (message "Generating makefile \"%s\"...done" makefile-name)
17583       ;; save and close file
17584       (if (file-writable-p makefile-path-name)
17585           (progn (save-buffer)
17586                  (kill-buffer (current-buffer))
17587                  (set-buffer orig-buffer)
17588                  (when (fboundp 'add-to-history)
17589                    (add-to-history 'file-name-history makefile-path-name)))
17590         (vhdl-warning-when-idle
17591          (format "File not writable: \"%s\""
17592                  (abbreviate-file-name makefile-path-name)))
17593         (switch-to-buffer (current-buffer))))))
17594
17595
17596 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17597 ;;; Bug reports
17598 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17599 ;; (using `reporter.el')
17600
17601 (defconst vhdl-mode-help-address
17602   "Reto Zimmermann <reto@gnu.org>"
17603   "Address for VHDL Mode bug reports.")
17604
17605 (defun vhdl-submit-bug-report ()
17606   "Submit via mail a bug report on VHDL Mode."
17607   (interactive)
17608   ;; load in reporter
17609   (and
17610    (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
17611    (let ((reporter-prompt-for-summary-p t))
17612      (reporter-submit-bug-report
17613       vhdl-mode-help-address
17614       (concat "VHDL Mode " vhdl-version)
17615       (list
17616        ;; report all important user options
17617        'vhdl-offsets-alist
17618        'vhdl-comment-only-line-offset
17619        'tab-width
17620        'vhdl-electric-mode
17621        'vhdl-stutter-mode
17622        'vhdl-indent-tabs-mode
17623        'vhdl-project-alist
17624        'vhdl-project
17625        'vhdl-project-file-name
17626        'vhdl-project-auto-load
17627        'vhdl-project-sort
17628        'vhdl-compiler-alist
17629        'vhdl-compiler
17630        'vhdl-compile-use-local-error-regexp
17631        'vhdl-makefile-default-targets
17632        'vhdl-makefile-generation-hook
17633        'vhdl-default-library
17634        'vhdl-standard
17635        'vhdl-basic-offset
17636        'vhdl-upper-case-keywords
17637        'vhdl-upper-case-types
17638        'vhdl-upper-case-attributes
17639        'vhdl-upper-case-enum-values
17640        'vhdl-upper-case-constants
17641        'vhdl-use-direct-instantiation
17642        'vhdl-array-index-record-field-in-sensitivity-list
17643        'vhdl-compose-configuration-name
17644        'vhdl-entity-file-name
17645        'vhdl-architecture-file-name
17646        'vhdl-configuration-file-name
17647        'vhdl-package-file-name
17648        'vhdl-file-name-case
17649        'vhdl-electric-keywords
17650        'vhdl-optional-labels
17651        'vhdl-insert-empty-lines
17652        'vhdl-argument-list-indent
17653        'vhdl-association-list-with-formals
17654        'vhdl-conditions-in-parenthesis
17655        'vhdl-sensitivity-list-all
17656        'vhdl-zero-string
17657        'vhdl-one-string
17658        'vhdl-file-header
17659        'vhdl-file-footer
17660        'vhdl-company-name
17661        'vhdl-copyright-string
17662        'vhdl-platform-spec
17663        'vhdl-date-format
17664        'vhdl-modify-date-prefix-string
17665        'vhdl-modify-date-on-saving
17666        'vhdl-reset-kind
17667        'vhdl-reset-active-high
17668        'vhdl-clock-rising-edge
17669        'vhdl-clock-edge-condition
17670        'vhdl-clock-name
17671        'vhdl-reset-name
17672        'vhdl-model-alist
17673        'vhdl-include-port-comments
17674        'vhdl-include-direction-comments
17675        'vhdl-include-type-comments
17676        'vhdl-include-group-comments
17677        'vhdl-actual-generic-name
17678        'vhdl-actual-port-name
17679        'vhdl-instance-name
17680        'vhdl-testbench-entity-name
17681        'vhdl-testbench-architecture-name
17682        'vhdl-testbench-configuration-name
17683        'vhdl-testbench-dut-name
17684        'vhdl-testbench-include-header
17685        'vhdl-testbench-declarations
17686        'vhdl-testbench-statements
17687        'vhdl-testbench-initialize-signals
17688        'vhdl-testbench-include-library
17689        'vhdl-testbench-include-configuration
17690        'vhdl-testbench-create-files
17691        'vhdl-testbench-entity-file-name
17692        'vhdl-testbench-architecture-file-name
17693        'vhdl-compose-create-files
17694        'vhdl-compose-configuration-create-file
17695        'vhdl-compose-configuration-hierarchical
17696        'vhdl-compose-configuration-use-subconfiguration
17697        'vhdl-compose-include-header
17698        'vhdl-compose-architecture-name
17699        'vhdl-components-package-name
17700        'vhdl-use-components-package
17701        'vhdl-self-insert-comments
17702        'vhdl-prompt-for-comments
17703        'vhdl-inline-comment-column
17704        'vhdl-end-comment-column
17705        'vhdl-auto-align
17706        'vhdl-align-groups
17707        'vhdl-align-group-separate
17708        'vhdl-align-same-indent
17709        'vhdl-highlight-keywords
17710        'vhdl-highlight-names
17711        'vhdl-highlight-special-words
17712        'vhdl-highlight-forbidden-words
17713        'vhdl-highlight-verilog-keywords
17714        'vhdl-highlight-translate-off
17715        'vhdl-highlight-case-sensitive
17716        'vhdl-special-syntax-alist
17717        'vhdl-forbidden-words
17718        'vhdl-forbidden-syntax
17719        'vhdl-directive-keywords
17720        'vhdl-speedbar-auto-open
17721        'vhdl-speedbar-display-mode
17722        'vhdl-speedbar-scan-limit
17723        'vhdl-speedbar-jump-to-unit
17724        'vhdl-speedbar-update-on-saving
17725        'vhdl-speedbar-save-cache
17726        'vhdl-speedbar-cache-file-name
17727        'vhdl-index-menu
17728        'vhdl-source-file-menu
17729        'vhdl-hideshow-menu
17730        'vhdl-hide-all-init
17731        'vhdl-print-two-column
17732        'vhdl-print-customize-faces
17733        'vhdl-intelligent-tab
17734        'vhdl-indent-syntax-based
17735        'vhdl-indent-comment-like-next-code-line
17736        'vhdl-word-completion-case-sensitive
17737        'vhdl-word-completion-in-minibuffer
17738        'vhdl-underscore-is-part-of-word
17739        'vhdl-mode-hook)
17740       (function
17741        (lambda ()
17742          (insert
17743           (if vhdl-special-indent-hook
17744               (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
17745                       "vhdl-special-indent-hook is set to '"
17746                       (format "%s" vhdl-special-indent-hook)
17747                       ".\nPerhaps this is your problem?\n"
17748                       "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
17749             "\n"))))
17750       nil
17751       "Hi Reto,"))))
17752
17753
17754 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17755 ;;; Documentation
17756 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17757
17758 (defconst vhdl-doc-release-notes nil
17759   "\
17760 Release Notes for VHDL Mode 3.37
17761 ================================
17762
17763 - Added support for VHDL'08:
17764   - New keywords, types, functions, attributes, operators, packages
17765   - Context declaration
17766   - Block comments
17767   - Directives
17768   - `all' keyword in sensitivity list
17769
17770
17771 Release Notes for VHDL Mode 3.34
17772 ================================
17773
17774 - Added support for GNU Emacs 22/23/24:
17775   - Compilation error parsing fixed for new `compile.el' package.
17776
17777 - Port translation: Derive actual generic name from formal generic name.
17778
17779 - New user options:
17780   `vhdl-actual-generic-name': Specify how actual generic names are obtained.
17781
17782
17783 Release Notes for VHDL Mode 3.33
17784 ================================
17785
17786 New Features
17787 ------------
17788
17789 CONFIGURATION DECLARATION GENERATION:
17790   - Automatic generation of a configuration declaration for a design.
17791     (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.)
17792
17793
17794 Key Bindings
17795 ------------
17796
17797 For Emacs compliance the following key bindings have been changed:
17798
17799 - `C-c c'        ->  `C-c C-c'      `vhdl-comment-uncomment-region'
17800 - `C-c f'        ->  `C-c C-i C-f'  `vhdl-fontify-buffer'
17801 - `C-c s'        ->  `C-c C-i C-s'  `vhdl-statistics-buffer'
17802 - `C-c C-c ...'  ->  `C-c C-m ...'  `vhdl-compose-...'
17803
17804
17805 User Options
17806 ------------
17807
17808 `vhdl-configuration-file-name': (new)
17809   Specify how the configuration file name is obtained.
17810 `vhdl-compose-configuration-name': (new)
17811   Specify how the configuration name is obtained.
17812 `vhdl-compose-configuration-create-file': (new)
17813   Specify whether a new file should be created for a configuration.
17814 `vhdl-compose-configuration-hierarchical': (new)
17815   Specify whether hierarchical configurations should be created.
17816 `vhdl-compose-configuration-use-subconfiguration': (new)
17817   Specify whether subconfigurations should be used inside configurations.
17818 `vhdl-makefile-default-targets': (new)
17819   Customize names of Makefile default targets.
17820 `vhdl-indent-comment-like-next-code-line': (new)
17821   Specify whether comment lines are indented like following code line.
17822 `vhdl-array-index-record-field-in-sensitivity-list': (new)
17823   Specify whether to include array indices / record fields in sensitivity list.
17824 ")
17825
17826
17827 (defconst vhdl-doc-keywords nil
17828   "\
17829 Reserved words in VHDL
17830 ----------------------
17831
17832 VHDL'08 (IEEE Std 1076-2008):
17833   `vhdl-08-keywords'      : keywords
17834   `vhdl-08-types'         : standardized types
17835   `vhdl-08-attributes'    : standardized attributes
17836   `vhdl-08-functions'     : standardized functions
17837   `vhdl-08-packages'      : standardized packages and libraries
17838
17839 VHDL'93/02 (IEEE Std 1076-1993/2002):
17840   `vhdl-02-keywords'      : keywords
17841   `vhdl-02-types'         : standardized types
17842   `vhdl-02-attributes'    : standardized attributes
17843   `vhdl-02-enum-values'   : standardized enumeration values
17844   `vhdl-02-functions'     : standardized functions
17845   `vhdl-02-packages'      : standardized packages and libraries
17846
17847 VHDL-AMS (IEEE Std 1076.1 / 1076.1.1):
17848   `vhdl-ams-keywords'     : keywords
17849   `vhdl-ams-types'        : standardized types
17850   `vhdl-ams-attributes'   : standardized attributes
17851   `vhdl-ams-enum-values'  : standardized enumeration values
17852   `vhdl-ams-constants'    : standardized constants
17853   `vhdl-ams-functions'    : standardized functions
17854
17855 Math Packages (IEEE Std 1076.2):
17856   `vhdl-math-types'       : standardized types
17857   `vhdl-math-constants'   : standardized constants
17858   `vhdl-math-functions'   : standardized functions
17859   `vhdl-math-packages'    : standardized packages
17860
17861 Forbidden words:
17862   `vhdl-verilog-keywords' : Verilog reserved words
17863
17864 NOTE: click `mouse-2' on variable names above (not in XEmacs).")
17865
17866
17867 (defconst vhdl-doc-coding-style nil
17868   "\
17869 For VHDL coding style and naming convention guidelines, see the following
17870 references:
17871
17872 [1] Ben Cohen.
17873     \"VHDL Coding Styles and Methodologies\".
17874     Kluwer Academic Publishers, 1999.
17875     http://members.aol.com/vhdlcohen/vhdl/
17876
17877 [2] Michael Keating and Pierre Bricaud.
17878     \"Reuse Methodology Manual, Second Edition\".
17879     Kluwer Academic Publishers, 1999.
17880     http://www.openmore.com/openmore/rmm2.html
17881
17882 [3] European Space Agency.
17883     \"VHDL Modelling Guidelines\".
17884     ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
17885
17886 Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
17887 to visually support naming conventions.")
17888
17889
17890 (defun vhdl-version ()
17891   "Echo the current version of VHDL Mode in the minibuffer."
17892   (interactive)
17893   (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
17894   (vhdl-keep-region-active))
17895
17896 (defun vhdl-doc-variable (variable)
17897   "Display VARIABLE's documentation in *Help* buffer."
17898   (interactive)
17899   (unless (featurep 'xemacs)
17900     (help-setup-xref (list #'vhdl-doc-variable variable)
17901                      (called-interactively-p 'interactive)))
17902   (with-output-to-temp-buffer
17903       (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17904     (princ (documentation-property variable 'variable-documentation))
17905     (with-current-buffer standard-output
17906       (help-mode))
17907     (help-print-return-message)))
17908
17909 (defun vhdl-doc-mode ()
17910   "Display VHDL Mode documentation in *Help* buffer."
17911   (interactive)
17912   (unless (featurep 'xemacs)
17913     (help-setup-xref (list #'vhdl-doc-mode)
17914                      (called-interactively-p 'interactive)))
17915   (with-output-to-temp-buffer
17916       (if (fboundp 'help-buffer) (help-buffer) "*Help*")
17917     (princ mode-name)
17918     (princ " mode:\n")
17919     (princ (documentation 'vhdl-mode))
17920     (with-current-buffer standard-output
17921       (help-mode))
17922     (help-print-return-message)))
17923
17924
17925 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17926
17927 (provide 'vhdl-mode)
17928
17929 ;;; vhdl-mode.el ends here