/[emacs]/emacs/lisp/progmodes/vhdl-mode.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/vhdl-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15 by rms, Fri Jan 25 05:06:14 2002 UTC revision 1.15.4.1 by miles, Fri Apr 4 06:20:36 2003 UTC
# Line 1  Line 1 
1  ;;; vhdl-mode.el --- major mode for editing VHDL code  ;;; vhdl-mode.el --- major mode for editing VHDL code
2    
3  ;; Copyright (C) 1992,93,94,95,96,97,98,99 Free Software Foundation, Inc.  ;; Copyright (C) 1992-2003 Free Software Foundation, Inc.
4    
5  ;; Authors:     Reto Zimmermann               <mailto:Reto.Zimmermann@iaeth.ch>  ;; Authors:     Reto Zimmermann <reto@gnu.org>
6  ;;                                          <http://www.iis.ee.ethz.ch/~zimmi/>  ;;              Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
7  ;;              Rodney J. Whitby                 <mailto:rwhitby@geocities.com>  ;; Maintainer:  Reto Zimmermann <reto@gnu.org>
8  ;;                          <http://www.geocities.com/SiliconValley/Park/8287/>  ;; RCS:         $Id$
 ;; Maintainer:  VHDL Mode Maintainers                 <vhdl-mode@geocities.com>  
 ;;                         <http://www.geocities.com/SiliconValley/Peaks/8287/>  
 ;; Version:     3.29  
9  ;; Keywords:    languages vhdl  ;; Keywords:    languages vhdl
10    ;; WWW:         http://opensource.ethz.ch/emacs/vhdl-mode.html
11    
12    (defconst vhdl-version "3.32.12"
13      "VHDL Mode version number.")
14    
15    (defconst vhdl-time-stamp "2003-02-28"
16      "VHDL Mode time stamp for last update.")
17    
18  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
19    
# Line 35  Line 39 
39  ;; This package provides an Emacs major mode for editing VHDL code.  ;; This package provides an Emacs major mode for editing VHDL code.
40  ;; It includes the following features:  ;; It includes the following features:
41    
42  ;;   - Highlighting of VHDL syntax  ;;   - Syntax highlighting
43  ;;   - Indentation based on versatile syntax analysis  ;;   - Indentation
44  ;;   - Template insertion (electrification) for most VHDL constructs  ;;   - Template insertion (electrification)
45  ;;   - Insertion of customizable VHDL file headers  ;;   - Insertion of file headers
46  ;;   - Insertion of user-specified models  ;;   - Insertion of user-specified models
47  ;;   - Word completion (dynamic abbreviations)  ;;   - Port translation / testbench generation
48  ;;   - Comprehensive menu  ;;   - Sensitivity list updating
49  ;;   - File browser (using Speedbar or index/sources menu)  ;;   - File browser
50  ;;   - Design hierarchy browser (using Speedbar)  ;;   - Design hierarchy browser
51  ;;   - Source file compilation (syntax analysis)  ;;   - Source file compilation (syntax analysis)
52  ;;   - Postscript printing with fontification  ;;   - Makefile generation
53  ;;   - Lower and upper case keywords  ;;   - Code hiding
54  ;;   - Hiding code of design units  ;;   - Word/keyword completion
55  ;;   - Code beautification  ;;   - Block commenting
56  ;;   - Port translation and test bench generation  ;;   - Code fixing/alignment/beautification
57    ;;   - Postscript printing
58  ;;   - VHDL'87/'93 and VHDL-AMS supported  ;;   - VHDL'87/'93 and VHDL-AMS supported
59    ;;   - Comprehensive menu
60  ;;   - Fully customizable  ;;   - Fully customizable
61  ;;   - Works under GNU Emacs (Unix and Windows NT/95) and XEmacs  ;;   - Works under GNU Emacs (recommended) and XEmacs
 ;;     (GNU Emacs is preferred due to higher robustness and functionality)  
62    
63  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
64  ;; Usage  ;; Documentation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
65    
66  ;; see below (comment in `vhdl-mode' function) or type `C-c C-h' in Emacs.  ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs.
67    
68  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
69  ;; Emacs Versions  ;; Emacs Versions
70    
71    ;; supported: GNU Emacs 20.X/21.X, XEmacs 20.X/21.X
72    ;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally)
73    
74  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
75    ;; Installation
76    
77    ;; Prerequisites:  GNU Emacs 20.X/21.X, XEmacs 20.X/21.X.
78    
79    ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation
80    ;; or into an arbitrary directory that is added to the load path by the
81    ;; following line in your Emacs start-up file `.emacs':
82    
83    ;;   (setq load-path (cons (expand-file-name "<directory-name>") load-path))
84    
85    ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same
86    ;; directory.  Otherwise, byte-compile the source file:
87    ;;   Emacs:  M-x byte-compile-file RET vhdl-mode.el RET
88    ;;   Unix:   emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el
89    
90  ;; supported: Emacs 20.X (Unix and Windows NT/95), XEmacs 20.X  ;; Add the following lines to the `site-start.el' file in the `site-lisp'
91  ;; tested on: Emacs 20.3, XEmacs 20.4 (marginally)  ;; directory of your Emacs installation or to your Emacs start-up file `.emacs'
92    ;; (not required in Emacs 20.X):
93    
94    ;;   (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t)
95    ;;   (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist))
96    
97    ;; More detailed installation instructions are included in the official
98    ;; VHDL Mode distribution.
99    
100  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
101  ;; Acknowledgements  ;; Acknowledgements
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
102    
103  ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>  ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu>
104  ;; and Steve Grout.  ;; and Steve Grout.
105    
106  ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.  ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>.
107  ;; Ideas about alignment from John Wiegley <johnw@borland.com>.  ;; Ideas about alignment from John Wiegley <johnw@gnu.org>.
108    
109  ;; Many thanks to all the users who sent me bug reports and enhancement  ;; Many thanks to all the users who sent me bug reports and enhancement
110  ;; requests.  Colin Marquardt, will you never stop asking for new features :-?  ;; requests.
111    ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable
112    ;; enhancement suggestions and the fruitful discussions.
113  ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.  ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints.
114  ;; Thanks to Ulf Klaperski for the indentation speedup hint.  ;; Thanks to Ulf Klaperski for the indentation speedup hint.
115    
# Line 89  Line 119 
119  ;; This work has been funded in part by MICROSWISS, a Microelectronics Program  ;; This work has been funded in part by MICROSWISS, a Microelectronics Program
120  ;; of the Swiss Government.  ;; of the Swiss Government.
121    
122    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
123    
124  ;;; Code:  ;;; Code:
125    
126    ;; XEmacs handling
127    (defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
128      "Non-nil if XEmacs is used.")
129    ;; Emacs 21 handling
130    (defconst vhdl-emacs-21 (and (= emacs-major-version 21) (not vhdl-xemacs))
131      "Non-nil if GNU Emacs 21 is used.")
132    
133    
134  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135  ;;; Variables  ;;; Variables
136  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137    
138  ;; help function  ;; help function for user options
139  (defun vhdl-custom-set (variable value &rest functions)  (defun vhdl-custom-set (variable value &rest functions)
140    "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."    "Set variables as in `custom-set-default' and call FUNCTIONS afterwards."
141    (if (fboundp 'custom-set-default)    (if (fboundp 'custom-set-default)
# Line 106  Line 145 
145      (when (fboundp (car functions)) (funcall (car functions)))      (when (fboundp (car functions)) (funcall (car functions)))
146      (setq functions (cdr functions))))      (setq functions (cdr functions))))
147    
148    (defun vhdl-widget-directory-validate (widget)
149      "Check that the value of WIDGET is a valid directory entry (i.e. ends with
150    '/' or is empty)."
151      (let ((val (widget-value widget)))
152        (unless (string-match "^\\(\\|.*/\\)$" val)
153          (widget-put widget :error "Invalid directory entry: must end with '/'")
154          widget)))
155    
156    ;; help string for user options
157    (defconst vhdl-name-doc-string "
158    
159    FROM REGEXP is a regular expression matching the original name:
160      \".*\"       matches the entire string
161      \"\\(...\\)\"  matches a substring
162    TO STRING specifies the string to be inserted as new name:
163      \"\\&\"  means substitute entire matched text
164      \"\\N\"  means substitute what matched the Nth \"\\(...\\)\"
165    Examples:
166      \".*\"           \"\\&\"    inserts original string
167      \".*\"           \"\\&_i\"  attaches \"_i\" to original string
168      \"\\(.*\\)_[io]$\" \"\\1\"    strips off \"_i\" or \"_o\" from original string
169      \".*\"           \"foo\"   inserts constant string \"foo\"
170      \".*\"           \"\"      inserts empty string")
171    
172  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
173  ;; User variables  ;; User variables
174    
# Line 113  Line 176 
176    "Customizations for VHDL Mode."    "Customizations for VHDL Mode."
177    :prefix "vhdl-"    :prefix "vhdl-"
178    :group 'languages    :group 'languages
179    :version "20.4"  ; comment out for XEmacs  ;  :version "20.4"  ; comment out for XEmacs
180    )    )
181    
182  (defgroup vhdl-mode nil  (defgroup vhdl-mode nil
# Line 123  Line 186 
186  (defcustom vhdl-electric-mode t  (defcustom vhdl-electric-mode t
187    "*Non-nil enables electrification (automatic template generation).    "*Non-nil enables electrification (automatic template generation).
188  If nil, template generators can still be invoked through key bindings and  If nil, template generators can still be invoked through key bindings and
189  menu.  Is indicated in the modeline by `/e' after the mode name and can be  menu.  Is indicated in the modeline by \"/e\" after the mode name and can be
190  toggled by `\\[vhdl-electric-mode]'."  toggled by `\\[vhdl-electric-mode]'."
191    :type 'boolean    :type 'boolean
192    :group 'vhdl-mode)    :group 'vhdl-mode)
193    
194  (defcustom vhdl-stutter-mode t  (defcustom vhdl-stutter-mode t
195    "*Non-nil enables stuttering.    "*Non-nil enables stuttering.
196  Is indicated in the modeline by `/s' after the mode name and can be toggled  Is indicated in the modeline by \"/s\" after the mode name and can be toggled
197  by `\\[vhdl-stutter-mode]'."  by `\\[vhdl-stutter-mode]'."
198    :type 'boolean    :type 'boolean
199    :group 'vhdl-mode)    :group 'vhdl-mode)
# Line 142  Overrides local variable `indent-tabs-mo Line 205  Overrides local variable `indent-tabs-mo
205    :group 'vhdl-mode)    :group 'vhdl-mode)
206    
207    
 (defgroup vhdl-project nil  
   "Customizations for projects."  
   :group 'vhdl)  
   
 (defcustom vhdl-project-alist  
   '(("example 1" "Project with individual source files"  
      ("~/example1/vhdl/system.vhd" "~/example1/vhdl/component_*.vhd") "\  
 -------------------------------------------------------------------------------  
 -- This is a multi-line project description  
 -- that can be used as a project dependent part of the file header.  
 ")  
     ("example 2" "Project where source files are located in two directories"  
      ("$EXAMPLE2/vhdl/components/" "$EXAMPLE2/vhdl/system/") "")  
     ("example 3" "Project where source files are located in some directory trees"  
      ("-r ~/example3/*/vhdl/") ""))  
   "*List of projects and their properties.  
   Name       : name of project  
   Title      : title of project (one-line string)  
   Sources    : a) source files  : path + \"/\" + file name  
                b) directory     : path + \"/\"  
                c) directory tree: \"-r \" + path + \"/\"  
   Description: description of project (multi-line string)  
   
 Project name and description are used to insert into the file header (see  
 variable `vhdl-file-header').  
   
 Path and file name can contain wildcards `*' and `?'.  Environment variables  
 \(e.g. \"$EXAMPLE2\") are resolved.  
   
 The hierarchy browser shows the hierarchy of the design units found in  
 `Sources'.  If no directories or files are specified, the current directory is  
 shown.  
   
 NOTE: Reflect the new setting in the choice list of variable `vhdl-project'  
       by restarting Emacs."  
   :type '(repeat (list :tag "Project" :indent 2  
                        (string :tag "Name ")  
                        (string :tag "Title")  
                        (repeat :tag "Sources" :indent 4  
                                (string :format "%v"))  
                        (string :tag "Description: (type `C-j' for newline)"  
                                :format "%t\n%v")))  
   :set (lambda (variable value)  
          (vhdl-custom-set variable value 'vhdl-update-mode-menu))  
   :group 'vhdl-project)  
   
 (defcustom vhdl-project ""  
   "*Specifies the default for the current project.  
 Select a project name from the ones defined in variable `vhdl-project-alist'.  
 Is used to determine the project title and description to be inserted in file  
 headers and the source files/directories to be scanned in the hierarchy  
 browser.  The current project can also be changed temporarily in the menu."  
   :type (let ((project-alist vhdl-project-alist) choice-list)  
           (while project-alist  
             (setq choice-list (cons (list 'const (car (car project-alist)))  
                                     choice-list))  
             (setq project-alist (cdr project-alist)))  
           (append '(choice (const :tag "None" "") (const :tag "--"))  
                   (nreverse choice-list)))  
   :group 'vhdl-project)  
   
   
208  (defgroup vhdl-compile nil  (defgroup vhdl-compile nil
209    "Customizations for compilation."    "Customizations for compilation."
210    :group 'vhdl)    :group 'vhdl)
211    
212  (defcustom vhdl-compiler-alist  (defcustom vhdl-compiler-alist
213    '(    '(
214      ;; Cadence Design Systems: cv -file test.vhd      ;; Cadence Leapfrog: cv -file test.vhd
215      ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared      ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared
216      ("Cadence" "cv -file" "" "" "./"      ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1"
217       ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2) ("" 0))       nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog"
218         ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0)
219         ("\\1/entity" "\\2/\\1" "\\1/configuration"
220          "\\1/package" "\\1/body" downcase))
221        ;; Cadence Affirma NC vhdl: ncvhdl test.vhd
222        ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier
223        ;; (PLL_400X_TOP) is not declared [10.3].
224        ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1"
225         nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl"
226         ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0)
227         nil)
228      ;; Ikos Voyager: analyze test.vhd      ;; Ikos Voyager: analyze test.vhd
229      ;; analyze sdrctl.vhd      ;; analyze test.vhd
230      ;; E L4/C5:        this library unit is inaccessible      ;; E L4/C5:        this library unit is inaccessible
231      ("Ikos" "analyze" "" "" "./"      ("Ikos" "analyze" "-l \\1" "make" "-f \\1"
232       ("E L\\([0-9]+\\)/C[0-9]+:" 0 1)       nil "mkdir \\1" "./" "work/" "Makefile" "ikos"
233       ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2))       ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2)
234         ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2)
235         nil)
236      ;; ModelSim, Model Technology: vcom test.vhd      ;; ModelSim, Model Technology: vcom test.vhd
237      ;; ERROR: test.vhd(14): Unknown identifier: positiv      ;; ERROR: test.vhd(14): Unknown identifier: positiv
238      ;; WARNING[2]: test.vhd(85): Possible infinite loop      ;; WARNING[2]: test.vhd(85): Possible infinite loop
239      ("ModelSim" "vcom" "" "vmake > Makefile" "./"      ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb
240       ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3) ("" 0))      ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1"
241         nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim"
242         ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
243         ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
244          "\\1/_primary.dat" "\\1/body.dat" downcase))
245        ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd
246        ;; test.vhd:34: error message
247        ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1"
248         nil "mkdir \\1" "./" "work/" "Makefile" "provhdl"
249         ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
250         ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif"
251          "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase))
252      ;; QuickHDL, Mentor Graphics: qvhcom test.vhd      ;; QuickHDL, Mentor Graphics: qvhcom test.vhd
253      ;; ERROR: test.vhd(24): near "dnd": expecting: END      ;; ERROR: test.vhd(24): near "dnd": expecting: END
254      ;; WARNING[4]: test.vhd(30): A space is required between ...      ;; WARNING[4]: test.vhd(30): A space is required between ...
255      ("QuickHDL" "qvhcom" "" "qhmake >! Makefile" "./"      ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1"
256       ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3) ("" 0))       nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl"
257      ;; Synopsys, VHDL Analyzer: vhdlan test.vhd       ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0)
258         ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat"
259          "\\1/_primary.dat" "\\1/body.dat" downcase))
260        ;; Savant: scram -publish-cc test.vhd
261        ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for
262        ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1"
263         nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant"
264         ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0)
265         ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl"
266          "\\1_config.vhdl" "\\1_package.vhdl"
267          "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase))
268        ;; Simili: vhdlp -work test.vhd
269        ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix
270        ("Simili" "vhdlp" "-work \\1" "make" "-f \\1"
271         nil "mkdir \\1" "./" "work/" "Makefile" "simili"
272         ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0)
273         ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var"
274          "\\1/prim.var" "\\1/_body.var" downcase))
275        ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd
276        ;;     ERROR[11]::File test.vhd Line 100: Use of undeclared identifier
277        ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
278         nil "mkdir \\1" "./" "work/" "Makefile" "speedwave"
279         ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0)
280         nil)
281        ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd
282      ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.      ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
283      ("Synopsys" "vhdlan" "" "" "./"      ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1"
284       ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2) ("" 0))       nil "mkdir \\1" "./" "work/" "Makefile" "synopsys"
285         ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
286         ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase))
287        ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd
288        ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context.
289        ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1"
290         nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc"
291         ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0)
292         ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase))
293        ;; Synplify:
294        ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0
295        ("Synplify" "n/a" "n/a" "make" "-f \\1"
296         nil "mkdir \\1" "./" "work/" "Makefile" "synplify"
297         ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0)
298         nil)
299      ;; Vantage: analyze -libfile vsslib.ini -src test.vhd      ;; Vantage: analyze -libfile vsslib.ini -src test.vhd
300      ;;     Compiling "pcu.vhd" line 1...      ;;     Compiling "test.vhd" line 1...
301      ;; **Error: LINE 499 *** No aggregate value is valid in this context.      ;; **Error: LINE 49 *** No aggregate value is valid in this context.
302      ("Vantage" "analyze -libfile vsslib.ini -src" "" "" "./"      ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
303       ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1)       nil "mkdir \\1" "./" "work/" "Makefile" "vantage"
304       ("^ *Compiling \"\\(.+\\)\" " 1))       ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
305         ("^ *Compiling \"\\(.+\\)\" " 1)
306         nil)
307        ;; VeriBest: vc vhdl test.vhd
308        ;; (no file name printed out!)
309        ;;     32:   Z <=  A and BitA ;
310        ;;                       ^^^^
311        ;; [Error] Name BITA is unknown
312        ("VeriBest" "vc" "vhdl" "make" "-f \\1"
313         nil "mkdir \\1" "./" "work/" "Makefile" "veribest"
314         ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0)
315         nil)
316      ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd      ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd
317      ;;     Compiling "pcu.vhd" line 1...      ;;     Compiling "test.vhd" line 1...
318      ;; **Error: LINE 499 *** No aggregate value is valid in this context.      ;; **Error: LINE 49 *** No aggregate value is valid in this context.
319      ("Viewlogic" "analyze -libfile vsslib.ini -src" "" "" "./"      ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1"
320       ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1)       nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic"
321       ("^ *Compiling \"\\(.+\\)\" " 1))       ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0)
322         ("^ *Compiling \"\\(.+\\)\" " 1)
323         nil)
324      )      )
325    "*List of available VHDL compilers and their properties.    "*List of available VHDL compilers and their properties.
326  Each list entry specifies the following items for a compiler:  Each list entry specifies the following items for a compiler:
327  Compiler:  Compiler:
328    Compiler Name    : name used in variable `vhdl-compiler' to choose compiler    Compiler name    : name used in option `vhdl-compiler' to choose compiler
329    Compile Command  : command including options used for syntax analysis    Compile command  : command used for source file compilation
330    Make Command     : command including options used instead of `make' (default)    Compile options  : compile options (\"\\1\" inserts library name)
331    Generate Makefile: command to generate a Makefile (used by `make' command)    Make command     : command used for compilation using a Makefile
332    From Directory   : directory where compilation is run (must end with '/')    Make options     : make options (\"\\1\" inserts Makefile name)
333  Error Message:    Generate Makefile: use built-in function or command to generate a Makefile
334                         \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name)
335      Library command  : command to create library directory \(\"\\1\" inserts
336                         library directory, \"\\2\" inserts library name)
337      Compile directory: where compilation is run and the Makefile is placed
338      Library directory: directory of default library
339      Makefile name    : name of Makefile (default is \"Makefile\")
340      ID string        : compiler identification string (see `vhdl-project-alist')
341    Error message:
342    Regexp           : regular expression to match error messages    Regexp           : regular expression to match error messages
343    File Subexp Index: index of subexpression that matches the file name    File subexp index: index of subexpression that matches the file name
344    Line Subexp Index: index of subexpression that matches the line number    Line subexp index: index of subexpression that matches the line number
345  File Message:    Column subexp idx: index of subexpression that matches the column number
346    File message:
347    Regexp           : regular expression to match a file name message    Regexp           : regular expression to match a file name message
348    File Subexp Index: index of subexpression that matches the file name    File subexp index: index of subexpression that matches the file name
349    Unit-to-file name mapping: mapping of library unit names to names of files
350  See also variable `vhdl-compiler-options' to add options to the compile                       generated by the compiler (used for Makefile generation)
351  command.    To string        : string a name is mapped to (\"\\1\" inserts the unit name,
352                         \"\\2\" inserts the entity name for architectures)
353      Case adjustment  : adjust case of inserted unit names
354    
355    Compile options allows insertion of the library name (see `vhdl-project-alist')
356    in order to set the compilers library option (e.g. \"vcom -work my_lib\").
357    
358    For Makefile generation, the built-in function can be used (requires
359    specification of the unit-to-file name mapping).  Alternatively, an
360    external command can be specified.  Work directory allows specification of
361    an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\",
362    used for Makefile generation).  To use another library name than \"work\",
363    customize `vhdl-project-alist'.  The library command is inserted in Makefiles
364    to automatically create the library directory if not existent.
365    
366    Compile options, compile directory, library directory, and Makefile name are
367    overwritten by the project settings if a project is defined (see
368    `vhdl-project-alist').  Directory paths are relative to the source file
369    directory.
370    
371  Some compilers do not include the file name in the error message, but print  Some compilers do not include the file name in the error message, but print
372  out a file name message in advance.  In this case, set \"File Subexp Index\"  out a file name message in advance.  In this case, set \"File Subexp Index\"
373  to 0 and fill out the \"File Message\" entries.  under \"Error Message\" to 0 and fill out the \"File Message\" entries.
374    If no file name at all is printed out, set both \"File Message\" entries to 0
375    \(a default file name message will be printed out instead, does not work in
376    XEmacs).
377    
378  A compiler is selected for syntax analysis (`\\[vhdl-compile]') by  A compiler is selected for syntax analysis (`\\[vhdl-compile]') by
379  assigning its name to variable `vhdl-compiler'.  assigning its name to option `vhdl-compiler'.
380    
381    Please send any missing or erroneous compiler properties to the maintainer for
382    updating.
383    
384  NOTE: Reflect the new setting in the choice list of variable `vhdl-compiler'  NOTE: Reflect the new setting in the choice list of option `vhdl-compiler'
385        by restarting Emacs."        by restarting Emacs."
386    :type '(repeat (list :tag "Compiler" :indent 2    :type '(repeat
387                         (string :tag "Compiler Name    ")            (list :tag "Compiler" :indent 2
388                         (string :tag "Compile Command  ")                  (string :tag "Compiler name      ")
389                         (string :tag "Make Command     ")                  (string :tag "Compile command    ")
390                         (string :tag "Generate Makefile")                  (string :tag "Compile options    " "-work \\1")
391                         (string :tag "From Directory   " "./")                  (string :tag "Make command       " "make")
392                         (list :tag "Error Message" :indent 4                  (string :tag "Make options       " "-f \\1")
393                               (regexp  :tag "Regexp           ")                  (choice :tag "Generate Makefile  "
394                               (integer :tag "File Subexp Index")                          (const :tag "Built-in function" nil)
395                               (integer :tag "Line Subexp Index"))                          (string :tag "Command" "vmake \\2 > \\1"))
396                         (list :tag "File Message" :indent 4                  (string :tag "Library command    " "mkdir \\1")
397                               (regexp  :tag "Regexp           ")                  (directory :tag "Compile directory  "
398                               (integer :tag "File Subexp Index"))))                             :validate vhdl-widget-directory-validate "./")
399                    (directory :tag "Library directory  "
400                               :validate vhdl-widget-directory-validate "work/")
401                    (file :tag "Makefile name      " "Makefile")
402                    (string :tag "ID string          ")
403                    (list :tag "Error message" :indent 4
404                          (regexp  :tag "Regexp           ")
405                          (integer :tag "File subexp index")
406                          (integer :tag "Line subexp index")
407                          (integer :tag "Column subexp idx"))
408                    (list :tag "File message" :indent 4
409                          (regexp  :tag "Regexp           ")
410                          (integer :tag "File subexp index"))
411                    (choice :tag "Unit-to-file name mapping"
412                            :format "%t: %[Value Menu%] %v\n"
413                            (const :tag "Not defined" nil)
414                            (list :tag "To string" :indent 4
415                                  (string :tag "Entity           " "\\1.vhd")
416                                  (string :tag "Architecture     " "\\2_\\1.vhd")
417                                  (string :tag "Configuration    " "\\1.vhd")
418                                  (string :tag "Package          " "\\1.vhd")
419                                  (string :tag "Package Body     " "\\1_body.vhd")
420                                  (choice :tag "Case adjustment  "
421                                          (const :tag "None" identity)
422                                          (const :tag "Upcase" upcase)
423                                          (const :tag "Downcase" downcase))))))
424    :set (lambda (variable value)    :set (lambda (variable value)
425           (vhdl-custom-set variable value 'vhdl-update-mode-menu))           (vhdl-custom-set variable value 'vhdl-update-mode-menu))
426    :group 'vhdl-compile)    :group 'vhdl-compile)
427    
428  (defcustom vhdl-compiler "ModelSim"  (defcustom vhdl-compiler "ModelSim"
429    "*Specifies the VHDL compiler to be used for syntax analysis.    "*Specifies the VHDL compiler to be used for syntax analysis.
430  Select a compiler name from the ones defined in variable `vhdl-compiler-alist'."  Select a compiler name from the ones defined in option `vhdl-compiler-alist'."
431    :type (let ((compiler-alist vhdl-compiler-alist) choice-list)    :type (let ((alist vhdl-compiler-alist) list)
432            (while compiler-alist            (while alist
433              (setq choice-list (cons (list 'const (car (car compiler-alist)))              (setq list (cons (list 'const (caar alist)) list))
434                                      choice-list))              (setq alist (cdr alist)))
435              (setq compiler-alist (cdr compiler-alist)))            (append '(choice) (nreverse list)))
436            (append '(choice) (nreverse choice-list)))    :group 'vhdl-compile)
437    
438    (defcustom vhdl-compile-use-local-error-regexp t
439      "*Non-nil means use buffer-local `compilation-error-regexp-alist'.
440    In this case, only error message regexps for VHDL compilers are active if
441    compilation is started from a VHDL buffer.  Otherwise, the error message
442    regexps are appended to the predefined global regexps, and all regexps are
443    active all the time.  Note that by doing that, the predefined global regexps
444    might result in erroneous parsing of error messages for some VHDL compilers.
445    
446    NOTE: Activate the new setting by restarting Emacs."
447      :type 'boolean
448    :group 'vhdl-compile)    :group 'vhdl-compile)
449    
450  (defcustom vhdl-compiler-options ""  (defcustom vhdl-makefile-generation-hook nil
451   "*Options to be added to the compile command."    "*Functions to run at the end of Makefile generation.
452    Allows to insert user specific parts into a Makefile.
453    
454    Example:
455      \(lambda nil
456        \(re-search-backward \"^# Rule for compiling entire design\")
457        \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))"
458      :type 'hook
459      :group 'vhdl-compile)
460    
461    (defcustom vhdl-default-library "work"
462      "*Name of default library.
463    Is overwritten by project settings if a project is active."
464    :type 'string    :type 'string
465    :group 'vhdl-compile)    :group 'vhdl-compile)
466    
467    
468  (defgroup vhdl-style nil  (defgroup vhdl-project nil
469    "Customizations for code styles."    "Customizations for projects."
470    :group 'vhdl)    :group 'vhdl)
471    
472    (defcustom vhdl-project-alist
473      '(("Example 1" "Source files in two directories, custom library name, VHDL'87"
474         "~/example1/" ("src/system/" "src/components/") ""
475         (("ModelSim" "-87 \\2" "-f \\1 top_level" nil)
476          ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil))))
477         "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "")
478        ("Example 2" "Individual source files, multiple compilers in different directories"
479         "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") ""
480         nil "\\1/" "work" "\\1/work/" "Makefile" "")
481        ("Example 3" "Source files in a directory tree, multiple compilers in same directory"
482         "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/"
483         nil "./" "work" "work-\\1/" "Makefile-\\1" "\
484    -------------------------------------------------------------------------------
485    -- This is a multi-line project description
486    -- that can be used as a project dependent part of the file header.
487    "))
488      "*List of projects and their properties.
489      Name             : name used in option `vhdl-project' to choose project
490      Title            : title of project (single-line string)
491      Default directory: default project directory (absolute path)
492      Sources          : a) source files  : path + \"/\" + file name
493                         b) directory     : path + \"/\"
494                         c) directory tree: \"-r \" + path + \"/\"
495      Exclude regexp   : matches file/directory names to be excluded as sources
496      Compile options  : project-specific options for each compiler
497        Compiler name  : name of compiler for which these options are valid
498        Compile options: project-specific compiler options
499                         (\"\\1\" inserts library name, \"\\2\" default options)
500        Make options:    project-specific make options
501                         (\"\\1\" inserts Makefile name, \"\\2\" default options)
502        Exceptions     : file-specific exceptions
503          File name regexp: matches file names for which exceptions are valid
504          - Options       : file-specific compiler options string
505                            (\"\\1\" inserts library name, \"\\2\" default options,
506                            \"\\3\" project-specific options)
507          - Do not compile: do not compile this file (in Makefile)
508      Compile directory: where compilation is run and the Makefile is placed
509                         \(\"\\1\" inserts compiler ID string)
510      Library name     : name of library (default is \"work\")
511      Library directory: path to library (\"\\1\" inserts compiler ID string)
512      Makefile name    : name of Makefile
513                         (\"\\1\" inserts compiler ID string, \"\\2\" library name)
514      Description      : description of project (multi-line string)
515    
516    Project title and description are used to insert into the file header (see
517    option `vhdl-file-header').
518    
519    The default directory must have an absolute path (use `M-TAB' for completion).
520    All other paths can be absolute or relative to the default directory.  All
521    paths must end with '/'.
522    
523    The design units found in the sources (files and directories) are shown in the
524    hierarchy browser.  Path and file name can contain wildcards `*' and `?' as
525    well as \"./\" and \"../\" (\"sh\" syntax).  Paths can also be absolute.
526    Environment variables (e.g. \"$EXAMPLE2\") are resolved.  If no sources are
527    specified, the default directory is taken as source directory.  Otherwise,
528    the default directory is only taken as source directory if there is a sources
529    entry with the empty string or \"./\".  Exclude regexp allows to filter out
530    specific file and directory names from the list of sources (e.g. CVS
531    directories).
532    
533    Files are compiled in the compile directory.  Makefiles are also placed into
534    the compile directory.  Library directory specifies which directory the
535    compiler compiles into (used to generate the Makefile).
536    
537    Since different compile/library directories and Makefiles may exist for
538    different compilers within one project, these paths and names allow the
539    insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist').
540    Compile options, compile directory, library directory, and Makefile name
541    overwrite the settings of the current compiler.
542    
543    File-specific compiler options (highest priority) overwrite project-specific
544    options which overwrite default options (lowest priority).  Lower priority
545    options can be inserted in higher priority options.  This allows to reuse
546    default options (e.g. \"-file\") in project- or file-specific options (e.g.
547    \"-93 -file\").
548    
549    NOTE: Reflect the new setting in the choice list of option `vhdl-project'
550          by restarting Emacs."
551      :type `(repeat
552              (list :tag "Project" :indent 2
553                    (string :tag "Name             ")
554                    (string :tag "Title            ")
555                    (directory :tag "Default directory"
556                               :validate vhdl-widget-directory-validate
557                               ,(abbreviate-file-name default-directory))
558                    (repeat :tag "Sources          " :indent 4
559                            (directory :format "     %v" "./"))
560                    (regexp :tag "Exclude regexp   ")
561                    (repeat
562                     :tag "Compile options  " :indent 4
563                     (list :tag "Compiler" :indent 6
564                           ,(let ((alist vhdl-compiler-alist) list)
565                              (while alist
566                                (setq list (cons (list 'const (caar alist)) list))
567                                (setq alist (cdr alist)))
568                              (append '(choice :tag "Compiler name")
569                                      (nreverse list)))
570                           (string :tag "Compile options" "\\2")
571                           (string :tag "Make options   " "\\2")
572                           (repeat
573                            :tag "Exceptions   " :indent 8
574                            (cons :format "%v"
575                                  (regexp :tag "File name regexp    ")
576                                  (choice :format "%[Value Menu%] %v"
577                                          (string :tag "Options" "\\3")
578                                          (const :tag "Do not compile" nil))))))
579                    (directory :tag "Compile directory"
580                               :validate vhdl-widget-directory-validate "./")
581                    (string :tag "Library name     " "work")
582                    (directory :tag "Library directory"
583                               :validate vhdl-widget-directory-validate "work/")
584                    (file :tag "Makefile name    " "Makefile")
585                    (string :tag "Description: (type `C-j' for newline)"
586                            :format "%t\n%v\n")))
587      :set (lambda (variable value)
588             (vhdl-custom-set variable value
589                              'vhdl-update-mode-menu
590                              'vhdl-speedbar-refresh))
591      :group 'vhdl-project)
592    
593    (defcustom vhdl-project nil
594      "*Specifies the default for the current project.
595    Select a project name from the ones defined in option `vhdl-project-alist'.
596    Is used to determine the project title and description to be inserted in file
597    headers and the source files/directories to be scanned in the hierarchy
598    browser.  The current project can also be changed temporarily in the menu."
599      :type (let ((alist vhdl-project-alist) list)
600              (while alist
601                (setq list (cons (list 'const (caar alist)) list))
602                (setq alist (cdr alist)))
603              (append '(choice (const :tag "None" nil) (const :tag "--"))
604                      (nreverse list)))
605      :group 'vhdl-project)
606    
607    (defcustom vhdl-project-file-name '("\\1.prj")
608      "*List of file names/paths for importing/exporting project setups.
609    \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is
610    replaced by the user name (allows to have user-specific project setups).
611    The first entry is used as file name to import/export individual project
612    setups.  All entries are used to automatically import project setups at
613    startup (see option `vhdl-project-auto-load').  Projects loaded from the
614    first entry are automatically made current.  Hint: specify local project
615    setups in first entry, global setups in following entries; loading a local
616    project setup will make it current, while loading the global setups
617    is done without changing the current project.
618    Names can also have an absolute path (i.e. project setups can be stored
619    in global directories)."
620      :type '(repeat (string :tag "File name" "\\1.prj"))
621      :group 'vhdl-project)
622    
623    (defcustom vhdl-project-auto-load '(startup)
624      "*Automatically load project setups from files.
625    All project setup files that match the file names specified in option
626    `vhdl-project-file-name' are automatically loaded.  The project of the
627    \(alphabetically) last loaded setup of the first `vhdl-project-file-name'
628    entry is activated.
629    A project setup file can be obtained by exporting a project (see menu).
630      At startup: project setup file is loaded at Emacs startup"
631      :type '(set (const :tag "At startup" startup))
632      :group 'vhdl-project)
633    
634    (defcustom vhdl-project-sort t
635      "*Non-nil means projects are displayed in alphabetical order."
636      :type 'boolean
637      :group 'vhdl-project)
638    
639    
640    (defgroup vhdl-style nil
641      "Customizations for coding styles."
642      :group 'vhdl
643      :group 'vhdl-template
644      :group 'vhdl-port
645      :group 'vhdl-compose)
646    
647  (defcustom vhdl-standard '(87 nil)  (defcustom vhdl-standard '(87 nil)
648    "*VHDL standards used.    "*VHDL standards used.
649  Basic standard:  Basic standard:
# Line 320  Basic standard: Line 651  Basic standard:
651    VHDL'93      : IEEE Std 1076-1993    VHDL'93      : IEEE Std 1076-1993
652  Additional standards:  Additional standards:
653    VHDL-AMS     : IEEE Std 1076.1 (analog-mixed-signal)    VHDL-AMS     : IEEE Std 1076.1 (analog-mixed-signal)
654    Math Packages: IEEE Std 1076.2 (`math_real', `math_complex')    Math packages: IEEE Std 1076.2 (`math_real', `math_complex')
655    
656  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
657        \"Activate New Customizations\"."        \"Activate Options\"."
658    :type '(list (choice :tag "Basic standard"    :type '(list (choice :tag "Basic standard"
659                         (const :tag "VHDL'87" 87)                         (const :tag "VHDL'87" 87)
660                         (const :tag "VHDL'93" 93))                         (const :tag "VHDL'93" 93))
661                 (set :tag "Additional standards" :indent 2                 (set :tag "Additional standards" :indent 2
662                      (const :tag "VHDL-AMS" ams)                      (const :tag "VHDL-AMS" ams)
663                      (const :tag "Math Packages" math)))                      (const :tag "Math packages" math)))
664    :set (lambda (variable value)    :set (lambda (variable value)
665           (vhdl-custom-set variable value           (vhdl-custom-set variable value
666                            'vhdl-template-map-init                            'vhdl-template-map-init
# Line 386  This is done when expanded." Line 717  This is done when expanded."
717           (vhdl-custom-set variable value 'vhdl-abbrev-list-init))           (vhdl-custom-set variable value 'vhdl-abbrev-list-init))
718    :group 'vhdl-style)    :group 'vhdl-style)
719    
720    (defcustom vhdl-use-direct-instantiation 'standard
721      "*Non-nil means use VHDL'93 direct component instantiation.
722      Never   : never
723      Standard: only in VHDL standards that allow it (VHDL'93 and higher)
724      Always  : always"
725      :type '(choice (const :tag "Never" never)
726                     (const :tag "Standard" standard)
727                     (const :tag "Always" always))
728      :group 'vhdl-style)
729    
730    
731    (defgroup vhdl-naming nil
732      "Customizations for naming conventions."
733      :group 'vhdl)
734    
735    (defcustom vhdl-entity-file-name '(".*" . "\\&")
736      (concat
737       "*Specifies how the entity file name is obtained.
738    The entity file name can be obtained by modifying the entity name (e.g.
739    attaching or stripping off a substring).  The file extension is automatically
740    taken from the file name of the current buffer."
741       vhdl-name-doc-string)
742      :type '(cons (regexp :tag "From regexp")
743                   (string :tag "To string  "))
744      :group 'vhdl-naming
745      :group 'vhdl-compose)
746    
747    (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2")
748      (concat
749       "*Specifies how the architecture file name is obtained.
750    The architecture file name can be obtained by modifying the entity
751    and/or architecture name (e.g. attaching or stripping off a substring).  The
752    string that is matched against the regexp is the concatenation of the entity
753    and the architecture name separated by a space.  This gives access to both
754    names (see default setting as example)."
755       vhdl-name-doc-string)
756      :type '(cons (regexp :tag "From regexp")
757                   (string :tag "To string  "))
758      :group 'vhdl-naming
759      :group 'vhdl-compose)
760    
761    (defcustom vhdl-package-file-name '(".*" . "\\&")
762      (concat
763       "*Specifies how the package file name is obtained.
764    The package file name can be obtained by modifying the package name (e.g.
765    attaching or stripping off a substring).  The file extension is automatically
766    taken from the file name of the current buffer."
767       vhdl-name-doc-string)
768      :type '(cons (regexp :tag "From regexp")
769                   (string :tag "To string  "))
770      :group 'vhdl-naming
771      :group 'vhdl-compose)
772    
773    (defcustom vhdl-file-name-case 'identity
774      "*Specifies how to change case for obtaining file names.
775    When deriving a file name from a VHDL unit name, case can be changed as
776    follows:
777      As Is:      case is not changed (taken as is)
778      Lower Case: whole name is changed to lower case
779      Upper Case: whole name is changed to upper case
780      Capitalize: first letter of each word in name is capitalized"
781      :type '(choice (const :tag "As Is" identity)
782                     (const :tag "Lower Case" downcase)
783                     (const :tag "Upper Case" upcase)
784                     (const :tag "Capitalize" capitalize))
785      :group 'vhdl-naming
786      :group 'vhdl-compose)
787    
788    
789  (defgroup vhdl-electric nil  (defgroup vhdl-template nil
790    "Customizations for electrification."    "Customizations for electrification."
791    :group 'vhdl)    :group 'vhdl)
792    
793  (defcustom vhdl-electric-keywords '(vhdl user)  (defcustom vhdl-electric-keywords '(vhdl user)
794    "*Type of keywords for which electrification is enabled.    "*Type of keywords for which electrification is enabled.
795    VHDL keywords: invoke built-in templates    VHDL keywords: invoke built-in templates
796    User keywords: invoke user models (see variable `vhdl-model-alist')"    User keywords: invoke user models (see option `vhdl-model-alist')"
797    :type '(set (const :tag "VHDL keywords" vhdl)    :type '(set (const :tag "VHDL keywords" vhdl)
798                (const :tag "User keywords" user))                (const :tag "User model keywords" user))
799    :set (lambda (variable value)    :set (lambda (variable value)
800           (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))           (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init))
801    :group 'vhdl-electric)    :group 'vhdl-template)
802    
803  (defcustom vhdl-optional-labels 'process  (defcustom vhdl-optional-labels 'process
804    "*Constructs for which labels are to be queried.    "*Constructs for which labels are to be queried.
# Line 410  Template generators prompt for optional Line 809  Template generators prompt for optional
809    :type '(choice (const :tag "None" none)    :type '(choice (const :tag "None" none)
810                   (const :tag "Processes only" process)                   (const :tag "Processes only" process)
811                   (const :tag "All constructs" all))                   (const :tag "All constructs" all))
812    :group 'vhdl-electric)    :group 'vhdl-template)
813    
814  (defcustom vhdl-insert-empty-lines 'unit  (defcustom vhdl-insert-empty-lines 'unit
815    "*Specifies whether to insert empty lines in some templates.    "*Specifies whether to insert empty lines in some templates.
# Line 419  This improves readability of code.  Empt Line 818  This improves readability of code.  Empt
818    Design units only: entities, architectures, configurations, packages only    Design units only: entities, architectures, configurations, packages only
819    All constructs   : also all constructs with BEGIN...END parts    All constructs   : also all constructs with BEGIN...END parts
820    
821  Replaces variable `vhdl-additional-empty-lines'."  Replaces option `vhdl-additional-empty-lines'."
822    :type '(choice (const :tag "None" none)    :type '(choice (const :tag "None" none)
823                   (const :tag "Design units only" unit)                   (const :tag "Design units only" unit)
824                   (const :tag "All constructs" all))                   (const :tag "All constructs" all))
825    :group 'vhdl-electric)    :group 'vhdl-template
826      :group 'vhdl-port
827      :group 'vhdl-compose)
828    
829  (defcustom vhdl-argument-list-indent nil  (defcustom vhdl-argument-list-indent nil
830    "*Non-nil means indent argument lists relative to opening parenthesis.    "*Non-nil means indent argument lists relative to opening parenthesis.
# Line 431  That is, argument, association, and port Line 832  That is, argument, association, and port
832  opening parenthesis and subsequent lines are indented accordingly.  opening parenthesis and subsequent lines are indented accordingly.
833  Otherwise, lists start on a new line and are indented as normal code."  Otherwise, lists start on a new line and are indented as normal code."
834    :type 'boolean    :type 'boolean
835    :group 'vhdl-electric)    :group 'vhdl-template
836      :group 'vhdl-port
837      :group 'vhdl-compose)
838    
839  (defcustom vhdl-association-list-with-formals t  (defcustom vhdl-association-list-with-formals t
840    "*Non-nil means write association lists with formal parameters.    "*Non-nil means write association lists with formal parameters.
841  In templates, you are prompted for formal and actual parameters.  Templates prompt for formal and actual parameters (ports/generics).
842    When pasting component instantiations, formals are included.
843  If nil, only a list of actual parameters is entered."  If nil, only a list of actual parameters is entered."
844    :type 'boolean    :type 'boolean
845    :group 'vhdl-electric)    :group 'vhdl-template
846      :group 'vhdl-port
847      :group 'vhdl-compose)
848    
849  (defcustom vhdl-conditions-in-parenthesis nil  (defcustom vhdl-conditions-in-parenthesis nil
850    "*Non-nil means place parenthesis around condition expressions."    "*Non-nil means place parenthesis around condition expressions."
851    :type 'boolean    :type 'boolean
852    :group 'vhdl-electric)    :group 'vhdl-template)
853    
854  (defcustom vhdl-zero-string "'0'"  (defcustom vhdl-zero-string "'0'"
855    "*String to use for a logic zero."    "*String to use for a logic zero."
856    :type 'string    :type 'string
857    :group 'vhdl-electric)    :group 'vhdl-template)
858    
859  (defcustom vhdl-one-string "'1'"  (defcustom vhdl-one-string "'1'"
860    "*String to use for a logic one."    "*String to use for a logic one."
861    :type 'string    :type 'string
862    :group 'vhdl-electric)    :group 'vhdl-template)
863    
864    
865  (defgroup vhdl-header nil  (defgroup vhdl-header nil
866    "Customizations for file header."    "Customizations for file header."
867    :group 'vhdl-electric)    :group 'vhdl-template
868      :group 'vhdl-compose)
869    
870  (defcustom vhdl-file-header "\  (defcustom vhdl-file-header "\
871  -------------------------------------------------------------------------------  -------------------------------------------------------------------------------
# Line 468  If nil, only a list of actual parameters Line 875  If nil, only a list of actual parameters
875  -- File       : <filename>  -- File       : <filename>
876  -- Author     : <author>  -- Author     : <author>
877  -- Company    : <company>  -- Company    : <company>
878    -- Created    : <date>
879  -- Last update: <date>  -- Last update: <date>
880  -- Platform   : <platform>  -- Platform   : <platform>
881    -- Standard   : <standard>
882  <projectdesc>-------------------------------------------------------------------------------  <projectdesc>-------------------------------------------------------------------------------
883  -- Description: <cursor>  -- Description: <cursor>
884  -------------------------------------------------------------------------------  <copyright>-------------------------------------------------------------------------------
885  -- Revisions  :  -- Revisions  :
886  -- Date        Version  Author  Description  -- Date        Version  Author  Description
887  -- <date>  1.0      <login>\tCreated  -- <date>  1.0      <login>\tCreated
# Line 487  If the header contains RCS keywords, the Line 896  If the header contains RCS keywords, the
896  if the header needs to be version controlled.  if the header needs to be version controlled.
897    
898  The following keywords for template generation are supported:  The following keywords for template generation are supported:
899    <filename>   : replaced by the name of the buffer    <filename>    : replaced by the name of the buffer
900    <author>     : replaced by the user name and email address (customize    <author>      : replaced by the user name and email address
901                   `mail-host-address' or `user-mail-address' if required)                    \(`user-full-name',`mail-host-address', `user-mail-address')
902    <login>      : replaced by user login name    <login>       : replaced by user login name (`user-login-name')
903    <company>    : replaced by contents of variable `vhdl-company-name'    <company>     : replaced by contents of option `vhdl-company-name'
904    <date>       : replaced by the current date    <date>        : replaced by the current date
905    <project>    : replaced by title of current project (`vhdl-project')    <year>        : replaced by the current year
906    <projectdesc>: replaced by description of current project (`vhdl-project')    <project>     : replaced by title of current project (`vhdl-project')
907    <platform>   : replaced by contents of variable `vhdl-platform-spec'    <projectdesc> : replaced by description of current project (`vhdl-project')
908    <... string> : replaced by a queried string (... is the prompt word)    <copyright>   : replaced by copyright string (`vhdl-copyright-string')
909    <cursor>     : final cursor position    <platform>    : replaced by contents of option `vhdl-platform-spec'
910      <standard>    : replaced by the VHDL language standard(s) used
911      <... string>  : replaced by a queried string (\"...\" is the prompt word)
912      <title string>: replaced by file title in automatically generated files
913      <cursor>      : final cursor position
914    
915  The (multi-line) project description <projectdesc> can be used as a project  The (multi-line) project description <projectdesc> can be used as a project
916  dependent part of the file header and can also contain the above keywords."  dependent part of the file header and can also contain the above keywords."
# Line 509  dependent part of the file header and ca Line 922  dependent part of the file header and ca
922  If the string specifies an existing file name, the contents of the file is  If the string specifies an existing file name, the contents of the file is
923  inserted, otherwise the string itself is inserted as file footer (i.e. at  inserted, otherwise the string itself is inserted as file footer (i.e. at
924  the end of the file).  the end of the file).
925  Type `C-j' for newlines."  Type `C-j' for newlines.
926    The same keywords as in option `vhdl-file-header' can be used."
927    :type 'string    :type 'string
928    :group 'vhdl-header)    :group 'vhdl-header)
929    
930  (defcustom vhdl-company-name ""  (defcustom vhdl-company-name ""
931    "*Name of company to insert in file header."    "*Name of company to insert in file header.
932    See option `vhdl-file-header'."
933      :type 'string
934      :group 'vhdl-header)
935    
936    (defcustom vhdl-copyright-string "\
937    -------------------------------------------------------------------------------
938    -- Copyright (c) <year> <company>
939    "
940      "*Copyright string to insert in file header.
941    Can be multi-line string (type `C-j' for newline) and contain other file
942    header keywords (see option `vhdl-file-header')."
943    :type 'string    :type 'string
944    :group 'vhdl-header)    :group 'vhdl-header)
945    
946  (defcustom vhdl-platform-spec ""  (defcustom vhdl-platform-spec ""
947    "*Specification of VHDL platform to insert in file header.    "*Specification of VHDL platform to insert in file header.
948  The platform specification should contain names and versions of the  The platform specification should contain names and versions of the
949  simulation and synthesis tools used."  simulation and synthesis tools used.
950    See option `vhdl-file-header'."
951    :type 'string    :type 'string
952    :group 'vhdl-header)    :group 'vhdl-header)
953    
954  (defcustom vhdl-date-format "%Y/%m/%d"  (defcustom vhdl-date-format "%Y-%m-%d"
955    "*Specifies the date format to use in the header.    "*Specifies the date format to use in the header.
956  This string is passed as argument to the command `format-time-string'.  This string is passed as argument to the command `format-time-string'.
957  For more information on format strings, see the documentation for the  For more information on format strings, see the documentation for the
# Line 545  of the line replaced by the current date Line 971  of the line replaced by the current date
971    "*Non-nil means update the modification date when the buffer is saved.    "*Non-nil means update the modification date when the buffer is saved.
972  Calls function `\\[vhdl-template-modify]').  Calls function `\\[vhdl-template-modify]').
973    
974  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
975        \"Activate New Customizations\""        \"Activate Options\"."
976    :type 'boolean    :type 'boolean
977    :group 'vhdl-header)    :group 'vhdl-header)
978    
979    
980  (defgroup vhdl-sequential-process nil  (defgroup vhdl-sequential-process nil
981    "Customizations for sequential processes."    "Customizations for sequential processes."
982    :group 'vhdl-electric)    :group 'vhdl-template)
983    
984  (defcustom vhdl-reset-kind 'async  (defcustom vhdl-reset-kind 'async
985    "*Specifies which kind of reset to use in sequential processes."    "*Specifies which kind of reset to use in sequential processes."
# Line 564  NOTE: Activate the new setting in a VHDL Line 990  NOTE: Activate the new setting in a VHDL
990    
991  (defcustom vhdl-reset-active-high nil  (defcustom vhdl-reset-active-high nil
992    "*Non-nil means reset in sequential processes is active high.    "*Non-nil means reset in sequential processes is active high.
993  nil means active low."  Nil means active low."
994    :type 'boolean    :type 'boolean
995    :group 'vhdl-sequential-process)    :group 'vhdl-sequential-process)
996    
997  (defcustom vhdl-clock-rising-edge t  (defcustom vhdl-clock-rising-edge t
998    "*Non-nil means rising edge of clock triggers sequential processes.    "*Non-nil means rising edge of clock triggers sequential processes.
999  nil means falling edge."  Nil means falling edge."
1000    :type 'boolean    :type 'boolean
1001    :group 'vhdl-sequential-process)    :group 'vhdl-sequential-process)
1002    
# Line 598  nil means falling edge." Line 1024  nil means falling edge."
1024    :group 'vhdl)    :group 'vhdl)
1025    
1026  (defcustom vhdl-model-alist  (defcustom vhdl-model-alist
1027    '(("example model"    '(("Example Model"
1028       "<label> : process (<clock>, <reset>)       "<label> : process (<clock>, <reset>)
1029  begin  -- process <label>  begin  -- process <label>
1030    if <reset> = '0' then  -- asynchronous reset (active low)    if <reset> = '0' then  -- asynchronous reset (active low)
1031      <cursor>      <cursor>
1032    elsif <clock>'event and <clock> = '1' then  -- rising clock edge    elsif <clock>'event and <clock> = '1' then  -- rising clock edge
1033      if <enable> = '1' then  -- synchronous load      if <enable> = '1' then  -- synchronous load
1034          
1035      end if;      end if;
1036    end if;    end if;
1037  end process <label>;"  end process <label>;"
# Line 614  end process <label>;" Line 1040  end process <label>;"
1040  VHDL models (templates) can be specified by the user in this list.  They can be  VHDL models (templates) can be specified by the user in this list.  They can be
1041  invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword  invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword
1042  electrification (i.e. overriding existing or creating new keywords, see  electrification (i.e. overriding existing or creating new keywords, see
1043  variable `vhdl-electric-keywords').  option `vhdl-electric-keywords').
1044    Name       : name of model (string of words and spaces)    Name       : name of model (string of words and spaces)
1045    String     : string or name of file to be inserted as model (newline: `C-j')    String     : string or name of file to be inserted as model (newline: `C-j')
1046    Key Binding: key binding to invoke model, added to prefix `C-c C-m'    Key Binding: key binding to invoke model, added to prefix `C-c C-m'
# Line 627  the model.  Special prompts are: Line 1053  the model.  Special prompts are:
1053    <clock> : name specified in `vhdl-clock-name' (if not empty)    <clock> : name specified in `vhdl-clock-name' (if not empty)
1054    <reset> : name specified in `vhdl-reset-name' (if not empty)    <reset> : name specified in `vhdl-reset-name' (if not empty)
1055    <cursor>: final cursor position    <cursor>: final cursor position
1056    File header prompts (see variable `vhdl-file-header') are automatically
1057    replaced, so that user models can also be used to insert different types of
1058    headers.
1059    
1060  If the string specifies an existing file name, the contents of the file is  If the string specifies an existing file name, the contents of the file is
1061  inserted, otherwise the string itself is inserted.  inserted, otherwise the string itself is inserted.
1062  The code within the models should be correctly indented.  The code within the models should be correctly indented.
1063  Type `C-j' for newlines.  Type `C-j' for newlines.
1064    
1065  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1066        \"Activate New Customizations\""        \"Activate Options\"."
1067    :type '(repeat (list :tag "Model" :indent 2    :type '(repeat (list :tag "Model" :indent 2
1068                         (string :tag "Name       ")                         (string :tag "Name       ")
1069                         (string :tag "String     : (type `C-j' for newline)"                         (string :tag "String     : (type `C-j' for newline)"
1070                                 :format "%t\n%v")                                 :format "%t\n%v")
1071                         (sexp   :tag "Key Binding" x)                         (sexp   :tag "Key binding" x)
1072                         (string :tag "Keyword    ")))                         (string :tag "Keyword    " :format "%t: %v\n")))
1073    :set (lambda (variable value)    :set (lambda (variable value)
1074           (vhdl-custom-set variable value           (vhdl-custom-set variable value
1075                            'vhdl-model-map-init                            'vhdl-model-map-init
# Line 649  NOTE: Activate the new setting in a VHDL Line 1078  NOTE: Activate the new setting in a VHDL
1078                            'vhdl-update-mode-menu))                            'vhdl-update-mode-menu))
1079    :group 'vhdl-model)    :group 'vhdl-model)
1080    
1081    
1082  (defgroup vhdl-port nil  (defgroup vhdl-port nil
1083    "Customizations for port transformation functions."    "Customizations for port translation functions."
1084    :group 'vhdl)    :group 'vhdl
1085      :group 'vhdl-compose)
1086    
1087  (defcustom vhdl-include-port-comments nil  (defcustom vhdl-include-port-comments nil
1088    "*Non-nil means include port comments when a port is pasted."    "*Non-nil means include port comments when a port is pasted."
# Line 659  NOTE: Activate the new setting in a VHDL Line 1090  NOTE: Activate the new setting in a VHDL
1090    :group 'vhdl-port)    :group 'vhdl-port)
1091    
1092  (defcustom vhdl-include-direction-comments nil  (defcustom vhdl-include-direction-comments nil
1093    "*Non-nil means include signal direction in instantiations as comments."    "*Non-nil means include port direction in instantiations as comments."
1094    :type 'boolean    :type 'boolean
1095    :group 'vhdl-port)    :group 'vhdl-port)
1096    
1097  (defconst vhdl-name-doc-string "  (defcustom vhdl-include-type-comments nil
1098      "*Non-nil means include generic/port type in instantiations as comments."
1099      :type 'boolean
1100      :group 'vhdl-port)
1101    
1102  FROM REGEXP is a regular expression matching the formal port name:  (defcustom vhdl-include-group-comments 'never
1103    `.*'       matches the entire name    "*Specifies whether to include group comments and spacings.
1104    `\\(...\\)'  matches a substring  The comments and empty lines between groups of ports are pasted:
1105  TO STRING specifies the string to be inserted as actual port name:    Never       : never
1106    `\\&'  means substitute original matched text    Declarations: in entity/component/constant/signal declarations only
1107    `\\N'  means substitute what matched the Nth `\\(...\\)'    Always      : also in generic/port maps"
1108  Examples:    :type '(choice (const :tag "Never" never)
1109    `.*'           `\\&'    leaves name as it is                   (const :tag "Declarations" decl)
1110    `.*'           `\\&_i'  attaches `_i' to original name                   (const :tag "Always" always))
1111    `\\(.*\\)_[io]$' `\\1'    strips off `_i' or `_o' from original name    :group 'vhdl-port)
   `.*'           `'      leaves name empty")  
1112    
1113  (defcustom vhdl-actual-port-name '(".*" . "\\&_i")  (defcustom vhdl-actual-port-name '(".*" . "\\&")
1114    (concat    (concat
1115     "*Specifies how actual port names are obtained from formal port names.     "*Specifies how actual port names are obtained from formal port names.
1116  In a component instantiation, an actual port name can be obtained by  In a component instantiation, an actual port name can be obtained by
1117  modifying the formal port name (e.g. attaching or stripping off a substring)."  modifying the formal port name (e.g. attaching or stripping off a substring)."
1118     vhdl-name-doc-string)     vhdl-name-doc-string)
1119    :type '(cons (regexp :tag "From Regexp")    :type '(cons (regexp :tag "From regexp")
1120                 (string :tag "To String  "))                 (string :tag "To string  "))
1121    :group 'vhdl-port)    :group 'vhdl-port)
1122    
1123  (defcustom vhdl-instance-name '(".*" . "")  (defcustom vhdl-instance-name '(".*" . "\\&_%d")
1124    (concat    (concat
1125     "*Specifies how an instance name is obtained.     "*Specifies how an instance name is obtained.
1126  The instance name can be obtained by modifying the name of the component to be  The instance name can be obtained by modifying the name of the component to be
1127  instantiated (e.g. attaching or stripping off a substring).  instantiated (e.g. attaching or stripping off a substring).  \"%d\" is replaced
1128    by a unique number (starting with 1).
1129  If TO STRING is empty, the instance name is queried."  If TO STRING is empty, the instance name is queried."
1130     vhdl-name-doc-string)     vhdl-name-doc-string)
1131    :type '(cons (regexp :tag "From Regexp")    :type '(cons (regexp :tag "From regexp")
1132                 (string :tag "To String  "))                 (string :tag "To string  "))
1133      :group 'vhdl-port)
1134    
1135    
1136    (defgroup vhdl-testbench nil
1137      "Customizations for testbench generation ."
1138    :group 'vhdl-port)    :group 'vhdl-port)
1139    
1140  (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")  (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb")
1141    (concat    (concat
1142     "*Specifies how the test bench entity name is obtained.     "*Specifies how the testbench entity name is obtained.
1143  The entity name of a test bench can be obtained by modifying the name of  The entity name of a testbench can be obtained by modifying the name of
1144  the component to be tested (e.g. attaching or stripping off a substring)."  the component to be tested (e.g. attaching or stripping off a substring)."
1145     vhdl-name-doc-string)     vhdl-name-doc-string)
1146    :type '(cons (regexp :tag "From Regexp")    :type '(cons (regexp :tag "From regexp")
1147                 (string :tag "To String  "))                 (string :tag "To string  "))
1148    :group 'vhdl-port)    :group 'vhdl-testbench)
1149    
1150  (defcustom vhdl-testbench-architecture-name '(".*" . "")  (defcustom vhdl-testbench-architecture-name '(".*" . "")
1151    (concat    (concat
1152     "*Specifies how the test bench architecture name is obtained.     "*Specifies how the testbench architecture name is obtained.
1153  The test bench architecture name can be obtained by modifying the name of  The testbench architecture name can be obtained by modifying the name of
1154  the component to be tested (e.g. attaching or stripping off a substring).  the component to be tested (e.g. attaching or stripping off a substring).
1155  If TO STRING is empty, the architecture name is queried."  If TO STRING is empty, the architecture name is queried."
1156     vhdl-name-doc-string)     vhdl-name-doc-string)
1157    :type '(cons (regexp :tag "From Regexp")    :type '(cons (regexp :tag "From regexp")
1158                 (string :tag "To String  "))                 (string :tag "To string  "))
1159    :group 'vhdl-port)    :group 'vhdl-testbench)
1160    
1161    (defcustom vhdl-testbench-configuration-name
1162      '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg")
1163      (concat
1164       "*Specifies how the testbench configuration name is obtained.
1165    The configuration name of a testbench can be obtained by modifying the entity
1166    and/or architecture name (e.g. attaching or stripping off a substring).  The
1167    string that is matched against the regexp is the concatenation of the entity
1168    and the architecture name separated by a space.  This gives access to both
1169    names (see default setting as example)."
1170       vhdl-name-doc-string)
1171      :type '(cons (regexp :tag "From regexp")
1172                   (string :tag "To string  "))
1173      :group 'vhdl-testbench)
1174    
1175  (defcustom vhdl-testbench-dut-name '(".*" . "DUT")  (defcustom vhdl-testbench-dut-name '(".*" . "DUT")
1176    (concat    (concat
1177     "*Specifies how a DUT instance name is obtained.     "*Specifies how a DUT instance name is obtained.
1178  The design-under-test instance name (i.e. the component instantiated in the  The design-under-test instance name (i.e. the component instantiated in the
1179  test bench) can be obtained by modifying the component name (e.g. attaching  testbench) can be obtained by modifying the component name (e.g. attaching
1180  or stripping off a substring)."  or stripping off a substring)."
1181     vhdl-name-doc-string)     vhdl-name-doc-string)
1182    :type '(cons (regexp :tag "From Regexp")    :type '(cons (regexp :tag "From regexp")
1183                 (string :tag "To String  "))                 (string :tag "To string  "))
1184    :group 'vhdl-port)    :group 'vhdl-testbench)
   
 (defcustom vhdl-testbench-entity-header ""  
   "*String or file to be inserted as test bench entity header.  
 If the string specifies an existing file name, the contents of the file is  
 inserted, otherwise the string itself is inserted at the beginning of the test  
 bench entity template.  
 Type `C-j' for newlines."  
   :type 'string  
   :group 'vhdl-port)  
1185    
1186  (defcustom vhdl-testbench-architecture-header ""  (defcustom vhdl-testbench-include-header t
1187    "*String or file to be inserted as test bench architecture header.    "*Non-nil means include a header in automatically generated files."
1188  If the string specifies an existing file name, the contents of the file is    :type 'boolean
1189  inserted, otherwise the string itself is inserted at the beginning of the test    :group 'vhdl-testbench)
 bench architecture template, if a separate file is created for the  
 architecture.  
 Type `C-j' for newlines."  
   :type 'string  
   :group 'vhdl-port)  
1190    
1191  (defcustom vhdl-testbench-declarations ""  (defcustom vhdl-testbench-declarations "\
1192    "*String or file to be inserted in the test bench declarative part.    -- clock
1193      signal Clk : std_logic := '1';
1194    "
1195      "*String or file to be inserted in the testbench declarative part.
1196  If the string specifies an existing file name, the contents of the file is  If the string specifies an existing file name, the contents of the file is
1197  inserted, otherwise the string itself is inserted in the test bench  inserted, otherwise the string itself is inserted in the testbench
1198  architecture before the BEGIN keyword.  architecture before the BEGIN keyword.
1199  Type `C-j' for newlines."  Type `C-j' for newlines."
1200    :type 'string    :type 'string
1201    :group 'vhdl-port)    :group 'vhdl-testbench)
1202    
1203    (defcustom vhdl-testbench-statements "\
1204      -- clock generation
1205      Clk <= not Clk after 10 ns;
1206    
1207      -- waveform generation
1208      WaveGen_Proc: process
1209      begin
1210        -- insert signal assignments here
1211    
1212  (defcustom vhdl-testbench-statements ""      wait until Clk = '1';
1213    "*String or file to be inserted in the test bench statement part.    end process WaveGen_Proc;
1214    "
1215      "*String or file to be inserted in the testbench statement part.
1216  If the string specifies an existing file name, the contents of the file is  If the string specifies an existing file name, the contents of the file is
1217  inserted, otherwise the string itself is inserted in the test bench  inserted, otherwise the string itself is inserted in the testbench
1218  architecture before the END keyword.  architecture before the END keyword.
1219  Type `C-j' for newlines."  Type `C-j' for newlines."
1220    :type 'string    :type 'string
1221    :group 'vhdl-port)    :group 'vhdl-testbench)
1222    
1223  (defcustom vhdl-testbench-initialize-signals nil  (defcustom vhdl-testbench-initialize-signals nil
1224    "*Non-nil means initialize signals with `0' when declared in test bench."    "*Non-nil means initialize signals with `0' when declared in testbench."
1225    :type 'boolean    :type 'boolean
1226    :group 'vhdl-port)    :group 'vhdl-testbench)
1227    
1228    (defcustom vhdl-testbench-include-library t
1229      "*Non-nil means a library/use clause for std_logic_1164 is included."
1230      :type 'boolean
1231      :group 'vhdl-testbench)
1232    
1233    (defcustom vhdl-testbench-include-configuration t
1234      "*Non-nil means a testbench configuration is attached at the end."
1235      :type 'boolean
1236      :group 'vhdl-testbench)
1237    
1238  (defcustom vhdl-testbench-create-files 'single  (defcustom vhdl-testbench-create-files 'single
1239    "*Specifies whether new files should be created for the test bench.    "*Specifies whether new files should be created for the testbench.
1240  Test bench entity and architecture are inserted:  testbench entity and architecture are inserted:
1241    None          : in current buffer    None          : in current buffer
1242    Single file   : in new single file    Single file   : in new single file
1243    Separate files: in two separate files    Separate files: in two separate files
# Line 782  Note that the files have the same name a Line 1245  Note that the files have the same name a
1245    :type '(choice (const :tag "None" none)    :type '(choice (const :tag "None" none)
1246                   (const :tag "Single file" single)                   (const :tag "Single file" single)
1247                   (const :tag "Separate files" separate))                   (const :tag "Separate files" separate))
1248    :group 'vhdl-port)    :group 'vhdl-testbench)
1249    
1250    
1251    (defgroup vhdl-compose nil
1252      "Customizations for structural composition."
1253      :group 'vhdl)
1254    
1255    (defcustom vhdl-compose-create-files 'single
1256      "*Specifies whether new files should be created for the new component.
1257    The component's entity and architecture are inserted:
1258      None          : in current buffer
1259      Single file   : in new single file
1260      Separate files: in two separate files
1261    The file names are obtained from variables `vhdl-entity-file-name' and
1262    `vhdl-architecture-file-name'."
1263      :type '(choice (const :tag "None" none)
1264                     (const :tag "Single file" single)
1265                     (const :tag "Separate files" separate))
1266      :group 'vhdl-compose)
1267    
1268    (defcustom vhdl-compose-include-header t
1269      "*Non-nil means include a header in automatically generated files."
1270      :type 'boolean
1271      :group 'vhdl-compose)
1272    
1273    (defcustom vhdl-compose-architecture-name '(".*" . "str")
1274      (concat
1275       "*Specifies how the component architecture name is obtained.
1276    The component architecture name can be obtained by modifying the entity name
1277    \(e.g. attaching or stripping off a substring).
1278    If TO STRING is empty, the architecture name is queried."
1279       vhdl-name-doc-string)
1280      :type '(cons (regexp :tag "From regexp")
1281                   (string :tag "To string  "))
1282      :group 'vhdl-compose)
1283    
1284    (defcustom vhdl-components-package-name
1285      '((".*" . "\\&_components") . "components")
1286      (concat
1287       "*Specifies how the name for the components package is obtained.
1288    The components package is a package containing all component declarations for
1289    the current design.  Its name can be obtained by modifying the project name
1290    \(e.g. attaching or stripping off a substring).  If no project is defined, the
1291    DIRECTORY entry is chosen."
1292       vhdl-name-doc-string)
1293      :type '(cons (cons :tag "Project" :indent 2
1294                         (regexp :tag "From regexp")
1295                         (string :tag "To string  "))
1296                   (string :tag "Directory:\n  String     "))
1297      :group 'vhdl-compose)
1298    
1299    (defcustom vhdl-use-components-package nil
1300      "*Non-nil means use a separate components package for component declarations.
1301    Otherwise, component declarations are inserted and searched for in the
1302    architecture declarative parts."
1303      :type 'boolean
1304      :group 'vhdl-compose)
1305    
1306    
1307  (defgroup vhdl-comment nil  (defgroup vhdl-comment nil
# Line 800  Note that the files have the same name a Line 1319  Note that the files have the same name a
1319    :group 'vhdl-comment)    :group 'vhdl-comment)
1320    
1321  (defcustom vhdl-inline-comment-column 40  (defcustom vhdl-inline-comment-column 40
1322    "*Column to indent inline comments to.    "*Column to indent and align inline comments to.
1323  Overrides local variable `comment-column'.  Overrides local option `comment-column'.
1324    
1325  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1326        \"Activate New Customizations\""        \"Activate Options\"."
1327    :type 'integer    :type 'integer
1328    :group 'vhdl-comment)    :group 'vhdl-comment)
1329    
# Line 812  NOTE: Activate the new setting in a VHDL Line 1331  NOTE: Activate the new setting in a VHDL
1331    "*End of comment column.    "*End of comment column.
1332  Comments that exceed this column number are wrapped.  Comments that exceed this column number are wrapped.
1333    
1334  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1335        \"Activate New Customizations\""        \"Activate Options\"."
1336    :type 'integer    :type 'integer
1337    :group 'vhdl-comment)    :group 'vhdl-comment)
1338    
# Line 831  NOTE: Activate the new setting in a VHDL Line 1350  NOTE: Activate the new setting in a VHDL
1350    
1351  (defcustom vhdl-align-groups t  (defcustom vhdl-align-groups t
1352    "*Non-nil means align groups of code lines separately.    "*Non-nil means align groups of code lines separately.
1353  A group of code lines is a region of lines with no empty lines inbetween."  A group of code lines is a region of consecutive lines between two lines that
1354    match the regexp in option `vhdl-align-group-separate'."
1355      :type 'boolean
1356      :group 'vhdl-align)
1357    
1358    (defcustom vhdl-align-group-separate "^\\s-*$"
1359      "*Regexp for matching a line that separates groups of lines for alignment.
1360    Examples:
1361      \"^\\s-*$\":          matches an empty line
1362      \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line"
1363      :type 'regexp
1364      :group 'vhdl-align)
1365    
1366    (defcustom vhdl-align-same-indent t
1367      "*Non-nil means align blocks with same indent separately.
1368    When a region or the entire buffer is aligned, the code is divided into
1369    blocks of same indent which are aligned separately (except for argument/port
1370    lists).  This gives nicer alignment in most cases.
1371    Option `vhdl-align-groups' still applies within these blocks."
1372    :type 'boolean    :type 'boolean
1373    :group 'vhdl-align)    :group 'vhdl-align)
1374    
# Line 843  A group of code lines is a region of lin Line 1380  A group of code lines is a region of lin
1380  (defcustom vhdl-highlight-keywords t  (defcustom vhdl-highlight-keywords t
1381    "*Non-nil means highlight VHDL keywords and other standardized words.    "*Non-nil means highlight VHDL keywords and other standardized words.
1382  The following faces are used:  The following faces are used:
1383    `font-lock-keyword-face'        : keywords    `font-lock-keyword-face'       : keywords
1384    `font-lock-type-face'           : standardized types    `font-lock-type-face'          : standardized types
1385    `vhdl-font-lock-attribute-face' : standardized attributes    `vhdl-font-lock-attribute-face': standardized attributes
1386    `vhdl-font-lock-enumvalue-face' : standardized enumeration values    `vhdl-font-lock-enumvalue-face': standardized enumeration values
1387    `vhdl-font-lock-function-face'  : standardized function and package names    `vhdl-font-lock-function-face' : standardized function and package names
1388    
1389  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1390        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1391    :type 'boolean    :type 'boolean
1392    :set (lambda (variable value)    :set (lambda (variable value)
1393           (vhdl-custom-set variable value 'vhdl-font-lock-init))           (vhdl-custom-set variable value 'vhdl-font-lock-init))
# Line 859  NOTE: Activate the new setting in a VHDL Line 1396  NOTE: Activate the new setting in a VHDL
1396  (defcustom vhdl-highlight-names t  (defcustom vhdl-highlight-names t
1397    "*Non-nil means highlight declaration names and construct labels.    "*Non-nil means highlight declaration names and construct labels.
1398  The following faces are used:  The following faces are used:
1399    `font-lock-function-name-face'  : names in declarations of units,    `font-lock-function-name-face' : names in declarations of units,
1400       subprograms, components, as well as labels of VHDL constructs       subprograms, components, as well as labels of VHDL constructs
1401    `font-lock-type-face'           : names in type/nature declarations    `font-lock-type-face'          : names in type/nature declarations
1402    `vhdl-font-lock-attribute-face' : names in attribute declarations    `vhdl-font-lock-attribute-face': names in attribute declarations
1403    `font-lock-variable-name-face'  : names in declarations of signals,    `font-lock-variable-name-face' : names in declarations of signals,
1404       variables, constants, subprogram parameters, generics, and ports       variables, constants, subprogram parameters, generics, and ports
1405    
1406  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1407        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1408    :type 'boolean    :type 'boolean
1409    :set (lambda (variable value)    :set (lambda (variable value)
1410           (vhdl-custom-set variable value 'vhdl-font-lock-init))           (vhdl-custom-set variable value 'vhdl-font-lock-init))
# Line 875  NOTE: Activate the new setting in a VHDL Line 1412  NOTE: Activate the new setting in a VHDL
1412    
1413  (defcustom vhdl-highlight-special-words nil  (defcustom vhdl-highlight-special-words nil
1414    "*Non-nil means highlight words with special syntax.    "*Non-nil means highlight words with special syntax.
1415  The words with syntax and color specified in variable  The words with syntax and color specified in option `vhdl-special-syntax-alist'
1416  `vhdl-special-syntax-alist' are highlighted accordingly.  are highlighted accordingly.
1417  Can be used for visual support of naming conventions.  Can be used for visual support of naming conventions.
1418    
1419  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1420        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1421    :type 'boolean    :type 'boolean
1422    :set (lambda (variable value)    :set (lambda (variable value)
1423           (vhdl-custom-set variable value 'vhdl-font-lock-init))           (vhdl-custom-set variable value 'vhdl-font-lock-init))
# Line 888  NOTE: Activate the new setting in a VHDL Line 1425  NOTE: Activate the new setting in a VHDL
1425    
1426  (defcustom vhdl-highlight-forbidden-words nil  (defcustom vhdl-highlight-forbidden-words nil
1427    "*Non-nil means highlight forbidden words.    "*Non-nil means highlight forbidden words.
1428  The reserved words specified in variable `vhdl-forbidden-words' or having the  The reserved words specified in option `vhdl-forbidden-words' or having the
1429  syntax specified in variable `vhdl-forbidden-syntax' are highlighted in a  syntax specified in option `vhdl-forbidden-syntax' are highlighted in a
1430  warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to  warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to
1431  use them.  use them.
1432    
1433  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1434        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1435    :type 'boolean    :type 'boolean
1436    :set (lambda (variable value)    :set (lambda (variable value)
1437           (vhdl-custom-set variable value           (vhdl-custom-set variable value
# Line 907  Verilog keywords are highlighted in a wa Line 1444  Verilog keywords are highlighted in a wa
1444  `vhdl-font-lock-reserved-words-face') to indicate not to use them.  `vhdl-font-lock-reserved-words-face') to indicate not to use them.
1445    
1446  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1447        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1448    :type 'boolean    :type 'boolean
1449    :set (lambda (variable value)    :set (lambda (variable value)
1450           (vhdl-custom-set variable value           (vhdl-custom-set variable value
# Line 922  That is, all code between \"-- pragma tr Line 1459  That is, all code between \"-- pragma tr
1459  Note: this might slow down on-the-fly fontification (and thus editing).  Note: this might slow down on-the-fly fontification (and thus editing).
1460    
1461  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1462        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1463    :type 'boolean    :type 'boolean
1464    :set (lambda (variable value)    :set (lambda (variable value)
1465           (vhdl-custom-set variable value 'vhdl-font-lock-init))           (vhdl-custom-set variable value 'vhdl-font-lock-init))
# Line 935  Possible trade-off: Line 1472  Possible trade-off:
1472             special syntax is not considered             special syntax is not considered
1473    nil      only lower-case VHDL words are highlighted, but case of words with    nil      only lower-case VHDL words are highlighted, but case of words with
1474             special syntax is considered             special syntax is considered
1475  Overrides local variable `font-lock-keywords-case-fold-search'.  Overrides local option `font-lock-keywords-case-fold-search'.
1476    
1477  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1478        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1479    :type 'boolean    :type 'boolean
1480    :group 'vhdl-highlight)    :group 'vhdl-highlight)
1481    
1482  (defcustom vhdl-special-syntax-alist nil  (defcustom vhdl-special-syntax-alist
1483      '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1")
1484        ("type" "\\w+_t" "ForestGreen" "PaleGreen")
1485        ("variable" "\\w+_v" "Grey50" "Grey80"))
1486    "*List of special syntax to be highlighted.    "*List of special syntax to be highlighted.
1487  If variable `vhdl-highlight-special-words' is non-nil, words with the specified  If option `vhdl-highlight-special-words' is non-nil, words with the specified
1488  syntax (as regular expression) are highlighted in the corresponding color.  syntax (as regular expression) are highlighted in the corresponding color.
1489    
1490    Name         : string of words and spaces    Name         : string of words and spaces
# Line 958  syntax (as regular expression) are highl Line 1498  syntax (as regular expression) are highl
1498                   AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)                   AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1)
1499    
1500  Can be used for visual support of naming conventions, such as highlighting  Can be used for visual support of naming conventions, such as highlighting
1501  different kinds of signals (e.g. \"Clk_c\", \"Rst_r\") or objects (e.g.  different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g.
1502  \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using  \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using
1503  name suffices.  common substrings or name suffices.
1504  For each entry, a new face is generated with the specified colors and name  For each entry, a new face is generated with the specified colors and name
1505  \"vhdl-font-lock-\" + name + \"-face\".  \"vhdl-font-lock-\" + name + \"-face\".
1506    
1507  NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu  NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu
1508        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking.        entry \"Fontify Buffer\").  All other changes require restarting Emacs."
       All other changes require restarting Emacs."  
1509    :type '(repeat (list :tag "Face" :indent 2    :type '(repeat (list :tag "Face" :indent 2
1510                         (string :tag "Name         ")                         (string :tag "Name         ")
1511                         (regexp :tag "Regexp       " "\\w+_")                         (regexp :tag "Regexp       " "\\w+_")
# Line 978  NOTE: Activate a changed regexp in a VHD Line 1517  NOTE: Activate a changed regexp in a VHD
1517    
1518  (defcustom vhdl-forbidden-words '()  (defcustom vhdl-forbidden-words '()
1519    "*List of forbidden words to be highlighted.    "*List of forbidden words to be highlighted.
1520  If variable `vhdl-highlight-forbidden-words' is non-nil, these reserved  If option `vhdl-highlight-forbidden-words' is non-nil, these reserved
1521  words are highlighted in a warning color to indicate not to use them.  words are highlighted in a warning color to indicate not to use them.
1522    
1523  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1524        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1525    :type '(repeat (string :format "%v"))    :type '(repeat (string :format "%v"))
1526    :set (lambda (variable value)    :set (lambda (variable value)
1527           (vhdl-custom-set variable value           (vhdl-custom-set variable value
# Line 991  NOTE: Activate the new setting in a VHDL Line 1530  NOTE: Activate the new setting in a VHDL
1530    
1531  (defcustom vhdl-forbidden-syntax ""  (defcustom vhdl-forbidden-syntax ""
1532    "*Syntax of forbidden words to be highlighted.    "*Syntax of forbidden words to be highlighted.
1533  If variable `vhdl-highlight-forbidden-words' is non-nil, words with this  If option `vhdl-highlight-forbidden-words' is non-nil, words with this
1534  syntax are highlighted in a warning color to indicate not to use them.  syntax are highlighted in a warning color to indicate not to use them.
1535  Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"  Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\"
1536  highlights identifiers with 10 or more characters).  highlights identifiers with 10 or more characters).
1537    
1538  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1539        entry \"Fontify Buffer\").  XEmacs: turn off and on font locking."        entry \"Fontify Buffer\")."
1540    :type 'regexp    :type 'regexp
1541    :set (lambda (variable value)    :set (lambda (variable value)
1542           (vhdl-custom-set variable value           (vhdl-custom-set variable value
1543                            'vhdl-words-init 'vhdl-font-lock-init))                            'vhdl-words-init 'vhdl-font-lock-init))
1544    :group 'vhdl-highlight)    :group 'vhdl-highlight)
1545    
1546    (defcustom vhdl-directive-keywords '("pragma" "synopsys")
1547      "*List of compiler directive keywords recognized for highlighting.
1548    
1549  (defgroup vhdl-menu nil  NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu
1550    "Customizations for speedbar and menues."        entry \"Fontify Buffer\")."
1551      :type '(repeat (string :format "%v"))
1552      :set (lambda (variable value)
1553             (vhdl-custom-set variable value
1554                              'vhdl-words-init 'vhdl-font-lock-init))
1555      :group 'vhdl-highlight)
1556    
1557    
1558    (defgroup vhdl-speedbar nil
1559      "Customizations for speedbar."
1560    :group 'vhdl)    :group 'vhdl)
1561    
1562  (defcustom vhdl-speedbar nil  (defcustom vhdl-speedbar-auto-open nil
1563    "*Non-nil means open the speedbar automatically at startup.    "*Non-nil means automatically open speedbar at startup.
1564  Alternatively, the speedbar can be opened from the VHDL menu."  Alternatively, the speedbar can be opened from the VHDL menu."
1565    :type 'boolean    :type 'boolean
1566    :group 'vhdl-menu)    :group 'vhdl-speedbar)
1567    
1568  (defcustom vhdl-speedbar-show-hierarchy nil  (defcustom vhdl-speedbar-display-mode 'files
1569    "*Non-nil means open the speedbar as hierarchy browser at startup.    "*Specifies the default displaying mode when opening speedbar.
1570  Otherwise, the speedbar is opened as normal file browser."  Alternatively, the displaying mode can be selected from the speedbar menu or
1571    by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)."
1572      :type '(choice (const :tag "Files" files)
1573                     (const :tag "Directory hierarchy" directory)
1574                     (const :tag "Project hierarchy" project))
1575      :group 'vhdl-speedbar)
1576    
1577    (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50))
1578      "*Limits scanning of large files and netlists.
1579    Design units: maximum file size to scan for design units
1580    Hierarchy (instances of subcomponents):
1581      File size: maximum file size to scan for instances (in bytes)
1582      Instances per arch: maximum number of instances to scan per architecture
1583    
1584    \"None\" always means that there is no limit.
1585    In case of files not or incompletely scanned, a warning message and the file
1586    names are printed out.
1587    Background: scanning for instances is considerably slower than scanning for
1588    design units, especially when there are many instances.  These limits should
1589    prevent the scanning of large netlists."
1590      :type '(list (choice :tag "Design units"
1591                           :format "%t        : %[Value Menu%] %v"
1592                           (const :tag "None" nil)
1593                           (integer :tag "File size"))
1594                   (list :tag "Hierarchy" :indent 2
1595                         (choice :tag "File size"
1596                                 :format "%t         : %[Value Menu%] %v"
1597                                 (const :tag "None" nil)
1598                                 (integer :tag "Size     "))
1599                         (choice :tag "Instances per arch"
1600                                 (const :tag "None" nil)
1601                                 (integer :tag "Number   "))))
1602      :group 'vhdl-speedbar)
1603    
1604    (defcustom vhdl-speedbar-jump-to-unit t
1605      "*Non-nil means jump to the design unit code when opened in a buffer.
1606    The buffer cursor position is left unchanged otherwise."
1607    :type 'boolean    :type 'boolean
1608    :group 'vhdl-menu)    :group 'vhdl-speedbar)
1609    
1610  (defcustom vhdl-speedbar-hierarchy-indent 1  (defcustom vhdl-speedbar-update-on-saving t
1611    "*Amount of indentation in hierarchy display of subcomponent."    "*Automatically update design hierarchy when buffer is saved."
1612    :type 'integer    :type 'boolean
1613    :group 'vhdl-menu)    :group 'vhdl-speedbar)
1614    
1615    (defcustom vhdl-speedbar-save-cache '(hierarchy display)
1616      "*Automatically save modified hierarchy caches when exiting Emacs.
1617      Hierarchy: design hierarchy information
1618      Display:   displaying information (which design units to expand)"
1619      :type '(set (const :tag "Hierarchy" hierarchy)
1620                  (const :tag "Display"   display))
1621      :group 'vhdl-speedbar)
1622    
1623    (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2"
1624      "*Name of file for saving hierarchy cache.
1625    \"\\1\" is replaced by the project name if a project is specified,
1626    \"directory\" otherwise.  \"\\2\" is replaced by the user name (allows for
1627    different users to have cache files in the same directory). Can also have
1628    an absolute path (i.e. all caches can be stored in one global directory)."
1629      :type 'string
1630      :group 'vhdl-speedbar)
1631    
1632    
1633    (defgroup vhdl-menu nil
1634      "Customizations for menues."
1635      :group 'vhdl)
1636    
1637  (defcustom vhdl-index-menu nil  (defcustom vhdl-index-menu nil
1638    "*Non-nil means add an index menu for a source file when loading.    "*Non-nil means add an index menu for a source file when loading.
1639  Alternatively, the speedbar can be used.  Note that the index menu scans a file  Alternatively, the speedbar can be used.  Note that the index menu scans a file
1640  when it is opened, while speedbar only scans the file upon request.  when it is opened, while speedbar only scans the file upon request."
 Does not work under XEmacs."  
1641    :type 'boolean    :type 'boolean
1642    :group 'vhdl-menu)    :group 'vhdl-menu)
1643    
# Line 1041  Alternatively, the speedbar can be used. Line 1648  Alternatively, the speedbar can be used.
1648    :group 'vhdl-menu)    :group 'vhdl-menu)
1649    
1650  (defcustom vhdl-hideshow-menu nil  (defcustom vhdl-hideshow-menu nil
1651    "*Non-nil means add hideshow menu and functionality.    "*Non-nil means add hideshow menu and functionality at startup.
1652  Hideshow allows hiding code of VHDL design units.  Hideshow can also be enabled from the VHDL Mode menu.
1653  Does not work under XEmacs.  Hideshow allows hiding code of various VHDL constructs.
1654    
1655  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1656        \"Activate New Customizations\""        \"Activate Options\"."
1657    :type 'boolean    :type 'boolean
1658    :group 'vhdl-menu)    :group 'vhdl-menu)
1659    
# Line 1062  NOTE: Activate the new setting in a VHDL Line 1669  NOTE: Activate the new setting in a VHDL
1669    
1670  (defcustom vhdl-print-two-column t  (defcustom vhdl-print-two-column t
1671    "*Non-nil means print code in two columns and landscape format.    "*Non-nil means print code in two columns and landscape format.
1672    Adjusts settings in a way that postscript printing (\"File\" menu, `ps-print')
1673    prints VHDL files in a nice two-column landscape style.
1674    
1675  NOTE: Activate the new setting by restarting Emacs.  NOTE: Activate the new setting by restarting Emacs.
1676        Overrides `ps-print' settings locally."        Overrides `ps-print' settings locally."
# Line 1088  else if not at beginning of line then in Line 1697  else if not at beginning of line then in
1697  else if last command was a `TAB' or `RET' then dedent one step,  else if last command was a `TAB' or `RET' then dedent one step,
1698  else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').  else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
1699  If nil, TAB always indents current line (i.e. `TAB' is bound to  If nil, TAB always indents current line (i.e. `TAB' is bound to
1700  `vhdl-indent-line').  `indent-according-to-mode').
1701    
1702  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1703        \"Activate New Customizations\""        \"Activate Options\"."
1704      :type 'boolean
1705      :group 'vhdl-misc)
1706    
1707    (defcustom vhdl-indent-syntax-based t
1708      "*Non-nil means indent lines of code based on their syntactic context.
1709    Otherwise, a line is indented like the previous nonblank line.  This can be
1710    useful in large files where syntax-based indentation gets very slow."
1711    :type 'boolean    :type 'boolean
1712    :group 'vhdl-misc)    :group 'vhdl-misc)
1713    
# Line 1115  An identifier containing underscores is Line 1731  An identifier containing underscores is
1731  select and move operations.  All parts of an identifier separated by underscore  select and move operations.  All parts of an identifier separated by underscore
1732  are treated as single words otherwise.  are treated as single words otherwise.
1733    
1734  NOTE: Activate the new setting in a VHDL buffer using the menu entry  NOTE: Activate the new setting in a VHDL buffer by using the menu entry
1735        \"Activate New Customizations\""        \"Activate Options\"."
1736    :type 'boolean    :type 'boolean
1737    :set (lambda (variable value)    :set (lambda (variable value)
1738           (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init))           (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init))
# Line 1128  NOTE: Activate the new setting in a VHDL Line 1744  NOTE: Activate the new setting in a VHDL
1744    :group 'vhdl)    :group 'vhdl)
1745    
1746  ;; add related general customizations  ;; add related general customizations
1747  (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)  (custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
1748  (if (string-match "XEmacs" emacs-version)  (if vhdl-xemacs
1749      (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)      (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
1750    (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))    (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
 (unless (string-match "XEmacs" emacs-version)  
   (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))  
1751  (custom-add-to-group 'vhdl-related 'ps-print 'custom-group)  (custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
1752    (custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
1753    (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
1754    (unless vhdl-xemacs
1755      (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
1756    (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
1757  (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)  (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
1758  (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)  (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable)
1759    
1760  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1761  ;; Internal variables  ;; Internal variables
1762    
1763  (defconst vhdl-version "3.29"  (defvar vhdl-menu-max-size 20
1764    "VHDL Mode version number.")    "*Specifies the maximum size of a menu before splitting it into submenues.")
1765    
1766  (defvar vhdl-progress-interval 1  (defvar vhdl-progress-interval 1
1767    "*Interval used to update progress status during long operations.    "*Interval used to update progress status during long operations.
1768  If a number, percentage complete gets updated after each interval of  If a number, percentage complete gets updated after each interval of
1769  that many seconds.   To inhibit all messages, set this variable to nil.")  that many seconds.  To inhibit all messages, set this option to nil.")
1770    
1771  (defvar vhdl-inhibit-startup-warnings-p nil  (defvar vhdl-inhibit-startup-warnings-p nil
1772    "*If non-nil, inhibits start up compatibility warnings.")    "*If non-nil, inhibits start up compatibility warnings.")
# Line 1264  This hook gets called after a line is in Line 1883  This hook gets called after a line is in
1883  (defvar vhdl-style-alist  (defvar vhdl-style-alist
1884    '(("IEEE"    '(("IEEE"
1885       (vhdl-basic-offset . 4)       (vhdl-basic-offset . 4)
1886       (vhdl-offsets-alist . ())       (vhdl-offsets-alist . ())))
      )  
     )  
1887    "Styles of Indentation.    "Styles of Indentation.
1888  Elements of this alist are of the form:  Elements of this alist are of the form:
1889    
# Line 1306  your style, only those that are differen Line 1923  your style, only those that are differen
1923    
1924    
1925  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1926  ;; Compatibility  ;;; Required packages
1927    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1928    
1929  (defvar vhdl-startup-warnings nil  ;; mandatory
1930    "Warnings to tell the user during start up.")  (require 'assoc)
1931    (require 'compile)                      ; XEmacs
1932    (require 'easymenu)
1933    (require 'hippie-exp)
1934    
1935  (defun vhdl-print-warnings ()  ;; optional (minimize warning messages during compile)
1936    "Print out messages in variable `vhdl-startup-warnings'."  (eval-when-compile
1937    (let ((warnings vhdl-startup-warnings))    (require 'font-lock)
1938      (while warnings    (require 'ps-print)
1939        (message (concat "WARNING:  " (car warnings)))    (require 'speedbar))
       (setq warnings (cdr warnings))))  
   (when (> (length vhdl-startup-warnings) 1)  
     (message "WARNING:  See warning messages in *Messages* buffer.")))  
   
 (defun vhdl-add-warning (string)  
   "Add STRING to warning list `vhdl-startup-warnings'."  
   (setq vhdl-startup-warnings (cons string vhdl-startup-warnings)))  
1940    
 ;; Perform compatibility checks.  
 (when (not (stringp vhdl-compiler))     ; changed format of `vhdl-compiler'  
   (setq vhdl-compiler "ModelSim")  
   (vhdl-add-warning "Variable `vhdl-compiler' has changed format; customize again"))  
 (when (not (listp vhdl-standard))       ; changed format of `vhdl-standard'  
   (setq vhdl-standard '(87 nil))  
   (vhdl-add-warning "Variable `vhdl-standard' has changed format; customize again"))  
 (when (= (length (car vhdl-model-alist)) 3)  
   (let ((old-alist vhdl-model-alist)    ; changed format of `vhdl-model-alist'  
         new-alist)  
     (while old-alist  
       (setq new-alist (cons (append (car old-alist) '("")) new-alist))  
       (setq old-alist (cdr old-alist)))  
     (setq vhdl-model-alist (nreverse new-alist))))  
 (when (= (length (car vhdl-project-alist)) 3)  
   (let ((old-alist vhdl-project-alist) ; changed format of `vhdl-project-alist'  
         new-alist)  
     (while old-alist  
       (setq new-alist (cons (append (car old-alist) '("")) new-alist))  
       (setq old-alist (cdr old-alist)))  
     (setq vhdl-project-alist (nreverse new-alist))))  
1941    
1942  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1943  ;; Help functions  ;;; Compatibility
   
 (defsubst vhdl-standard-p (standard)  
   "Check if STANDARD is specified as used standard."  
   (or (eq standard (car vhdl-standard))  
        (memq standard (cadr vhdl-standard))))  
   
1944  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Required packages  
   
 (require 'assoc)  
   
1945    
1946  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1947  ;;; Emacs variant handling  ;; XEmacs compatibility
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
1948    
1949  ;; active regions  ;; active regions
   
1950  (defun vhdl-keep-region-active ()  (defun vhdl-keep-region-active ()
1951    "Do whatever is necessary to keep the region active in XEmacs.    "Do whatever is necessary to keep the region active in XEmacs.
1952  Ignore byte-compiler warnings you might see."  Ignore byte-compiler warnings you might see."
1953    (and (boundp 'zmacs-region-stays)    (and (boundp 'zmacs-region-stays)
1954         (setq zmacs-region-stays t)))         (setq zmacs-region-stays t)))
1955    
1956  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;; `wildcard-to-regexp' is included only in XEmacs 21
 ;; XEmacs hacks  
   
1957  (unless (fboundp 'wildcard-to-regexp)  (unless (fboundp 'wildcard-to-regexp)
1958    (defun wildcard-to-regexp (wildcard)    (defun wildcard-to-regexp (wildcard)
1959      "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'."      "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'."
# Line 1391  Ignore byte-compiler warnings you might Line 1970  Ignore byte-compiler warnings you might
1970              (setq i (1+ i)))))              (setq i (1+ i)))))
1971        (concat "\\`" result "\\'"))))        (concat "\\`" result "\\'"))))
1972    
1973    ;; `regexp-opt' undefined (`xemacs-devel' not installed)
1974    ;; `regexp-opt' accelerates fontification by 10-20%
1975    (unless (fboundp 'regexp-opt)
1976    ;  (vhdl-warning-when-idle "Please install `xemacs-devel' package.")
1977      (defun regexp-opt (strings &optional paren)
1978        (let ((open (if paren "\\(" "")) (close (if paren "\\)" "")))
1979          (concat open (mapconcat 'regexp-quote strings "\\|") close))))
1980    
1981    ;; `match-string-no-properties' undefined (XEmacs, what else?)
1982    (unless (fboundp 'match-string-no-properties)
1983      (defalias 'match-string-no-properties 'match-string))
1984    
1985    ;; `subst-char-in-string' undefined (XEmacs)
1986    (unless (fboundp 'subst-char-in-string)
1987      (defun subst-char-in-string (fromchar tochar string &optional inplace)
1988        (let ((i (length string))
1989              (newstr (if inplace string (copy-sequence string))))
1990          (while (> i 0)
1991            (setq i (1- i))
1992            (if (eq (aref newstr i) fromchar) (aset newstr i tochar)))
1993          newstr)))
1994    
1995    ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
1996    (when (and vhdl-xemacs (string< itimer-version "1.09")
1997               (not noninteractive))
1998      (load "itimer")
1999      (when (string< itimer-version "1.09")
2000        (message "WARNING:  Install included `itimer.el' patch first (see INSTALL file)")
2001        (beep) (sit-for 5)))
2002    
2003    ;; `file-expand-wildcards' undefined (XEmacs)
2004    (unless (fboundp 'file-expand-wildcards)
2005      (defun file-expand-wildcards (pattern &optional full)
2006        "Taken from Emacs' `files.el'."
2007        (let* ((nondir (file-name-nondirectory pattern))
2008               (dirpart (file-name-directory pattern))
2009               (dirs (if (and dirpart (string-match "[[*?]" dirpart))
2010                         (mapcar 'file-name-as-directory
2011                                 (file-expand-wildcards (directory-file-name dirpart)))
2012                       (list dirpart)))
2013               contents)
2014          (while dirs
2015            (when (or (null (car dirs))     ; Possible if DIRPART is not wild.
2016                      (file-directory-p (directory-file-name (car dirs))))
2017              (let ((this-dir-contents
2018                     (delq nil
2019                           (mapcar #'(lambda (name)
2020                                       (unless (string-match "\\`\\.\\.?\\'"
2021                                                             (file-name-nondirectory name))
2022                                         name))
2023                                   (directory-files (or (car dirs) ".") full
2024                                                    (wildcard-to-regexp nondir))))))
2025                (setq contents
2026                      (nconc
2027                       (if (and (car dirs) (not full))
2028                           (mapcar (function (lambda (name) (concat (car dirs) name)))
2029                                   this-dir-contents)
2030                         this-dir-contents)
2031                       contents))))
2032            (setq dirs (cdr dirs)))
2033          contents)))
2034    
2035    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2036    ;; Compatibility with older VHDL Mode versions
2037    
2038    (defvar vhdl-warnings nil
2039      "Warnings to tell the user during start up.")
2040    
2041    (defun vhdl-run-when-idle (secs repeat function)
2042      "Wait until idle, then run FUNCTION."
2043      (if vhdl-xemacs
2044          (start-itimer "vhdl-mode" function secs repeat t)
2045    ;    (run-with-idle-timer secs repeat function)))
2046        ;; explicitely activate timer (necessary when Emacs is already idle)
2047        (aset (run-with-idle-timer secs repeat function) 0 nil)))
2048    
2049    (defun vhdl-warning-when-idle (&rest args)
2050      "Wait until idle, then print out warning STRING and beep."
2051      (if noninteractive
2052          (vhdl-warning (apply 'format args) t)
2053        (unless vhdl-warnings
2054          (vhdl-run-when-idle .1 nil 'vhdl-print-warnings))
2055        (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings))))
2056    
2057    (defun vhdl-warning (string &optional nobeep)
2058      "Print out warning STRING and beep."
2059      (message (concat "WARNING:  " string))
2060      (unless (or nobeep noninteractive) (beep)))
2061    
2062    (defun vhdl-print-warnings ()
2063      "Print out messages in variable `vhdl-warnings'."
2064      (let ((no-warnings (length vhdl-warnings)))
2065        (setq vhdl-warnings (nreverse vhdl-warnings))
2066        (while vhdl-warnings
2067          (message (concat "WARNING:  " (car vhdl-warnings)))
2068          (setq vhdl-warnings (cdr vhdl-warnings)))
2069        (beep)
2070        (when (> no-warnings 1)
2071          (message "WARNING:  See warnings in message buffer (type `C-c M-m')."))))
2072    
2073    ;; Backward compatibility checks and fixes
2074    ;; option `vhdl-compiler' changed format
2075    (unless (stringp vhdl-compiler)
2076      (setq vhdl-compiler "ModelSim")
2077      (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again"))
2078    
2079    ;; option `vhdl-standard' changed format
2080    (unless (listp vhdl-standard)
2081      (setq vhdl-standard '(87 nil))
2082      (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again"))
2083    
2084    ;; option `vhdl-model-alist' changed format
2085    (when (= (length (car vhdl-model-alist)) 3)
2086      (let ((old-alist vhdl-model-alist)
2087            new-alist)
2088        (while old-alist
2089          (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2090          (setq old-alist (cdr old-alist)))
2091        (setq vhdl-model-alist (nreverse new-alist)))
2092      (customize-save-variable 'vhdl-model-alist vhdl-model-alist))
2093    
2094    ;; option `vhdl-project-alist' changed format
2095    (when (= (length (car vhdl-project-alist)) 3)
2096      (let ((old-alist vhdl-project-alist)
2097            new-alist)
2098        (while old-alist
2099          (setq new-alist (cons (append (car old-alist) '("")) new-alist))
2100          (setq old-alist (cdr old-alist)))
2101        (setq vhdl-project-alist (nreverse new-alist)))
2102      (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2103    
2104    ;; option `vhdl-project-alist' changed format (3.31.1)
2105    (when (= (length (car vhdl-project-alist)) 4)
2106      (let ((old-alist vhdl-project-alist)
2107            new-alist elem)
2108        (while old-alist
2109          (setq elem (car old-alist))
2110          (setq new-alist
2111                (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem)
2112                            nil "./" "work" "work/" "Makefile" (nth 3 elem))
2113                      new-alist))
2114          (setq old-alist (cdr old-alist)))
2115        (setq vhdl-project-alist (nreverse new-alist)))
2116      (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize"))
2117    
2118    ;; option `vhdl-project-alist' changed format (3.31.12)
2119    (when (= (length (car vhdl-project-alist)) 10)
2120      (let ((tmp-alist vhdl-project-alist))
2121        (while tmp-alist
2122          (setcdr (nthcdr 3 (car tmp-alist))
2123                  (cons "" (nthcdr 4 (car tmp-alist))))
2124          (setq tmp-alist (cdr tmp-alist))))
2125      (customize-save-variable 'vhdl-project-alist vhdl-project-alist))
2126    
2127    ;; option `vhdl-compiler-alist' changed format (3.31.1)
2128    (when (= (length (car vhdl-compiler-alist)) 7)
2129      (let ((old-alist vhdl-compiler-alist)
2130            new-alist elem)
2131        (while old-alist
2132          (setq elem (car old-alist))
2133          (setq new-alist
2134                (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1"
2135                            (if (equal (nth 3 elem) "") nil (nth 3 elem))
2136                            (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem))
2137                            (nth 5 elem) (nth 6 elem) nil)
2138                      new-alist))
2139          (setq old-alist (cdr old-alist)))
2140        (setq vhdl-compiler-alist (nreverse new-alist)))
2141      (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize"))
2142    
2143    ;; option `vhdl-compiler-alist' changed format (3.31.10)
2144    (when (= (length (car vhdl-compiler-alist)) 12)
2145      (let ((tmp-alist vhdl-compiler-alist))
2146        (while tmp-alist
2147          (setcdr (nthcdr 4 (car tmp-alist))
2148                  (cons "mkdir \\1" (nthcdr 5 (car tmp-alist))))
2149          (setq tmp-alist (cdr tmp-alist))))
2150      (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2151    
2152    ;; option `vhdl-compiler-alist' changed format (3.31.11)
2153    (when (= (length (car vhdl-compiler-alist)) 13)
2154      (let ((tmp-alist vhdl-compiler-alist))
2155        (while tmp-alist
2156          (setcdr (nthcdr 3 (car tmp-alist))
2157                  (cons "" (nthcdr 4 (car tmp-alist))))
2158          (setq tmp-alist (cdr tmp-alist))))
2159      (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2160    
2161    ;; option `vhdl-compiler-alist' changed format (3.32.7)
2162    (when (= (length (nth 11 (car vhdl-compiler-alist))) 3)
2163      (let ((tmp-alist vhdl-compiler-alist))
2164        (while tmp-alist
2165          (setcdr (nthcdr 2 (nth 11 (car tmp-alist)))
2166                  '(0 . nil))
2167          (setq tmp-alist (cdr tmp-alist))))
2168      (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist))
2169    
2170    ;; option `vhdl-project': empty value changed from "" to nil (3.31.1)
2171    (when (equal vhdl-project "")
2172      (setq vhdl-project nil)
2173      (customize-save-variable 'vhdl-project vhdl-project))
2174    
2175    ;; option `vhdl-project-file-name': changed format (3.31.17 beta)
2176    (when (stringp vhdl-project-file-name)
2177      (setq vhdl-project-file-name (list vhdl-project-file-name))
2178      (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name))
2179    
2180    ;; option `speedbar-indentation-width': introduced in speedbar 0.10
2181    (if (not (boundp 'speedbar-indentation-width))
2182        (defvar speedbar-indentation-width 2)
2183      ;; set default to 2 if not already customized
2184      (unless (get 'speedbar-indentation-width 'saved-value)
2185        (setq speedbar-indentation-width 2)))
2186    
2187    
2188    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2189    ;;; Help functions / inline substitutions / macros
2190    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2191    
2192    (defun vhdl-standard-p (standard)
2193      "Check if STANDARD is specified as used standard."
2194      (or (eq standard (car vhdl-standard))
2195          (memq standard (cadr vhdl-standard))))
2196    
2197    (defun vhdl-project-p (&optional warning)
2198      "Return non-nil if a project is displayed, i.e. directories or files are
2199    specified."
2200      (if (assoc vhdl-project vhdl-project-alist)
2201          vhdl-project
2202        (when (and vhdl-project warning)
2203          (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project))
2204        nil))
2205    
2206    (defun vhdl-resolve-env-variable (string)
2207      "Resolve environment variables in STRING."
2208      (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string)
2209        (setq string (concat (match-string 1 string)
2210                             (getenv (match-string 2 string))
2211                             (match-string 4 string))))
2212      string)
2213    
2214    (defun vhdl-default-directory ()
2215      "Return the default directory of the current project or the directory of the
2216    current buffer if no project is defined."
2217      (if (vhdl-project-p)
2218          (expand-file-name (vhdl-resolve-env-variable
2219                             (nth 1 (aget vhdl-project-alist vhdl-project))))
2220        default-directory))
2221    
2222    (defmacro vhdl-prepare-search-1 (&rest body)
2223      "Enable case insensitive search and switch to syntax table that includes '_',
2224    then execute BODY, and finally restore the old environment.  Used for
2225    consistent searching."
2226      `(let ((case-fold-search t)           ; case insensitive search
2227             (current-syntax-table (syntax-table))
2228             result
2229             (restore-prog                  ; program to restore enviroment
2230              '(progn
2231                 ;; restore syntax table
2232                 (set-syntax-table current-syntax-table))))
2233         ;; use extended syntax table
2234         (set-syntax-table vhdl-mode-ext-syntax-table)
2235         ;; execute BODY safely
2236         (setq result
2237               (condition-case info
2238                   (progn ,@body)
2239                 (error (eval restore-prog) ; restore environment on error
2240                        (error (cadr info))))) ; pass error up
2241         ;; restore environment
2242         (eval restore-prog)
2243         result))
2244    
2245    (defmacro vhdl-prepare-search-2 (&rest body)
2246      "Enable case insensitive search, switch to syntax table that includes '_',
2247    and remove `intangible' overlays, then execute BODY, and finally restore the
2248    old environment.  Used for consistent searching."
2249      `(let ((case-fold-search t)           ; case insensitive search
2250             (current-syntax-table (syntax-table))
2251             result overlay-all-list overlay-intangible-list overlay
2252             (restore-prog                  ; program to restore enviroment
2253              '(progn
2254                 ;; restore syntax table
2255                 (set-syntax-table current-syntax-table)
2256                 ;; restore `intangible' overlays
2257                 (when (fboundp 'overlay-lists)
2258                   (while overlay-intangible-list
2259                     (overlay-put (car overlay-intangible-list) 'intangible t)
2260                     (setq overlay-intangible-list
2261                           (cdr overlay-intangible-list)))))))
2262         ;; use extended syntax table
2263         (set-syntax-table vhdl-mode-ext-syntax-table)
2264         ;; remove `intangible' overlays
2265         (when (fboundp 'overlay-lists)
2266           (setq overlay-all-list (overlay-lists))
2267           (setq overlay-all-list
2268                 (append (car overlay-all-list) (cdr overlay-all-list)))
2269           (while overlay-all-list
2270             (setq overlay (car overlay-all-list))
2271             (when (memq 'intangible (overlay-properties overlay))
2272               (setq overlay-intangible-list
2273                     (cons overlay overlay-intangible-list))
2274               (overlay-put overlay 'intangible nil))
2275             (setq overlay-all-list (cdr overlay-all-list))))
2276         ;; execute BODY safely
2277         (setq result
2278               (condition-case info
2279                   (progn ,@body)
2280                 (error (eval restore-prog) ; restore environment on error
2281                        (error (cadr info))))) ; pass error up
2282         ;; restore environment
2283         (eval restore-prog)
2284         result))
2285    
2286    (defmacro vhdl-visit-file (file-name issue-error &rest body)
2287      "Visit file FILE-NAME and execute BODY."
2288      `(if (null ,file-name)
2289           (progn ,@body)
2290         (unless (file-directory-p ,file-name)
2291           (let ((source-buffer (current-buffer))
2292                 (visiting-buffer (find-buffer-visiting ,file-name))
2293                 file-opened)
2294             (when (or (and visiting-buffer (set-buffer visiting-buffer))
2295                       (condition-case ()
2296                           (progn (set-buffer (create-file-buffer ,file-name))
2297                                  (setq file-opened t)
2298                                  (vhdl-insert-file-contents ,file-name)
2299                                  (modify-syntax-entry ?\- ". 12" (syntax-table))
2300                                  (modify-syntax-entry ?\n ">" (syntax-table))
2301                                  (modify-syntax-entry ?\^M ">" (syntax-table))
2302                                  (modify-syntax-entry ?_ "w" (syntax-table))
2303                                  t)
2304                         (error
2305                          (if ,issue-error
2306                              (progn
2307                                (when file-opened (kill-buffer (current-buffer)))
2308                                (set-buffer source-buffer)
2309                                (error (format "ERROR:  File cannot be opened: \"%s\"" ,file-name)))
2310                            (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t)
2311                            nil))))
2312               (condition-case info
2313                   (progn ,@body)
2314                 (error
2315                  (if ,issue-error
2316                      (progn
2317                        (when file-opened (kill-buffer (current-buffer)))
2318                        (set-buffer source-buffer)
2319                        (error (cadr info)))
2320                    (vhdl-warning (cadr info))))))
2321             (when file-opened (kill-buffer (current-buffer)))
2322             (set-buffer source-buffer)))))
2323    
2324    (defun vhdl-insert-file-contents (filename)
2325      "Nicked from `insert-file-contents-literally', but allow coding system
2326    conversion."
2327      (let ((format-alist nil)
2328            (after-insert-file-functions nil)
2329            (jka-compr-compression-info-list nil))
2330        (insert-file-contents filename t)))
2331    
2332    (defun vhdl-sort-alist (alist)
2333      "Sort alist."
2334      (sort alist (function (lambda (a b) (string< (car a) (car b))))))
2335    
2336    (defun vhdl-get-subdirs (directory)
2337      "Recursively get subdirectories of DIRECTORY."
2338      (let ((dir-list (list (file-name-as-directory directory)))
2339            file-list)
2340        (setq file-list (vhdl-directory-files directory t "\\w.*"))
2341        (while file-list
2342          (when (file-directory-p (car file-list))
2343            (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))
2344          (setq file-list (cdr file-list)))
2345        dir-list))
2346    
2347    (defun vhdl-aput (alist-symbol key &optional value)
2348      "As `aput', but delete key-value pair if VALUE is nil."
2349      (if value
2350          (aput alist-symbol key value)
2351        (adelete alist-symbol key)))
2352    
2353    (defun vhdl-delete (elt list)
2354      "Delete by side effect the first occurrence of ELT as a member of LIST."
2355      (setq list (cons nil list))
2356      (let ((list1 list))
2357        (while (and (cdr list1) (not (equal elt (cadr list1))))
2358          (setq list1 (cdr list1)))
2359        (when list
2360          (setcdr list1 (cddr list1))))
2361      (cdr list))
2362    
2363    (defun vhdl-speedbar-refresh (&optional key)
2364      "Refresh directory or project with name KEY."
2365      (when (and (boundp 'speedbar-frame)
2366                 (frame-live-p speedbar-frame))
2367        (let ((pos (point))
2368              (last-frame (selected-frame)))
2369          (if (null key)
2370              (speedbar-refresh)
2371            (select-frame speedbar-frame)
2372            (when (save-excursion
2373                    (goto-char (point-min))
2374                    (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t))
2375              (goto-char (match-end 1))
2376              (speedbar-do-function-pointer)
2377              (backward-char 2)
2378              (speedbar-do-function-pointer)
2379              (message "Refreshing speedbar...done"))
2380            (select-frame last-frame)))))
2381    
2382    (defun vhdl-show-messages ()
2383      "Get *Messages* buffer to show recent messages."
2384      (interactive)
2385      (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*")))
2386    
2387    (defun vhdl-use-direct-instantiation ()
2388      "Return whether direct instantiation is used."
2389      (or (eq vhdl-use-direct-instantiation 'always)
2390          (and (eq vhdl-use-direct-instantiation 'standard)
2391               (not (vhdl-standard-p '87)))))
2392    
2393    (defun vhdl-max-marker (marker1 marker2)
2394      "Return larger marker."
2395      (if (> marker1 marker2) marker1 marker2))
2396    
2397    (defun vhdl-goto-marker (marker)
2398      "Goto marker in appropriate buffer."
2399      (when (markerp marker)
2400        (set-buffer (marker-buffer marker)))
2401      (goto-char marker))
2402    
2403    (defun vhdl-menu-split (list title)
2404      "Split menu LIST into several submenues, if number of
2405    elements > `vhdl-menu-max-size'."
2406      (if (> (length list) vhdl-menu-max-size)
2407          (let ((remain list)
2408                (result '())
2409                (sublist '())
2410                (menuno 1)
2411                (i 0))
2412            (while remain
2413              (setq sublist (cons (car remain) sublist))
2414              (setq remain (cdr remain))
2415              (setq i (+ i 1))
2416              (if (= i vhdl-menu-max-size)
2417                  (progn
2418                    (setq result (cons (cons (format "%s %s" title menuno)
2419                                             (nreverse sublist)) result))
2420                    (setq i 0)
2421                    (setq menuno (+ menuno 1))
2422                    (setq sublist '()))))
2423            (and sublist
2424                 (setq result (cons (cons (format "%s %s" title menuno)
2425                                          (nreverse sublist)) result)))
2426            (nreverse result))
2427        list))
2428    
2429    
2430  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2431  ;;; Bindings  ;;; Bindings
# Line 1399  Ignore byte-compiler warnings you might Line 2434  Ignore byte-compiler warnings you might
2434  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2435  ;; Key bindings  ;; Key bindings
2436    
2437  (defvar vhdl-template-map ()  (defvar vhdl-template-map nil
2438    "Keymap for VHDL templates.")    "Keymap for VHDL templates.")
2439    
2440  (defun vhdl-template-map-init ()  (defun vhdl-template-map-init ()
# Line 1512  STRING are replaced by `-' and substring Line 2547  STRING are replaced by `-' and substring
2547      (when postfix (setq name (concat name "-" postfix)))      (when postfix (setq name (concat name "-" postfix)))
2548      (intern name)))      (intern name)))
2549    
2550  (defvar vhdl-model-map ()  (defvar vhdl-model-map nil
2551    "Keymap for VHDL models.")    "Keymap for VHDL models.")
2552    
2553  (defun vhdl-model-map-init ()  (defun vhdl-model-map-init ()
# Line 1529  STRING are replaced by `-' and substring Line 2564  STRING are replaced by `-' and substring
2564  ;; initialize user model map for VHDL Mode  ;; initialize user model map for VHDL Mode
2565  (vhdl-model-map-init)  (vhdl-model-map-init)
2566    
2567  (defvar vhdl-mode-map ()  (defvar vhdl-mode-map nil
2568    "Keymap for VHDL Mode.")    "Keymap for VHDL Mode.")
2569    
2570  (defun vhdl-mode-map-init ()  (defun vhdl-mode-map-init ()
# Line 1545  STRING are replaced by `-' and substring Line 2580  STRING are replaced by `-' and substring
2580    (define-key vhdl-mode-map "\M-\C-f"      'vhdl-forward-sexp)    (define-key vhdl-mode-map "\M-\C-f"      'vhdl-forward-sexp)
2581    (define-key vhdl-mode-map "\M-\C-b"      'vhdl-backward-sexp)    (define-key vhdl-mode-map "\M-\C-b"      'vhdl-backward-sexp)
2582    (define-key vhdl-mode-map "\M-\C-u"      'vhdl-backward-up-list)    (define-key vhdl-mode-map "\M-\C-u"      'vhdl-backward-up-list)
2583    (define-key vhdl-mode-map "\M-\C-a"      'vhdl-beginning-of-defun)    (define-key vhdl-mode-map "\M-\C-a"      'vhdl-backward-same-indent)
2584    (define-key vhdl-mode-map "\M-\C-e"      'vhdl-end-of-defun)    (define-key vhdl-mode-map "\M-\C-e"      'vhdl-forward-same-indent)
2585    (define-key vhdl-mode-map "\M-\C-h"      'vhdl-mark-defun)    (unless vhdl-xemacs ; would override `M-backspace' in XEmacs
2586        (define-key vhdl-mode-map "\M-\C-h"      'vhdl-mark-defun))
2587    (define-key vhdl-mode-map "\M-\C-q"      'vhdl-indent-sexp)    (define-key vhdl-mode-map "\M-\C-q"      'vhdl-indent-sexp)
2588      (define-key vhdl-mode-map "\M-^"         'vhdl-delete-indentation)
2589    ;; backspace/delete key bindings    ;; backspace/delete key bindings
2590    (define-key vhdl-mode-map [backspace]    'backward-delete-char-untabify)    (define-key vhdl-mode-map [backspace]    'backward-delete-char-untabify)
2591    (define-key vhdl-mode-map [delete]       'delete-char)    (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable
2592    (unless (string-match "XEmacs" emacs-version)      (define-key vhdl-mode-map [delete]       'delete-char)
2593      (define-key vhdl-mode-map [M-delete]   'kill-word))      (define-key vhdl-mode-map [(meta delete)] 'kill-word))
2594    ;; mode specific key bindings    ;; mode specific key bindings
2595    (define-key vhdl-mode-map "\C-c\C-e"     'vhdl-electric-mode)    (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode)
2596    (define-key vhdl-mode-map "\C-c\C-s"     'vhdl-stutter-mode)    (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode)
2597      (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project)
2598      (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project)
2599      (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project)
2600      (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project)
2601      (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler)
2602    (define-key vhdl-mode-map "\C-c\C-k"     'vhdl-compile)    (define-key vhdl-mode-map "\C-c\C-k"     'vhdl-compile)
2603    (define-key vhdl-mode-map "\C-c\M-\C-k"  'vhdl-make)    (define-key vhdl-mode-map "\C-c\M-\C-k"  'vhdl-make)
2604      (define-key vhdl-mode-map "\C-c\M-k"     'vhdl-generate-makefile)
2605    (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)    (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy)
2606    (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)    (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy)
2607    (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)    (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity)
# Line 1566  STRING are replaced by `-' and substring Line 2609  STRING are replaced by `-' and substring
2609    (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)    (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
2610    (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)    (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
2611    (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)    (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
2612    (if (string-match "XEmacs" emacs-version) ; `... C-g' not allowed in XEmacs    (if vhdl-xemacs ; `... C-g' not allowed in XEmacs
2613        (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)        (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
2614      (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))      (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
2615      (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
2616    (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)    (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench)
2617    (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)    (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten)
2618    (define-key vhdl-mode-map "\C-c\C-c"     'vhdl-comment-uncomment-region)    (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction)
2619      (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy)
2620      (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy)
2621      (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration)
2622      (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
2623      (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
2624      (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
2625      (define-key vhdl-mode-map "\C-c\C-c\C-n" 'vhdl-compose-new-component)
2626      (define-key vhdl-mode-map "\C-c\C-c\C-p" 'vhdl-compose-place-component)
2627      (define-key vhdl-mode-map "\C-c\C-c\C-w" 'vhdl-compose-wire-components)
2628      (define-key vhdl-mode-map "\C-c\C-c\C-k" 'vhdl-compose-components-package)
2629      (define-key vhdl-mode-map "\C-cc"        'vhdl-comment-uncomment-region)
2630    (define-key vhdl-mode-map "\C-c-"        'vhdl-comment-append-inline)    (define-key vhdl-mode-map "\C-c-"        'vhdl-comment-append-inline)
2631    (define-key vhdl-mode-map "\C-c\M--"     'vhdl-comment-display-line)    (define-key vhdl-mode-map "\C-c\M--"     'vhdl-comment-display-line)
2632    (define-key vhdl-mode-map "\C-c\M-\C-i"  'vhdl-indent-line)    (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
2633      (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group)
2634    (define-key vhdl-mode-map "\M-\C-\\"     'vhdl-indent-region)    (define-key vhdl-mode-map "\M-\C-\\"     'vhdl-indent-region)
2635    (define-key vhdl-mode-map "\C-c\C-a"     'vhdl-align-group)    (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer)
2636    (define-key vhdl-mode-map "\C-c\C-r\C-a" 'vhdl-align-noindent-region)    (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group)
2637    (define-key vhdl-mode-map "\C-c\M-\C-a"  'vhdl-align-inline-comment-group)    (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group)
2638    (define-key vhdl-mode-map "\C-c\C-r\M-\C-a" 'vhdl-align-inline-comment-region)    (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent)
2639    (define-key vhdl-mode-map "\C-c\C-w"     'vhdl-fixup-whitespace-region)    (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list)
2640      (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations)
2641      (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region)
2642      (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer)
2643      (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group)
2644      (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region)
2645      (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list)
2646      (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list)
2647      (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group)
2648      (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent)
2649      (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region)
2650    (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)    (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill)
2651    (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)    (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy)
2652    (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)    (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank)
# Line 1590  STRING are replaced by `-' and substring Line 2656  STRING are replaced by `-' and substring
2656    (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)    (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open)
2657    (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)    (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line)
2658    (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)    (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line)
2659    (define-key vhdl-mode-map "\C-c\C-r\C-u" 'vhdl-fix-case-region)    (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause)
2660    (define-key vhdl-mode-map "\C-c\C-u"     'vhdl-fix-case-buffer)    (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region)
2661    (define-key vhdl-mode-map "\C-c\C-f"     'vhdl-fontify-buffer)    (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer)
2662    (define-key vhdl-mode-map "\C-c\C-x"     'vhdl-show-syntactic-information)    (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region)
2663      (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer)
2664      (define-key vhdl-mode-map "\C-c\M-b"     'vhdl-beautify-region)
2665      (define-key vhdl-mode-map "\C-c\C-b"     'vhdl-beautify-buffer)
2666      (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
2667      (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
2668      (define-key vhdl-mode-map "\C-cf"        'vhdl-fontify-buffer)
2669      (define-key vhdl-mode-map "\C-cs"        'vhdl-statistics-buffer)
2670      (define-key vhdl-mode-map "\C-c\M-m"     'vhdl-show-messages)
2671    (define-key vhdl-mode-map "\C-c\C-h"     'vhdl-doc-mode)    (define-key vhdl-mode-map "\C-c\C-h"     'vhdl-doc-mode)
2672    (define-key vhdl-mode-map "\C-c\C-v"     'vhdl-version)    (define-key vhdl-mode-map "\C-c\C-v"     'vhdl-version)
2673    (define-key vhdl-mode-map "\C-c\C-r\C-b" 'vhdl-beautify-region)    (define-key vhdl-mode-map "\M-\t"        'insert-tab)
   (define-key vhdl-mode-map "\C-c\C-b"     'vhdl-beautify-buffer)  
   (define-key vhdl-mode-map "\M-\t"        'tab-to-tab-stop)  
2674    ;; insert commands bindings    ;; insert commands bindings
2675    (define-key vhdl-mode-map "\C-c\C-i\C-c" 'vhdl-template-insert-construct)    (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct)
2676    (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)    (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package)
2677    (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)    (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive)
2678    (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)    (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert)
# Line 1608  STRING are replaced by `-' and substring Line 2680  STRING are replaced by `-' and substring
2680    (define-key vhdl-mode-map " "            'vhdl-electric-space)    (define-key vhdl-mode-map " "            'vhdl-electric-space)
2681    (if vhdl-intelligent-tab    (if vhdl-intelligent-tab
2682        (define-key vhdl-mode-map "\t"       'vhdl-electric-tab)        (define-key vhdl-mode-map "\t"       'vhdl-electric-tab)
2683      (define-key vhdl-mode-map "\t"         'vhdl-indent-line))      (define-key vhdl-mode-map "\t"         'indent-according-to-mode))
2684    (define-key vhdl-mode-map "\r"           'vhdl-electric-return)    (define-key vhdl-mode-map "\r"           'vhdl-electric-return)
2685    (define-key vhdl-mode-map "-"            'vhdl-electric-dash)    (define-key vhdl-mode-map "-"            'vhdl-electric-dash)
2686    (define-key vhdl-mode-map "["            'vhdl-electric-open-bracket)    (define-key vhdl-mode-map "["            'vhdl-electric-open-bracket)
# Line 1650  STRING are replaced by `-' and substring Line 2722  STRING are replaced by `-' and substring
2722     vhdl-electric-period     vhdl-electric-period
2723     vhdl-electric-equal))     vhdl-electric-equal))
2724    
2725  ;; syntax table  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2726    ;; Syntax table
2727    
2728  (defvar vhdl-mode-syntax-table nil  (defvar vhdl-mode-syntax-table nil
2729    "Syntax table used in `vhdl-mode' buffers.")    "Syntax table used in `vhdl-mode' buffers.")
2730    
2731    (defvar vhdl-mode-ext-syntax-table nil
2732      "Syntax table extended by `_' used in `vhdl-mode' buffers.")
2733    
2734  (defun vhdl-mode-syntax-table-init ()  (defun vhdl-mode-syntax-table-init ()
2735    "Initialize `vhdl-mode-syntax-table'."    "Initialize `vhdl-mode-syntax-table'."
2736    (setq vhdl-mode-syntax-table (make-syntax-table))    (setq vhdl-mode-syntax-table (make-syntax-table))
# Line 1678  STRING are replaced by `-' and substring Line 2755  STRING are replaced by `-' and substring
2755    (modify-syntax-entry ?\" "\""   vhdl-mode-syntax-table)    (modify-syntax-entry ?\" "\""   vhdl-mode-syntax-table)
2756    ;; define underscore    ;; define underscore
2757    (when vhdl-underscore-is-part-of-word    (when vhdl-underscore-is-part-of-word
2758      (modify-syntax-entry ?_ "w"   vhdl-mode-syntax-table))      (modify-syntax-entry ?\_ "w"   vhdl-mode-syntax-table))
2759    ;; a single hyphen is punctuation, but a double hyphen starts a comment    ;; a single hyphen is punctuation, but a double hyphen starts a comment
2760    (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)    (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table)
2761    ;; and \n and \^M end a comment    ;; and \n and \^M end a comment
# Line 1690  STRING are replaced by `-' and substring Line 2767  STRING are replaced by `-' and substring
2767    (modify-syntax-entry ?\[ "(]"   vhdl-mode-syntax-table)    (modify-syntax-entry ?\[ "(]"   vhdl-mode-syntax-table)
2768    (modify-syntax-entry ?\] ")["   vhdl-mode-syntax-table)    (modify-syntax-entry ?\] ")["   vhdl-mode-syntax-table)
2769    (modify-syntax-entry ?\{ "(}"   vhdl-mode-syntax-table)    (modify-syntax-entry ?\{ "(}"   vhdl-mode-syntax-table)
2770    (modify-syntax-entry ?\} "){"   vhdl-mode-syntax-table))    (modify-syntax-entry ?\} "){"   vhdl-mode-syntax-table)
2771      ;; extended syntax table including '_' (for simpler search regexps)
2772      (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table))
2773      (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table))
2774    
2775  ;; initialize syntax table for VHDL Mode  ;; initialize syntax table for VHDL Mode
2776  (vhdl-mode-syntax-table-init)  (vhdl-mode-syntax-table-init)
2777    
 (defmacro vhdl-ext-syntax-table (&rest body)  
   "Execute BODY with syntax table that includes `_' in word class."  
   `(let (result)  
      (modify-syntax-entry ?_ "w" vhdl-mode-syntax-table)  
      (setq result (progn ,@body))  
      (when (not vhdl-underscore-is-part-of-word)  
        (modify-syntax-entry ?_ "_" vhdl-mode-syntax-table))  
      result))  
   
2778  (defvar vhdl-syntactic-context nil  (defvar vhdl-syntactic-context nil
2779    "Buffer local variable containing syntactic analysis list.")    "Buffer local variable containing syntactic analysis list.")
2780  (make-variable-buffer-local 'vhdl-syntactic-context)  (make-variable-buffer-local 'vhdl-syntactic-context)
2781    
2782  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2783  ;; Abbrev hook bindings  ;; Abbrev ook bindings
2784    
2785  (defvar vhdl-mode-abbrev-table nil  (defvar vhdl-mode-abbrev-table nil
2786    "Abbrev table to use in `vhdl-mode' buffers.")    "Abbrev table to use in `vhdl-mode' buffers.")
# Line 1722  STRING are replaced by `-' and substring Line 2793  STRING are replaced by `-' and substring
2793       (when (memq 'vhdl vhdl-electric-keywords)       (when (memq 'vhdl vhdl-electric-keywords)
2794         ;; VHDL'93 keywords         ;; VHDL'93 keywords
2795         '(         '(
2796           ("--"            "" vhdl-template-display-comment-hook 0 t)           ("--"            "" vhdl-template-display-comment-hook 0)
2797           ("abs"           "" vhdl-template-default-hook 0 t)           ("abs"           "" vhdl-template-default-hook 0)
2798           ("access"        "" vhdl-template-default-hook 0 t)           ("access"        "" vhdl-template-default-hook 0)
2799           ("after"         "" vhdl-template-default-hook 0 t)           ("after"         "" vhdl-template-default-hook 0)
2800           ("alias"         "" vhdl-template-alias-hook 0 t)           ("alias"         "" vhdl-template-alias-hook 0)
2801           ("all"           "" vhdl-template-default-hook 0 t)           ("all"           "" vhdl-template-default-hook 0)
2802           ("and"           "" vhdl-template-default-hook 0 t)           ("and"           "" vhdl-template-default-hook 0)
2803           ("arch"          "" vhdl-template-architecture-hook 0 t)           ("arch"          "" vhdl-template-architecture-hook 0)
2804           ("architecture"  "" vhdl-template-architecture-hook 0 t)           ("architecture"  "" vhdl-template-architecture-hook 0)
2805           ("array"         "" vhdl-template-default-hook 0 t)           ("array"         "" vhdl-template-default-hook 0)
2806           ("assert"        "" vhdl-template-assert-hook 0 t)           ("assert"        "" vhdl-template-assert-hook 0)
2807           ("attr"          "" vhdl-template-attribute-hook 0 t)           ("attr"          "" vhdl-template-attribute-hook 0)
2808           ("attribute"     "" vhdl-template-attribute-hook 0 t)           ("attribute"     "" vhdl-template-attribute-hook 0)
2809           ("begin"         "" vhdl-template-default-indent-hook 0 t)           ("begin"         "" vhdl-template-default-indent-hook 0)
2810           ("block"         "" vhdl-template-block-hook 0 t)           ("block"         "" vhdl-template-block-hook 0)
2811           ("body"          "" vhdl-template-default-hook 0 t)           ("body"          "" vhdl-template-default-hook 0)
2812           ("buffer"        "" vhdl-template-default-hook 0 t)           ("buffer"        "" vhdl-template-default-hook 0)
2813           ("bus"           "" vhdl-template-default-hook 0 t)           ("bus"           "" vhdl-template-default-hook 0)
2814           ("case"          "" vhdl-template-case-hook 0 t)           ("case"          "" vhdl-template-case-hook 0)
2815           ("comp"          "" vhdl-template-component-hook 0 t)           ("comp"          "" vhdl-template-component-hook 0)
2816           ("component"     "" vhdl-template-component-hook 0 t)           ("component"     "" vhdl-template-component-hook 0)
2817           ("cond"          "" vhdl-template-conditional-signal-asst-hook 0 t)           ("cond"          "" vhdl-template-conditional-signal-asst-hook 0)
2818           ("conditional"   "" vhdl-template-conditional-signal-asst-hook 0 t)           ("conditional"   "" vhdl-template-conditional-signal-asst-hook 0)
2819           ("conf"          "" vhdl-template-configuration-hook 0 t)           ("conf"          "" vhdl-template-configuration-hook 0)
2820           ("configuration" "" vhdl-template-configuration-hook 0 t)           ("configuration" "" vhdl-template-configuration-hook 0)
2821           ("cons"          "" vhdl-template-constant-hook 0 t)           ("cons"          "" vhdl-template-constant-hook 0)
2822           ("constant"      "" vhdl-template-constant-hook 0 t)           ("constant"      "" vhdl-template-constant-hook 0)
2823           ("disconnect"    "" vhdl-template-disconnect-hook 0 t)           ("disconnect"    "" vhdl-template-disconnect-hook 0)
2824           ("downto"        "" vhdl-template-default-hook 0 t)           ("downto"        "" vhdl-template-default-hook 0)
2825           ("else"          "" vhdl-template-else-hook 0 t)           ("else"          "" vhdl-template-else-hook 0)
2826           ("elseif"        "" vhdl-template-elsif-hook 0 t)           ("elseif"        "" vhdl-template-elsif-hook 0)
2827           ("elsif"         "" vhdl-template-elsif-hook 0 t)           ("elsif"         "" vhdl-template-elsif-hook 0)
2828           ("end"           "" vhdl-template-default-indent-hook 0 t)           ("end"           "" vhdl-template-default-indent-hook 0)
2829           ("entity"        "" vhdl-template-entity-hook 0 t)           ("entity"        "" vhdl-template-entity-hook 0)
2830           ("exit"          "" vhdl-template-exit-hook 0 t)           ("exit"          "" vhdl-template-exit-hook 0)
2831           ("file"          "" vhdl-template-file-hook 0 t)           ("file"          "" vhdl-template-file-hook 0)
2832           ("for"           "" vhdl-template-for-hook 0 t)           ("for"           "" vhdl-template-for-hook 0)
2833           ("func"          "" vhdl-template-function-hook 0 t)           ("func"          "" vhdl-template-function-hook 0)
2834           ("function"      "" vhdl-template-function-hook 0 t)           ("function"      "" vhdl-template-function-hook 0)
2835           ("generic"       "" vhdl-template-generic-hook 0 t)           ("generic"       "" vhdl-template-generic-hook 0)
2836           ("group"         "" vhdl-template-group-hook 0 t)           ("group"         "" vhdl-template-group-hook 0)
2837           ("guarded"       "" vhdl-template-default-hook 0 t)           ("guarded"       "" vhdl-template-default-hook 0)
2838           ("if"            "" vhdl-template-if-hook 0 t)           ("if"            "" vhdl-template-if-hook 0)
2839           ("impure"        "" vhdl-template-default-hook 0 t)           ("impure"        "" vhdl-template-default-hook 0)
2840           ("in"            "" vhdl-template-default-hook 0 t)           ("in"            "" vhdl-template-default-hook 0)
2841           ("inertial"      "" vhdl-template-default-hook 0 t)           ("inertial"      "" vhdl-template-default-hook 0)
2842           ("inout"         "" vhdl-template-default-hook 0 t)           ("inout"         "" vhdl-template-default-hook 0)
2843           ("inst"          "" vhdl-template-instance-hook 0 t)           ("inst"          "" vhdl-template-instance-hook 0)
2844           ("instance"      "" vhdl-template-instance-hook 0 t)           ("instance"      "" vhdl-template-instance-hook 0)
2845           ("is"            "" vhdl-template-default-hook 0 t)           ("is"            "" vhdl-template-default-hook 0)
2846           ("label"         "" vhdl-template-default-hook 0 t)           ("label"         "" vhdl-template-default-hook 0)
2847           ("library"       "" vhdl-template-library-hook 0 t)           ("library"       "" vhdl-template-library-hook 0)
2848           ("linkage"       "" vhdl-template-default-hook 0 t)           ("linkage"       "" vhdl-template-default-hook 0)
2849           ("literal"       "" vhdl-template-default-hook 0 t)           ("literal"       "" vhdl-template-default-hook 0)
2850           ("loop"          "" vhdl-template-bare-loop-hook 0 t)           ("loop"          "" vhdl-template-bare-loop-hook 0)
2851           ("map"           "" vhdl-template-map-hook 0 t)           ("map"           "" vhdl-template-map-hook 0)
2852           ("mod"           "" vhdl-template-default-hook 0 t)           ("mod"           "" vhdl-template-default-hook 0)
2853           ("nand"          "" vhdl-template-default-hook 0 t)           ("nand"          "" vhdl-template-default-hook 0)
2854           ("new"           "" vhdl-template-default-hook 0 t)           ("new"           "" vhdl-template-default-hook 0)
2855           ("next"          "" vhdl-template-next-hook 0 t)           ("next"          "" vhdl-template-next-hook 0)
2856           ("nor"           "" vhdl-template-default-hook 0 t)           ("nor"           "" vhdl-template-default-hook 0)
2857           ("not"           "" vhdl-template-default-hook 0 t)           ("not"           "" vhdl-template-default-hook 0)
2858           ("null"          "" vhdl-template-default-hook 0 t)           ("null"          "" vhdl-template-default-hook 0)
2859           ("of"            "" vhdl-template-default-hook 0 t)           ("of"            "" vhdl-template-default-hook 0)
2860           ("on"            "" vhdl-template-default-hook 0 t)           ("on"            "" vhdl-template-default-hook 0)
2861           ("open"          "" vhdl-template-default-hook 0 t)           ("open"          "" vhdl-template-default-hook 0)
2862           ("or"            "" vhdl-template-default-hook 0 t)           ("or"            "" vhdl-template-default-hook 0)
2863           ("others"        "" vhdl-template-default-hook 0 t)           ("others"        "" vhdl-template-others-hook 0)
2864           ("out"           "" vhdl-template-default-hook 0 t)           ("out"           "" vhdl-template-default-hook 0)
2865           ("pack"          "" vhdl-template-package-hook 0 t)           ("pack"          "" vhdl-template-package-hook 0)
2866           ("package"       "" vhdl-template-package-hook 0 t)           ("package"       "" vhdl-template-package-hook 0)
2867           ("port"          "" vhdl-template-port-hook 0 t)           ("port"          "" vhdl-template-port-hook 0)
2868           ("postponed"     "" vhdl-template-default-hook 0 t)           ("postponed"     "" vhdl-template-default-hook 0)
2869           ("procedure"     "" vhdl-template-procedure-hook 0 t)           ("procedure"     "" vhdl-template-procedure-hook 0)
2870           ("process"       "" vhdl-template-process-hook 0 t)           ("process"       "" vhdl-template-process-hook 0)
2871           ("pure"          "" vhdl-template-default-hook 0 t)           ("pure"          "" vhdl-template-default-hook 0)
2872           ("range"         "" vhdl-template-default-hook 0 t)           ("range"         "" vhdl-template-default-hook 0)
2873           ("record"        "" vhdl-template-default-hook 0 t)           ("record"        "" vhdl-template-default-hook 0)
2874           ("register"      "" vhdl-template-default-hook 0 t)           ("register"      "" vhdl-template-default-hook 0)
2875           ("reject"        "" vhdl-template-default-hook 0 t)           ("reject"        "" vhdl-template-default-hook 0)
2876           ("rem"           "" vhdl-template-default-hook 0 t)           ("rem"           "" vhdl-template-default-hook 0)
2877           ("report"        "" vhdl-template-report-hook 0 t)           ("report"        "" vhdl-template-report-hook 0)
2878           ("return"        "" vhdl-template-return-hook 0 t)           ("return"        "" vhdl-template-return-hook 0)
2879           ("rol"           "" vhdl-template-default-hook 0 t)           ("rol"           "" vhdl-template-default-hook 0)
2880           ("ror"           "" vhdl-template-default-hook 0 t)           ("ror"           "" vhdl-template-default-hook 0)
2881           ("select"        "" vhdl-template-selected-signal-asst-hook 0 t)           ("select"        "" vhdl-template-selected-signal-asst-hook 0)
2882           ("severity"      "" vhdl-template-default-hook 0 t)           ("severity"      "" vhdl-template-default-hook 0)
2883           ("shared"        "" vhdl-template-default-hook 0 t)           ("shared"        "" vhdl-template-default-hook 0)
2884           ("sig"           "" vhdl-template-signal-hook 0 t)           ("sig"           "" vhdl-template-signal-hook 0)
2885           ("signal"        "" vhdl-template-signal-hook 0 t)           ("signal"        "" vhdl-template-signal-hook 0)
2886           ("sla"           "" vhdl-template-default-hook 0 t)           ("sla"           "" vhdl-template-default-hook 0)
2887           ("sll"           "" vhdl-template-default-hook 0 t)           ("sll"           "" vhdl-template-default-hook 0)
2888           ("sra"           "" vhdl-template-default-hook 0 t)           ("sra"           "" vhdl-template-default-hook 0)
2889           ("srl"           "" vhdl-template-default-hook 0 t)           ("srl"           "" vhdl-template-default-hook 0)
2890           ("subtype"       "" vhdl-template-subtype-hook 0 t)           ("subtype"       "" vhdl-template-subtype-hook 0)
2891           ("then"          "" vhdl-template-default-hook 0 t)           ("then"          "" vhdl-template-default-hook 0)
2892           ("to"            "" vhdl-template-default-hook 0 t)           ("to"            "" vhdl-template-default-hook 0)
2893           ("transport"     "" vhdl-template-default-hook 0 t)           ("transport"     "" vhdl-template-default-hook 0)
2894           ("type"          "" vhdl-template-type-hook 0 t)           ("type"          "" vhdl-template-type-hook 0)
2895           ("unaffected"    "" vhdl-template-default-hook 0 t)           ("unaffected"    "" vhdl-template-default-hook 0)
2896           ("units"         "" vhdl-template-default-hook 0 t)           ("units"         "" vhdl-template-default-hook 0)
2897           ("until"         "" vhdl-template-default-hook 0 t)           ("until"         "" vhdl-template-default-hook 0)
2898           ("use"           "" vhdl-template-use-hook 0 t)           ("use"           "" vhdl-template-use-hook 0)
2899           ("var"           "" vhdl-template-variable-hook 0 t)           ("var"           "" vhdl-template-variable-hook 0)
2900           ("variable"      "" vhdl-template-variable-hook 0 t)           ("variable"      "" vhdl-template-variable-hook 0)
2901           ("wait"          "" vhdl-template-wait-hook 0 t)           ("wait"          "" vhdl-template-wait-hook 0)
2902           ("when"          "" vhdl-template-when-hook 0 t)           ("when"          "" vhdl-template-when-hook 0)
2903           ("while"         "" vhdl-template-while-loop-hook 0 t)           ("while"         "" vhdl-template-while-loop-hook 0)
2904           ("with"          "" vhdl-template-with-hook 0 t)           ("with"          "" vhdl-template-with-hook 0)
2905           ("xnor"          "" vhdl-template-default-hook 0 t)           ("xnor"          "" vhdl-template-default-hook 0)
2906           ("xor"           "" vhdl-template-default-hook 0 t)           ("xor"           "" vhdl-template-default-hook 0)
2907           ))           ))
2908       ;; VHDL-AMS keywords       ;; VHDL-AMS keywords
2909       (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))       (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
2910         '(         '(
2911           ("across"     "" vhdl-template-default-hook 0 t)           ("across"     "" vhdl-template-default-hook 0)
2912           ("break"      "" vhdl-template-break-hook 0 t)           ("break"      "" vhdl-template-break-hook 0)
2913           ("limit"      "" vhdl-template-limit-hook 0 t)           ("limit"      "" vhdl-template-limit-hook 0)
2914           ("nature"     "" vhdl-template-nature-hook 0 t)           ("nature"     "" vhdl-template-nature-hook 0)
2915           ("noise"      "" vhdl-template-default-hook 0 t)           ("noise"      "" vhdl-template-default-hook 0)
2916           ("procedural" "" vhdl-template-procedural-hook 0 t)           ("procedural" "" vhdl-template-procedural-hook 0)
2917           ("quantity"   "" vhdl-template-quantity-hook 0 t)           ("quantity"   "" vhdl-template-quantity-hook 0)
2918           ("reference"  "" vhdl-template-default-hook 0 t)           ("reference"  "" vhdl-template-default-hook 0)
2919           ("spectrum"   "" vhdl-template-default-hook 0 t)           ("spectrum"   "" vhdl-template-default-hook 0)
2920           ("subnature"  "" vhdl-template-subnature-hook 0 t)           ("subnature"  "" vhdl-template-subnature-hook 0)
2921           ("terminal"   "" vhdl-template-terminal-hook 0 t)           ("terminal"   "" vhdl-template-terminal-hook 0)
2922           ("through"    "" vhdl-template-default-hook 0 t)           ("through"    "" vhdl-template-default-hook 0)
2923           ("tolerance"  "" vhdl-template-default-hook 0 t)           ("tolerance"  "" vhdl-template-default-hook 0)
2924           ))           ))
2925       ;; user model keywords       ;; user model keywords
2926       (when (memq 'user vhdl-electric-keywords)       (when (memq 'user vhdl-electric-keywords)
# Line 1969  STRING are replaced by `-' and substring Line 3040  STRING are replaced by `-' and substring
3040  (vhdl-template-package-alist-init)  (vhdl-template-package-alist-init)
3041    
3042  (defvar vhdl-template-directive-alist  (defvar vhdl-template-directive-alist
3043    (append    '(
3044     '(      ("translate_on"     vhdl-template-directive-translate-on)
3045       ("translate_on"    vhdl-template-directive-translate-on)      ("translate_off"    vhdl-template-directive-translate-off)
3046       ("translate_off"   vhdl-template-directive-translate-off)      ("synthesis_on"     vhdl-template-directive-synthesis-on)
3047       ("synthesis_on"    vhdl-template-directive-synthesis-on)      ("synthesis_off"    vhdl-template-directive-synthesis-off)
3048       ("synthesis_off"   vhdl-template-directive-synthesis-off)      )
      ))  
3049    "List of built-in directive templates.")    "List of built-in directive templates.")
3050    
3051    
# Line 1991  STRING are replaced by `-' and substring Line 3061  STRING are replaced by `-' and substring
3061    (interactive)    (interactive)
3062    (customize-browse 'vhdl))    (customize-browse 'vhdl))
3063    
 (defun vhdl-create-customize-menu ()  
   "Create a full customization menu for VHDL, insert it into the menu."  
   (interactive)  
   (if (fboundp 'customize-menu-create)  
       (easy-menu-change  
        '("VHDL") "Customize"  
        `(["Browse VHDL Group..." vhdl-customize t]  
          ,(customize-menu-create 'vhdl)  
          "--"  
          ["Activate New Customizations" vhdl-activate-customizations t]))  
     (error "Cannot expand menu (outdated version of cus-edit.el)")))  
   
3064  (defun vhdl-create-mode-menu ()  (defun vhdl-create-mode-menu ()
3065    "Create VHDL Mode menu."    "Create VHDL Mode menu."
3066    (list    `("VHDL"
3067     "VHDL"      ,(append
3068     '("Mode"        '("Project"
3069       ["Electric" vhdl-electric-mode :style toggle :selected vhdl-electric-mode]          ["None"                 (vhdl-set-project "")
3070       ["Stutter"  vhdl-stutter-mode  :style toggle :selected vhdl-stutter-mode]                                  :style radio :selected (null vhdl-project)]
3071       )          "--")
3072     "--"        ;; add menu entries for defined projects
3073     (append        (let ((project-alist vhdl-project-alist) menu-list name)
3074      '("Project"          (while project-alist
3075        ["None" (vhdl-project-switch "")            (setq name (caar project-alist))
3076         :style radio :selected (equal vhdl-project "")]            (setq menu-list
3077        "--"                  (cons `[,name (vhdl-set-project ,name)
3078        )                          :style radio :selected (equal ,name vhdl-project)]
3079      ;; add menu entries for defined projects                        menu-list))
3080      (let ((project-alist vhdl-project-alist) menu-alist name)            (setq project-alist (cdr project-alist)))
3081        (while project-alist          (setq menu-list
3082          (setq name (car (car project-alist)))                (if vhdl-project-sort
3083          (setq menu-alist (cons (vector name (list 'vhdl-project-switch name)                    (sort menu-list
3084                                         :style 'radio :selected                          (function (lambda (a b) (string< (elt a 0) (elt b 0)))))
3085                                         (list 'equal 'vhdl-project name))                  (nreverse menu-list)))
3086                                 menu-alist))          (vhdl-menu-split menu-list "Project"))
3087          (setq project-alist (cdr project-alist)))        '("--" "--"
3088        (setq menu-alist (cons '["Add Project..."          ["Select Project..."    vhdl-set-project t]
3089                                 (customize-variable 'vhdl-project-alist) t]          "--"
3090                               (cons "--" menu-alist)))          ["Duplicate Project"    vhdl-duplicate-project vhdl-project]
3091        (nreverse menu-alist)))          ["Import Project..."    vhdl-import-project
3092     "--"                                  :keys "C-c C-p C-m" :active t]
3093     (list          ["Export Project"       vhdl-export-project vhdl-project]
3094      "Compile"          "--"
3095      ["Compile Buffer"           vhdl-compile t]          ["Customize Project..." (customize-option 'vhdl-project-alist) t]))
     ["Stop Compilation"         kill-compilation t]  
     "--"  
     ["Make"                     vhdl-make t]  
     ["Generate Makefile"        vhdl-generate-makefile t]  
3096      "--"      "--"
3097      ["Next Error"               next-error t]      ("Compile"
3098      ["Previous Error"           previous-error t]       ["Compile Buffer"          vhdl-compile t]
3099      ["First Error"              first-error t]       ["Stop Compilation"        kill-compilation t]
3100         "--"
3101         ["Make"                    vhdl-make t]
3102         ["Generate Makefile"       vhdl-generate-makefile t]
3103         "--"
3104         ["Next Error"              next-error t]
3105         ["Previous Error"          previous-error t]
3106         ["First Error"             first-error t]
3107         "--"
3108         ,(append
3109           '("Compiler")
3110           ;; add menu entries for defined compilers
3111           (let ((comp-alist vhdl-compiler-alist) menu-list name)
3112             (while comp-alist
3113               (setq name (caar comp-alist))
3114               (setq menu-list
3115                     (cons `[,name (setq vhdl-compiler ,name)
3116                             :style radio :selected (equal ,name vhdl-compiler)]
3117                           menu-list))
3118               (setq comp-alist (cdr comp-alist)))
3119             (setq menu-list (nreverse menu-list))
3120             (vhdl-menu-split menu-list "Compiler"))
3121           '("--" "--"
3122             ["Select Compiler..."  vhdl-set-compiler t]
3123             "--"
3124             ["Customize Compiler..."
3125              (customize-option 'vhdl-compiler-alist) t])))
3126      "--"      "--"
3127      (append      ,(append
3128       '("Compiler")        '("Template"
3129       ;; add menu entries for defined compilers          ("VHDL Construct 1"
3130       (let ((comp-alist vhdl-compiler-alist) menu-alist name)           ["Alias"               vhdl-template-alias t]
3131         (while comp-alist           ["Architecture"        vhdl-template-architecture t]
3132           (setq name (car (car comp-alist)))           ["Assert"              vhdl-template-assert t]
3133           (setq menu-alist (cons (vector name (list 'setq 'vhdl-compiler name)           ["Attribute (Decl)"    vhdl-template-attribute-decl t]
3134                                          :style 'radio :selected           ["Attribute (Spec)"    vhdl-template-attribute-spec t]
3135                                          (list 'equal 'vhdl-compiler name))           ["Block"               vhdl-template-block t]
3136                                  menu-alist))           ["Case"                vhdl-template-case-is t]
3137           (setq comp-alist (cdr comp-alist)))           ["Component (Decl)"    vhdl-template-component-decl t]
3138         (setq menu-alist (cons '["Add Compiler..."           ["(Component) Instance"        vhdl-template-component-inst t]
3139                                  (customize-variable 'vhdl-compiler-alist) t]           ["Conditional (Signal Asst)"   vhdl-template-conditional-signal-asst t]
3140                                (cons "--" menu-alist)))           ["Configuration (Block)"       vhdl-template-block-configuration t]
3141         (nreverse menu-alist))))           ["Configuration (Comp)"        vhdl-template-component-conf t]
3142     "--"           ["Configuration (Decl)"        vhdl-template-configuration-decl t]
3143     (append           ["Configuration (Spec)"        vhdl-template-configuration-spec t]
3144      '("Template"           ["Constant"            vhdl-template-constant t]
3145        ("VHDL Construct 1"           ["Disconnect"          vhdl-template-disconnect t]
3146         ["Alias"                 vhdl-template-alias t]           ["Else"                vhdl-template-else t]
3147         ["Architecture"          vhdl-template-architecture t]           ["Elsif"               vhdl-template-elsif t]
3148         ["Assert"                vhdl-template-assert t]           ["Entity"              vhdl-template-entity t]
3149         ["Attribute (Decl)"      vhdl-template-attribute-decl t]           ["Exit"                vhdl-template-exit t]
3150         ["Attribute (Spec)"      vhdl-template-attribute-spec t]           ["File"                vhdl-template-file t]
3151         ["Block"                 vhdl-template-block t]           ["For (Generate)"      vhdl-template-for-generate t]
3152         ["Case"                  vhdl-template-case-is t]           ["For (Loop)"          vhdl-template-for-loop t]
3153         ["Component (Decl)"      vhdl-template-component-decl t]           ["Function (Body)"     vhdl-template-function-body t]
3154         ["(Component) Instance"  vhdl-template-component-inst t]           ["Function (Decl)"     vhdl-template-function-decl t]
3155         ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t]           ["Generic"             vhdl-template-generic t]
3156         ["Configuration (Block)"vhdl-template-block-configuration t]           ["Group (Decl)"        vhdl-template-group-decl t]
3157         ["Configuration (Comp)"  vhdl-template-component-conf t]           ["Group (Template)"    vhdl-template-group-template t])
3158         ["Configuration (Decl)"  vhdl-template-configuration-decl t]          ("VHDL Construct 2"
3159         ["Configuration (Spec)"  vhdl-template-configuration-spec t]           ["If (Generate)"       vhdl-template-if-generate t]
3160         ["Constant"              vhdl-template-constant t]           ["If (Then)"           vhdl-template-if-then t]
3161         ["Disconnect"            vhdl-template-disconnect t]           ["Library"             vhdl-template-library t]
3162         ["Else"                  vhdl-template-else t]           ["Loop"                vhdl-template-bare-loop t]
3163         ["Elsif"                 vhdl-template-elsif t]           ["Map"                 vhdl-template-map t]
3164         ["Entity"                vhdl-template-entity t]           ["Next"                vhdl-template-next t]
3165         ["Exit"                  vhdl-template-exit t]           ["Others (Aggregate)"  vhdl-template-others t]
3166         ["File"                  vhdl-template-file t]           ["Package (Decl)"      vhdl-template-package-decl t]
3167         ["For (Generate)"        vhdl-template-for-generate t]           ["Package (Body)"      vhdl-template-package-body t]
3168         ["For (Loop)"            vhdl-template-for-loop t]           ["Port"                vhdl-template-port t]
3169         ["Function (Body)"       vhdl-template-function-body t]           ["Procedure (Body)"    vhdl-template-procedure-body t]
3170         ["Function (Decl)"       vhdl-template-function-decl t]           ["Procedure (Decl)"    vhdl-template-procedure-decl t]
3171         ["Generic"               vhdl-template-generic t]           ["Process (Comb)"      vhdl-template-process-comb t]
3172         ["Group (Decl)"          vhdl-template-group-decl t]           ["Process (Seq)"       vhdl-template-process-seq t]
3173         ["Group (Template)"      vhdl-template-group-template t]           ["Report"              vhdl-template-report t]
3174         )           ["Return"              vhdl-template-return t]
3175        ("VHDL Construct 2"           ["Select"              vhdl-template-selected-signal-asst t]
3176         ["If (Generate)"         vhdl-template-if-generate t]           ["Signal"              vhdl-template-signal t]
3177         ["If (Then)"             vhdl-template-if-then t]           ["Subtype"             vhdl-template-subtype t]
3178         ["Library"               vhdl-template-library t]           ["Type"                vhdl-template-type t]
3179         ["Loop"                  vhdl-template-bare-loop t]           ["Use"                 vhdl-template-use t]
3180         ["Map"                   vhdl-template-map t]           ["Variable"            vhdl-template-variable t]
3181         ["Next"                  vhdl-template-next t]           ["Wait"                vhdl-template-wait t]
3182         ["(Others)"              vhdl-template-others t]           ["(Clocked Wait)"      vhdl-template-clocked-wait t]
3183         ["Package (Decl)"        vhdl-template-package-decl t]           ["When"                vhdl-template-when t]
3184         ["Package (Body)"        vhdl-template-package-body t]           ["While (Loop)"        vhdl-template-while-loop t]
3185         ["Port"                  vhdl-template-port t]           ["With"                vhdl-template-with t]))
3186         ["Procedure (Body)"      vhdl-template-procedure-body t]        (when (vhdl-standard-p 'ams)
3187         ["Procedure (Decl)"      vhdl-template-procedure-decl t]          '(("VHDL-AMS Construct"
3188         ["Process (Comb)"        vhdl-template-process-comb t]             ["Break"             vhdl-template-break t]
3189         ["Process (Seq)"         vhdl-template-process-seq t]             ["Case (Use)"        vhdl-template-case-use t]
3190         ["Report"                vhdl-template-report t]             ["If (Use)"          vhdl-template-if-use t]
3191         ["Return"                vhdl-template-return t]             ["Limit"             vhdl-template-limit t]
3192         ["Select"                vhdl-template-selected-signal-asst t]             ["Nature"            vhdl-template-nature t]
3193         ["Signal"                vhdl-template-signal t]             ["Procedural"        vhdl-template-procedural t]
3194         ["Subtype"               vhdl-template-subtype t]             ["Quantity (Free)"   vhdl-template-quantity-free t]
3195         ["Type"                  vhdl-template-type t]             ["Quantity (Branch)" vhdl-template-quantity-branch t]
3196         ["Use"                   vhdl-template-use t]             ["Quantity (Source)" vhdl-template-quantity-source t]
3197         ["Variable"              vhdl-template-variable t]             ["Subnature"         vhdl-template-subnature t]
3198         ["Wait"                  vhdl-template-wait t]             ["Terminal"          vhdl-template-terminal t])))
3199         ["(Clocked Wait)"        vhdl-template-clocked-wait t]        '(["Insert Construct..."  vhdl-template-insert-construct
3200         ["When"                  vhdl-template-when t]                                  :keys "C-c C-i C-t"]
3201         ["While (Loop)"          vhdl-template-while-loop t]          "--")
3202         ["With"                  vhdl-template-with t]        (list
3203         ))         (append
3204      (when (vhdl-standard-p 'ams)          '("Package")
3205        '(("VHDL-AMS Construct"          (when (vhdl-standard-p 'math)
3206           ["Break"               vhdl-template-break t]            '(["math_complex"     vhdl-template-package-math-complex t]
3207           ["Case (Use)"          vhdl-template-case-use t]              ["math_real"        vhdl-template-package-math-real t]))
3208           ["If (Use)"            vhdl-template-if-use t]          '(["numeric_bit"        vhdl-template-package-numeric-bit t]
3209           ["Limit"               vhdl-template-limit t]            ["numeric_std"        vhdl-template-package-numeric-std t]
3210           ["Nature"              vhdl-template-nature t]            ["std_logic_1164"     vhdl-template-package-std-logic-1164 t]
3211           ["Procedural"          vhdl-template-procedural t]            ["textio"             vhdl-template-package-textio t]
3212           ["Quantity (Free)"     vhdl-template-quantity-free t]            "--"
3213           ["Quantity (Branch)"   vhdl-template-quantity-branch t]            ["std_logic_arith"    vhdl-template-package-std-logic-arith t]
3214           ["Quantity (Source)"   vhdl-template-quantity-source t]            ["std_logic_signed"   vhdl-template-package-std-logic-signed t]
3215           ["Subnature"           vhdl-template-subnature t]            ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t]
3216           ["Terminal"            vhdl-template-terminal t]            ["std_logic_misc"     vhdl-template-package-std-logic-misc t]
3217           )))            ["std_logic_textio"   vhdl-template-package-std-logic-textio t]
3218      '(["Insert Construct"       vhdl-template-insert-construct            "--"
3219         :keys "C-c C-i C-c"]            ["Insert Package..."  vhdl-template-insert-package
3220        "--")                                  :keys "C-c C-i C-p"])))
3221      (list        '(("Directive"
3222       (append           ["translate_on"        vhdl-template-directive-translate-on t]
3223        '("Package")           ["translate_off"       vhdl-template-directive-translate-off t]
3224        (when (vhdl-standard-p 'math)           ["synthesis_on"        vhdl-template-directive-synthesis-on t]
3225          '(           ["synthesis_off"       vhdl-template-directive-synthesis-off t]
3226            ["math_complex"       vhdl-template-package-math-complex t]           "--"
3227            ["math_real"          vhdl-template-package-math-real t]           ["Insert Directive..." vhdl-template-insert-directive
3228            ))                                  :keys "C-c C-i C-d"])
       '(  
         ["numeric_bit"          vhdl-template-package-numeric-bit t]  
         ["numeric_std"          vhdl-template-package-numeric-std t]  
         ["std_logic_1164"       vhdl-template-package-std-logic-1164 t]  
         ["textio"               vhdl-template-package-textio t]  
3229          "--"          "--"
3230          ["std_logic_arith"      vhdl-template-package-std-logic-arith t]          ["Insert Header"        vhdl-template-header :keys "C-c C-t C-h"]
3231          ["std_logic_signed"     vhdl-template-package-std-logic-signed t]          ["Insert Footer"        vhdl-template-footer t]
3232          ["std_logic_unsigned"   vhdl-template-package-std-logic-unsigned t]          ["Insert Date"          vhdl-template-insert-date t]
3233          ["std_logic_misc"       vhdl-template-package-std-logic-misc t]          ["Modify Date"          vhdl-template-modify :keys "C-c C-t C-m"]
         ["std_logic_textio"     vhdl-template-package-std-logic-textio t]  
3234          "--"          "--"
3235          ["Insert Package"       vhdl-template-insert-package          ["Query Next Prompt"    vhdl-template-search-prompt t]))
3236           :keys "C-c C-i C-p"]      ,(append
3237          )))        '("Model")
3238      '(("Directive"        ;; add menu entries for defined models
3239         ["translate_on"          vhdl-template-directive-translate-on t]        (let ((model-alist vhdl-model-alist) menu-list model)
3240         ["translate_off"         vhdl-template-directive-translate-off t]          (while model-alist
3241         ["synthesis_on"          vhdl-template-directive-synthesis-on t]            (setq model (car model-alist))
3242         ["synthesis_off"         vhdl-template-directive-synthesis-off t]            (setq menu-list
3243         "--"                  (cons
3244         ["Insert Directive"      vhdl-template-insert-directive                   (vector
3245          :keys "C-c C-i C-d"]                    (nth 0 model)
3246         )                    (vhdl-function-name "vhdl-model" (nth 0 model))
3247        "--"                    :keys (concat "C-c C-m " (key-description (nth 2 model))))
3248        ["Insert Header"          vhdl-template-header :keys "C-c C-t C-h"]                   menu-list))
3249        ["Insert Footer"          vhdl-template-footer t]            (setq model-alist (cdr model-alist)))
3250        ["Insert Date"            vhdl-template-insert-date t]          (setq menu-list (nreverse menu-list))
3251        ["Modify Date"            vhdl-template-modify :keys "C-c C-t C-m"]          (vhdl-menu-split menu-list "Model"))
3252        "--"        '("--" "--"
3253        ["Query Next Prompt"      vhdl-template-search-prompt t]          ["Insert Model..."      vhdl-model-insert :keys "C-c C-i C-m"]
3254        ))          ["Customize Model..."   (customize-option 'vhdl-model-alist) t]))
3255     (append      ("Port"
     '("Model")  
     ;; add menu entries for defined models  
     (let ((model-alist vhdl-model-alist) menu-alist model)  
       (while model-alist  
         (setq model (car model-alist))  
         (setq menu-alist  
               (cons (vector  
                      (nth 0 model)  
                      (vhdl-function-name "vhdl-model" (nth 0 model))  
                      :keys (concat "C-c C-m " (key-description (nth 2 model))))  
                     menu-alist))  
         (setq model-alist (cdr model-alist)))  
       (setq menu-alist  
             (append  
              (nreverse menu-alist)  
              '("--"  
                ["Insert Model" vhdl-model-insert  :keys "C-c C-i C-m"]  
                ["Add Model..." (customize-variable 'vhdl-model-alist) t])))  
       menu-alist))  
    '("Port"  
3256       ["Copy"                    vhdl-port-copy t]       ["Copy"                    vhdl-port-copy t]
3257       "--"       "--"
3258       ["Paste As Entity"         vhdl-port-paste-entity vhdl-port-list]       ["Paste As Entity"         vhdl-port-paste-entity vhdl-port-list]
# Line 2208  STRING are replaced by `-' and substring Line 3262  STRING are replaced by `-' and substring
3262       ["Paste As Signals"        vhdl-port-paste-signals vhdl-port-list]       ["Paste As Signals"        vhdl-port-paste-signals vhdl-port-list]
3263       ["Paste As Constants"      vhdl-port-paste-constants vhdl-port-list]       ["Paste As Constants"      vhdl-port-paste-constants vhdl-port-list]
3264       ["Paste As Generic Map"    vhdl-port-paste-generic-map vhdl-port-list]       ["Paste As Generic Map"    vhdl-port-paste-generic-map vhdl-port-list]
3265       ["Paste As Test Bench"     vhdl-port-paste-testbench vhdl-port-list]       ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list]
3266       "--"       "--"
3267       ["Flatten"                 vhdl-port-flatten vhdl-port-list]       ["Paste As Testbench"      vhdl-port-paste-testbench vhdl-port-list]
3268       )       "--"
3269     "--"       ["Flatten"                 vhdl-port-flatten
3270     '("Comment"        :style toggle :selected vhdl-port-flattened :active vhdl-port-list]
3271         ["Reverse Direction"       vhdl-port-reverse-direction
3272          :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list])
3273        ("Compose"
3274         ["New Component"           vhdl-compose-new-component t]
3275         ["Place Component"         vhdl-compose-place-component vhdl-port-list]
3276         ["Wire Components"         vhdl-compose-wire-components t]
3277         "--"
3278         ["Generate Components Package"     vhdl-compose-components-package t])
3279        ("Subprogram"
3280         ["Copy"                    vhdl-subprog-copy t]
3281         "--"
3282         ["Paste As Declaration"    vhdl-subprog-paste-declaration vhdl-subprog-list]
3283         ["Paste As Body"           vhdl-subprog-paste-body vhdl-subprog-list]
3284         ["Paste As Call"           vhdl-subprog-paste-call vhdl-subprog-list]
3285         "--"
3286         ["Flatten"                 vhdl-subprog-flatten
3287          :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list])
3288        "--"
3289        ("Comment"
3290       ["(Un)Comment Out Region"  vhdl-comment-uncomment-region (mark)]       ["(Un)Comment Out Region"  vhdl-comment-uncomment-region (mark)]
3291       "--"       "--"
3292       ["Insert Inline Comment"   vhdl-comment-append-inline t]       ["Insert Inline Comment"   vhdl-comment-append-inline t]
# Line 2223  STRING are replaced by `-' and substring Line 3296  STRING are replaced by `-' and substring
3296       ["Fill Comment"            fill-paragraph t]       ["Fill Comment"            fill-paragraph t]
3297       ["Fill Comment Region"     fill-region (mark)]       ["Fill Comment Region"     fill-region (mark)]
3298       ["Kill Comment Region"     vhdl-comment-kill-region (mark)]       ["Kill Comment Region"     vhdl-comment-kill-region (mark)]
3299       ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]       ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)])
3300       )      ("Line"
    '("Line"  
3301       ["Kill"                    vhdl-line-kill t]       ["Kill"                    vhdl-line-kill t]
3302       ["Copy"                    vhdl-line-copy t]       ["Copy"                    vhdl-line-copy t]
3303       ["Yank"                    vhdl-line-yank t]       ["Yank"                    vhdl-line-yank t]
# Line 2234  STRING are replaced by `-' and substring Line 3306  STRING are replaced by `-' and substring
3306       ["Transpose Next"          vhdl-line-transpose-next t]       ["Transpose Next"          vhdl-line-transpose-next t]
3307       ["Transpose Prev"          vhdl-line-transpose-previous t]       ["Transpose Prev"          vhdl-line-transpose-previous t]
3308       ["Open"                    vhdl-line-open t]       ["Open"                    vhdl-line-open t]
3309       ["Join"                    delete-indentation t]       ["Join"                    vhdl-delete-indentation t]
3310       "--"       "--"
3311       ["Goto"                    goto-line t]       ["Goto"                    goto-line t]
3312       ["(Un)Comment Out"         vhdl-comment-uncomment-line t]       ["(Un)Comment Out"         vhdl-comment-uncomment-line t])
3313       )      ("Move"
    '("Move"  
3314       ["Forward Statement"       vhdl-end-of-statement t]       ["Forward Statement"       vhdl-end-of-statement t]
3315       ["Backward Statement"      vhdl-beginning-of-statement t]       ["Backward Statement"      vhdl-beginning-of-statement t]
3316       ["Forward Expression"      vhdl-forward-sexp t]       ["Forward Expression"      vhdl-forward-sexp t]
3317       ["Backward Expression"     vhdl-backward-sexp t]       ["Backward Expression"     vhdl-backward-sexp t]
3318         ["Forward Same Indent"     vhdl-forward-same-indent t]
3319         ["Backward Same Indent"    vhdl-backward-same-indent t]
3320       ["Forward Function"        vhdl-end-of-defun t]       ["Forward Function"        vhdl-end-of-defun t]
3321       ["Backward Function"       vhdl-beginning-of-defun t]       ["Backward Function"       vhdl-beginning-of-defun t]
3322       ["Mark Function"           vhdl-mark-defun t]       ["Mark Function"           vhdl-mark-defun t])
3323       )      "--"
3324     "--"      ("Indent"
3325     '("Indent"       ["Line"                    indent-according-to-mode :keys "C-c C-i C-l"]
3326       ["Line"                    vhdl-indent-line t]       ["Group"                   vhdl-indent-group :keys "C-c C-i C-g"]
3327       ["Region"                  vhdl-indent-region (mark)]       ["Region"                  vhdl-indent-region (mark)]
3328       ["Buffer"                  vhdl-indent-buffer t]       ["Buffer"                  vhdl-indent-buffer :keys "C-c C-i C-b"])
3329       )      ("Align"
    '("Align"  
3330       ["Group"                   vhdl-align-group t]       ["Group"                   vhdl-align-group t]
3331       ["Region"                  vhdl-align-noindent-region (mark)]       ["Same Indent"             vhdl-align-same-indent :keys "C-c C-a C-i"]
3332       ["Buffer"                  vhdl-align-noindent-buffer t]       ["List"                    vhdl-align-list t]
3333         ["Declarations"            vhdl-align-declarations t]
3334         ["Region"                  vhdl-align-region (mark)]
3335         ["Buffer"                  vhdl-align-buffer t]
3336       "--"       "--"
3337       ["Inline Comment Group"    vhdl-align-inline-comment-group t]       ["Inline Comment Group"    vhdl-align-inline-comment-group t]
3338       ["Inline Comment Region"   vhdl-align-inline-comment-region (mark)]       ["Inline Comment Region"   vhdl-align-inline-comment-region (mark)]
3339       ["Inline Comment Buffer"   vhdl-align-inline-comment-buffer t]       ["Inline Comment Buffer"   vhdl-align-inline-comment-buffer t])
3340        ("Fill"
3341         ["List"                    vhdl-fill-list t]
3342         ["Group"                   vhdl-fill-group t]
3343         ["Same Indent"             vhdl-fill-same-indent :keys "C-c C-f C-i"]
3344         ["Region"                  vhdl-fill-region (mark)])
3345        ("Beautify"
3346         ["Region"                  vhdl-beautify-region (mark)]
3347         ["Buffer"                  vhdl-beautify-buffer t])
3348        ("Fix"
3349         ["Generic/Port Clause"     vhdl-fix-clause t]
3350       "--"       "--"
3351       ["Fixup Whitespace Region" vhdl-fixup-whitespace-region (mark)]       ["Case Region"             vhdl-fix-case-region (mark)]
3352       ["Fixup Whitespace Buffer" vhdl-fixup-whitespace-buffer t]       ["Case Buffer"             vhdl-fix-case-buffer t]
3353       )       "--"
3354     '("Fix Case"       ["Whitespace Region"       vhdl-fixup-whitespace-region (mark)]
3355       ["Region"                  vhdl-fix-case-region (mark)]       ["Whitespace Buffer"       vhdl-fixup-whitespace-buffer t]
3356       ["Buffer"                  vhdl-fix-case-buffer t]       "--"
3357       )       ["Trailing Spaces Buffer"  vhdl-remove-trailing-spaces t])
3358     '("Beautify"      ("Update"
3359       ["Beautify Region"         vhdl-beautify-region (mark)]       ["Sensitivity List"        vhdl-update-sensitivity-list-process t]
3360       ["Beautify Buffer"         vhdl-beautify-buffer t]       ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t])
3361       )      "--"
3362     "--"      ["Fontify Buffer"           vhdl-fontify-buffer t]
3363     ["Fontify Buffer"            vhdl-fontify-buffer t]      ["Statistics Buffer"        vhdl-statistics-buffer t]
3364     ["Syntactic Info"            vhdl-show-syntactic-information t]      ["Show Messages"            vhdl-show-messages t]
3365     "--"      ["Syntactic Info"           vhdl-show-syntactic-information t]
3366     '("Documentation"      "--"
3367        ["Speedbar"                 vhdl-speedbar t]
3368        ["Hide/Show"                vhdl-hs-minor-mode t]
3369        "--"
3370        ("Documentation"
3371       ["VHDL Mode"               vhdl-doc-mode :keys "C-c C-h"]       ["VHDL Mode"               vhdl-doc-mode :keys "C-c C-h"]
3372         ["Release Notes"           (vhdl-doc-variable 'vhdl-doc-release-notes) t]
3373       ["Reserved Words"          (vhdl-doc-variable 'vhdl-doc-keywords) t]       ["Reserved Words"          (vhdl-doc-variable 'vhdl-doc-keywords) t]
3374       ["Coding Style"            (vhdl-doc-variable 'vhdl-doc-coding-style) t]       ["Coding Style"            (vhdl-doc-variable 'vhdl-doc-coding-style) t])
3375       )      ["Version"                  vhdl-version t]
3376     ["Version"                   vhdl-version t]      ["Bug Report..."            vhdl-submit-bug-report t]
3377     ["Bug Report..."             vhdl-submit-bug-report t]      "--"
3378     "--"      ("Options"
3379     '("Speedbar"       ("Mode"
3380       ["Open/Close"              vhdl-speedbar t]        ["Electric Mode"
3381       "--"         (progn (customize-set-variable 'vhdl-electric-mode
3382       ["Show Hierarchy"          vhdl-speedbar-toggle-hierarchy                                        (not vhdl-electric-mode))
3383        :style toggle                (vhdl-mode-line-update))
3384        :selected         :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
3385        (and (boundp 'speedbar-initial-expansion-list-name)        ["Stutter Mode"
3386             (equal speedbar-initial-expansion-list-name "vhdl hierarchy"))         (progn (customize-set-variable 'vhdl-stutter-mode
3387        :active (and (boundp 'speedbar-frame) speedbar-frame)]                                        (not vhdl-stutter-mode))
3388       )                (vhdl-mode-line-update))
3389     "--"         :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
3390     '("Customize"        ["Indent Tabs Mode"
3391       ["Browse VHDL Group..."    vhdl-customize t]         (progn (customize-set-variable 'vhdl-indent-tabs-mode
3392       ["Build Customize Menu"    vhdl-create-customize-menu                                        (not vhdl-indent-tabs-mode))
3393                                  (fboundp 'customize-menu-create)]                (setq indent-tabs-mode vhdl-indent-tabs-mode))
3394           :style toggle :selected vhdl-indent-tabs-mode]
3395          "--"
3396          ["Customize Group..." (customize-group 'vhdl-mode) t])
3397         ("Project"
3398          ["Project Setup..." (customize-option 'vhdl-project-alist) t]
3399          ,(append
3400            '("Selected Project at Startup"
3401              ["None" (progn (customize-set-variable 'vhdl-project nil)
3402                             (vhdl-set-project ""))
3403               :style radio :selected (null vhdl-project)]
3404              "--")
3405            ;; add menu entries for defined projects
3406            (let ((project-alist vhdl-project-alist) menu-list name)
3407              (while project-alist
3408                (setq name (caar project-alist))
3409                (setq menu-list
3410                      (cons `[,name (progn (customize-set-variable
3411                                            'vhdl-project ,name)
3412                                           (vhdl-set-project ,name))
3413                              :style radio :selected (equal ,name vhdl-project)]
3414                            menu-list))
3415                (setq project-alist (cdr project-alist)))
3416              (setq menu-list (nreverse menu-list))
3417              (vhdl-menu-split menu-list "Project")))
3418          ["Setup File Name..." (customize-option 'vhdl-project-file-name) t]
3419          ("Auto Load Setup File"
3420           ["At Startup"
3421            (customize-set-variable 'vhdl-project-auto-load
3422                                    (if (memq 'startup vhdl-project-auto-load)
3423                                       (delq 'startup vhdl-project-auto-load)
3424                                     (cons 'startup vhdl-project-auto-load)))
3425           :style toggle :selected (memq 'startup vhdl-project-auto-load)])
3426          ["Sort Projects"
3427           (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort))
3428           :style toggle :selected vhdl-project-sort]
3429          "--"
3430          ["Customize Group..." (customize-group 'vhdl-project) t])
3431         ("Compiler"
3432          ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t]
3433          ,(append
3434            '("Selected Compiler at Startup")
3435            ;; add menu entries for defined compilers
3436            (let ((comp-alist vhdl-compiler-alist) menu-list name)
3437              (while comp-alist
3438                (setq name (caar comp-alist))
3439                (setq menu-list
3440                      (cons `[,name (customize-set-variable 'vhdl-compiler ,name)
3441                              :style radio :selected (equal ,name vhdl-compiler)]
3442                            menu-list))
3443                (setq comp-alist (cdr comp-alist)))
3444              (setq menu-list (nreverse menu-list))
3445              (vhdl-menu-split menu-list "Compler")))
3446          ["Use Local Error Regexp"
3447           (customize-set-variable 'vhdl-compile-use-local-error-regexp
3448                                   (not vhdl-compile-use-local-error-regexp))
3449           :style toggle :selected vhdl-compile-use-local-error-regexp]
3450          ["Makefile Generation Hook..."
3451           (customize-option 'vhdl-makefile-generation-hook) t]
3452          ["Default Library Name" (customize-option 'vhdl-default-library) t]
3453          "--"
3454          ["Customize Group..." (customize-group 'vhdl-compiler) t])
3455         ("Style"
3456          ("VHDL Standard"
3457           ["VHDL'87"
3458            (progn (customize-set-variable 'vhdl-standard
3459                                           (list '87 (cadr vhdl-standard)))
3460                   (vhdl-activate-customizations))
3461            :style radio :selected (eq '87 (car vhdl-standard))]
3462           ["VHDL'93"
3463            (progn (customize-set-variable 'vhdl-standard
3464                                           (list '93 (cadr vhdl-standard)))
3465                   (vhdl-activate-customizations))
3466            :style radio :selected (eq '93 (car vhdl-standard))]
3467           "--"
3468           ["VHDL-AMS"
3469            (progn (customize-set-variable
3470                    'vhdl-standard (list (car vhdl-standard)
3471                                         (if (memq 'ams (cadr vhdl-standard))
3472                                             (delq 'ams (cadr vhdl-standard))
3473                                           (cons 'ams (cadr vhdl-standard)))))
3474                   (vhdl-activate-customizations))
3475            :style toggle :selected (memq 'ams (cadr vhdl-standard))]
3476           ["Math Packages"
3477            (progn (customize-set-variable
3478                    'vhdl-standard (list (car vhdl-standard)
3479                                         (if (memq 'math (cadr vhdl-standard))
3480                                             (delq 'math (cadr vhdl-standard))
3481                                           (cons 'math (cadr vhdl-standard)))))
3482                   (vhdl-activate-customizations))
3483            :style toggle :selected (memq 'math (cadr vhdl-standard))])
3484          ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t]
3485          ["Upper Case Keywords"
3486           (customize-set-variable 'vhdl-upper-case-keywords
3487                                   (not vhdl-upper-case-keywords))
3488           :style toggle :selected vhdl-upper-case-keywords]
3489          ["Upper Case Types"
3490           (customize-set-variable 'vhdl-upper-case-types
3491                                   (not vhdl-upper-case-types))
3492           :style toggle :selected vhdl-upper-case-types]
3493          ["Upper Case Attributes"
3494           (customize-set-variable 'vhdl-upper-case-attributes
3495                                   (not vhdl-upper-case-attributes))
3496           :style toggle :selected vhdl-upper-case-attributes]
3497          ["Upper Case Enumeration Values"
3498           (customize-set-variable 'vhdl-upper-case-enum-values
3499                                   (not vhdl-upper-case-enum-values))
3500           :style toggle :selected vhdl-upper-case-enum-values]
3501          ["Upper Case Constants"
3502           (customize-set-variable 'vhdl-upper-case-constants
3503                                   (not vhdl-upper-case-constants))
3504           :style toggle :selected vhdl-upper-case-constants]
3505          ("Use Direct Instantiation"
3506           ["Never"
3507            (customize-set-variable 'vhdl-use-direct-instantiation 'never)
3508            :style radio :selected (eq 'never vhdl-use-direct-instantiation)]
3509           ["Standard"
3510            (customize-set-variable 'vhdl-use-direct-instantiation 'standard)
3511            :style radio :selected (eq 'standard vhdl-use-direct-instantiation)]
3512           ["Always"
3513            (customize-set-variable 'vhdl-use-direct-instantiation 'always)
3514            :style radio :selected (eq 'always vhdl-use-direct-instantiation)])
3515          "--"
3516          ["Customize Group..." (customize-group 'vhdl-style) t])
3517         ("Naming"
3518          ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t]
3519          ["Architecture File Name..."
3520           (customize-option 'vhdl-architecture-file-name) t]
3521          ["Package File Name..." (customize-option 'vhdl-package-file-name) t]
3522          ("File Name Case"
3523           ["As Is"
3524            (customize-set-variable 'vhdl-file-name-case 'identity)
3525            :style radio :selected (eq 'identity vhdl-file-name-case)]
3526           ["Lower Case"
3527            (customize-set-variable 'vhdl-file-name-case 'downcase)
3528            :style radio :selected (eq 'downcase vhdl-file-name-case)]
3529           ["Upper Case"
3530            (customize-set-variable 'vhdl-file-name-case 'upcase)
3531            :style radio :selected (eq 'upcase vhdl-file-name-case)]
3532           ["Capitalize"
3533            (customize-set-variable 'vhdl-file-name-case 'capitalize)
3534            :style radio :selected (eq 'capitalize vhdl-file-name-case)])
3535          "--"
3536          ["Customize Group..." (customize-group 'vhdl-naming) t])
3537         ("Template"
3538          ("Electric Keywords"
3539           ["VHDL Keywords"
3540            (customize-set-variable 'vhdl-electric-keywords
3541                                    (if (memq 'vhdl vhdl-electric-keywords)
3542                                        (delq 'vhdl vhdl-electric-keywords)
3543                                      (cons 'vhdl vhdl-electric-keywords)))
3544            :style toggle :selected (memq 'vhdl vhdl-electric-keywords)]
3545           ["User Model Keywords"
3546            (customize-set-variable 'vhdl-electric-keywords
3547                                    (if (memq 'user vhdl-electric-keywords)
3548                                         (delq 'user vhdl-electric-keywords)
3549                                       (cons 'user vhdl-electric-keywords)))
3550            :style toggle :selected (memq 'user vhdl-electric-keywords)])
3551          ("Insert Optional Labels"
3552           ["None"
3553            (customize-set-variable 'vhdl-optional-labels 'none)
3554            :style radio :selected (eq 'none vhdl-optional-labels)]
3555           ["Processes Only"
3556            (customize-set-variable 'vhdl-optional-labels 'process)
3557            :style radio :selected (eq 'process vhdl-optional-labels)]
3558           ["All Constructs"
3559            (customize-set-variable 'vhdl-optional-labels 'all)
3560            :style radio :selected (eq 'all vhdl-optional-labels)])
3561          ("Insert Empty Lines"
3562           ["None"
3563            (customize-set-variable 'vhdl-insert-empty-lines 'none)
3564            :style radio :selected (eq 'none vhdl-insert-empty-lines)]
3565           ["Design Units Only"
3566            (customize-set-variable 'vhdl-insert-empty-lines 'unit)
3567            :style radio :selected (eq 'unit vhdl-insert-empty-lines)]
3568           ["All Constructs"
3569            (customize-set-variable 'vhdl-insert-empty-lines 'all)
3570            :style radio :selected (eq 'all vhdl-insert-empty-lines)])
3571          ["Argument List Indent"
3572           (customize-set-variable 'vhdl-argument-list-indent
3573                                   (not vhdl-argument-list-indent))
3574           :style toggle :selected vhdl-argument-list-indent]
3575          ["Association List with Formals"
3576           (customize-set-variable 'vhdl-association-list-with-formals
3577                                   (not vhdl-association-list-with-formals))
3578           :style toggle :selected vhdl-association-list-with-formals]
3579          ["Conditions in Parenthesis"
3580           (customize-set-variable 'vhdl-conditions-in-parenthesis
3581                                   (not vhdl-conditions-in-parenthesis))
3582           :style toggle :selected vhdl-conditions-in-parenthesis]
3583          ["Zero String..." (customize-option 'vhdl-zero-string) t]
3584          ["One String..." (customize-option 'vhdl-one-string) t]
3585          ("File Header"
3586           ["Header String..." (customize-option 'vhdl-file-header) t]
3587           ["Footer String..." (customize-option 'vhdl-file-footer) t]
3588           ["Company Name..." (customize-option 'vhdl-company-name) t]
3589           ["Copyright String..." (customize-option 'vhdl-copyright-string) t]
3590           ["Platform Specification..." (customize-option 'vhdl-platform-spec) t]
3591           ["Date Format..." (customize-option 'vhdl-date-format) t]
3592           ["Modify Date Prefix String..."
3593            (customize-option 'vhdl-modify-date-prefix-string) t]
3594           ["Modify Date on Saving"
3595            (progn (customize-set-variable 'vhdl-modify-date-on-saving
3596                                           (not vhdl-modify-date-on-saving))
3597                   (vhdl-activate-customizations))
3598            :style toggle :selected vhdl-modify-date-on-saving])
3599          ("Sequential Process"
3600           ("Kind of Reset"
3601            ["None"
3602             (customize-set-variable 'vhdl-reset-kind 'none)
3603             :style radio :selected (eq 'none vhdl-reset-kind)]
3604            ["Synchronous"
3605             (customize-set-variable 'vhdl-reset-kind 'sync)
3606             :style radio :selected (eq 'sync vhdl-reset-kind)]
3607            ["Asynchronous"
3608             (customize-set-variable 'vhdl-reset-kind 'async)
3609             :style radio :selected (eq 'async vhdl-reset-kind)])
3610           ["Reset is Active High"
3611            (customize-set-variable 'vhdl-reset-active-high
3612                                    (not vhdl-reset-active-high))
3613            :style toggle :selected vhdl-reset-active-high]
3614           ["Use Rising Clock Edge"
3615            (customize-set-variable 'vhdl-clock-rising-edge
3616                                    (not vhdl-clock-rising-edge))
3617            :style toggle :selected vhdl-clock-rising-edge]
3618           ("Clock Edge Condition"
3619            ["Standard"
3620             (customize-set-variable 'vhdl-clock-edge-condition 'standard)
3621             :style radio :selected (eq 'standard vhdl-clock-edge-condition)]
3622            ["Function \"rising_edge\""
3623             (customize-set-variable 'vhdl-clock-edge-condition 'function)
3624             :style radio :selected (eq 'function vhdl-clock-edge-condition)])
3625           ["Clock Name..." (customize-option 'vhdl-clock-name) t]
3626           ["Reset Name..." (customize-option 'vhdl-reset-name) t])
3627          "--"
3628          ["Customize Group..." (customize-group 'vhdl-template) t])
3629         ("Model"
3630          ["Model Definition..." (customize-option 'vhdl-model-alist) t])
3631         ("Port"
3632          ["Include Port Comments"
3633           (customize-set-variable 'vhdl-include-port-comments
3634                                   (not vhdl-include-port-comments))
3635           :style toggle :selected vhdl-include-port-comments]
3636          ["Include Direction Comments"
3637           (customize-set-variable 'vhdl-include-direction-comments
3638                                   (not vhdl-include-direction-comments))
3639           :style toggle :selected vhdl-include-direction-comments]
3640          ["Include Type Comments"
3641           (customize-set-variable 'vhdl-include-type-comments
3642                                   (not vhdl-include-type-comments))
3643           :style toggle :selected vhdl-include-type-comments]
3644          ("Include Group Comments"
3645           ["Never"
3646            (customize-set-variable 'vhdl-include-group-comments 'never)
3647            :style radio :selected (eq 'never vhdl-include-group-comments)]
3648           ["Declarations"
3649            (customize-set-variable 'vhdl-include-group-comments 'decl)
3650            :style radio :selected (eq 'decl vhdl-include-group-comments)]
3651           ["Always"
3652            (customize-set-variable 'vhdl-include-group-comments 'always)
3653            :style radio :selected (eq 'always vhdl-include-group-comments)])
3654          ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t]
3655          ["Instance Name..." (customize-option 'vhdl-instance-name) t]
3656          ("Testbench"
3657           ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t]
3658           ["Architecture Name..."
3659            (customize-option 'vhdl-testbench-architecture-name) t]
3660           ["Configuration Name..."
3661            (customize-option 'vhdl-testbench-configuration-name) t]
3662           ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t]
3663           ["Include Header"
3664            (customize-set-variable 'vhdl-testbench-include-header
3665                                    (not vhdl-testbench-include-header))
3666            :style toggle :selected vhdl-testbench-include-header]
3667           ["Declarations..." (customize-option 'vhdl-testbench-declarations) t]
3668           ["Statements..." (customize-option 'vhdl-testbench-statements) t]
3669           ["Initialize Signals"
3670            (customize-set-variable 'vhdl-testbench-initialize-signals
3671                                    (not vhdl-testbench-initialize-signals))
3672            :style toggle :selected vhdl-testbench-initialize-signals]
3673           ["Include Library Clause"
3674            (customize-set-variable 'vhdl-testbench-include-library
3675                                    (not vhdl-testbench-include-library))
3676            :style toggle :selected vhdl-testbench-include-library]
3677           ["Include Configuration"
3678            (customize-set-variable 'vhdl-testbench-include-configuration
3679                                    (not vhdl-testbench-include-configuration))
3680            :style toggle :selected vhdl-testbench-include-configuration]
3681           ("Create Files"
3682            ["None"
3683             (customize-set-variable 'vhdl-testbench-create-files 'none)
3684             :style radio :selected (eq 'none vhdl-testbench-create-files)]
3685            ["Single"
3686             (customize-set-variable 'vhdl-testbench-create-files 'single)
3687             :style radio :selected (eq 'single vhdl-testbench-create-files)]
3688            ["Separate"
3689             (customize-set-variable 'vhdl-testbench-create-files 'separate)
3690             :style radio :selected (eq 'separate vhdl-testbench-create-files)]))
3691          "--"
3692          ["Customize Group..." (customize-group 'vhdl-port) t])
3693         ("Compose"
3694          ("Create Files"
3695           ["None"
3696            (customize-set-variable 'vhdl-compose-create-files 'none)
3697            :style radio :selected (eq 'none vhdl-compose-create-files)]
3698           ["Single"
3699            (customize-set-variable 'vhdl-compose-create-files 'single)
3700            :style radio :selected (eq 'single vhdl-compose-create-files)]
3701           ["Separate"
3702            (customize-set-variable 'vhdl-compose-create-files 'separate)
3703            :style radio :selected (eq 'separate vhdl-compose-create-files)])
3704          ["Include Header"
3705           (customize-set-variable 'vhdl-compose-include-header
3706                                   (not vhdl-compose-include-header))
3707           :style toggle :selected vhdl-compose-include-header]
3708          ["Architecture Name..."
3709           (customize-option 'vhdl-compose-architecture-name) t]
3710          ["Components Package Name..."
3711           (customize-option 'vhdl-components-package-name) t]
3712          ["Use Components Package"
3713           (customize-set-variable 'vhdl-use-components-package
3714                                   (not vhdl-use-components-package))
3715           :style toggle :selected vhdl-use-components-package]
3716          "--"
3717          ["Customize Group..." (customize-group 'vhdl-compose) t])
3718         ("Comment"
3719          ["Self Insert Comments"
3720           (customize-set-variable 'vhdl-self-insert-comments
3721                                   (not vhdl-self-insert-comments))
3722           :style toggle :selected vhdl-self-insert-comments]
3723          ["Prompt for Comments"
3724           (customize-set-variable 'vhdl-prompt-for-comments
3725                                   (not vhdl-prompt-for-comments))
3726           :style toggle :selected vhdl-prompt-for-comments]
3727          ["Inline Comment Column..."
3728           (customize-option 'vhdl-inline-comment-column) t]
3729          ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t]
3730          "--"
3731          ["Customize Group..." (customize-group 'vhdl-comment) t])
3732         ("Align"
3733          ["Auto Align Templates"
3734           (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align))
3735           :style toggle :selected vhdl-auto-align]
3736          ["Align Line Groups"
3737           (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups))
3738           :style toggle :selected vhdl-align-groups]
3739          ["Group Separation String..."
3740           (customize-set-variable 'vhdl-align-group-separate) t]
3741          ["Align Lines with Same Indent"
3742           (customize-set-variable 'vhdl-align-same-indent
3743                                   (not vhdl-align-same-indent))
3744           :style toggle :selected vhdl-align-same-indent]
3745          "--"
3746          ["Customize Group..." (customize-group 'vhdl-align) t])
3747         ("Highlight"
3748          ["Highlighting On/Off..."
3749           (customize-option
3750            (if vhdl-xemacs 'font-lock-auto-fontify 'global-font-lock-mode)) t]
3751          ["Highlight Keywords"
3752           (progn (customize-set-variable 'vhdl-highlight-keywords
3753                                          (not vhdl-highlight-keywords))
3754                  (vhdl-fontify-buffer))
3755           :style toggle :selected vhdl-highlight-keywords]
3756          ["Highlight Names"
3757           (progn (customize-set-variable 'vhdl-highlight-names
3758                                          (not vhdl-highlight-names))
3759                  (vhdl-fontify-buffer))
3760           :style toggle :selected vhdl-highlight-names]
3761          ["Highlight Special Words"
3762           (progn (customize-set-variable 'vhdl-highlight-special-words
3763                                          (not vhdl-highlight-special-words))
3764                  (vhdl-fontify-buffer))
3765           :style toggle :selected vhdl-highlight-special-words]
3766          ["Highlight Forbidden Words"
3767           (progn (customize-set-variable 'vhdl-highlight-forbidden-words
3768                                          (not vhdl-highlight-forbidden-words))
3769                  (vhdl-fontify-buffer))
3770           :style toggle :selected vhdl-highlight-forbidden-words]
3771          ["Highlight Verilog Keywords"
3772           (progn (customize-set-variable 'vhdl-highlight-verilog-keywords
3773                                          (not vhdl-highlight-verilog-keywords))
3774                  (vhdl-fontify-buffer))
3775           :style toggle :selected vhdl-highlight-verilog-keywords]
3776          ["Highlight \"translate_off\""
3777           (progn (customize-set-variable 'vhdl-highlight-translate-off
3778                                          (not vhdl-highlight-translate-off))
3779                  (vhdl-fontify-buffer))
3780           :style toggle :selected vhdl-highlight-translate-off]
3781          ["Case Sensitive Highlighting"
3782           (progn (customize-set-variable 'vhdl-highlight-case-sensitive
3783                                          (not vhdl-highlight-case-sensitive))
3784                  (vhdl-fontify-buffer))
3785           :style toggle :selected vhdl-highlight-case-sensitive]
3786          ["Special Syntax Definition..."
3787           (customize-option 'vhdl-special-syntax-alist) t]
3788          ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t]
3789          ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t]
3790          ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t]
3791          ["Colors..." (customize-group 'vhdl-highlight-faces) t]
3792          "--"
3793          ["Customize Group..." (customize-group 'vhdl-highlight) t])
3794         ("Speedbar"
3795          ["Auto Open at Startup"
3796           (customize-set-variable 'vhdl-speedbar-auto-open
3797                                   (not vhdl-speedbar-auto-open))
3798           :style toggle :selected vhdl-speedbar-auto-open]
3799          ("Default Displaying Mode"
3800           ["Files"
3801            (customize-set-variable 'vhdl-speedbar-display-mode 'files)
3802            :style radio :selected (eq 'files vhdl-speedbar-display-mode)]
3803           ["Directory Hierarchy"
3804            (customize-set-variable 'vhdl-speedbar-display-mode 'directory)
3805            :style radio :selected (eq 'directory vhdl-speedbar-display-mode)]
3806           ["Project Hierarchy"
3807            (customize-set-variable 'vhdl-speedbar-display-mode 'project)
3808            :style radio :selected (eq 'project vhdl-speedbar-display-mode)])
3809          ["Indentation Offset..."
3810           (customize-option 'speedbar-indentation-width) t]
3811          ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t]
3812          ["Jump to Unit when Opening"
3813           (customize-set-variable 'vhdl-speedbar-jump-to-unit
3814                                   (not vhdl-speedbar-jump-to-unit))
3815           :style toggle :selected vhdl-speedbar-jump-to-unit]
3816          ["Update Hierarchy on File Saving"
3817           (customize-set-variable 'vhdl-speedbar-update-on-saving
3818                                   (not vhdl-speedbar-update-on-saving))
3819           :style toggle :selected vhdl-speedbar-update-on-saving]
3820          ("Save in Cache File"
3821           ["Hierarchy Information"
3822            (customize-set-variable 'vhdl-speedbar-save-cache
3823                                    (if (memq 'hierarchy vhdl-speedbar-save-cache)
3824                                        (delq 'hierarchy vhdl-speedbar-save-cache)
3825                                      (cons 'hierarchy vhdl-speedbar-save-cache)))
3826            :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)]
3827           ["Displaying Status"
3828            (customize-set-variable 'vhdl-speedbar-save-cache
3829                                    (if (memq 'display vhdl-speedbar-save-cache)
3830                                        (delq 'display vhdl-speedbar-save-cache)
3831                                      (cons 'display vhdl-speedbar-save-cache)))
3832            :style toggle :selected (memq 'display vhdl-speedbar-save-cache)])
3833          ["Cache File Name..."
3834           (customize-option 'vhdl-speedbar-cache-file-name) t]
3835          "--"
3836          ["Customize Group..." (customize-group 'vhdl-speedbar) t])
3837         ("Menu"
3838          ["Add Index Menu when Loading File"
3839           (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu))
3840                  (vhdl-index-menu-init))
3841           :style toggle :selected vhdl-index-menu]
3842          ["Add Source File Menu when Loading File"
3843           (progn (customize-set-variable 'vhdl-source-file-menu
3844                                          (not vhdl-source-file-menu))
3845                  (vhdl-add-source-files-menu))
3846           :style toggle :selected vhdl-source-file-menu]
3847          ["Add Hideshow Menu at Startup"
3848           (progn (customize-set-variable 'vhdl-hideshow-menu
3849                                          (not vhdl-hideshow-menu))
3850                  (vhdl-activate-customizations))
3851           :style toggle :selected vhdl-hideshow-menu]
3852          ["Hide Everything Initially"
3853           (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init))
3854           :style toggle :selected vhdl-hide-all-init]
3855          "--"
3856          ["Customize Group..." (customize-group 'vhdl-menu) t])
3857         ("Print"
3858          ["In Two Column Format"
3859           (progn (customize-set-variable 'vhdl-print-two-column
3860                                          (not vhdl-print-two-column))
3861                  (message "Activate new setting by saving options and restarting Emacs"))
3862           :style toggle :selected vhdl-print-two-column]
3863          ["Use Customized Faces"
3864           (progn (customize-set-variable 'vhdl-print-customize-faces
3865                                          (not vhdl-print-customize-faces))
3866                  (message "Activate new setting by saving options and restarting Emacs"))
3867           :style toggle :selected vhdl-print-customize-faces]
3868          "--"
3869          ["Customize Group..." (customize-group 'vhdl-print) t])
3870         ("Miscellaneous"
3871          ["Use Intelligent Tab"
3872           (progn (customize-set-variable 'vhdl-intelligent-tab
3873                                          (not vhdl-intelligent-tab))
3874                  (vhdl-activate-customizations))
3875           :style toggle :selected vhdl-intelligent-tab]
3876          ["Indent Syntax-Based"
3877           (customize-set-variable 'vhdl-indent-syntax-based
3878                                   (not vhdl-indent-syntax-based))
3879           :style toggle :selected vhdl-indent-syntax-based]
3880          ["Word Completion is Case Sensitive"
3881           (customize-set-variable 'vhdl-word-completion-case-sensitive
3882                                   (not vhdl-word-completion-case-sensitive))
3883           :style toggle :selected vhdl-word-completion-case-sensitive]
3884          ["Word Completion in Minibuffer"
3885           (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer
3886                                          (not vhdl-word-completion-in-minibuffer))
3887                  (message "Activate new setting by saving options and restarting Emacs"))
3888           :style toggle :selected vhdl-word-completion-in-minibuffer]
3889          ["Underscore is Part of Word"
3890           (progn (customize-set-variable 'vhdl-underscore-is-part-of-word
3891                                          (not vhdl-underscore-is-part-of-word))
3892                  (vhdl-activate-customizations))
3893           :style toggle :selected vhdl-underscore-is-part-of-word]
3894          "--"
3895          ["Customize Group..." (customize-group 'vhdl-misc) t])
3896         ["Related..." (customize-browse 'vhdl-related) t]
3897       "--"       "--"
3898       ["Activate New Customizations" vhdl-activate-customizations t])       ["Save Options" customize-save-customized t]
3899     ))       ["Activate Options" vhdl-activate-customizations t]
3900         ["Browse Options..." vhdl-customize t])))
3901    
3902  (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)  (defvar vhdl-mode-menu-list (vhdl-create-mode-menu)
3903    "VHDL Mode menu.")    "VHDL Mode menu.")
3904    
3905  (defun vhdl-update-mode-menu ()  (defun vhdl-update-mode-menu ()
3906    "Update VHDL mode menu."    "Update VHDL Mode menu."
3907    (interactive)    (interactive)
3908    (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs    (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs
3909    (setq vhdl-mode-menu-list (vhdl-create-mode-menu))    (setq vhdl-mode-menu-list (vhdl-create-mode-menu))
# Line 2317  STRING are replaced by `-' and substring Line 3911  STRING are replaced by `-' and substring
3911    (easy-menu-define vhdl-mode-menu vhdl-mode-map    (easy-menu-define vhdl-mode-menu vhdl-mode-map
3912                      "Menu keymap for VHDL Mode." vhdl-mode-menu-list))                      "Menu keymap for VHDL Mode." vhdl-mode-menu-list))
3913    
 (require 'easymenu)  
   
3914  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3915  ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')  ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el')
3916    
3917  (defvar vhdl-imenu-generic-expression  (defconst vhdl-imenu-generic-expression
3918    '(    '(
3919      ("Subprogram"      ("Subprogram"
3920       "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"       "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)"
# Line 2362  STRING are replaced by `-' and substring Line 3954  STRING are replaced by `-' and substring
3954    (set (make-local-variable 'imenu-case-fold-search) t)    (set (make-local-variable 'imenu-case-fold-search) t)
3955    (set (make-local-variable 'imenu-generic-expression)    (set (make-local-variable 'imenu-generic-expression)
3956         vhdl-imenu-generic-expression)         vhdl-imenu-generic-expression)
3957    (when (and vhdl-index-menu (not (string-match "XEmacs" emacs-version)))    (when (and vhdl-index-menu (fboundp 'imenu))
3958      (if (or (not (boundp 'font-lock-maximum-size))      (if (or (not (boundp 'font-lock-maximum-size))
3959              (> font-lock-maximum-size (buffer-size)))              (> font-lock-maximum-size (buffer-size)))
3960          (imenu-add-to-menubar "Index")          (imenu-add-to-menubar "Index")
3961        (message "Scanning buffer for index...buffer too big"))))        (message "Scanning buffer for index...buffer too big"))))
3962    
3963  ;; ############################################################################  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3964  ;; Source file menu (using `easy-menu.el')  ;; Source file menu (using `easy-menu.el')
3965    
3966  (defvar vhdl-sources-menu nil)  (defvar vhdl-sources-menu nil)
# Line 2376  STRING are replaced by `-' and substring Line 3968  STRING are replaced by `-' and substring
3968  (defun vhdl-directory-files (directory &optional full match)  (defun vhdl-directory-files (directory &optional full match)
3969    "Call `directory-files' if DIRECTORY exists, otherwise generate error    "Call `directory-files' if DIRECTORY exists, otherwise generate error
3970  message."  message."
3971    (if (file-directory-p directory)    (if (not (file-directory-p directory))
3972        (directory-files directory full match)        (vhdl-warning-when-idle "No such directory: \"%s\"" directory)
3973      (message "No such directory: \"%s\"" directory)      (let ((dir (directory-files directory full match)))
3974      nil))        (setq dir (delete "." dir))
3975          (setq dir (delete ".." dir))
3976          dir)))
3977    
3978  (defun vhdl-get-source-files (&optional full directory)  (defun vhdl-get-source-files (&optional full directory)
3979    "Get list of VHDL source files in DIRECTORY or current directory."    "Get list of VHDL source files in DIRECTORY or current directory."
3980    (let ((mode-alist auto-mode-alist)    (let ((mode-alist auto-mode-alist)
3981          filename-regexp)          filename-regexp)
3982      ;; create regular expressions for matching file names      ;; create regular expressions for matching file names
3983      (setq filename-regexp ".*\\(")      (setq filename-regexp "\\`[^.].*\\(")
3984      (while mode-alist      (while mode-alist
3985        (when (eq (cdr (car mode-alist)) 'vhdl-mode)        (when (eq (cdar mode-alist) 'vhdl-mode)
3986          (setq filename-regexp          (setq filename-regexp
3987                (concat filename-regexp (car (car mode-alist)) "\\|")))                (concat filename-regexp (caar mode-alist) "\\|")))
3988        (setq mode-alist (cdr mode-alist)))        (setq mode-alist (cdr mode-alist)))
3989      (setq filename-regexp      (setq filename-regexp
3990            (concat (substring filename-regexp 0            (concat (substring filename-regexp 0
3991                               (string-match "\\\\|$" filename-regexp)) "\\)"))                               (string-match "\\\\|$" filename-regexp)) "\\)"))
3992      ;; find files      ;; find files
3993      (nreverse (vhdl-directory-files      (vhdl-directory-files
3994                 (or directory default-directory) full filename-regexp))))       (or directory default-directory) full filename-regexp)))
3995    
3996  (defun vhdl-add-source-files-menu ()  (defun vhdl-add-source-files-menu ()
3997    "Scan directory for all VHDL source files and generate menu.    "Scan directory for all VHDL source files and generate menu.
# Line 2405  The directory of the current source file Line 3999  The directory of the current source file
3999    (interactive)    (interactive)
4000    (message "Scanning directory for source files ...")    (message "Scanning directory for source files ...")
4001    (let ((newmap (current-local-map))    (let ((newmap (current-local-map))
         (mode-alist auto-mode-alist)  
4002          (file-list (vhdl-get-source-files))          (file-list (vhdl-get-source-files))
4003          menu-list found)          menu-list found)
4004      ;; Create list for menu      ;; Create list for menu
# Line 2416  The directory of the current source file Line 4009  The directory of the current source file
4009                                     (list 'find-file (car file-list)) t)                                     (list 'find-file (car file-list)) t)
4010                             menu-list))                             menu-list))
4011        (setq file-list (cdr file-list)))        (setq file-list (cdr file-list)))
4012      (setq menu-list (vhdl-menu-split menu-list 25))      (setq menu-list (vhdl-menu-split menu-list "Sources"))
4013      (when found (setq menu-list (cons "--" menu-list)))      (when found (setq menu-list (cons "--" menu-list)))
4014      (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list))      (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list))
4015      (setq menu-list (cons "Sources" menu-list))      (setq menu-list (cons "Sources" menu-list))
# Line 2426  The directory of the current source file Line 4019  The directory of the current source file
4019                        "VHDL source files menu" menu-list))                        "VHDL source files menu" menu-list))
4020    (message ""))    (message ""))
4021    
 (defun vhdl-menu-split (list n)  
   "Split menu LIST into several submenues, if number of elements > N."  
   (if (> (length list) n)  
       (let ((remain list)  
             (result '())  
             (sublist '())  
             (menuno 1)  
             (i 0))  
         (while remain  
           (setq sublist (cons (car remain) sublist))  
           (setq remain (cdr remain))  
           (setq i (+ i 1))  
           (if (= i n)  
               (progn  
                 (setq result (cons (cons (format "Sources %s" menuno)  
                                          (nreverse sublist)) result))  
                 (setq i 0)  
                 (setq menuno (+ menuno 1))  
                 (setq sublist '()))))  
         (and sublist  
              (setq result (cons (cons (format "Sources %s" menuno)  
                                       (nreverse sublist)) result)))  
         (nreverse result))  
     list))  
   
4022    
4023  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4024  ;;; VHDL Mode definition  ;;; Mode definition
4025  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4026  ;; performs all buffer local initializations  ;; performs all buffer local initializations
4027    
# Line 2464  The directory of the current source file Line 4032  The directory of the current source file
4032  Usage:  Usage:
4033  ------  ------
4034    
4035  - TEMPLATE INSERTION (electrification):  After typing a VHDL keyword and    TEMPLATE INSERTION (electrification):
4036    entering `\\[vhdl-electric-space]', you are prompted for arguments while a template is generated      After typing a VHDL keyword and entering `SPC', you are prompted for
4037    for that VHDL construct.  Typing `\\[vhdl-electric-return]' or `\\[keyboard-quit]' at the first (mandatory)      arguments while a template is generated for that VHDL construct.  Typing
4038    prompt aborts the current template generation.  Optional arguments are      `RET' or `C-g' at the first \(mandatory) prompt aborts the current
4039    indicated by square brackets and removed if the queried string is left empty.      template generation.  Optional arguments are indicated by square
4040    Prompts for mandatory arguments remain in the code if the queried string is      brackets and removed if the queried string is left empty.  Prompts for
4041    left empty.  They can be queried again by `\\[vhdl-template-search-prompt]'.      mandatory arguments remain in the code if the queried string is left
4042    Typing `\\[just-one-space]' after a keyword inserts a space without calling the template      empty.  They can be queried again by `C-c C-t C-q'.  Enabled
4043    generator.  Automatic template generation (i.e. electrification) can be      electrification is indicated by `/e' in the modeline.
4044    disabled (enabled) by typing `\\[vhdl-electric-mode]' or by setting custom variable  
4045    `vhdl-electric-mode' (see CUSTOMIZATION).        Typing `M-SPC' after a keyword inserts a space without calling the
4046    Enabled electrification is indicated by `/e' in the modeline.      template generator.  Automatic template generation (i.e.
4047    Template generators can be invoked from the VHDL menu, by key bindings, by      electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by
4048    typing `C-c C-i C-c' and choosing a construct, or by typing the keyword (i.e.      setting option `vhdl-electric-mode' (see OPTIONS).
4049    first word of menu entry not in parenthesis) and `\\[vhdl-electric-space]'.  
4050    The following abbreviations can also be used:        Template generators can be invoked from the VHDL menu, by key
4051    arch, attr, cond, conf, comp, cons, func, inst, pack, sig, var.      bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing
4052    Template styles can be customized in customization group `vhdl-electric'      the keyword (i.e. first word of menu entry not in parenthesis) and
4053    \(see CUSTOMIZATION).      `SPC'.  The following abbreviations can also be used: arch, attr, cond,
4054        conf, comp, cons, func, inst, pack, sig, var.
4055  - HEADER INSERTION:  A file header can be inserted by `\\[vhdl-template-header]'.  A  
4056    file footer (template at the end of the file) can be inserted by        Template styles can be customized in customization group
4057    `\\[vhdl-template-footer]'.  See customization group `vhdl-header'.      `vhdl-template' \(see OPTIONS).
4058    
4059  - STUTTERING:  Double striking of some keys inserts cumbersome VHDL syntax  
4060    elements.  Stuttering can be disabled (enabled) by typing `\\[vhdl-stutter-mode]' or by    HEADER INSERTION:
4061    variable `vhdl-stutter-mode'.  Enabled stuttering is indicated by `/s' in      A file header can be inserted by `C-c C-t C-h'.  A file footer
4062    the modeline.  The stuttering keys and their effects are:      (template at the end of the file) can be inserted by `C-c C-t C-f'.
4063        ;;   -->  \" : \"         [   -->  (        --    -->  comment      See customization group `vhdl-header'.
4064        ;;;  -->  \" := \"        [[  -->  [        --CR  -->  comment-out code  
4065        ..   -->  \" => \"        ]   -->  )        ---   -->  horizontal line  
4066        ,,   -->  \" <= \"        ]]  -->  ]        ----  -->  display comment    STUTTERING:
4067        ==   -->  \" == \"        ''  -->  \\\"      Double striking of some keys inserts cumbersome VHDL syntax elements.
4068        Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by
4069  - WORD COMPLETION:  Typing `\\[vhdl-electric-tab]' after a (not completed) word looks for a VHDL      option `vhdl-stutter-mode'.  Enabled stuttering is indicated by `/s' in
4070    keyword or a word in the buffer that starts alike, inserts it and adjusts      the modeline.  The stuttering keys and their effects are:
4071    case.  Re-typing `\\[vhdl-electric-tab]' toggles through alternative word completions.  
4072    This also works in the minibuffer (i.e. in template generator prompts).        ;;   -->  \" : \"       [   -->  (        --    -->  comment
4073    Typing `\\[vhdl-electric-tab]' after `(' looks for and inserts complete parenthesized        ;;;  -->  \" := \"      [[  -->  [        --CR  -->  comment-out code
4074    expressions (e.g. for array index ranges).  All keywords as well as standard        ..   -->  \" => \"      ]   -->  )        ---   -->  horizontal line
4075    types and subprograms of VHDL have predefined abbreviations (e.g. type \"std\"        ,,   -->  \" <= \"      ]]  -->  ]        ----  -->  display comment
4076    and `\\[vhdl-electric-tab]' will toggle through all standard types beginning with \"std\").        ==   -->  \" == \"      ''  -->  \\\"
4077    
4078    Typing `\\[vhdl-electric-tab]' after a non-word character indents the line if at the beginning  
4079    of a line (i.e. no preceding non-blank characters),and inserts a tabulator    WORD COMPLETION:
4080    stop otherwise.  `\\[tab-to-tab-stop]' always inserts a tabulator stop.      Typing `TAB' after a (not completed) word looks for a VHDL keyword or a
4081        word in the buffer that starts alike, inserts it and adjusts case.
4082  - COMMENTS:      Re-typing `TAB' toggles through alternative word completions.  This also
4083        `--'       puts a single comment.      works in the minibuffer (i.e. in template generator prompts).
4084        `---'      draws a horizontal line for separating code segments.  
4085        `----'     inserts a display comment, i.e. two horizontal lines with a        Typing `TAB' after `(' looks for and inserts complete parenthesized
4086                   comment in between.      expressions (e.g. for array index ranges).  All keywords as well as
4087        `--CR'     comments out code on that line.  Re-hitting CR comments out      standard types and subprograms of VHDL have predefined abbreviations
4088                   following lines.      \(e.g. type \"std\" and `TAB' will toggle through all standard types
4089        `\\[vhdl-comment-uncomment-region]'  comments out a region if not commented out,      beginning with \"std\").
4090                   uncomments a region if already commented out.  
4091          Typing `TAB' after a non-word character indents the line if at the
4092    You are prompted for comments after object definitions (i.e. signals,      beginning of a line (i.e. no preceding non-blank characters), and
4093    variables, constants, ports) and after subprogram and process specifications      inserts a tabulator stop otherwise.  `M-TAB' always inserts a tabulator
4094    if variable `vhdl-prompt-for-comments' is non-nil.  Comments are      stop.
4095    automatically inserted as additional labels (e.g. after begin statements) and  
4096    as help comments if `vhdl-self-insert-comments' is non-nil.  
4097    Inline comments (i.e. comments after a piece of code on the same line) are    COMMENTS:
4098    indented at least to `vhdl-inline-comment-column'.  Comments go at maximum to          `--'       puts a single comment.
4099    `vhdl-end-comment-column'.  `\\[vhdl-electric-return]' after a space in a comment will open a          `---'      draws a horizontal line for separating code segments.
4100    new comment line.  Typing beyond `vhdl-end-comment-column' in a comment          `----'     inserts a display comment, i.e. two horizontal lines
4101    automatically opens a new comment line.  `\\[fill-paragraph]' re-fills                     with a comment in between.
4102    multi-line comments.          `--CR'     comments out code on that line.  Re-hitting CR comments
4103                       out following lines.
4104  - INDENTATION:  `\\[vhdl-electric-tab]' indents a line if at the beginning of the line.          `C-c c'    comments out a region if not commented out,
4105    The amount of indentation is specified by variable `vhdl-basic-offset'.                     uncomments a region if already commented out.
4106    `\\[vhdl-indent-line]' always indents the current line (is bound to `TAB' if variable  
4107    `vhdl-intelligent-tab' is nil).  Indentation can be done for an entire region        You are prompted for comments after object definitions (i.e. signals,
4108    \(`\\[vhdl-indent-region]') or buffer (menu).  Argument and port lists are indented normally      variables, constants, ports) and after subprogram and process
4109    \(nil) or relative to the opening parenthesis (non-nil) according to variable      specifications if option `vhdl-prompt-for-comments' is non-nil.
4110    `vhdl-argument-list-indent'.  If variable `vhdl-indent-tabs-mode' is nil,      Comments are automatically inserted as additional labels (e.g. after
4111    spaces are used instead of tabs.  `\\[tabify]' and `\\[untabify]' allow      begin statements) and as help comments if `vhdl-self-insert-comments' is
4112    to convert spaces to tabs and vice versa.      non-nil.
4113    
4114  - ALIGNMENT:  The alignment functions align operators, keywords, and inline        Inline comments (i.e. comments after a piece of code on the same line)
4115    comment to beautify argument lists, port maps, etc.  `\\[vhdl-align-group]' aligns a group      are indented at least to `vhdl-inline-comment-column'.  Comments go at
4116    of consecutive lines separated by blank lines.  `\\[vhdl-align-noindent-region]' aligns an      maximum to `vhdl-end-comment-column'.  `RET' after a space in a comment
4117    entire region.  If variable `vhdl-align-groups' is non-nil, groups of code      will open a new comment line.  Typing beyond `vhdl-end-comment-column'
4118    lines separated by empty lines are aligned individually.  `\\[vhdl-align-inline-comment-group]' aligns      in a comment automatically opens a new comment line.  `M-q' re-fills
4119    inline comments for a group of lines, and `\\[vhdl-align-inline-comment-region]' for a region.      multi-line comments.
4120    Some templates are automatically aligned after generation if custom variable  
4121    `vhdl-auto-align' is non-nil.  
4122    `\\[vhdl-fixup-whitespace-region]' fixes up whitespace in a region.  That is, operator symbols    INDENTATION:
4123    are surrounded by one space, and multiple spaces are eliminated.      `TAB' indents a line if at the beginning of the line.  The amount of
4124        indentation is specified by option `vhdl-basic-offset'.  `C-c C-i C-l'
4125  - PORT TRANSLATION:  Generic and port clauses from entity or component      always indents the current line (is bound to `TAB' if option
4126    declarations can be copied (`\\[vhdl-port-copy]') and pasted as entity and      `vhdl-intelligent-tab' is nil).
4127    component declarations, as component instantiations and corresponding  
4128    internal constants and signals, as a generic map with constants as actual        Indentation can be done for a group of lines (`C-c C-i C-g'), a region
4129    parameters, and as a test bench (menu).      \(`M-C-\\') or the entire buffer (menu).  Argument and port lists are
4130    A clause with several generic/port names on the same line can be flattened      indented normally (nil) or relative to the opening parenthesis (non-nil)
4131    (`\\[vhdl-port-flatten]') so that only one name per line exists.  Names for actual      according to option `vhdl-argument-list-indent'.
4132    ports, instances, test benches, and design-under-test instances can be  
4133    derived from existing names according to variables `vhdl-...-name'.        If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of
4134    Variables `vhdl-testbench-...' allow the insertion of additional templates      tabs.  `M-x tabify' and `M-x untabify' allow to convert spaces to tabs
4135    into a test bench.  New files are created for the test bench entity and      and vice versa.
4136    architecture according to variable `vhdl-testbench-create-files'.  
4137    See customization group `vhdl-port'.        Syntax-based indentation can be very slow in large files.  Option
4138        `vhdl-indent-syntax-based' allows to use faster but simpler indentation.
4139  - TEST BENCH GENERATION:  See PORT TRANSLATION.  
4140    
4141  - KEY BINDINGS:  Key bindings (`C-c ...') exist for most commands (see in    ALIGNMENT:
4142    menu).      The alignment functions align operators, keywords, and inline comments
4143        to beautify the code.  `C-c C-a C-a' aligns a group of consecutive lines
4144  - VHDL MENU:  All commands can be invoked from the VHDL menu.      separated by blank lines, `C-c C-a C-i' a block of lines with same
4145        indent.  `C-c C-a C-l' aligns all lines belonging to a list enclosed by
4146  - FILE BROWSER:  The speedbar allows browsing of directories and file contents.      a pair of parentheses (e.g. port clause/map, argument list), and `C-c
4147    It can be accessed from the VHDL menu and is automatically opened if      C-a C-d' all lines within the declarative part of a design unit.  `C-c
4148    variable `vhdl-speedbar' is non-nil.      C-a M-a' aligns an entire region.  `C-c C-a C-c' aligns inline comments
4149    In speedbar, open files and directories with `mouse-2' on the name and      for a group of lines, and `C-c C-a M-c' for a region.
4150    browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.  
4151          If option `vhdl-align-groups' is non-nil, groups of code lines
4152  - DESIGN HIERARCHY BROWSER:  The speedbar can also be used for browsing the      separated by special lines (see option `vhdl-align-group-separate') are
4153    hierarchy of design units contained in the source files of the current      aligned individually.  If option `vhdl-align-same-indent' is non-nil,
4154    directory or in the source files/directories specified for a project (see      blocks of lines with same indent are aligned separately.  Some templates
4155    variable `vhdl-project-alist').      are automatically aligned after generation if option `vhdl-auto-align'
4156    The speedbar can be switched between file and hierarchy browsing mode in the      is non-nil.
4157    VHDL menu or by typing `f' and `h' in speedbar.  
4158    In speedbar, open design units with `mouse-2' on the name and browse their        Alignment tries to align inline comments at
4159    hierarchy with `mouse-2' on the `+'.  The hierarchy can be rescanned and      `vhdl-inline-comment-column' and tries inline comment not to exceed
4160    ports directly be copied from entities by using the speedbar menu.      `vhdl-end-comment-column'.
4161    
4162  - PROJECTS:  Projects can be defined in variable `vhdl-project-alist' and a        `C-c C-x M-w' fixes up whitespace in a region.  That is, operator
4163    current project be selected using variable `vhdl-project' (permanently) or      symbols are surrounded by one space, and multiple spaces are eliminated.
4164    from the menu (temporarily).  For each project, a title string (for the file  
4165    headers) and source files/directories (for the hierarchy browser) can be  
4166    specified.  | CODE FILLING:
4167    |   Code filling allows to condens code (e.g. sensitivity lists or port
4168  - SPECIAL MENUES:  As an alternative to the speedbar, an index menu can  |   maps) by removing comments and newlines and re-wrapping so that all
4169    be added (set variable `vhdl-index-menu' to non-nil) or made accessible  |   lines are maximally filled (block filling).  `C-c C-f C-f' fills a list
4170    as a mouse menu (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to  |   enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by
4171    your start-up file) for browsing the file contents.  Also, a source file menu  |   blank lines, `C-c C-f C-i' a block of lines with same indent, and
4172    can be added (set variable `vhdl-source-file-menu' to non-nil) for browsing  |   `C-c C-f M-f' an entire region.
4173    the current directory for VHDL source files.  
4174    
4175  - SOURCE FILE COMPILATION:  The syntax of the current buffer can be analyzed    CODE BEAUTIFICATION:
4176    by calling a VHDL compiler (menu, `\\[vhdl-compile]').  The compiler to be used is      `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
4177    specified by variable `vhdl-compiler'.  The available compilers are listed      buffer respectively.  This inludes indentation, alignment, and case
4178    in variable `vhdl-compiler-alist' including all required compilation command,      fixing.  Code beautification can also be run non-interactively using the
4179    destination directory, and error message syntax information.  New compilers      command:
4180    can be added.  Additional compile command options can be set in variable  
4181    `vhdl-compiler-options'.        emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer
4182    An entire hierarchy of source files can be compiled by the `make' command  
4183    \(menu, `\\[vhdl-make]').  This only works if an appropriate Makefile exists.  
4184    The make command itself as well as a command to generate a Makefile can also    PORT TRANSLATION:
4185    be specified in variable `vhdl-compiler-alist'.      Generic and port clauses from entity or component declarations can be
4186        copied (`C-c C-p C-w') and pasted as entity and component declarations,
4187  - VHDL STANDARDS:  The VHDL standards to be used are specified in variable      as component instantiations and corresponding internal constants and
4188    `vhdl-standard'.  Available standards are: VHDL'87/'93, VHDL-AMS,      signals, as a generic map with constants as actual generics, and as
4189    Math Packages.      internal signal initializations (menu).
4190    
4191  - KEYWORD CASE:  Lower and upper case for keywords and standardized types,        To include formals in component instantiations, see option
4192    attributes, and enumeration values is supported.  If the variable      `vhdl-association-list-with-formals'.  To include comments in pasting,
4193    `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in lower      see options `vhdl-include-...-comments'.
4194    case and are converted into upper case automatically (not for types,  
4195    attributes, and enumeration values).  The case of keywords, types,        A clause with several generic/port names on the same line can be
4196    attributes,and enumeration values can be fixed for an entire region (menu)      flattened (`C-c C-p C-f') so that only one name per line exists.  The
4197    or buffer (`\\[vhdl-fix-case-buffer]') according to the variables  |   direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become
4198    `vhdl-upper-case-{keywords,types,attributes,enum-values}'.  |   outputs and vice versa, which can be useful in testbenches.  (This
4199    |   reversion is done on the internal data structure and is only reflected
4200  - HIGHLIGHTING (fontification):  Keywords and standardized types, attributes,  |   in subsequent paste operations.)
4201    enumeration values, and function names (controlled by variable  
4202    `vhdl-highlight-keywords'), as well as comments, strings, and template        Names for actual ports, instances, testbenches, and
4203    prompts are highlighted using different colors.  Unit, subprogram, signal,      design-under-test instances can be derived from existing names according
4204    variable, constant, parameter and generic/port names in declarations as well      to options `vhdl-...-name'.  See customization group `vhdl-port'.
4205    as labels are highlighted if variable `vhdl-highlight-names' is non-nil.  
4206    
4207    Additional reserved words or words with a forbidden syntax (e.g. words that  | SUBPROGRAM TRANSLATION:
4208    should be avoided) can be specified in variable `vhdl-forbidden-words' or  |   Similar functionality exists for copying/pasting the interface of
4209    `vhdl-forbidden-syntax' and be highlighted in a warning color (variable  |   subprograms (function/procedure).  A subprogram interface can be copied
4210    `vhdl-highlight-forbidden-words').  Verilog keywords are highlighted as  |   and then pasted as a subprogram declaration, body or call (uses
4211    forbidden words if variable `vhdl-highlight-verilog-keywords' is non-nil.  |   association list with formals).
4212    
4213    Words with special syntax can be highlighted by specifying their syntax and  
4214    color in variable `vhdl-special-syntax-alist' and by setting variable    TESTBENCH GENERATION:
4215    `vhdl-highlight-special-words' to non-nil.  This allows to establish some      A copied port can also be pasted as a testbench.  The generated
4216    naming conventions (e.g. to distinguish different kinds of signals or other      testbench includes an entity, an architecture, and an optional
4217    objects by using name suffices) and to support them visually.      configuration.  The architecture contains the component declaration and
4218        instantiation of the DUT as well as internal constant and signal
4219    Variable `vhdl-highlight-case-sensitive' can be set to non-nil in order to      declarations.  Additional user-defined templates can be inserted.  The
4220    support case-sensitive highlighting.  However, keywords are then only      names used for entity/architecture/configuration/DUT as well as the file
4221    highlighted if written in lower case.      structure to be generated can be customized. See customization group
4222       `vhdl-testbench'.
4223    Code between \"translate_off\" and \"translate_on\" pragmas is highlighted  
4224    using a different background color if variable `vhdl-highlight-translate-off'  
4225    is non-nil.    KEY BINDINGS:
4226        Key bindings (`C-c ...') exist for most commands (see in menu).
4227    All colors can be customized by command `\\[customize-face]'.  
4228    For highlighting of matching parenthesis, see customization group  
4229    `paren-showing' (`\\[customize-group]').    VHDL MENU:
4230        All commands can be found in the VHDL menu including their key bindings.
4231  - USER MODELS:  VHDL models (templates) can be specified by the user and made  
4232    accessible in the menu, through key bindings (`C-c C-m ...'), or by keyword  
4233    electrification.  See custom variable `vhdl-model-alist'.    FILE BROWSER:
4234        The speedbar allows browsing of directories and file contents.  It can
4235  - HIDE/SHOW:  The code of entire VHDL design units can be hidden using the      be accessed from the VHDL menu and is automatically opened if option
4236    `Hide/Show' menu or by pressing `S-mouse-2' within the code (variable      `vhdl-speedbar-auto-open' is non-nil.
4237    `vhdl-hideshow-menu').  
4238          In speedbar, open files and directories with `mouse-2' on the name and
4239  - PRINTING:  Postscript printing with different faces (an optimized set of      browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'.
4240    faces is used if `vhdl-print-customize-faces' is non-nil) or colors  
4241    \(if `ps-print-color-p' is non-nil) is possible using the standard Emacs  
4242    postscript printing commands.  Variable `vhdl-print-two-column' defines    DESIGN HIERARCHY BROWSER:
4243    appropriate default settings for nice landscape two-column printing.  The      The speedbar can also be used for browsing the hierarchy of design units
4244    paper format can be set by variable `ps-paper-type'.  Do not forget to      contained in the source files of the current directory or the specified
4245    switch `ps-print-color-p' to nil for printing on black-and-white printers.      projects (see option `vhdl-project-alist').
4246    
4247  - CUSTOMIZATION:  All variables can easily be customized using the `Customize'        The speedbar can be switched between file, directory hierarchy and
4248    menu entry or `\\[customize-option]' (`\\[customize-group]' for groups).      project hierarchy browsing mode in the speedbar menu or by typing `f',
4249    Some customizations only take effect after some action (read the NOTE in      `h' or `H' in speedbar.
4250    the variable documentation).  Customization can also be done globally (i.e.  
4251    site-wide, read the INSTALL file).        In speedbar, open design units with `mouse-2' on the name and browse
4252        their hierarchy with `mouse-2' on the `+'.  Ports can directly be copied
4253  - FILE EXTENSIONS:  As default, files with extensions \".vhd\" and \".vhdl\" are      from entities and components (in packages).  Individual design units and
4254    automatically recognized as VHDL source files.  To add an extension \".xxx\",      complete designs can directly be compiled (\"Make\" menu entry).
4255    add the following line to your Emacs start-up file (`.emacs'):  
4256      \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))        The hierarchy is automatically updated upon saving a modified source
4257        file when option `vhdl-speedbar-update-on-saving' is non-nil.  The
4258        hierarchy is only updated for projects that have been opened once in the
4259        speedbar.  The hierarchy is cached between Emacs sessions in a file (see
4260        options in group `vhdl-speedbar').
4261    
4262          Simple design consistency checks are done during scanning, such as
4263        multiple declarations of the same unit or missing primary units that are
4264        required by secondary units.
4265    
4266    
4267    | STRUCTURAL COMPOSITION:
4268    |   Enables simple structural composition.  `C-c C-c C-n' creates a skeleton
4269    |   for a new component.  Subcomponents (i.e. component declaration and
4270    |   instantiation) can be automatically placed from a previously read port
4271    |   \(`C-c C-c C-p') or directly from the hierarchy browser (`P').  Finally,
4272    |   all subcomponents can be automatically connected using internal signals
4273    |   and ports (`C-c C-c C-w') following these rules:
4274    |     - subcomponent actual ports with same name are considered to be
4275    |       connected by a signal (internal signal or port)
4276    |     - signals that are only inputs to subcomponents are considered as
4277    |       inputs to this component -> input port created
4278    |     - signals that are only outputs from subcomponents are considered as
4279    |       outputs from this component -> output port created
4280    |     - signals that are inputs to AND outputs from subcomponents are
4281    |       considered as internal connections -> internal signal created
4282    |
4283    |     Component declarations can be placed in a components package (option
4284    |   `vhdl-use-components-package') which can be automatically generated for
4285    |   an entire directory or project (`C-c C-c M-p').  The VHDL'93 direct
4286    |   component instantiation is also supported (option
4287    |   `vhdl-use-direct-instantiation').
4288    |
4289    |     Purpose:  With appropriate naming conventions it is possible to
4290    |   create higher design levels with only a few mouse clicks or key
4291    |   strokes.  A new design level can be created by simply generating a new
4292    |   component, placing the required subcomponents from the hierarchy
4293    |   browser, and wiring everything automatically.
4294    |
4295    |     Note: Automatic wiring only works reliably on templates of new
4296    |   components and component instantiations that were created by VHDL mode.
4297    |
4298    |     See the options group `vhdl-compose' for all relevant user options.
4299    
4300    
4301      SOURCE FILE COMPILATION:
4302        The syntax of the current buffer can be analyzed by calling a VHDL
4303        compiler (menu, `C-c C-k').  The compiler to be used is specified by
4304        option `vhdl-compiler'.  The available compilers are listed in option
4305        `vhdl-compiler-alist' including all required compilation command,
4306        command options, compilation directory, and error message syntax
4307        information.  New compilers can be added.
4308    
4309          All the source files of an entire design can be compiled by the `make'
4310        command (menu, `C-c M-C-k') if an appropriate Makefile exists.
4311    
4312    
4313      MAKEFILE GENERATION:
4314        Makefiles can be generated automatically by an internal generation
4315        routine (`C-c M-k').  The library unit dependency information is
4316        obtained from the hierarchy browser.  Makefile generation can be
4317        customized for each compiler in option `vhdl-compiler-alist'.
4318    
4319          Makefile generation can also be run non-interactively using the
4320        command:
4321    
4322            emacs -batch -l ~/.emacs -l vhdl-mode
4323                  [-compiler compilername] [-project projectname]
4324                  -f vhdl-generate-makefile
4325    
4326          The Makefile's default target \"all\" compiles the entire design, the
4327        target \"clean\" removes it and the target \"library\" creates the
4328        library directory if not existent.  The Makefile also includes a target
4329        for each primary library unit which allows selective compilation of this
4330        unit, its secondary units and its subhierarchy (example: compilation of
4331        a design specified by a configuration).  User specific parts can be
4332        inserted into a Makefile with option `vhdl-makefile-generation-hook'.
4333    
4334        Limitations:
4335          - Only library units and dependencies within the current library are
4336            considered.  Makefiles for designs that span multiple libraries are
4337            not (yet) supported.
4338          - Only one-level configurations are supported (also hierarchical),
4339            but configurations that go down several levels are not.
4340          - The \"others\" keyword in configurations is not supported.
4341    
4342    
4343      PROJECTS:
4344        Projects can be defined in option `vhdl-project-alist' and a current
4345        project be selected using option `vhdl-project' (permanently) or from
4346        the menu or speedbar (temporarily).  For each project, title and
4347        description strings (for the file headers), source files/directories
4348        (for the hierarchy browser and Makefile generation), library name, and
4349        compiler-dependent options, exceptions and compilation directory can be
4350        specified.  Compilation settings overwrite the settings of option
4351        `vhdl-compiler-alist'.
4352    
4353          Project setups can be exported (i.e. written to a file) and imported.
4354        Imported setups are not automatically saved in `vhdl-project-alist' but
4355        can be saved afterwards in its customization buffer.  When starting
4356        Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l
4357        vhdl-mode\") in a directory with an existing project setup file, it is
4358        automatically loaded and its project activated if option
4359        `vhdl-project-auto-load' is non-nil.  Names/paths of the project setup
4360        files can be specified in option `vhdl-project-file-name'.  Multiple
4361        project setups can be automatically loaded from global directories.
4362        This is an alternative to specifying project setups with option
4363        `vhdl-project-alist'.
4364    
4365    
4366      SPECIAL MENUES:
4367        As an alternative to the speedbar, an index menu can be added (set
4368        option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu
4369        (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up
4370        file) for browsing the file contents (is not populated if buffer is
4371        larger than `font-lock-maximum-size').  Also, a source file menu can be
4372        added (set option `vhdl-source-file-menu' to non-nil) for browsing the
4373        current directory for VHDL source files.
4374    
4375    
4376      VHDL STANDARDS:
4377        The VHDL standards to be used are specified in option `vhdl-standard'.
4378        Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages.
4379    
4380    
4381      KEYWORD CASE:
4382        Lower and upper case for keywords and standardized types, attributes,
4383        and enumeration values is supported.  If the option
4384        `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in
4385        lower case and are converted into upper case automatically (not for
4386        types, attributes, and enumeration values).  The case of keywords,
4387        types, attributes,and enumeration values can be fixed for an entire
4388        region (menu) or buffer (`C-c C-x C-c') according to the options
4389        `vhdl-upper-case-{keywords,types,attributes,enum-values}'.
4390    
4391    
4392      HIGHLIGHTING (fontification):
4393        Keywords and standardized types, attributes, enumeration values, and
4394        function names (controlled by option `vhdl-highlight-keywords'), as well
4395        as comments, strings, and template prompts are highlighted using
4396        different colors.  Unit, subprogram, signal, variable, constant,
4397        parameter and generic/port names in declarations as well as labels are
4398        highlighted if option `vhdl-highlight-names' is non-nil.
4399    
4400          Additional reserved words or words with a forbidden syntax (e.g. words
4401        that should be avoided) can be specified in option
4402        `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in
4403        a warning color (option `vhdl-highlight-forbidden-words').  Verilog
4404        keywords are highlighted as forbidden words if option
4405        `vhdl-highlight-verilog-keywords' is non-nil.
4406    
4407          Words with special syntax can be highlighted by specifying their
4408        syntax and color in option `vhdl-special-syntax-alist' and by setting
4409        option `vhdl-highlight-special-words' to non-nil.  This allows to
4410        establish some naming conventions (e.g. to distinguish different kinds
4411        of signals or other objects by using name suffices) and to support them
4412        visually.
4413    
4414          Option `vhdl-highlight-case-sensitive' can be set to non-nil in order
4415        to support case-sensitive highlighting.  However, keywords are then only
4416        highlighted if written in lower case.
4417    
4418          Code between \"translate_off\" and \"translate_on\" pragmas is
4419        highlighted using a different background color if option
4420        `vhdl-highlight-translate-off' is non-nil.
4421    
4422          For documentation and customization of the used colors see
4423        customization group `vhdl-highlight-faces' (`M-x customize-group').  For
4424        highlighting of matching parenthesis, see customization group
4425        `paren-showing'.  Automatic buffer highlighting is turned on/off by
4426        option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs).
4427    
4428    
4429      USER MODELS:
4430        VHDL models (templates) can be specified by the user and made accessible
4431        in the menu, through key bindings (`C-c C-m ...'), or by keyword
4432        electrification.  See option `vhdl-model-alist'.
4433    
4434    
4435      HIDE/SHOW:
4436        The code of blocks, processes, subprograms, component declarations and
4437        instantiations, generic/port clauses, and configuration declarations can
4438        be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within
4439        the code (see customization group `vhdl-menu').  XEmacs: limited
4440        functionality due to old `hideshow.el' package.
4441    
4442    
4443      CODE UPDATING:
4444        - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the
4445          current process, `C-c C-u M-s' of all processes in the current buffer.
4446          Limitations:
4447            - Only declared local signals (ports, signals declared in
4448              architecture and blocks) are automatically inserted.
4449            - Global signals declared in packages are not automatically inserted.
4450              Insert them once manually (will be kept afterwards).
4451            - Out parameters of procedures are considered to be read.
4452          Use option `vhdl-entity-file-name' to specify the entity file name
4453          \(used to obtain the port names).
4454    
4455    
4456      CODE FIXING:
4457        `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause
4458        \(e.g. if the closing parenthesis is on the wrong line or is missing).
4459    
4460    
4461      PRINTING:
4462        Postscript printing with different faces (an optimized set of faces is
4463        used if `vhdl-print-customize-faces' is non-nil) or colors \(if
4464        `ps-print-color-p' is non-nil) is possible using the standard Emacs
4465        postscript printing commands.  Option `vhdl-print-two-column' defines
4466        appropriate default settings for nice landscape two-column printing.
4467        The paper format can be set by option `ps-paper-type'.  Do not forget to
4468        switch `ps-print-color-p' to nil for printing on black-and-white
4469        printers.
4470    
4471    
4472      OPTIONS:
4473        User options allow customization of VHDL Mode.  All options are
4474        accessible from the \"Options\" menu entry.  Simple options (switches
4475        and choices) can directly be changed, while for complex options a
4476        customization buffer is opened.  Changed options can be saved for future
4477        sessions using the \"Save Options\" menu entry.
4478    
4479          Options and their detailed descriptions can also be accessed by using
4480        the \"Customize\" menu entry or the command `M-x customize-option' (`M-x
4481        customize-group' for groups).  Some customizations only take effect
4482        after some action (read the NOTE in the option documentation).
4483        Customization can also be done globally (i.e. site-wide, read the
4484        INSTALL file).
4485    
4486          Not all options are described in this documentation, so go and see
4487        what other useful user options there are (`M-x vhdl-customize' or menu)!
4488    
4489    
4490      FILE EXTENSIONS:
4491        As default, files with extensions \".vhd\" and \".vhdl\" are
4492        automatically recognized as VHDL source files.  To add an extension
4493        \".xxx\", add the following line to your Emacs start-up file (`.emacs'):
4494    
4495          \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist))
4496    
4497    
4498      HINTS:
4499        - To start Emacs with open VHDL hierarchy browser without having to load
4500          a VHDL file first, use the command:
4501    
4502            emacs -l vhdl-mode -f speedbar-frame-mode
4503    
4504        - Type `C-g C-g' to interrupt long operations or if Emacs hangs.
4505    
4506        - Some features only work on properly indented code.
4507    
4508  - HINTS:  
4509    - Type `\\[keyboard-quit] \\[keyboard-quit]' to interrupt long operations or if Emacs hangs.    RELEASE NOTES:
4510        See also the release notes (menu) for added features in new releases.
4511    
4512    
4513  Maintenance:  Maintenance:
4514  ------------  ------------
4515    
4516  To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode.  To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode.
4517  Add a description of the problem and include a reproducible test case.  Add a description of the problem and include a reproducible test case.
4518    
4519  Questions and enhancement requests can be sent to <vhdl-mode@geocities.com>.  Questions and enhancement requests can be sent to <reto@gnu.org>.
4520    
4521  The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.  The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases.
4522  The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta releases.  The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta
4523  You are kindly invited to participate in beta testing.  Subscribe to above  releases.  You are kindly invited to participate in beta testing.  Subscribe
4524  mailing lists by sending an email to <vhdl-mode@geocities.com>.  to above mailing lists by sending an email to <reto@gnu.org>.
4525    
4526  VHDL Mode is officially distributed on the Emacs VHDL Mode Home Page  VHDL Mode is officially distributed at
4527  <http://www.geocities.com/SiliconValley/Peaks/8287>, where the latest  http://opensource.ethz.ch/emacs/vhdl-mode.html
4528  version and release notes can be found.  where the latest version can be found.
4529    
4530    
4531  Bugs and Limitations:  Known problems:
4532  ---------------------  ---------------
4533    
 - Re-indenting large regions or expressions can be slow.  
4534  - Indentation bug in simultaneous if- and case-statements (VHDL-AMS).  - Indentation bug in simultaneous if- and case-statements (VHDL-AMS).
4535  - Hideshow does not work under XEmacs.  - XEmacs: Incorrect start-up when automatically opening speedbar.
4536  - Index menu and file tagging in speedbar do not work under XEmacs.  - XEmacs: Indentation in XEmacs 21.4 (and higher).
 - Parsing compilation error messages for Ikos and Viewlogic VHDL compilers  
   does not work under XEmacs.  
4537    
4538    
4539                                                    The VHDL Mode Maintainers                                                  The VHDL Mode Authors
4540                                                  Reto Zimmermann and Rod Whitby                                              Reto Zimmermann and Rod Whitby
4541    
4542  Key bindings:  Key bindings:
4543  -------------  -------------
# Line 2737  Key bindings: Line 4553  Key bindings:
4553    (set-syntax-table vhdl-mode-syntax-table)    (set-syntax-table vhdl-mode-syntax-table)
4554    (setq local-abbrev-table vhdl-mode-abbrev-table)    (setq local-abbrev-table vhdl-mode-abbrev-table)
4555    
4556    ;; set local variable values    ;; set local variables
4557    (set (make-local-variable 'paragraph-start)    (set (make-local-variable 'paragraph-start)
4558         "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")         "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
4559    (set (make-local-variable 'paragraph-separate) paragraph-start)    (set (make-local-variable 'paragraph-separate) paragraph-start)
# Line 2747  Key bindings: Line 4563  Key bindings:
4563    (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)    (set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
4564    (set (make-local-variable 'comment-start) "--")    (set (make-local-variable 'comment-start) "--")
4565    (set (make-local-variable 'comment-end) "")    (set (make-local-variable 'comment-end) "")
4566      (when vhdl-emacs-21
4567        (set (make-local-variable 'comment-padding) ""))
4568    (set (make-local-variable 'comment-column) vhdl-inline-comment-column)    (set (make-local-variable 'comment-column) vhdl-inline-comment-column)
4569    (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)    (set (make-local-variable 'end-comment-column) vhdl-end-comment-column)
4570    (set (make-local-variable 'comment-start-skip) "--+\\s-*")    (set (make-local-variable 'comment-start-skip) "--+\\s-*")
4571    (set (make-local-variable 'comment-multi-line) nil)    (set (make-local-variable 'comment-multi-line) nil)
4572    (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)    (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode)
   (set (make-local-variable 'hippie-expand-only-buffers) '(vhdl-mode))  
4573    (set (make-local-variable 'hippie-expand-verbose) nil)    (set (make-local-variable 'hippie-expand-verbose) nil)
4574    
4575    ;; setup the comment indent variable in a Emacs version portable way    ;; setup the comment indent variable in a Emacs version portable way
# Line 2762  Key bindings: Line 4579  Key bindings:
4579      (setq comment-indent-function 'vhdl-comment-indent))      (setq comment-indent-function 'vhdl-comment-indent))
4580    
4581    ;; initialize font locking    ;; initialize font locking
   (require 'font-lock)  
4582    (set (make-local-variable 'font-lock-defaults)    (set (make-local-variable 'font-lock-defaults)
4583         (list         (list
4584          'vhdl-font-lock-keywords nil          '(nil vhdl-font-lock-keywords) nil
4585          (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line          (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
4586          '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))          '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
4587    (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)    (unless vhdl-emacs-21
4588    (set (make-local-variable 'lazy-lock-defer-contextually) nil)      (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
4589    (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)      (set (make-local-variable 'lazy-lock-defer-contextually) nil)
4590  ;  (set (make-local-variable 'lazy-lock-defer-time) 0.1)      (set (make-local-variable 'lazy-lock-defer-on-the-fly) t)
4591    (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)  ;    (set (make-local-variable 'lazy-lock-defer-time) 0.1)
4592    (turn-on-font-lock)      (set (make-local-variable 'lazy-lock-defer-on-scrolling) t))
4593    ;  (turn-on-font-lock)
4594    
4595    ;; variables for source file compilation    ;; variables for source file compilation
4596    (require 'compile)    (when vhdl-compile-use-local-error-regexp
4597    (set (make-local-variable 'compilation-error-regexp-alist) nil)      (set (make-local-variable 'compilation-error-regexp-alist) nil)
4598    (set (make-local-variable 'compilation-file-regexp-alist) nil)      (set (make-local-variable 'compilation-file-regexp-alist) nil))
4599    
4600    ;; add index menu    ;; add index menu
4601    (vhdl-index-menu-init)    (vhdl-index-menu-init)
# Line 2789  Key bindings: Line 4606  Key bindings:
4606    (easy-menu-define vhdl-mode-menu vhdl-mode-map    (easy-menu-define vhdl-mode-menu vhdl-mode-map
4607                      "Menu keymap for VHDL Mode." vhdl-mode-menu-list)                      "Menu keymap for VHDL Mode." vhdl-mode-menu-list)
4608    ;; initialize hideshow and add menu    ;; initialize hideshow and add menu
   (make-local-variable 'hs-minor-mode-hook)  
4609    (vhdl-hideshow-init)    (vhdl-hideshow-init)
4610    (run-hooks 'menu-bar-update-hook)    (run-hooks 'menu-bar-update-hook)
4611    
   ;; add speedbar  
   (when (fboundp 'speedbar)  
     (condition-case ()                  ; due to bug in `speedbar-el' v0.7.2a  
         (progn  
           (when (and vhdl-speedbar (not (and (boundp 'speedbar-frame)  
                                              (frame-live-p speedbar-frame))))  
             (speedbar-frame-mode 1)  
             (select-frame speedbar-attached-frame)))  
       (error (vhdl-add-warning "Before using Speedbar, install included `speedbar.el' patch"))))  
   
4612    ;; miscellaneous    ;; miscellaneous
4613    (vhdl-ps-print-init)    (vhdl-ps-print-init)
4614    (vhdl-modify-date-init)    (vhdl-write-file-hooks-init)
4615    (vhdl-mode-line-update)    (vhdl-mode-line-update)
4616    (message "VHDL Mode %s.  Type C-c C-h for documentation."    (message "VHDL Mode %s.%s" vhdl-version
4617             vhdl-version)             (if noninteractive "" "  See menu for documentation and release notes."))
   (vhdl-print-warnings)  
4618    
4619    ;; run hooks    ;; run hooks
4620    (run-hooks 'vhdl-mode-hook))    (run-hooks 'vhdl-mode-hook))
# Line 2822  Key bindings: Line 4627  Key bindings:
4627    (set-syntax-table vhdl-mode-syntax-table)    (set-syntax-table vhdl-mode-syntax-table)
4628    (setq comment-column vhdl-inline-comment-column)    (setq comment-column vhdl-inline-comment-column)
4629    (setq end-comment-column vhdl-end-comment-column)    (setq end-comment-column vhdl-end-comment-column)
4630    (vhdl-modify-date-init)    (vhdl-write-file-hooks-init)
4631    (vhdl-update-mode-menu)    (vhdl-update-mode-menu)
4632    (vhdl-hideshow-init)    (vhdl-hideshow-init)
4633    (run-hooks 'menu-bar-update-hook)    (run-hooks 'menu-bar-update-hook)
4634    (vhdl-mode-line-update))    (vhdl-mode-line-update))
4635    
4636  (defun vhdl-modify-date-init ()  (defun vhdl-write-file-hooks-init ()
4637    "Add/remove hook for modifying date when buffer is saved."    "Add/remove hooks when buffer is saved."
4638    (if vhdl-modify-date-on-saving    (if vhdl-modify-date-on-saving
4639        (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)        (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)
4640      (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)))      (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror))
4641      (make-local-variable 'after-save-hook)
4642      (add-hook 'after-save-hook 'vhdl-add-modified-file))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
 ;;; Documentation  
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  
   
 (defvar vhdl-doc-keywords nil  
   "Reserved words in VHDL:  
   
 VHDL'93 (IEEE Std 1076-1993):  
   `vhdl-93-keywords'      : keywords  
   `vhdl-93-types'         : standardized types  
   `vhdl-93-attributes'    : standardized attributes  
   `vhdl-93-enum-values'   : standardized enumeration values  
   `vhdl-93-functions'     : standardized functions  
   `vhdl-93-packages'      : standardized packages and libraries  
   
 VHDL-AMS (IEEE Std 1076.1):  
   `vhdl-ams-keywords'     : keywords  
   `vhdl-ams-types'        : standardized types  
   `vhdl-ams-attributes'   : standardized attributes  
   `vhdl-ams-enum-values'  : standardized enumeration values  
   `vhdl-ams-functions'    : standardized functions  
   
 Math Packages (IEEE Std 1076.2):  
   `vhdl-math-types'       : standardized types  
   `vhdl-math-constants'   : standardized constants  
   `vhdl-math-functions'   : standardized functions  
   `vhdl-math-packages'    : standardized packages  
   
 Forbidden words:  
   `vhdl-verilog-keywords' : Verilog reserved words  
   
 NOTE: click `mouse-2' on variable names above (not in XEmacs).")  
   
 (defvar vhdl-doc-coding-style nil  
   "For VHDL coding style and naming convention guidelines, see the following  
 references:  
   
 \[1] Ben Cohen.  
     \"VHDL Coding Styles and Methodologies\".  
     Kluwer Academic Publishers, 1999.  
     http://members.aol.com/vhdlcohen/vhdl/  
   
 \[2] Michael Keating and Pierre Bricaud.  
     \"Reuse Methodology Manual\".  
     Kluwer Academic Publishers, 1998.  
     http://www.synopsys.com/products/reuse/rmm.html  
   
 \[3] European Space Agency.  
     \"VHDL Modelling Guidelines\".  
     ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}  
   
 Use variables `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'  
 to visually support naming conventions.")  
   
 (defun vhdl-doc-variable (variable)  
   "Display VARIABLE's documentation in *Help* buffer."  
   (interactive)  
   (with-output-to-temp-buffer "*Help*"  
     (princ (documentation-property variable 'variable-documentation))  
     (unless (string-match "XEmacs" emacs-version)  
       (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))  
     (save-excursion  
       (set-buffer standard-output)  
       (help-mode))  
     (print-help-return-message)))  
4643    
4644  (defun vhdl-doc-mode ()  (defun vhdl-process-command-line-option (option)
4645    "Display VHDL mode documentation in *Help* buffer."    "Process command line options for VHDL Mode."
4646    (interactive)    (cond
4647    (with-output-to-temp-buffer "*Help*"     ;; set compiler
4648      (princ mode-name)     ((equal option "-compiler")
4649      (princ " mode:\n")      (vhdl-set-compiler (car command-line-args-left))
4650      (princ (documentation 'vhdl-mode))      (setq command-line-args-left (cdr command-line-args-left)))
4651      (unless (string-match "XEmacs" emacs-version)     ;; set project
4652        (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))     ((equal option "-project")
4653      (save-excursion      (vhdl-set-project (car command-line-args-left))
4654        (set-buffer standard-output)      (setq command-line-args-left (cdr command-line-args-left)))))
4655        (help-mode))  
4656      (print-help-return-message)))  ;; make Emacs process VHDL Mode options
4657    (setq command-switch-alist
4658          (append command-switch-alist
4659                  '(("-compiler" . vhdl-process-command-line-option)
4660                    ("-project" . vhdl-process-command-line-option))))
4661    
4662    
4663  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 2991  to visually support naming conventions." Line 4735  to visually support naming conventions."
4735  (defconst vhdl-ams-types  (defconst vhdl-ams-types
4736    '(    '(
4737      "domain_type" "real_vector"      "domain_type" "real_vector"
4738      )      ;; from `nature_pkg' package
4739        "voltage" "current" "electrical" "position" "velocity" "force"
4740        "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational"
4741        "pressure" "flowrate" "fluid"
4742      )
4743    "List of VHDL-AMS standardized types.")    "List of VHDL-AMS standardized types.")
4744    
4745  (defconst vhdl-math-types  (defconst vhdl-math-types
# Line 3035  to visually support naming conventions." Line 4783  to visually support naming conventions."
4783  (defconst vhdl-ams-enum-values  (defconst vhdl-ams-enum-values
4784    '(    '(
4785      "quiescent_domain" "time_domain" "frequency_domain"      "quiescent_domain" "time_domain" "frequency_domain"
4786        ;; from `nature_pkg' package
4787        "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd"
4788      )      )
4789    "List of VHDL-AMS standardized enumeration values.")    "List of VHDL-AMS standardized enumeration values.")
4790    
# Line 3061  to visually support naming conventions." Line 4811  to visually support naming conventions."
4811      "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"      "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01"
4812      "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"      "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector"
4813      "shl" "shr" "ext" "sxt"      "shl" "shr" "ext" "sxt"
4814        "deallocate"
4815      )      )
4816    "List of VHDL'93 standardized functions.")    "List of VHDL'93 standardized functions.")
4817    
# Line 3090  to visually support naming conventions." Line 4841  to visually support naming conventions."
4841      )      )
4842    "List of VHDL'93 standardized packages and libraries.")    "List of VHDL'93 standardized packages and libraries.")
4843    
4844    (defconst vhdl-ams-packages
4845      '(
4846        ;; from `nature_pkg' package
4847        "nature_pkg"
4848        )
4849      "List of VHDL-AMS standardized packages and libraries.")
4850    
4851  (defconst vhdl-math-packages  (defconst vhdl-math-packages
4852    '(    '(
4853      "math_real" "math_complex"      "math_real" "math_complex"
# Line 3141  to visually support naming conventions." Line 4899  to visually support naming conventions."
4899  (defvar vhdl-reserved-words-regexp nil  (defvar vhdl-reserved-words-regexp nil
4900    "Regexp for additional reserved words.")    "Regexp for additional reserved words.")
4901    
4902    (defvar vhdl-directive-keywords-regexp nil
4903      "Regexp for compiler directive keywords.")
4904    
4905  (defun vhdl-words-init ()  (defun vhdl-words-init ()
4906    "Initialize reserved words."    "Initialize reserved words."
4907    (setq vhdl-keywords    (setq vhdl-keywords
# Line 3164  to visually support naming conventions." Line 4925  to visually support naming conventions."
4925                  (when (vhdl-standard-p 'math) vhdl-math-functions)))                  (when (vhdl-standard-p 'math) vhdl-math-functions)))
4926    (setq vhdl-packages    (setq vhdl-packages
4927          (append vhdl-93-packages          (append vhdl-93-packages
4928                    (when (vhdl-standard-p 'ams) vhdl-ams-packages)
4929                  (when (vhdl-standard-p 'math) vhdl-math-packages)))                  (when (vhdl-standard-p 'math) vhdl-math-packages)))
4930    (setq vhdl-reserved-words    (setq vhdl-reserved-words
4931          (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)          (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words)
# Line 3187  to visually support naming conventions." Line 4949  to visually support naming conventions."
4949                    (concat vhdl-forbidden-syntax "\\|"))                    (concat vhdl-forbidden-syntax "\\|"))
4950                  (regexp-opt vhdl-reserved-words)                  (regexp-opt vhdl-reserved-words)
4951                  "\\)\\>"))                  "\\)\\>"))
4952      (setq vhdl-directive-keywords-regexp
4953            (concat "\\<\\(" (mapconcat 'regexp-quote
4954                                        vhdl-directive-keywords "\\|") "\\)\\>"))
4955    (vhdl-abbrev-list-init))    (vhdl-abbrev-list-init))
4956    
4957  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 3211  to visually support naming conventions." Line 4976  to visually support naming conventions."
4976    
4977    
4978  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4979  ;;; Syntax analysis and indentation  ;;; Indentation
4980  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4981    
4982  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 3250  bopl -- beginning of previous line Line 5015  bopl -- beginning of previous line
5015    
5016  This function does not modify point or mark."  This function does not modify point or mark."
5017    (or (and (eq 'quote (car-safe position))    (or (and (eq 'quote (car-safe position))
5018             (null (cdr (cdr position))))             (null (cddr position)))
5019        (error "Bad buffer position requested: %s" position))        (error "ERROR:  Bad buffer position requested: %s" position))
5020    (setq position (nth 1 position))    (setq position (nth 1 position))
5021    `(let ((here (point)))    `(let ((here (point)))
5022       ,@(cond       ,@(cond
# Line 3260  This function does not modify point or m Line 5025  This function does not modify point or m
5025          ((eq position 'bod)  '((save-match-data          ((eq position 'bod)  '((save-match-data
5026                                   (vhdl-beginning-of-defun))))                                   (vhdl-beginning-of-defun))))
5027          ((eq position 'boi)  '((back-to-indentation)))          ((eq position 'boi)  '((back-to-indentation)))
5028          ((eq position 'eoi)  '((end-of-line)(skip-chars-backward " \t")))          ((eq position 'eoi)  '((end-of-line) (skip-chars-backward " \t")))
5029          ((eq position 'bonl) '((forward-line 1)))          ((eq position 'bonl) '((forward-line 1)))
5030          ((eq position 'bopl) '((forward-line -1)))          ((eq position 'bopl) '((forward-line -1)))
5031          ((eq position 'iopl)          ((eq position 'iopl)
# Line 3269  This function does not modify point or m Line 5034  This function does not modify point or m
5034          ((eq position 'ionl)          ((eq position 'ionl)
5035           '((forward-line 1)           '((forward-line 1)
5036             (back-to-indentation)))             (back-to-indentation)))
5037          (t (error "Unknown buffer position requested: %s" position))          (t (error "ERROR:  Unknown buffer position requested: %s" position))
5038          )          )
5039       (prog1       (prog1
5040           (point)           (point)
# Line 3358  offset for that syntactic element.  Opti Line 5123  offset for that syntactic element.  Opti
5123        (integerp offset)        (integerp offset)
5124        (fboundp offset)        (fboundp offset)
5125        (boundp offset)        (boundp offset)
5126        (error "Offset must be int, func, var, or one of +, -, ++, --: %s"        (error "ERROR:  Offset must be int, func, var, or one of +, -, ++, --: %s"
5127               offset))               offset))
5128    (let ((entry (assq symbol vhdl-offsets-alist)))    (let ((entry (assq symbol vhdl-offsets-alist)))
5129      (if entry      (if entry
# Line 3366  offset for that syntactic element.  Opti Line 5131  offset for that syntactic element.  Opti
5131        (if add-p        (if add-p
5132            (setq vhdl-offsets-alist            (setq vhdl-offsets-alist
5133                  (cons (cons symbol offset) vhdl-offsets-alist))                  (cons (cons symbol offset) vhdl-offsets-alist))
5134          (error "%s is not a valid syntactic symbol" symbol))))          (error "ERROR:  %s is not a valid syntactic symbol" symbol))))
5135    (vhdl-keep-region-active))    (vhdl-keep-region-active))
5136    
5137  (defun vhdl-set-style (style &optional local)  (defun vhdl-set-style (style &optional local)
# Line 3381  argument.  The styles are chosen from th Line 5146  argument.  The styles are chosen from th
5146                       current-prefix-arg))                       current-prefix-arg))
5147    (let ((vars (cdr (assoc style vhdl-style-alist))))    (let ((vars (cdr (assoc style vhdl-style-alist))))
5148      (or vars      (or vars
5149          (error "Invalid VHDL indentation style `%s'" style))          (error "ERROR:  Invalid VHDL indentation style `%s'" style))
5150      ;; set all the variables      ;; set all the variables
5151      (mapcar      (mapcar
5152       (function       (function
# Line 3423  the offset is simply returned." Line 5188  the offset is simply returned."
5188      (cond      (cond
5189       ((not match)       ((not match)
5190        (if vhdl-strict-syntax-p        (if vhdl-strict-syntax-p
5191            (error "Don't know how to indent a %s" symbol)            (error "ERROR:  Don't know how to indent a %s" symbol)
5192          (setq offset 0          (setq offset 0
5193                relpos 0)))                relpos 0)))
5194       ((eq offset '+)  (setq offset vhdl-basic-offset))       ((eq offset '+)  (setq offset vhdl-basic-offset))
# Line 3446  the offset is simply returned." Line 5211  the offset is simply returned."
5211    
5212  ;; Syntactic support functions:  ;; Syntactic support functions:
5213    
5214  ;; Returns `comment' if in a comment, `string' if in a string literal,  (defun vhdl-in-comment-p ()
5215  ;; or nil if not in a literal at all.  Optional LIM is used as the    "Check if point is in a comment."
5216  ;; backward limit of the search.  If omitted, or nil, (point-min) is    (eq (vhdl-in-literal) 'comment))
 ;; used.  
5217    
5218  (defun vhdl-in-literal (&optional lim)  (defun vhdl-in-string-p ()
5219      "Check if point is in a string."
5220      (eq (vhdl-in-literal) 'string))
5221    
5222    (defun vhdl-in-literal ()
5223    "Determine if point is in a VHDL literal."    "Determine if point is in a VHDL literal."
5224    (save-excursion    (save-excursion
5225      (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))      (let ((state (parse-partial-sexp (vhdl-point 'bol) (point))))
# Line 3460  the offset is simply returned." Line 5228  the offset is simply returned."
5228         ((nth 4 state) 'comment)         ((nth 4 state) 'comment)
5229         (t nil)))))         (t nil)))))
5230    
5231    (defun vhdl-forward-comment (&optional direction)
5232      "Skip all comments (including whitespace).  Skip backwards if DIRECTION is
5233    negative, skip forward otherwise."
5234      (interactive "p")
5235      (if (and direction (< direction 0))
5236          ;; skip backwards
5237          (progn
5238            (skip-chars-backward " \t\n")
5239            (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t)
5240              (goto-char (match-beginning 3))
5241              (skip-chars-backward " \t\n")))
5242        ;; skip forwards
5243        (skip-chars-forward " \t\n")
5244        (while (looking-at "--.*")
5245          (goto-char (match-end 0))
5246          (skip-chars-forward " \t\n"))))
5247    
5248    ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
5249    (unless (and vhdl-xemacs (string< "21.2" emacs-version))
5250      (defalias 'vhdl-forward-comment 'forward-comment))
5251    
5252  ;; This is the best we can do in Win-Emacs.  ;; This is the best we can do in Win-Emacs.
5253  (defun vhdl-win-il (&optional lim)  (defun vhdl-win-il (&optional lim)
5254    "Determine if point is in a VHDL literal."    "Determine if point is in a VHDL literal."
# Line 3526  the offset is simply returned." Line 5315  the offset is simply returned."
5315        (narrow-to-region lim (point))        (narrow-to-region lim (point))
5316        (while (/= here (point))        (while (/= here (point))
5317          (setq here (point))          (setq here (point))
5318          (forward-comment hugenum))          (vhdl-forward-comment hugenum)))))
       )))  
5319    
5320  ;; This is the best we can do in Win-Emacs.  ;; This is the best we can do in Win-Emacs.
5321  (defun vhdl-win-fsws (&optional lim)  (defun vhdl-win-fsws (&optional lim)
# Line 3540  the offset is simply returned." Line 5328  the offset is simply returned."
5328         ;; vhdl comment         ;; vhdl comment
5329         ((looking-at "--") (end-of-line))         ((looking-at "--") (end-of-line))
5330         ;; none of the above         ;; none of the above
5331         (t (setq stop t))         (t (setq stop t))))))
        ))))  
5332    
5333  (and (string-match "Win-Emacs" emacs-version)  (and (string-match "Win-Emacs" emacs-version)
5334       (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))       (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws))
# Line 3557  the offset is simply returned." Line 5344  the offset is simply returned."
5344              (narrow-to-region lim (point))              (narrow-to-region lim (point))
5345              (while (/= here (point))              (while (/= here (point))
5346                (setq here (point))                (setq here (point))
5347                (forward-comment hugenum)                (vhdl-forward-comment hugenum)))))))
               )))  
       )))  
5348    
5349  ;; This is the best we can do in Win-Emacs.  ;; This is the best we can do in Win-Emacs.
5350  (defun vhdl-win-bsws (&optional lim)  (defun vhdl-win-bsws (&optional lim)
# Line 3570  the offset is simply returned." Line 5355  the offset is simply returned."
5355        (skip-chars-backward " \t\n\r\f" lim)        (skip-chars-backward " \t\n\r\f" lim)
5356        (cond        (cond
5357         ;; vhdl comment         ;; vhdl comment
5358         ((eq (vhdl-in-literal lim) 'comment)         ((eq (vhdl-in-literal) 'comment)
5359          (skip-chars-backward "^-" lim)          (skip-chars-backward "^-" lim)
5360          (skip-chars-backward "-" lim)          (skip-chars-backward "-" lim)
5361          (while (not (or (and (= (following-char) ?-)          (while (not (or (and (= (following-char) ?-)
# Line 3579  the offset is simply returned." Line 5364  the offset is simply returned."
5364            (skip-chars-backward "^-" lim)            (skip-chars-backward "^-" lim)
5365            (skip-chars-backward "-" lim)))            (skip-chars-backward "-" lim)))
5366         ;; none of the above         ;; none of the above
5367         (t (setq stop t))         (t (setq stop t))))))
        ))))  
5368    
5369  (and (string-match "Win-Emacs" emacs-version)  (and (string-match "Win-Emacs" emacs-version)
5370      (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))      (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws))
# Line 3686  keyword." Line 5470  keyword."
5470                            ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"                            ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]"
5471                            lim 'move))                            lim 'move))
5472                 (if (or (= (preceding-char) ?_)                 (if (or (= (preceding-char) ?_)
5473                         (vhdl-in-literal lim))                         (vhdl-in-literal))
5474                     (backward-char)                     (backward-char)
5475                   (setq foundp t))))                   (setq foundp t))))
5476             (and (/= (following-char) ?\;)             (and (/= (following-char) ?\;)
# Line 3750  of an identifier that just happens to co Line 5534  of an identifier that just happens to co
5534    (save-excursion    (save-excursion
5535      (and (looking-at vhdl-begin-fwd-re)      (and (looking-at vhdl-begin-fwd-re)
5536           (/= (preceding-char) ?_)           (/= (preceding-char) ?_)
5537           (not (vhdl-in-literal lim))           (not (vhdl-in-literal))
5538           (vhdl-begin-p lim)           (vhdl-begin-p lim)
5539           (cond           (cond
5540            ;; "is", "generate", "loop":            ;; "is", "generate", "loop":
# Line 3826  of an identifier that just happens to co Line 5610  of an identifier that just happens to co
5610    (save-excursion    (save-excursion
5611      (let (pos)      (let (pos)
5612        (if (and (looking-at vhdl-end-fwd-re)        (if (and (looking-at vhdl-end-fwd-re)
5613                 (not (vhdl-in-literal lim))                 (not (vhdl-in-literal))
5614                 (vhdl-end-p lim))                 (vhdl-end-p lim))
5615            (if (looking-at "el")            (if (looking-at "el")
5616                ;; "else", "elsif":                ;; "else", "elsif":
# Line 3909  of an identifier that just happens to co Line 5693  of an identifier that just happens to co
5693                   (= (following-char) ?\())                   (= (following-char) ?\())
5694                 (forward-sexp 2)                 (forward-sexp 2)
5695               (forward-sexp))               (forward-sexp))
5696               (when (looking-at "[ \t\n]*is")
5697                 (goto-char (match-end 0)))
5698             (point))             (point))
5699            ((looking-at "component")            ((looking-at "component")
5700             (forward-sexp 2)             (forward-sexp 2)
5701               (when (looking-at "[ \t\n]*is")
5702                 (goto-char (match-end 0)))
5703             (point))             (point))
5704            ((looking-at "for")            ((looking-at "for")
5705             (forward-sexp 2)             (forward-sexp 2)
# Line 3981  contain a \"when\" keyword." Line 5769  contain a \"when\" keyword."
5769        (while (and (not foundp)        (while (and (not foundp)
5770                    (re-search-backward ";\\|<=" lim 'move))                    (re-search-backward ";\\|<=" lim 'move))
5771          (if (or (= (preceding-char) ?_)          (if (or (= (preceding-char) ?_)
5772                  (vhdl-in-literal lim))                  (vhdl-in-literal))
5773              (backward-char)              (backward-char)
5774            (setq foundp t)))            (setq foundp t)))
5775        (or (eq (following-char) ?\;)        (or (eq (following-char) ?\;)
# Line 3999  contain a \"when\" keyword." Line 5787  contain a \"when\" keyword."
5787      (while (and (not foundp)      (while (and (not foundp)
5788                  (re-search-backward vhdl-b-t-b-re lim 'move))                  (re-search-backward vhdl-b-t-b-re lim 'move))
5789        (if (or (= (preceding-char) ?_)        (if (or (= (preceding-char) ?_)
5790                (vhdl-in-literal lim))                (vhdl-in-literal))
5791            (backward-char)            (backward-char)
5792          (cond          (cond
5793           ;; "begin" keyword:           ;; "begin" keyword:
# Line 4031  With COUNT, do it that many times." Line 5819  With COUNT, do it that many times."
5819          ;; Check for an unbalanced "end" keyword          ;; Check for an unbalanced "end" keyword
5820          (if (and (looking-at vhdl-end-fwd-re)          (if (and (looking-at vhdl-end-fwd-re)
5821                   (/= (preceding-char) ?_)                   (/= (preceding-char) ?_)
5822                   (not (vhdl-in-literal lim))                   (not (vhdl-in-literal))
5823                   (vhdl-end-p lim)                   (vhdl-end-p lim)
5824                   (not (looking-at "else")))                   (not (looking-at "else")))
5825              (error              (error
5826               "Containing expression ends prematurely in vhdl-forward-sexp"))               "ERROR:  Containing expression ends prematurely in vhdl-forward-sexp"))
5827          ;; If the current keyword is a "begin" keyword, then find the          ;; If the current keyword is a "begin" keyword, then find the
5828          ;; corresponding "end" keyword.          ;; corresponding "end" keyword.
5829          (if (setq end-vec (vhdl-corresponding-end lim))          (if (setq end-vec (vhdl-corresponding-end lim))
# Line 4060  With COUNT, do it that many times." Line 5848  With COUNT, do it that many times."
5848                               (/= (current-indentation) column)                               (/= (current-indentation) column)
5849                               (> (point) eol))                               (> (point) eol))
5850                          (= (preceding-char) ?_)                          (= (preceding-char) ?_)
5851                          (setq literal (vhdl-in-literal lim)))                          (setq literal (vhdl-in-literal)))
5852                      (if (eq literal 'comment)                      (if (eq literal 'comment)
5853                          (end-of-line)                          (end-of-line)
5854                        (forward-char))                        (forward-char))
# Line 4072  With COUNT, do it that many times." Line 5860  With COUNT, do it that many times."
5860                    (setq foundp t))                    (setq foundp t))
5861                  )                  )
5862                (if (not foundp)                (if (not foundp)
5863                    (error "Unbalanced keywords in vhdl-forward-sexp"))                    (error "ERROR:  Unbalanced keywords in vhdl-forward-sexp"))
5864                )                )
5865            ;; If the current keyword is not a "begin" keyword, then just            ;; If the current keyword is not a "begin" keyword, then just
5866            ;; perform the normal forward-sexp.            ;; perform the normal forward-sexp.
# Line 4099  searches." Line 5887  searches."
5887          ;; of the following sexp and the closing brace of the previous sexp.          ;; of the following sexp and the closing brace of the previous sexp.
5888          (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")          (if (and (looking-at "else\\b\\([^_]\\|\\'\\)")
5889                   (/= (preceding-char) ?_)                   (/= (preceding-char) ?_)
5890                   (not (vhdl-in-literal lim)))                   (not (vhdl-in-literal)))
5891              nil              nil
5892            (backward-sexp)            (backward-sexp)
5893            (if (and (looking-at vhdl-begin-fwd-re)            (if (and (looking-at vhdl-begin-fwd-re)
5894                     (/= (preceding-char) ?_)                     (/= (preceding-char) ?_)
5895                     (not (vhdl-in-literal lim))                     (not (vhdl-in-literal))
5896                     (vhdl-begin-p lim))                     (vhdl-begin-p lim))
5897                (error "Containing expression ends prematurely in vhdl-backward-sexp")))                (error "ERROR:  Containing expression ends prematurely in vhdl-backward-sexp")))
5898          ;; If the current keyword is an "end" keyword, then find the          ;; If the current keyword is an "end" keyword, then find the
5899          ;; corresponding "begin" keyword.          ;; corresponding "begin" keyword.
5900          (if (and (setq begin-vec (vhdl-corresponding-begin lim))          (if (and (setq begin-vec (vhdl-corresponding-begin lim))
# Line 4138  searches." Line 5926  searches."
5926                                    (or (not internal-p)                                    (or (not internal-p)
5927                                        (/= (current-column) column))))                                        (/= (current-column) column))))
5928                          (= (preceding-char) ?_)                          (= (preceding-char) ?_)
5929                          (vhdl-in-literal lim))                          (vhdl-in-literal))
5930                      (backward-char)                      (backward-char)
5931                    ;; If there is a supplementary keyword, then                    ;; If there is a supplementary keyword, then
5932                    ;; search forward for it.                    ;; search forward for it.
# Line 4167  searches." Line 5955  searches."
5955                             ;; If we are in a literal, then try again.                             ;; If we are in a literal, then try again.
5956                             (if (or (= (preceding-char) ?_)                             (if (or (= (preceding-char) ?_)
5957                                     (setq literal                                     (setq literal
5958                                           (vhdl-in-literal last-forward)))                                           (vhdl-in-literal)))
5959                                 (if (eq literal 'comment)                                 (if (eq literal 'comment)
5960                                     (goto-char                                     (goto-char
5961                                      (min (vhdl-point 'eol) last-backward))                                      (min (vhdl-point 'eol) last-backward))
# Line 4185  searches." Line 5973  searches."
5973                      (setq foundp t)))                      (setq foundp t)))
5974                  ) ; end of the search for the statement keyword                  ) ; end of the search for the statement keyword
5975                (if (not foundp)                (if (not foundp)
5976                    (error "Unbalanced keywords in vhdl-backward-sexp"))                    (error "ERROR:  Unbalanced keywords in vhdl-backward-sexp"))
5977                ))                ))
5978          (setq count (1- count))          (setq count (1- count))
5979          )          )
# Line 4202  With argument, do this that many times." Line 5990  With argument, do this that many times."
5990      (save-excursion      (save-excursion
5991        (while (> count 0)        (while (> count 0)
5992          (if (looking-at vhdl-defun-re)          (if (looking-at vhdl-defun-re)
5993              (error "Unbalanced blocks"))              (error "ERROR:  Unbalanced blocks"))
5994          (vhdl-backward-to-block limit)          (vhdl-backward-to-block limit)
5995          (setq count (1- count)))          (setq count (1- count)))
5996        (setq target (point)))        (setq target (point)))
# Line 4251  returned point is at the first character Line 6039  returned point is at the first character
6039                  (re-search-backward vhdl-libunit-re nil 'move))                  (re-search-backward vhdl-libunit-re nil 'move))
6040        ;; If we are in a literal, or not at a real libunit, then try again.        ;; If we are in a literal, or not at a real libunit, then try again.
6041        (if (or (= (preceding-char) ?_)        (if (or (= (preceding-char) ?_)
6042                (vhdl-in-literal (point-min))                (vhdl-in-literal)
6043                (not (vhdl-libunit-p)))                (not (vhdl-libunit-p)))
6044            (backward-char)            (backward-char)
6045          ;; Find the corresponding "begin" keyword.          ;; Find the corresponding "begin" keyword.
# Line 4260  returned point is at the first character Line 6048  returned point is at the first character
6048                      (re-search-forward "\\bis\\b[^_]" last-backward t)                      (re-search-forward "\\bis\\b[^_]" last-backward t)
6049                      (setq placeholder (match-beginning 0)))                      (setq placeholder (match-beginning 0)))
6050            (if (or (= (preceding-char) ?_)            (if (or (= (preceding-char) ?_)
6051                    (setq literal (vhdl-in-literal last-forward)))                    (setq literal (vhdl-in-literal)))
6052                ;; It wasn't a real keyword, so keep searching.                ;; It wasn't a real keyword, so keep searching.
6053                (if (eq literal 'comment)                (if (eq literal 'comment)
6054                    (goto-char                    (goto-char
# Line 4301  stops due to beginning or end of buffer. Line 6089  stops due to beginning or end of buffer.
6089                      (re-search-backward vhdl-defun-re nil 'move))                      (re-search-backward vhdl-defun-re nil 'move))
6090            ;; If we are in a literal, then try again.            ;; If we are in a literal, then try again.
6091            (if (or (= (preceding-char) ?_)            (if (or (= (preceding-char) ?_)
6092                    (vhdl-in-literal (point-min)))                    (vhdl-in-literal))
6093                (backward-char)                (backward-char)
6094              (if (setq begin-string (vhdl-corresponding-defun))              (if (setq begin-string (vhdl-corresponding-defun))
6095                  ;; This is a real defun keyword.                  ;; This is a real defun keyword.
# Line 4314  stops due to beginning or end of buffer. Line 6102  stops due to beginning or end of buffer.
6102                                (search-forward begin-string last-backward t))                                (search-forward begin-string last-backward t))
6103                      (if (or (= (preceding-char) ?_)                      (if (or (= (preceding-char) ?_)
6104                              (save-match-data                              (save-match-data
6105                                (setq literal (vhdl-in-literal last-forward))))                                (setq literal (vhdl-in-literal))))
6106                          ;; It wasn't a real keyword, so keep searching.                          ;; It wasn't a real keyword, so keep searching.
6107                          (if (eq literal 'comment)                          (if (eq literal 'comment)
6108                              (goto-char                              (goto-char
# Line 4397  statement if already at the beginning of Line 6185  statement if already at the beginning of
6185                  ;; look backwards for a statement boundary                  ;; look backwards for a statement boundary
6186                  (re-search-backward vhdl-b-o-s-re lim 'move))                  (re-search-backward vhdl-b-o-s-re lim 'move))
6187        (if (or (= (preceding-char) ?_)        (if (or (= (preceding-char) ?_)
6188                (vhdl-in-literal lim))                (vhdl-in-literal))
6189            (backward-char)            (backward-char)
6190          (cond          (cond
6191           ;; If we are looking at an open paren, then stop after it           ;; If we are looking at an open paren, then stop after it
# Line 4667  is not moved." Line 6455  is not moved."
6455          ;; the most likely position to perform the majority of tests          ;; the most likely position to perform the majority of tests
6456          (goto-char indent-point)          (goto-char indent-point)
6457          (skip-chars-forward " \t")          (skip-chars-forward " \t")
6458          (setq literal (vhdl-in-literal lim))          (setq literal (vhdl-in-literal))
6459          (setq char-after-ip (following-char))          (setq char-after-ip (following-char))
6460          (setq begin-after-ip (and          (setq begin-after-ip (and
6461                                (not literal)                                (not literal)
# Line 4995  only-lines." Line 6783  only-lines."
6783        (while (and (not foundp)        (while (and (not foundp)
6784                    (< (point) (vhdl-point 'eol)))                    (< (point) (vhdl-point 'eol)))
6785          (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)          (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move)
6786          (if (vhdl-in-literal (cdr langelem))          (if (vhdl-in-literal)
6787              (forward-char)              (forward-char)
6788            (if (= (preceding-char) ?\()            (if (= (preceding-char) ?\()
6789                ;; skip over any parenthesized expressions                ;; skip over any parenthesized expressions
# Line 5017  only-lines." Line 6805  only-lines."
6805        )))        )))
6806    
6807  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6808  ;; Indentation commands  ;; Progress reporting
6809    
6810  (defsubst vhdl-in-comment-p ()  (defvar vhdl-progress-info nil
6811    "Check if point is to right of beginning comment delimiter."    "Array variable for progress information: 0 begin, 1 end, 2 time.")
   (let ((position (point)))  
     (save-excursion ; finds an unquoted comment  
       (beginning-of-line)  
       (re-search-forward "^\\([^\"]*\"[^\"]*\"\\)*[^\"]*--" position t))))  
6812    
6813  (defsubst vhdl-in-string-p ()  (defun vhdl-update-progress-info (string pos)
6814    "Check if point is in a string."    "Update progress information."
6815    (let ((position (point)))    (when (and vhdl-progress-info (not noninteractive)
6816      (save-excursion ; preceeded by odd number of string delimiters?               (< vhdl-progress-interval
6817        (beginning-of-line)                  (- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
6818        (eq position (re-search-forward "^\\([^\"]*\"[^\"]*\"\\)*[^\"]*\"[^\"]*"      (message (concat string "... (%2d%s)")
6819                                        position t)))))               (/ (* 100 (- pos (aref vhdl-progress-info 0)))
6820                    (- (aref vhdl-progress-info 1)
6821                       (aref vhdl-progress-info 0))) "%")
6822        (aset vhdl-progress-info 2 (nth 1 (current-time)))))
6823    
6824  (defsubst vhdl-in-comment-or-string-p ()  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6825    "Check if point is in a comment or a string."  ;; Indentation commands
   (and (vhdl-in-comment-p)  
        (vhdl-in-string-p)))  
6826    
6827  (defun vhdl-electric-tab (&optional prefix-arg)  (defun vhdl-electric-tab (&optional prefix-arg)
6828    "If preceeding character is part of a word or a paren then hippie-expand,    "If preceeding character is part of a word or a paren then hippie-expand,
6829  else if right of non whitespace on line then tab-to-tab-stop,  else if right of non whitespace on line then insert tab,
6830  else if last command was a tab or return then dedent one step,  else if last command was a tab or return then dedent one step or if a comment
6831    toggle between normal indent and inline comment indent,
6832  else indent `correctly'."  else indent `correctly'."
6833    (interactive "*P")    (interactive "*P")
6834    (vhdl-ext-syntax-table    (vhdl-prepare-search-2
6835     (cond ((= (char-syntax (preceding-char)) ?w)     (cond
6836            (let ((case-fold-search (not vhdl-word-completion-case-sensitive))      ;; expand word
6837                  (case-replace nil))      ((= (char-syntax (preceding-char)) ?w)
6838              (vhdl-expand-abbrev prefix-arg)))       (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
6839           ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))             (case-replace nil)
6840            (let ((case-fold-search (not vhdl-word-completion-case-sensitive))             (hippie-expand-only-buffers
6841                  (case-replace nil))              (or (and (boundp 'hippie-expand-only-buffers)
6842              (vhdl-expand-paren prefix-arg)))                       hippie-expand-only-buffers)
6843           ((> (current-column) (current-indentation))                  '(vhdl-mode))))
6844            (tab-to-tab-stop))         (vhdl-expand-abbrev prefix-arg)))
6845           ((and (or (eq last-command 'vhdl-electric-tab)      ;; expand parenthesis
6846                     (eq last-command 'vhdl-electric-return))      ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
6847                 (/= 0 (current-indentation)))       (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
6848            (backward-delete-char-untabify vhdl-basic-offset nil))             (case-replace nil))
6849           (t (vhdl-indent-line)))         (vhdl-expand-paren prefix-arg)))
6850        ;; insert tab
6851        ((> (current-column) (current-indentation))
6852         (insert-tab))
6853        ;; toggle comment indent
6854        ((and (looking-at "--")
6855              (or (eq last-command 'vhdl-electric-tab)
6856                  (eq last-command 'vhdl-electric-return)))
6857         (cond ((= (current-indentation) 0) ; no indent
6858                (indent-to 1)
6859                (indent-according-to-mode))
6860               ((< (current-indentation) comment-column) ; normal indent
6861                (indent-to comment-column)
6862                (indent-according-to-mode))
6863               (t                           ; inline comment indent
6864                (kill-line -0))))
6865        ;; dedent
6866        ((and (>= (current-indentation) vhdl-basic-offset)
6867              (or (eq last-command 'vhdl-electric-tab)
6868                  (eq last-command 'vhdl-electric-return)))
6869         (backward-delete-char-untabify vhdl-basic-offset nil))
6870        ;; indent line
6871        (t (indent-according-to-mode)))
6872     (setq this-command 'vhdl-electric-tab)))     (setq this-command 'vhdl-electric-tab)))
6873    
6874  (defun vhdl-electric-return ()  (defun vhdl-electric-return ()
# Line 5069  character is a space." Line 6877  character is a space."
6877    (interactive)    (interactive)
6878    (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))    (if (and (= (preceding-char) ? ) (vhdl-in-comment-p))
6879        (indent-new-comment-line)        (indent-new-comment-line)
6880        (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
6881          (vhdl-fix-case-word -1))
6882      (newline-and-indent)))      (newline-and-indent)))
6883    
 (defvar vhdl-progress-info nil  
   "Array variable for progress information: 0 begin, 1 end, 2 time.")  
   
6884  (defun vhdl-indent-line ()  (defun vhdl-indent-line ()
6885    "Indent the current line as VHDL code.  Returns the amount of    "Indent the current line as VHDL code.  Returns the amount of
6886  indentation change."  indentation change."
6887    (interactive)    (interactive)
6888    (let* ((syntax (vhdl-get-syntactic-context))    (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context)))
6889           (pos (- (point-max) (point)))           (pos (- (point-max) (point)))
6890           ;; special case: comments at or right of comment-column           (indent
6891           (indent (if (and (eq (car (car syntax)) 'comment)            (if syntax
6892                            (>= (vhdl-get-offset (car syntax)) comment-column))                ;; indent syntax-based
6893                       (vhdl-get-offset (car syntax))                (if (and (eq (caar syntax) 'comment)
6894                     (apply '+ (mapcar 'vhdl-get-offset syntax))))                         (>= (vhdl-get-offset (car syntax)) comment-column))
6895  ;        (indent (apply '+ (mapcar 'vhdl-get-offset syntax)))                    ;; special case: comments at or right of comment-column
6896                      (vhdl-get-offset (car syntax))
6897                    (apply '+ (mapcar 'vhdl-get-offset syntax)))
6898                ;; indent like previous nonblank line
6899                (save-excursion (beginning-of-line)
6900                                (re-search-backward "^[^\n]" nil t)
6901                                (current-indentation))))
6902           (shift-amt  (- indent (current-indentation))))           (shift-amt  (- indent (current-indentation))))
6903      (and vhdl-echo-syntactic-information-p      (and vhdl-echo-syntactic-information-p
6904           (message "syntax: %s, indent= %d" syntax indent))           (message "syntax: %s, indent= %d" syntax indent))
# Line 5100  indentation change." Line 6913  indentation change."
6913        (when (> (- (point-max) pos) (point))        (when (> (- (point-max) pos) (point))
6914          (goto-char (- (point-max) pos))))          (goto-char (- (point-max) pos))))
6915      (run-hooks 'vhdl-special-indent-hook)      (run-hooks 'vhdl-special-indent-hook)
6916      ;; update progress status      (vhdl-update-progress-info "Indenting" (vhdl-current-line))
     (when vhdl-progress-info  
       (aset vhdl-progress-info 1 (+ (aref vhdl-progress-info 1)  
                                     (if (> -500 shift-amt) 0 shift-amt)))  
       (when (< vhdl-progress-interval  
                (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))  
         (message "Indenting... (%2d%s)"  
                  (/ (* 100 (- (point) (aref vhdl-progress-info 0)))  
                     (- (aref vhdl-progress-info 1)  
                        (aref vhdl-progress-info 0))) "%")  
         (aset vhdl-progress-info 2 (nth 1 (current-time)))))  
6917      shift-amt))      shift-amt))
6918    
6919  (defun vhdl-indent-buffer ()  (defun vhdl-indent-region (beg end column)
   "Indent whole buffer as VHDL code.  
 Calls `indent-region' for whole buffer and adds progress reporting."  
   (interactive)  
   (when vhdl-progress-interval  
     (setq vhdl-progress-info (vector (point-min) (point-max) 0)))  
   (indent-region (point-min) (point-max) nil)  
   (when vhdl-progress-interval (message "Indenting...done"))  
   (setq vhdl-progress-info nil))  
   
 (defun vhdl-indent-region (start end column)  
6920    "Indent region as VHDL code.    "Indent region as VHDL code.
6921  Adds progress reporting to `indent-region'."  Adds progress reporting to `indent-region'."
6922    (interactive "r\nP")    (interactive "r\nP")
6923    (when vhdl-progress-interval (setq vhdl-progress-info (vector start end 0)))    (when vhdl-progress-interval
6924    (indent-region start end column)      (setq vhdl-progress-info (vector (count-lines (point-min) beg)
6925                                         (count-lines (point-min) end) 0)))
6926      (indent-region beg end column)
6927    (when vhdl-progress-interval (message "Indenting...done"))    (when vhdl-progress-interval (message "Indenting...done"))
6928    (setq vhdl-progress-info nil))    (setq vhdl-progress-info nil))
6929    
6930    (defun vhdl-indent-buffer ()
6931      "Indent whole buffer as VHDL code.
6932    Calls `indent-region' for whole buffer and adds progress reporting."
6933      (interactive)
6934      (vhdl-indent-region (point-min) (point-max) nil))
6935    
6936    (defun vhdl-indent-group ()
6937      "Indent group of lines between empty lines."
6938      (interactive)
6939      (let ((beg (save-excursion
6940                   (if (re-search-backward vhdl-align-group-separate nil t)
6941                       (point-marker)
6942                     (point-min-marker))))
6943            (end (save-excursion
6944                   (if (re-search-forward vhdl-align-group-separate nil t)
6945                       (point-marker)
6946                     (point-max-marker)))))
6947        (vhdl-indent-region beg end nil)))
6948    
6949  (defun vhdl-indent-sexp (&optional endpos)  (defun vhdl-indent-sexp (&optional endpos)
6950    "Indent each line of the list starting just after point.    "Indent each line of the list starting just after point.
6951  If optional arg ENDPOS is given, indent each line, stopping when  If optional arg ENDPOS is given, indent each line, stopping when
# Line 5148  ENDPOS is encountered." Line 6962  ENDPOS is encountered."
6962  (defun vhdl-show-syntactic-information ()  (defun vhdl-show-syntactic-information ()
6963    "Show syntactic information for current line."    "Show syntactic information for current line."
6964    (interactive)    (interactive)
6965    (message "syntactic analysis: %s" (vhdl-get-syntactic-context))    (message "Syntactic analysis: %s" (vhdl-get-syntactic-context))
6966    (vhdl-keep-region-active))    (vhdl-keep-region-active))
6967    
6968  ;; Verification and regression functions:  ;; Verification and regression functions:
# Line 5174  ENDPOS is encountered." Line 6988  ENDPOS is encountered."
6988       actual)       actual)
6989      (if (and (not arg) expected (listp expected))      (if (and (not arg) expected (listp expected))
6990          (if (not (equal expected expurgated))          (if (not (equal expected expurgated))
6991              (error "Should be: %s, is: %s" expected expurgated))              (error "ERROR:  Should be: %s, is: %s" expected expurgated))
6992        (save-excursion        (save-excursion
6993          (beginning-of-line)          (beginning-of-line)
6994          (when (not (looking-at "^\\s-*\\(--.*\\)?$"))          (when (not (looking-at "^\\s-*\\(--.*\\)?$"))
# Line 5190  ENDPOS is encountered." Line 7004  ENDPOS is encountered."
7004  ;;; Alignment, whitespace fixup, beautifying  ;;; Alignment, whitespace fixup, beautifying
7005  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7006    
7007  (defvar vhdl-align-alist  (defconst vhdl-align-alist
7008    '(    '(
7009      ;; after some keywords      ;; after some keywords
7010      (vhdl-mode "\\<\\(constant\\|quantity\\|signal\\|terminal\\|variable\\)[ \t]"      (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]"
7011                 "\\<\\(constant\\|quantity\\|signal\\|terminal\\|variable\\)\\([ \t]+\\)" 2)                 "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2)
7012      ;; before ':'      ;; before ':'
7013      (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")      (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]")
7014      ;; after direction specifications      ;; after direction specifications
7015      (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"      (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>"
7016                 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)                 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2)
7017      ;; before "==", ":=", "=>", and "<="      ;; before "==", ":=", "=>", and "<="
7018      (vhdl-mode "==" "\\([ \t]*\\)==" 1)      (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur
     (vhdl-mode ":=" "\\([ \t]*\\):=" 1) ; since ":= ... =>" can occur  
     (vhdl-mode "<=" "\\([ \t]*\\)<=" 1) ; since "<= ... =>" can occur  
7019      (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)      (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7020      (vhdl-mode ":=" "\\([ \t]*\\):=" 1) ; since "=> ... :=" can occur      (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur
     (vhdl-mode "<=" "\\([ \t]*\\)<=" 1) ; since "=> ... <=" can occur  
7021      ;; before some keywords      ;; before some keywords
7022      (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)      (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1)
7023      (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)      (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1)
7024      (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)      (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1)
7025        ;; before "=>" since "when/else ... =>" can occur
7026        (vhdl-mode "=>" "\\([ \t]*\\)=>" 1)
7027      )      )
7028    "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).    "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP).
7029  It is searched in order.  If REGEXP is found anywhere in the first  It is searched in order.  If REGEXP is found anywhere in the first
# Line 5220  contracted.  It may also provide regexps Line 7033  contracted.  It may also provide regexps
7033  whitespace.  SUBEXP specifies which sub-expression of  whitespace.  SUBEXP specifies which sub-expression of
7034  ALIGN-PATTERN matches the white space to be expanded/contracted.")  ALIGN-PATTERN matches the white space to be expanded/contracted.")
7035    
7036    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7037    ;; Align code
7038    
7039  (defvar vhdl-align-try-all-clauses t  (defvar vhdl-align-try-all-clauses t
7040    "If REGEXP is not found on the first line of the region that clause    "If REGEXP is not found on the first line of the region that clause
7041  is ignored.  If this variable is non-nil, then the clause is tried anyway.")  is ignored.  If this variable is non-nil, then the clause is tried anyway.")
7042    
7043  (defun vhdl-align-region (begin end &optional spacing alignment-list indent)  (defun vhdl-do-group (function &optional spacing)
7044      "Apply FUNCTION on group of lines between empty lines."
7045      (let
7046          ;; search for group beginning
7047          ((beg (save-excursion
7048                  (if (re-search-backward vhdl-align-group-separate nil t)
7049                      (progn (beginning-of-line 2) (back-to-indentation) (point))
7050                    (point-min))))
7051           ;; search for group end
7052           (end (save-excursion
7053                  (if (re-search-forward vhdl-align-group-separate nil t)
7054                      (progn (beginning-of-line) (point))
7055                    (point-max)))))
7056        ;; run FUNCTION
7057        (funcall function beg end spacing)))
7058    
7059    (defun vhdl-do-list (function &optional spacing)
7060      "Apply FUNCTION to the lines of a list surrounded by a balanced group of
7061    parentheses."
7062      (let (beg end)
7063        (save-excursion
7064          ;; search for beginning of balanced group of parentheses
7065          (setq beg (vhdl-re-search-backward "[()]" nil t))
7066          (while (looking-at ")")
7067            (forward-char) (backward-sexp)
7068            (setq beg (vhdl-re-search-backward "[()]" nil t)))
7069          ;; search for end of balanced group of parentheses
7070          (when beg
7071            (forward-list)
7072            (setq end (point))
7073            (goto-char (1+ beg))
7074            (skip-chars-forward " \t\n")
7075            (setq beg (point))))
7076        ;; run FUNCTION
7077        (if beg
7078            (funcall function beg end spacing)
7079          (error "ERROR:  Not within a list enclosed by a pair of parentheses"))))
7080    
7081    (defun vhdl-do-same-indent (function &optional spacing)
7082      "Apply FUNCTION to block of lines with same indent."
7083      (let ((indent (current-indentation))
7084            beg end)
7085        ;; search for first line with same indent
7086        (save-excursion
7087          (while (and (not (bobp))
7088                      (or (looking-at "^\\s-*\\(--.*\\)?$")
7089                          (= (current-indentation) indent)))
7090            (unless (looking-at "^\\s-*$")
7091              (back-to-indentation) (setq beg (point)))
7092            (beginning-of-line -0)))
7093        ;; search for last line with same indent
7094        (save-excursion
7095          (while (and (not (eobp))
7096                      (or (looking-at "^\\s-*\\(--.*\\)?$")
7097                          (= (current-indentation) indent)))
7098            (if (looking-at "^\\s-*$")
7099                (beginning-of-line 2)
7100              (beginning-of-line 2)
7101              (setq end (point)))))
7102        ;; run FUNCTION
7103        (funcall function beg end spacing)))
7104    
7105    (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent)
7106    "Attempt to align a range of lines based on the content of the    "Attempt to align a range of lines based on the content of the
7107  lines.  The definition of `alignment-list' determines the matching  lines.  The definition of `alignment-list' determines the matching
7108  order and the manner in which the lines are aligned.  If ALIGNMENT-LIST  order and the manner in which the lines are aligned.  If ALIGNMENT-LIST
# Line 5239  indentation is done before aligning." Line 7117  indentation is done before aligning."
7117        (setq end (point-marker))        (setq end (point-marker))
7118        (goto-char begin)        (goto-char begin)
7119        (setq bol (setq begin (progn (beginning-of-line) (point))))        (setq bol (setq begin (progn (beginning-of-line) (point))))
7120                                          ;      (untabify bol end)  ;      (untabify bol end)
7121        (when indent        (when indent
7122          (indent-region bol end nil))))          (indent-region bol end nil))))
7123    (let ((case-fold-search t)    (let ((copy (copy-alist alignment-list)))
7124          (copy (copy-alist alignment-list)))      (vhdl-prepare-search-2
     (vhdl-ext-syntax-table  
7125       (while copy       (while copy
7126         (save-excursion         (save-excursion
7127           (goto-char begin)           (goto-char begin)
# Line 5256  indentation is done before aligning." Line 7133  indentation is done before aligning."
7133                            (eq major-mode (car element)))                            (eq major-mode (car element)))
7134                        (or vhdl-align-try-all-clauses                        (or vhdl-align-try-all-clauses
7135                            (re-search-forward (car (cdr element)) eol t)))                            (re-search-forward (car (cdr element)) eol t)))
7136               (vhdl-align-region-1 begin end (car (cdr (cdr element)))               (vhdl-align-region-2 begin end (car (cdr (cdr element)))
7137                                    (car (cdr (cdr (cdr element)))) spacing))                                    (car (cdr (cdr (cdr element)))) spacing))
7138             (setq copy (cdr copy))))))))             (setq copy (cdr copy))))))))
7139    
7140  (defun vhdl-align-region-1 (begin end match &optional substr spacing)  (defun vhdl-align-region-2 (begin end match &optional substr spacing)
7141    "Align a range of lines from BEGIN to END.  The regular expression    "Align a range of lines from BEGIN to END.  The regular expression
7142  MATCH must match exactly one fields: the whitespace to be  MATCH must match exactly one fields: the whitespace to be
7143  contracted/expanded.  The alignment column will equal the  contracted/expanded.  The alignment column will equal the
# Line 5280  the token in MATCH." Line 7157  the token in MATCH."
7157        (while (< bol end)        (while (< bol end)
7158          (save-excursion          (save-excursion
7159            (when (and (re-search-forward match eol t)            (when (and (re-search-forward match eol t)
7160                       (not (vhdl-in-comment-p)))                       (not (vhdl-in-literal)))
7161              (setq distance (- (match-beginning substr) bol))              (setq distance (- (match-beginning substr) bol))
7162              (when (> distance max)              (when (> distance max)
7163                (setq max distance))))                (setq max distance))))
# Line 5295  the token in MATCH." Line 7172  the token in MATCH."
7172        (setq eol (save-excursion (end-of-line) (point)))        (setq eol (save-excursion (end-of-line) (point)))
7173        (while (> lines 0)        (while (> lines 0)
7174          (when (and (re-search-forward match eol t)          (when (and (re-search-forward match eol t)
7175                     (not (vhdl-in-comment-p)))                     (not (vhdl-in-literal)))
7176            (setq width (- (match-end substr) (match-beginning substr)))            (setq width (- (match-end substr) (match-beginning substr)))
7177            (setq distance (- (match-beginning substr) bol))            (setq distance (- (match-beginning substr) bol))
7178            (goto-char (match-beginning substr))            (goto-char (match-beginning substr))
# Line 5307  the token in MATCH." Line 7184  the token in MATCH."
7184                eol (save-excursion (end-of-line) (point)))                eol (save-excursion (end-of-line) (point)))
7185          (setq lines (1- lines))))))          (setq lines (1- lines))))))
7186    
7187  (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)  (defun vhdl-align-region-groups (beg end &optional spacing
7188    "Align inline comments in region."                                       no-message no-comments)
7189    (save-excursion    "Align region, treat groups of lines separately."
     (let ((high-start 0)  
           (high-length 0)  
           (case-fold-search t))  
       (vhdl-ext-syntax-table  
        (goto-char beg)  
        ;; search for longest code line and longest inline comment  
        (while (< (point) end)  
          (cond  
           ((and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))  
                 (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--\\s-*.*\\)$"))  
            (setq high-start  
                  (max high-start (- (match-end 1) (match-beginning 1))))  
            (setq high-length  
                  (max high-length (- (match-end 2) (match-beginning 2)))))  
           ((and (looking-at "^\\(\\s-*\\))\\(--\\s-*.*\\)$")  
                 (>= (- (match-end 1) (match-beginning 1)) comment-column))  
            (setq high-length  
                  (max high-length (- (match-end 2) (match-beginning 2))))))  
          (beginning-of-line 2))  
        (goto-char beg)  
        (setq spacing (or spacing 2))  
        (setq high-start (+ high-start spacing))  
        ;; align as nice as possible  
        (while (< (point) end)  
          (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))  
                     (or (looking-at "^.*[^ \t\n-]+\\(\\s-*\\)--")  
                         (and (looking-at "^\\(\\s-*\\)--")  
                              (>= (- (match-end 1) (match-beginning 1))  
                                  comment-column))))  
            (goto-char (match-end 1))  
            (delete-region (match-beginning 1) (match-end 1))  
            (insert-char ?  spacing)  
            (cond ((<= high-start comment-column)  
                   (indent-to comment-column))  
                  ((<= (+ high-start high-length) end-comment-column)  
                   (indent-to high-start))  
                  (t (indent-to comment-column))))  
          (beginning-of-line 2))))))  
   
 (defun vhdl-align-noindent-region (beg end &optional spacing no-message)  
   "Align region without indentation."  
7190    (interactive "r\nP")    (interactive "r\nP")
7191    (save-excursion    (save-excursion
7192      (let (pos)      (let (orig pos)
7193        (goto-char beg)        (goto-char beg)
7194        (beginning-of-line)        (beginning-of-line)
7195          (setq orig (point-marker))
7196        (setq beg (point))        (setq beg (point))
7197        (goto-char end)        (goto-char end)
7198        (setq end (point-marker))        (setq end (point-marker))
7199        (untabify beg end)        (untabify beg end)
7200        (unless no-message (message "Aligning..."))        (unless no-message
7201            (when vhdl-progress-interval
7202              (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7203                                               (count-lines (point-min) end) 0))))
7204        (vhdl-fixup-whitespace-region beg end t)        (vhdl-fixup-whitespace-region beg end t)
7205        (goto-char beg)        (goto-char beg)
7206        (if (not vhdl-align-groups)        (if (not vhdl-align-groups)
7207            ;; align entire region            ;; align entire region
7208            (progn (vhdl-align-region beg end spacing)            (progn (vhdl-align-region-1 beg end spacing)
7209                   (vhdl-align-inline-comment-region-1 beg end))                   (unless no-comments
7210                       (vhdl-align-inline-comment-region-1 beg end)))
7211          ;; align groups          ;; align groups
7212          (while (and (< beg end)          (while (and (< beg end)
7213                      (re-search-forward "^\\s-*$" end t))                      (re-search-forward vhdl-align-group-separate end t))
7214            (setq pos (point-marker))            (setq pos (point-marker))
7215            (vhdl-align-region beg pos spacing)            (vhdl-align-region-1 beg pos spacing)
7216            (vhdl-align-inline-comment-region-1 beg pos)            (unless no-comments (vhdl-align-inline-comment-region-1 beg pos))
7217              (vhdl-update-progress-info "Aligning" (vhdl-current-line))
7218            (setq beg (1+ pos))            (setq beg (1+ pos))
7219            (goto-char beg))            (goto-char beg))
7220          ;; align last group          ;; align last group
7221          (when (< beg end)          (when (< beg end)
7222            (vhdl-align-region beg end spacing)            (vhdl-align-region-1 beg end spacing)
7223            (vhdl-align-inline-comment-region-1 beg end)))))            (unless no-comments (vhdl-align-inline-comment-region-1 beg end))
7224    (unless no-message (message "Aligning...done")))            (vhdl-update-progress-info "Aligning" (vhdl-current-line))))
7225          (when vhdl-indent-tabs-mode
7226            (tabify orig end))
7227          (unless no-message
7228            (when vhdl-progress-interval (message "Aligning...done"))
7229            (setq vhdl-progress-info nil)))))
7230    
7231    (defun vhdl-align-region (beg end &optional spacing)
7232      "Align region, treat blocks with same indent and argument lists separately."
7233      (interactive "r\nP")
7234      (if (not vhdl-align-same-indent)
7235          ;; align entire region
7236          (vhdl-align-region-groups beg end spacing)
7237        ;; align blocks with same indent and argument lists
7238        (save-excursion
7239          (let ((cur-beg beg)
7240                indent cur-end)
7241            (when vhdl-progress-interval
7242              (setq vhdl-progress-info (vector (count-lines (point-min) beg)
7243                                               (count-lines (point-min) end) 0)))
7244            (goto-char end)
7245            (setq end (point-marker))
7246            (goto-char cur-beg)
7247            (while (< (point) end)
7248              ;; is argument list opening?
7249              (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp
7250                                                        (point) (vhdl-point 'eol)))))
7251                  ;; determine region for argument list
7252                  (progn (goto-char cur-beg)
7253                         (forward-sexp)
7254                         (setq cur-end (point))
7255                         (beginning-of-line 2))
7256                ;; determine region with same indent
7257                (setq indent (current-indentation))
7258                (setq cur-beg (point))
7259                (setq cur-end (vhdl-point 'bonl))
7260                (beginning-of-line 2)
7261                (while (and (< (point) end)
7262                            (or (looking-at "^\\s-*\\(--.*\\)?$")
7263                                (= (current-indentation) indent))
7264                            (<= (save-excursion
7265                                  (nth 0 (parse-partial-sexp
7266                                          (point) (vhdl-point 'eol)))) 0))
7267                  (unless (looking-at "^\\s-*$")
7268                    (setq cur-end (vhdl-point 'bonl)))
7269                  (beginning-of-line 2)))
7270              ;; align region
7271              (vhdl-align-region-groups cur-beg cur-end spacing t t))
7272            (vhdl-align-inline-comment-region beg end spacing noninteractive)
7273            (when vhdl-progress-interval (message "Aligning...done"))
7274            (setq vhdl-progress-info nil)))))
7275    
7276  (defun vhdl-align-group (&optional spacing)  (defun vhdl-align-group (&optional spacing)
7277    "Align group of lines between empty lines."    "Align group of lines between empty lines."
7278    (interactive)    (interactive)
7279    (save-excursion    (vhdl-do-group 'vhdl-align-region spacing))
7280      (let ((start (point))  
7281            beg end)  (defun vhdl-align-list (&optional spacing)
7282        (setq end (if (re-search-forward "^\\s-*$" nil t)    "Align the lines of a list surrounded by a balanced group of parentheses."
7283                      (point-marker) (point-max)))    (interactive)
7284        (goto-char start)    (vhdl-do-list 'vhdl-align-region-groups spacing))
7285        (setq beg (if (re-search-backward "^\\s-*$" nil t) (point) (point-min)))  
7286        (untabify beg end)  (defun vhdl-align-same-indent (&optional spacing)
7287        (message "Aligning...")    "Align block of lines with same indent."
7288        (vhdl-fixup-whitespace-region beg end t)    (interactive)
7289        (vhdl-align-region beg end spacing)    (vhdl-do-same-indent 'vhdl-align-region-groups spacing))
7290        (vhdl-align-inline-comment-region-1 beg end)  
7291        (message "Aligning...done"))))  (defun vhdl-align-declarations (&optional spacing)
7292      "Align the lines within the declarative part of a design unit."
7293      (interactive)
7294      (let (beg end)
7295        (vhdl-prepare-search-2
7296         (save-excursion
7297           ;; search for declarative part
7298           (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t)
7299                      (not (member (upcase (match-string 1)) '("BEGIN" "END"))))
7300             (setq beg (point))
7301             (re-search-forward "^\\(begin\\|end\\)\\>" nil t)
7302             (setq end (point)))))
7303        (if beg
7304            (vhdl-align-region-groups beg end spacing)
7305          (error "ERROR:  Not within the declarative part of a design unit"))))
7306    
7307  (defun vhdl-align-noindent-buffer ()  (defun vhdl-align-buffer ()
7308    "Align buffer without indentation."    "Align buffer."
7309    (interactive)    (interactive)
7310    (vhdl-align-noindent-region (point-min) (point-max)))    (vhdl-align-region (point-min) (point-max)))
7311    
7312    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7313    ;; Align inline comments
7314    
7315    (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing)
7316      "Align inline comments in region."
7317      (save-excursion
7318        (let ((start-max comment-column)
7319              (length-max 0)
7320              comment-list start-list tmp-list start length
7321              cur-start prev-start no-code)
7322          (setq spacing (or spacing 2))
7323          (vhdl-prepare-search-2
7324           (goto-char beg)
7325           ;; search for comment start positions and lengths
7326           (while (< (point) end)
7327             (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7328                        (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$")
7329                        (not (save-excursion (goto-char (match-beginning 2))
7330                                             (vhdl-in-literal))))
7331               (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7332               (setq length (- (match-end 2) (match-beginning 2)))
7333               (setq start-max (max start start-max))
7334               (setq length-max (max length length-max))
7335               (setq comment-list (cons (cons start length) comment-list)))
7336             (beginning-of-line 2))
7337           (setq comment-list
7338                 (sort comment-list (function (lambda (a b) (> (car a) (car b))))))
7339           ;; reduce start positions
7340           (setq start-list (list (caar comment-list)))
7341           (setq comment-list (cdr comment-list))
7342           (while comment-list
7343             (unless (or (= (caar comment-list) (car start-list))
7344                         (<= (+ (car start-list) (cdar comment-list))
7345                                end-comment-column))
7346               (setq start-list (cons (caar comment-list) start-list)))
7347             (setq comment-list (cdr comment-list)))
7348           ;; align lines as nicely as possible
7349           (goto-char beg)
7350           (while (< (point) end)
7351             (setq cur-start nil)
7352             (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>"))
7353                        (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$")
7354                                 (not (save-excursion
7355                                        (goto-char (match-beginning 3))
7356                                        (vhdl-in-literal))))
7357                            (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$")
7358                                 (>= (- (match-end 2) (match-beginning 2))
7359                                     comment-column))))
7360               (setq start (+ (- (match-end 1) (match-beginning 1)) spacing))
7361               (setq length (- (match-end 3) (match-beginning 3)))
7362               (setq no-code (= (match-beginning 1) (match-end 1)))
7363               ;; insert minimum whitespace
7364               (goto-char (match-end 2))
7365               (delete-region (match-beginning 2) (match-end 2))
7366               (insert-char ?\  spacing)
7367               (setq tmp-list start-list)
7368               ;; insert additional whitespace to align
7369               (setq cur-start
7370                     (cond
7371                      ;; align comment-only line to inline comment of previous line
7372                      ((and no-code prev-start
7373                            (<= length (- end-comment-column prev-start)))
7374                       prev-start)
7375                      ;; align all comments at `start-max' if this is possible
7376                      ((<= (+ start-max length-max) end-comment-column)
7377                       start-max)
7378                      ;; align at `comment-column' if possible
7379                      ((and (<= start comment-column)
7380                            (<= length (- end-comment-column comment-column)))
7381                       comment-column)
7382                      ;; align at left-most possible start position otherwise
7383                      (t
7384                       (while (and tmp-list (< (car tmp-list) start))
7385                         (setq tmp-list (cdr tmp-list)))
7386                       (car tmp-list))))
7387               (indent-to cur-start))
7388             (setq prev-start cur-start)
7389             (beginning-of-line 2))))))
7390    
7391  (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)  (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message)
7392    "Align inline comments within a region.  Groups of code lines separated by    "Align inline comments within a region.  Groups of code lines separated by
7393  empty lines are aligned individually, if `vhdl-align-groups' is non-nil."  empty lines are aligned individually, if `vhdl-align-groups' is non-nil."
7394    (interactive "r\nP")    (interactive "r\nP")
7395    (save-excursion    (save-excursion
7396      (let (pos)      (let (orig pos)
7397        (goto-char beg)        (goto-char beg)
7398        (beginning-of-line)        (beginning-of-line)
7399          (setq orig (point-marker))
7400        (setq beg (point))        (setq beg (point))
7401        (goto-char end)        (goto-char end)
7402        (setq end (point-marker))        (setq end (point-marker))
# Line 5421  empty lines are aligned individually, if Line 7407  empty lines are aligned individually, if
7407            ;; align entire region            ;; align entire region
7408            (vhdl-align-inline-comment-region-1 beg end spacing)            (vhdl-align-inline-comment-region-1 beg end spacing)
7409          ;; align groups          ;; align groups
7410          (while (and (< beg end) (re-search-forward "^\\s-*$" end t))          (while (and (< beg end)
7411                        (re-search-forward vhdl-align-group-separate end t))
7412            (setq pos (point-marker))            (setq pos (point-marker))
7413            (vhdl-align-inline-comment-region-1 beg pos spacing)            (vhdl-align-inline-comment-region-1 beg pos spacing)
7414            (setq beg (1+ pos))            (setq beg (1+ pos))
7415            (goto-char beg))            (goto-char beg))
7416          ;; align last group          ;; align last group
7417          (when (< beg end)          (when (< beg end)
7418            (vhdl-align-inline-comment-region-1 beg end spacing))))            (vhdl-align-inline-comment-region-1 beg end spacing)))
7419      (unless no-message (message "Aligning inline comments...done"))))        (when vhdl-indent-tabs-mode
7420            (tabify orig end))
7421          (unless no-message (message "Aligning inline comments...done")))))
7422    
7423  (defun vhdl-align-inline-comment-group (&optional spacing)  (defun vhdl-align-inline-comment-group (&optional spacing)
7424    "Align inline comments within a group of lines between empty lines."    "Align inline comments within a group of lines between empty lines."
# Line 5437  empty lines are aligned individually, if Line 7426  empty lines are aligned individually, if
7426    (save-excursion    (save-excursion
7427      (let ((start (point))      (let ((start (point))
7428            beg end)            beg end)
7429        (setq end (if (re-search-forward "^\\s-*$" nil t)        (setq end (if (re-search-forward vhdl-align-group-separate nil t)
7430                      (point-marker) (point-max)))                      (point-marker) (point-max)))
7431        (goto-char start)        (goto-char start)
7432        (setq beg (if (re-search-backward "^\\s-*$" nil t) (point) (point-min)))        (setq beg (if (re-search-backward vhdl-align-group-separate nil t)
7433                        (point) (point-min)))
7434        (untabify beg end)        (untabify beg end)
7435        (message "Aligning inline comments...")        (message "Aligning inline comments...")
7436        (vhdl-align-inline-comment-region-1 beg end)        (vhdl-align-inline-comment-region-1 beg end)
7437          (when vhdl-indent-tabs-mode
7438            (tabify beg end))
7439        (message "Aligning inline comments...done"))))        (message "Aligning inline comments...done"))))
7440    
7441  (defun vhdl-align-inline-comment-buffer ()  (defun vhdl-align-inline-comment-buffer ()
# Line 5452  empty lines are aligned individually, if Line 7444  empty lines are aligned individually, if
7444    (interactive)    (interactive)
7445    (vhdl-align-inline-comment-region (point-min) (point-max)))    (vhdl-align-inline-comment-region (point-min) (point-max)))
7446    
7447    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7448    ;; Fixup whitespace
7449    
7450  (defun vhdl-fixup-whitespace-region (beg end &optional no-message)  (defun vhdl-fixup-whitespace-region (beg end &optional no-message)
7451    "Fixup whitespace in region.  Surround operator symbols by one space,    "Fixup whitespace in region.  Surround operator symbols by one space,
7452  eliminate multiple spaces (except at beginning of line), eliminate spaces at  eliminate multiple spaces (except at beginning of line), eliminate spaces at
7453  end of line, do nothing in comments."  end of line, do nothing in comments and strings."
7454    (interactive "r")    (interactive "r")
7455    (unless no-message (message "Fixing up whitespace..."))    (unless no-message (message "Fixing up whitespace..."))
7456    (save-excursion    (save-excursion
7457      (goto-char end)      (goto-char end)
7458      (setq end (point-marker))      (setq end (point-marker))
     ;; surround operator symbols by one space  
     (goto-char beg)  
     (while (re-search-forward "\\([^/:<>=]\\|^\\)\\(--\\|:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\)\\([^=>]\\|$\\)"  
                               end t)  
       (if (equal "--" (match-string 2))  
           (re-search-forward ".*\n" end t)  
         (replace-match "\\1 \\2 \\3")))  
7459      ;; have no space before and one space after `,' and ';'      ;; have no space before and one space after `,' and ';'
7460      (goto-char beg)      (goto-char beg)
7461      (while (re-search-forward "\\(--\\|\\s-*\\([,;]\\)\\)" end t)      (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t)
7462        (if (equal "--" (match-string 1))        (if (match-string 1)
7463            (re-search-forward ".*\n" end t)            (goto-char (match-end 1))
7464          (replace-match "\\2 " nil nil nil 1)))          (replace-match "\\3 " nil nil nil 3)))
7465        ;; have no space after `('
7466        (goto-char beg)
7467        (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\((\\)\\s-+" end t)
7468          (if (match-string 1)
7469              (goto-char (match-end 1))
7470            (replace-match "\\2")))
7471        ;; have no space before `)'
7472        (goto-char beg)
7473        (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t)
7474          (if (match-string 1)
7475              (goto-char (match-end 1))
7476            (replace-match "\\2")))
7477        ;; surround operator symbols by one space
7478        (goto-char beg)
7479        (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t)
7480          (if (match-string 1)
7481              (goto-char (match-end 1))
7482            (replace-match "\\3 \\4 \\5")
7483            (goto-char (match-end 4))))
7484      ;; eliminate multiple spaces and spaces at end of line      ;; eliminate multiple spaces and spaces at end of line
7485      (goto-char beg)      (goto-char beg)
7486      (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))      (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t))
7487                   (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t))
7488                 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)                 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t)
7489                      (progn (replace-match "" nil nil) t))                      (progn (replace-match "" nil nil) t))
7490                 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)                 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t)
7491                      (progn (replace-match ";" nil nil) t))                      (progn (replace-match ";" nil nil) t))
7492                 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))                 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t))
7493                 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)                 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t)
7494                      (progn (replace-match "  " nil nil) t ))                      (progn (replace-match "  " nil nil) t))
7495                 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)                 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t)
7496                      (progn (replace-match " " nil nil) t ))                      (progn (replace-match " " nil nil) t))
7497                 (re-search-forward "\\S-+" end t))))                 (re-search-forward "[^ \t-]+" end t))))
7498    (unless no-message (message "Fixing up whitespace...done")))    (unless no-message (message "Fixing up whitespace...done")))
7499    
7500  (defun vhdl-fixup-whitespace-buffer ()  (defun vhdl-fixup-whitespace-buffer ()
# Line 5496  end of line, do nothing in comments." Line 7504  end of line, do nothing in comments."
7504    (interactive)    (interactive)
7505    (vhdl-fixup-whitespace-region (point-min) (point-max)))    (vhdl-fixup-whitespace-region (point-min) (point-max)))
7506    
7507    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7508    ;; Beautify
7509    
7510  (defun vhdl-beautify-region (beg end)  (defun vhdl-beautify-region (beg end)
7511    "Beautify region by applying indentation, whitespace fixup, alignment, and    "Beautify region by applying indentation, whitespace fixup, alignment, and
7512  case fixing to a resion.  Calls functions `vhdl-indent-buffer',  case fixing to a region.  Calls functions `vhdl-indent-buffer',
7513  `vhdl-align-noindent-buffer' (variable `vhdl-align-groups' set to non-nil), and  `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and
7514  `vhdl-fix-case-buffer'."  `vhdl-fix-case-buffer'."
7515    (interactive "r")    (interactive "r")
7516      (setq end (save-excursion (goto-char end) (point-marker)))
7517    (vhdl-indent-region beg end nil)    (vhdl-indent-region beg end nil)
7518    (let ((vhdl-align-groups t))    (let ((vhdl-align-groups t))
7519      (vhdl-align-noindent-region beg end))      (vhdl-align-region beg end))
7520    (vhdl-fix-case-region beg end))    (vhdl-fix-case-region beg end))
7521    
7522  (defun vhdl-beautify-buffer ()  (defun vhdl-beautify-buffer ()
# Line 5512  case fixing to a resion.  Calls function Line 7524  case fixing to a resion.  Calls function
7524  case fixing to entire buffer.  Calls `vhdl-beautify-region' for the entire  case fixing to entire buffer.  Calls `vhdl-beautify-region' for the entire
7525  buffer."  buffer."
7526    (interactive)    (interactive)
7527    (vhdl-beautify-region (point-min) (point-max)))    (vhdl-beautify-region (point-min) (point-max))
7528      (when noninteractive (save-buffer)))
7529    
7530    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7531    ;; Code filling
7532    
7533    (defun vhdl-fill-region (beg end &optional arg)
7534      "Fill lines for a region of code."
7535      (interactive "r")
7536      (save-excursion
7537        (goto-char beg)
7538        (let ((margin (if (interactive-p) (current-indentation) (current-column))))
7539          (goto-char end)
7540          (setq end (point-marker))
7541          ;; remove inline comments, newlines and whitespace
7542          (vhdl-comment-kill-region beg end)
7543          (vhdl-comment-kill-inline-region beg end)
7544          (subst-char-in-region beg (1- end) ?\n ?\ )
7545          (vhdl-fixup-whitespace-region beg end)
7546          ;; wrap and end-comment-column
7547          (goto-char beg)
7548          (while (re-search-forward "\\s-" end t)
7549            (when(> (current-column) vhdl-end-comment-column)
7550              (backward-char)
7551              (when (re-search-backward "\\s-" beg t)
7552                (replace-match "\n")
7553                (indent-to margin)))))))
7554    
7555    (defun vhdl-fill-group ()
7556      "Fill group of lines between empty lines."
7557      (interactive)
7558      (vhdl-do-group 'vhdl-fill-region))
7559    
7560    (defun vhdl-fill-list ()
7561      "Fill the lines of a list surrounded by a balanced group of parentheses."
7562      (interactive)
7563      (vhdl-do-list 'vhdl-fill-region))
7564    
7565    (defun vhdl-fill-same-indent ()
7566      "Fill the lines of block of lines with same indent."
7567      (interactive)
7568      (vhdl-do-same-indent 'vhdl-fill-region))
7569    
7570    
7571    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7572    ;;; Code updating/fixing
7573    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7574    
7575    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7576    ;; Sensitivity list update
7577    
7578    ;; Strategy:
7579    ;; - no sensitivity list is generated for processes with wait statements
7580    ;; - otherwise, do the following:
7581    ;;   1. scan for all local signals (ports, signals declared in arch./blocks)
7582    ;;   2. scan for all signals already in the sensitivity list (in order to catch
7583    ;;      manually entered global signals)
7584    ;;   3. signals from 1. and 2. form the list of visible signals
7585    ;;   4. search for if/elsif conditions containing an event (sequential code)
7586    ;;   5. scan for strings that are within syntactical regions where signals are
7587    ;;      read but not within sequential code, and that correspond to visible
7588    ;;      signals
7589    ;;   6. replace sensitivity list by list of signals from 5.
7590    
7591    (defun vhdl-update-sensitivity-list-process ()
7592      "Update sensitivity list of current process."
7593      (interactive)
7594      (save-excursion
7595        (vhdl-prepare-search-2
7596         (end-of-line)
7597         ;; look whether in process
7598         (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t)
7599                       (equal (upcase (match-string 2)) "PROCESS")
7600                       (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t))))
7601             (error "ERROR:  Not within a process")
7602           (message "Updating sensitivity list...")
7603           (vhdl-update-sensitivity-list)
7604           (message "Updating sensitivity list...done")))))
7605    
7606    (defun vhdl-update-sensitivity-list-buffer ()
7607      "Update sensitivity list of all processes in current buffer."
7608      (interactive)
7609      (save-excursion
7610        (vhdl-prepare-search-2
7611         (goto-char (point-min))
7612         (message "Updating sensitivity lists...")
7613         (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t)
7614           (goto-char (match-beginning 0))
7615           (condition-case nil (vhdl-update-sensitivity-list) (error)))
7616         (message "Updating sensitivity lists...done"))))
7617    
7618    (defun vhdl-update-sensitivity-list ()
7619      "Update sensitivity list."
7620        (let ((proc-beg (point))
7621              (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
7622              (proc-mid (re-search-backward "^\\s-*begin\\>" nil t))
7623              seq-region-list)
7624          (cond
7625           ;; search for wait statement (no sensitivity list allowed)
7626           ((progn (goto-char proc-mid)
7627                   (vhdl-re-search-forward "\\<wait\\>" proc-end t))
7628            (error "ERROR:  Process with wait statement, sensitivity list not generated"))
7629           ;; combinational process (update sensitivity list)
7630           (t
7631            (let
7632                ;; scan for visible signals
7633                ((visible-list (vhdl-get-visible-signals))
7634                 ;; define syntactic regions where signals are read
7635                 (scan-regions-list
7636                  '(;; right-hand side of signal/variable assignment
7637                    ;; (special case: "<=" is relational operator in a condition)
7638                    ((re-search-forward "[<:]=" proc-end t)
7639                     (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t))
7640                    ;; if condition
7641                    ((re-search-forward "^\\s-*if\\>" proc-end t)
7642                     (re-search-forward "\\<then\\>" proc-end t))
7643                    ;; elsif condition
7644                    ((re-search-forward "\\<elsif\\>" proc-end t)
7645                     (re-search-forward "\\<then\\>" proc-end t))
7646                    ;; while loop condition
7647                    ((re-search-forward "^\\s-*while\\>" proc-end t)
7648                     (re-search-forward "\\<loop\\>" proc-end t))
7649                    ;; exit/next condition
7650                    ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t)
7651                     (re-search-forward ";" proc-end t))
7652                    ;; assert condition
7653                    ((re-search-forward "\\<assert\\>" proc-end t)
7654                     (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t))
7655                    ;; case expression
7656                    ((re-search-forward "^\\s-*case\\>" proc-end t)
7657                     (re-search-forward "\\<is\\>" proc-end t))
7658                    ;; parameter list of procedure call
7659                    ((re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t)
7660                     (progn (backward-char) (forward-sexp) (point)))))
7661                 name read-list sens-list signal-list
7662                 sens-beg sens-end beg end margin)
7663              ;; scan for signals in old sensitivity list
7664              (goto-char proc-beg)
7665              (re-search-forward "\\<process\\>" proc-mid t)
7666              (if (not (looking-at "[ \t\n]*("))
7667                  (setq sens-beg (point))
7668                (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t))
7669                (goto-char (match-end 1))
7670                (forward-sexp)
7671                (setq sens-end (1- (point)))
7672                (goto-char sens-beg)
7673                (while (and (re-search-forward "\\(\\w+\\)" sens-end t)
7674                            (setq sens-list
7675                                  (cons (downcase (match-string 0)) sens-list))
7676                            (re-search-forward "\\s-*,\\s-*" sens-end t))))
7677              (setq signal-list (append visible-list sens-list))
7678              ;; search for sequential parts
7679              (goto-char proc-mid)
7680              (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t))
7681                (setq end (re-search-forward "\\<then\\>" proc-end t))
7682                (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t)
7683                  (goto-char end)
7684                  (backward-word 1)
7685                  (vhdl-forward-sexp)
7686                  (setq seq-region-list (cons (cons end (point)) seq-region-list))
7687                  (beginning-of-line)))
7688              ;; scan for signals read in process
7689              (while scan-regions-list
7690                (goto-char proc-mid)
7691                (while (and (setq beg (eval (nth 0 (car scan-regions-list))))
7692                            (setq end (eval (nth 1 (car scan-regions-list)))))
7693                  (goto-char beg)
7694                  (unless (or (vhdl-in-literal)
7695                              (and seq-region-list
7696                                   (let ((tmp-list seq-region-list))
7697                                     (while (and tmp-list
7698                                                 (< (point) (caar tmp-list)))
7699                                       (setq tmp-list (cdr tmp-list)))
7700                                     (and tmp-list (< (point) (cdar tmp-list))))))
7701                    (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>" end t)
7702                      (setq name (match-string 1))
7703                      (when (member (downcase name) signal-list)
7704                        (add-to-list 'read-list name)))))
7705                (setq scan-regions-list (cdr scan-regions-list)))
7706              ;; update sensitivity list
7707              (goto-char sens-beg)
7708              (if sens-end
7709                  (delete-region sens-beg sens-end)
7710                (when read-list
7711                  (insert " ()") (backward-char)))
7712              (setq read-list (sort read-list 'string<))
7713              (when read-list
7714                (setq margin (current-column))
7715                (insert (car read-list))
7716                (setq read-list (cdr read-list))
7717                (while read-list
7718                  (insert ",")
7719                  (if (<= (+ (current-column) (length (car read-list)) 2)
7720                          end-comment-column)
7721                      (insert " ")
7722                    (insert "\n") (indent-to margin))
7723                  (insert (car read-list))
7724                  (setq read-list (cdr read-list)))))))))
7725    
7726    (defun vhdl-get-visible-signals ()
7727      "Get all signals visible in the current block."
7728      (save-excursion
7729        (let (beg end signal-list entity-name file-name)
7730          ;; search for signals declared in surrounding block declarative parts
7731          (save-excursion
7732            (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t))
7733                                           (match-string 2))
7734                                 (goto-char (match-end 2))
7735                                 (vhdl-backward-sexp)
7736                                 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t))
7737                               beg)
7738                        (setq end (re-search-forward "^\\s-*begin\\>" nil t)))
7739              ;; scan for all declared signal names
7740              (goto-char beg)
7741              (while (re-search-forward "^\\s-*signal\\>" end t)
7742                (while (and (not (looking-at "[ \t\n]*:"))
7743                            (re-search-forward "[ \t\n,]+\\(\\w+\\)" end t))
7744                  (setq signal-list
7745                        (cons (downcase (match-string 1)) signal-list))))
7746              (goto-char beg)))
7747          ;; search for signals declared in architecture declarative part
7748          (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t))
7749                        (not (equal "END" (upcase (match-string 1))))
7750                        (setq entity-name (match-string 2))
7751                        (setq end (re-search-forward "^begin\\>" nil t))))
7752              (error "ERROR:  No architecture declarative part found")
7753            ;; scan for all declared signal names
7754            (goto-char beg)
7755            (while (re-search-forward "^\\s-*signal\\>" end t)
7756              (while (and (not (looking-at "[ \t\n]*:"))
7757                          (re-search-forward "[ \t\n,]+\\(\\w+\\)" end t))
7758                (setq signal-list
7759                      (cons (downcase (match-string 1)) signal-list)))))
7760          ;; search for signals declared in entity port clause
7761          (goto-char (point-min))
7762          (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)
7763            (setq file-name
7764                  (concat (vhdl-replace-string vhdl-entity-file-name entity-name)
7765                          "." (file-name-extension (buffer-file-name)))))
7766          (vhdl-visit-file
7767           file-name t
7768           (vhdl-prepare-search-2
7769            (goto-char (point-min))
7770            (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t))
7771                (error "ERROR:  Entity \"%s\" not found:\n  --> see option `vhdl-entity-file-name'" entity-name)
7772              (when (setq beg (re-search-forward
7773                               "^\\s-*port[ \t\n]*("
7774                               (save-excursion
7775                                 (re-search-forward "^end\\>" nil t)) t))
7776                (setq end (save-excursion
7777                            (backward-char) (forward-sexp) (point)))
7778                (vhdl-forward-syntactic-ws)
7779                (while (< (point) end)
7780                  (while (and (not (looking-at "[ \t\n]*:"))
7781                              (re-search-forward "[ \t\n,]*\\(\\w+\\)" end t))
7782                    (setq signal-list
7783                          (cons (downcase (match-string 1)) signal-list)))
7784                  (re-search-forward ";" end 1)
7785                  (vhdl-forward-syntactic-ws))))))
7786          signal-list)))
7787    
7788    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7789    ;; Generic/port clause fixing
7790    
7791    (defun vhdl-fix-clause ()
7792      "Fix closing parenthesis within generic/port clause."
7793      (interactive)
7794      (save-excursion
7795        (vhdl-prepare-search-2
7796         (let ((pos (point))
7797               beg end)
7798           (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t))
7799               (error "ERROR:  Not within a generic/port clause")
7800             ;; search for end of clause
7801             (goto-char (match-end 0))
7802             (setq beg (1- (point)))
7803             (vhdl-forward-syntactic-ws)
7804             (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;")
7805               (goto-char (1- (match-end 0)))
7806               (setq end (point-marker))
7807               (forward-char)
7808               (vhdl-forward-syntactic-ws))
7809             (goto-char end)
7810             (when (> pos (save-excursion (end-of-line) (point)))
7811               (error "ERROR:  Not within a generic/port clause"))
7812             ;; delete closing parenthesis on separate line (not supported style)
7813             (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
7814               (vhdl-line-kill)
7815               (vhdl-backward-syntactic-ws)
7816               (setq end (point-marker))
7817               (insert ";"))
7818             ;; delete superfluous parentheses
7819             (while (progn (goto-char beg)
7820                           (condition-case () (forward-sexp)
7821                             (error (goto-char (point-max))))
7822                           (< (point) end))
7823               (delete-backward-char 1))
7824             ;; add closing parenthesis
7825             (when (> (point) end)
7826               (goto-char end)
7827               (insert ")")))))))
7828    
7829    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7830    ;; Miscellaneous
7831    
7832    (defun vhdl-remove-trailing-spaces ()
7833      "Remove trailing spaces in the whole buffer."
7834      (interactive)
7835      (save-match-data
7836        (save-excursion
7837          (goto-char (point-min))
7838          (while (re-search-forward "[ \t]+$" (point-max) t)
7839            (unless (vhdl-in-literal)
7840              (replace-match "" nil nil))))))
7841    
7842    
7843  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 5527  buffer." Line 7852  buffer."
7852  Used for undoing after template abortion.")  Used for undoing after template abortion.")
7853    
7854  ;; correct different behavior of function `unread-command-events' in XEmacs  ;; correct different behavior of function `unread-command-events' in XEmacs
7855    (defun vhdl-character-to-event (arg))
7856  (defalias 'vhdl-character-to-event  (defalias 'vhdl-character-to-event
7857    (if (string-match "XEmacs" emacs-version) 'character-to-event 'identity))    (if vhdl-xemacs 'character-to-event 'identity))
7858    
7859    (defun vhdl-work-library ()
7860      "Return the working library name of the current project or \"work\" if no
7861    project is defined."
7862      (vhdl-resolve-env-variable
7863       (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library)))
7864    
7865  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7866  ;;  Enabling/disabling  ;;  Enabling/disabling
# Line 5539  Used for undoing after template abortion Line 7871  Used for undoing after template abortion
7871                            (and (or vhdl-electric-mode vhdl-stutter-mode) "/")                            (and (or vhdl-electric-mode vhdl-stutter-mode) "/")
7872                            (and vhdl-electric-mode "e")                            (and vhdl-electric-mode "e")
7873                            (and vhdl-stutter-mode "s")))                            (and vhdl-stutter-mode "s")))
7874    (force-mode-line-update))    (force-mode-line-update t))
7875    
7876  (defun vhdl-electric-mode (arg)  (defun vhdl-electric-mode (arg)
7877    "Toggle VHDL electric mode.    "Toggle VHDL electric mode.
# Line 5566  Turn on if ARG positive, turn off if ARG Line 7898  Turn on if ARG positive, turn off if ARG
7898    "-- starts a comment, --- draws a horizontal line,    "-- starts a comment, --- draws a horizontal line,
7899  ---- starts a display comment"  ---- starts a display comment"
7900    (interactive "p")    (interactive "p")
7901    (if vhdl-stutter-mode    (if (and vhdl-stutter-mode (not (vhdl-in-literal)))
7902        (cond        (cond
7903         ((and abbrev-start-location (= abbrev-start-location (point)))         ((and abbrev-start-location (= abbrev-start-location (point)))
7904          (setq abbrev-start-location nil)          (setq abbrev-start-location nil)
# Line 5595  Turn on if ARG positive, turn off if ARG Line 7927  Turn on if ARG positive, turn off if ARG
7927    
7928  (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"  (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['"
7929    (interactive "p")    (interactive "p")
7930    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7931        (if (= (preceding-char) ?\()        (if (= (preceding-char) ?\()
7932            (progn (delete-char -1) (insert-char ?\[ 1))            (progn (delete-char -1) (insert-char ?\[ 1))
7933          (insert-char ?\( 1))          (insert-char ?\( 1))
# Line 5603  Turn on if ARG positive, turn off if ARG Line 7935  Turn on if ARG positive, turn off if ARG
7935    
7936  (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"  (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'"
7937    (interactive "p")    (interactive "p")
7938    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7939        (progn        (progn
7940          (if (= (preceding-char) ?\))          (if (= (preceding-char) ?\))
7941              (progn (delete-char -1) (insert-char ?\] 1))              (progn (delete-char -1) (insert-char ?\] 1))
# Line 5613  Turn on if ARG positive, turn off if ARG Line 7945  Turn on if ARG positive, turn off if ARG
7945    
7946  (defun vhdl-electric-quote (count) "'' --> \""  (defun vhdl-electric-quote (count) "'' --> \""
7947    (interactive "p")    (interactive "p")
7948    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7949        (if (= (preceding-char) last-input-char)        (if (= (preceding-char) last-input-char)
7950            (progn (delete-backward-char 1) (insert-char ?\" 1))            (progn (delete-backward-char 1) (insert-char ?\" 1))
7951          (insert-char ?\' 1))          (insert-char ?\' 1))
# Line 5621  Turn on if ARG positive, turn off if ARG Line 7953  Turn on if ARG positive, turn off if ARG
7953    
7954  (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"  (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
7955    (interactive "p")    (interactive "p")
7956    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7957        (cond ((= (preceding-char) last-input-char)        (cond ((= (preceding-char) last-input-char)
7958               (progn (delete-char -1)               (progn (delete-char -1)
7959                      (when (not (eq (preceding-char) ? )) (insert " "))                      (unless (eq (preceding-char) ? ) (insert " "))
7960                      (insert ": ")                      (insert ": ")
7961                      (setq this-command 'vhdl-electric-colon)))                      (setq this-command 'vhdl-electric-colon)))
7962              ((and              ((and
# Line 5635  Turn on if ARG positive, turn off if ARG Line 7967  Turn on if ARG positive, turn off if ARG
7967    
7968  (defun vhdl-electric-comma (count) "',,' --> ' <= '"  (defun vhdl-electric-comma (count) "',,' --> ' <= '"
7969    (interactive "p")    (interactive "p")
7970    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7971        (cond ((= (preceding-char) last-input-char)        (cond ((= (preceding-char) last-input-char)
7972               (progn (delete-char -1)               (progn (delete-char -1)
7973                      (when (not (eq (preceding-char) ? )) (insert " "))                      (unless (eq (preceding-char) ? ) (insert " "))
7974                      (insert "<= ")))                      (insert "<= ")))
7975              (t (insert-char ?\, 1)))              (t (insert-char ?\, 1)))
7976      (self-insert-command count)))      (self-insert-command count)))
7977    
7978  (defun vhdl-electric-period (count) "'..' --> ' => '"  (defun vhdl-electric-period (count) "'..' --> ' => '"
7979    (interactive "p")    (interactive "p")
7980    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7981        (cond ((= (preceding-char) last-input-char)        (cond ((= (preceding-char) last-input-char)
7982               (progn (delete-char -1)               (progn (delete-char -1)
7983                      (when (not (eq (preceding-char) ? )) (insert " "))                      (unless (eq (preceding-char) ? ) (insert " "))
7984                      (insert "=> ")))                      (insert "=> ")))
7985              (t (insert-char ?\. 1)))              (t (insert-char ?\. 1)))
7986      (self-insert-command count)))      (self-insert-command count)))
7987    
7988  (defun vhdl-electric-equal (count) "'==' --> ' == '"  (defun vhdl-electric-equal (count) "'==' --> ' == '"
7989    (interactive "p")    (interactive "p")
7990    (if (and vhdl-stutter-mode (= count 1))    (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
7991        (cond ((= (preceding-char) last-input-char)        (cond ((= (preceding-char) last-input-char)
7992               (progn (delete-char -1)               (progn (delete-char -1)
7993                      (when (not (eq (preceding-char) ? )) (insert " "))                      (unless (eq (preceding-char) ? ) (insert " "))
7994                      (insert "== ")))                      (insert "== ")))
7995              (t (insert-char ?\= 1)))              (t (insert-char ?\= 1)))
7996      (self-insert-command count)))      (self-insert-command count)))
# Line 5682  Turn on if ARG positive, turn off if ARG Line 8014  Turn on if ARG positive, turn off if ARG
8014        (unless (vhdl-template-field        (unless (vhdl-template-field
8015                 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")                 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
8016                 nil t)                 nil t)
8017          (backward-delete-char 3))          (delete-backward-char 3))
8018        (vhdl-insert-keyword " IS ")        (vhdl-insert-keyword " IS ")
8019        (vhdl-template-field "name" ";")        (vhdl-template-field "name" ";")
8020        (vhdl-comment-insert-inline))))        (vhdl-comment-insert-inline))))
# Line 5692  Turn on if ARG positive, turn off if ARG Line 8024  Turn on if ARG positive, turn off if ARG
8024    (interactive)    (interactive)
8025    (let ((margin (current-indentation))    (let ((margin (current-indentation))
8026          (start (point))          (start (point))
8027          arch-name entity-exists string          arch-name)
         (case-fold-search t))  
8028      (vhdl-insert-keyword "ARCHITECTURE ")      (vhdl-insert-keyword "ARCHITECTURE ")
8029      (when (setq arch-name      (when (setq arch-name
8030                  (vhdl-template-field "name" nil t start (point)))                  (vhdl-template-field "name" nil t start (point)))
8031        (vhdl-insert-keyword " OF ")        (vhdl-insert-keyword " OF ")
8032        (save-excursion        (if (save-excursion
8033          (vhdl-ext-syntax-table              (vhdl-prepare-search-1
8034           (setq entity-exists (re-search-backward               (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t)))
8035                                "\\<entity \\(\\w+\\) is\\>" nil t))            (insert (match-string 1))
          (setq string (match-string 1))))  
       (if (and entity-exists (not (equal string "")))  
           (insert string)  
8036          (vhdl-template-field "entity name"))          (vhdl-template-field "entity name"))
8037        (vhdl-insert-keyword " IS")        (vhdl-insert-keyword " IS\n")
8038        (vhdl-template-begin-end        (vhdl-template-begin-end
8039         (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin         (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin
8040         (memq vhdl-insert-empty-lines '(unit all))))))         (memq vhdl-insert-empty-lines '(unit all))))))
# Line 5785  Turn on if ARG positive, turn off if ARG Line 8113  Turn on if ARG positive, turn off if ARG
8113            (insert ")")            (insert ")")
8114          (delete-char -2))          (delete-char -2))
8115        (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))        (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8116          (insert "\n")
8117        (vhdl-template-begin-end "BLOCK" label margin)        (vhdl-template-begin-end "BLOCK" label margin)
8118        (vhdl-comment-block))))        (vhdl-comment-block))))
8119    
# Line 5896  since these are almost equivalent)." Line 8225  since these are almost equivalent)."
8225          name end-column)          name end-column)
8226      (vhdl-insert-keyword "COMPONENT ")      (vhdl-insert-keyword "COMPONENT ")
8227      (when (setq name (vhdl-template-field "name" nil t start (point)))      (when (setq name (vhdl-template-field "name" nil t start (point)))
8228          (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
8229        (insert "\n\n")        (insert "\n\n")
8230        (indent-to margin)        (indent-to margin)
8231        (vhdl-insert-keyword "END COMPONENT")        (vhdl-insert-keyword "END COMPONENT")
# Line 5919  since these are almost equivalent)." Line 8249  since these are almost equivalent)."
8249          unit position)          unit position)
8250      (when (vhdl-template-field "instance label" nil t start (point))      (when (vhdl-template-field "instance label" nil t start (point))
8251        (insert ": ")        (insert ": ")
8252        (if (vhdl-standard-p '87)        (if (not (vhdl-use-direct-instantiation))
8253            (vhdl-template-field "component name")            (vhdl-template-field "component name")
8254          ;; direct instantiation          ;; direct instantiation
8255          (setq unit (vhdl-template-field          (setq unit (vhdl-template-field
8256                      "[COMPONENT | ENTITY | CONFIGURATION]" " " t))                      "[COMPONENT | ENTITY | CONFIGURATION]" " " t))
8257          (setq unit (upcase (or unit "")))          (setq unit (upcase (or unit "")))
8258          (cond ((equal unit "ENTITY")          (cond ((equal unit "ENTITY")
8259                 (vhdl-template-field "library name" "." nil nil nil nil "work")                 (vhdl-template-field "library name" "." nil nil nil nil
8260                                        (vhdl-work-library))
8261                 (vhdl-template-field "entity name" "(")                 (vhdl-template-field "entity name" "(")
8262                 (if (vhdl-template-field "[architecture name]" nil t)                 (if (vhdl-template-field "[architecture name]" nil t)
8263                     (insert ")")                     (insert ")")
8264                   (delete-char -1)))                   (delete-char -1)))
8265                ((equal unit "CONFIGURATION")                ((equal unit "CONFIGURATION")
8266                 (vhdl-template-field "library name" "." nil nil nil nil "work")                 (vhdl-template-field "library name" "." nil nil nil nil
8267                                        (vhdl-work-library))
8268                 (vhdl-template-field "configuration name"))                 (vhdl-template-field "configuration name"))
8269                (t (vhdl-template-field "component name"))))                (t (vhdl-template-field "component name"))))
8270        (insert "\n")        (insert "\n")
# Line 5976  since these are almost equivalent)." Line 8308  since these are almost equivalent)."
8308          (when vhdl-conditions-in-parenthesis (insert "(")))          (when vhdl-conditions-in-parenthesis (insert "(")))
8309        (delete-region position (point))        (delete-region position (point))
8310        (insert ";")        (insert ";")
8311        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1)))))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
8312    
8313  (defun vhdl-template-configuration ()  (defun vhdl-template-configuration ()
8314    "Insert a configuration specification if within an architecture,    "Insert a configuration specification if within an architecture,
8315  a block or component configuration if within a configuration declaration,  a block or component configuration if within a configuration declaration,
8316  a configuration declaration if not within a design unit."  a configuration declaration if not within a design unit."
8317    (interactive)    (interactive)
8318    (let ((case-fold-search t))    (vhdl-prepare-search-1
8319      (vhdl-ext-syntax-table     (cond
8320       (cond      ((and (save-excursion               ; architecture body
8321        ((and (save-excursion             ; architecture body              (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))
8322                (re-search-backward "^\\(architecture\\|end\\)\\>" nil t))            (equal "ARCHITECTURE" (upcase (match-string 1))))
8323              (equal "ARCHITECTURE" (upcase (match-string 1))))       (vhdl-template-configuration-spec))
8324         (vhdl-template-configuration-spec))      ((and (save-excursion               ; configuration declaration
8325        ((and (save-excursion             ; configuration declaration              (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8326                (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))            (equal "CONFIGURATION" (upcase (match-string 1))))
8327              (equal "CONFIGURATION" (upcase (match-string 1))))       (if (eq (vhdl-decision-query
8328         (if (eq (vhdl-decision-query                "configuration" "(b)lock or (c)omponent configuration?" t) ?c)
8329                  "configuration" "(b)lock or (c)omponent configuration?" t) ?c)           (vhdl-template-component-conf)
8330             (vhdl-template-component-conf)         (vhdl-template-block-configuration)))
8331           (vhdl-template-block-configuration)))      (t (vhdl-template-configuration-decl))))) ; otherwise
       (t (vhdl-template-configuration-decl)))))) ; otherwise  
8332    
8333  (defun vhdl-template-configuration-spec (&optional optional-use)  (defun vhdl-template-configuration-spec (&optional optional-use)
8334    "Insert a configuration specification."    "Insert a configuration specification."
# Line 6006  a configuration declaration if not withi Line 8337  a configuration declaration if not withi
8337          (start (point))          (start (point))
8338          aspect position)          aspect position)
8339      (vhdl-insert-keyword "FOR ")      (vhdl-insert-keyword "FOR ")
8340      (when (vhdl-template-field "component names | OTHERS | ALL" " : "      (when (vhdl-template-field "instance names | OTHERS | ALL" " : "
8341                                 t start (point))                                 t start (point))
8342        (vhdl-template-field "component type" "\n")        (vhdl-template-field "component name" "\n")
8343        (indent-to (+ margin vhdl-basic-offset))        (indent-to (+ margin vhdl-basic-offset))
8344        (setq start (point))        (setq start (point))
8345        (vhdl-insert-keyword "USE ")        (vhdl-insert-keyword "USE ")
# Line 6021  a configuration declaration if not withi Line 8352  a configuration declaration if not withi
8352                          "ENTITY | CONFIGURATION | OPEN" " ")))                          "ENTITY | CONFIGURATION | OPEN" " ")))
8353          (setq aspect (upcase (or aspect "")))          (setq aspect (upcase (or aspect "")))
8354          (cond ((equal aspect "ENTITY")          (cond ((equal aspect "ENTITY")
8355                 (vhdl-template-field "library name" "." nil nil nil nil "work")                 (vhdl-template-field "library name" "." nil nil nil nil
8356                                        (vhdl-work-library))
8357                 (vhdl-template-field "entity name" "(")                 (vhdl-template-field "entity name" "(")
8358                 (if (vhdl-template-field "[architecture name]" nil t)                 (if (vhdl-template-field "[architecture name]" nil t)
8359                     (insert ")")                     (insert ")")
# Line 6041  a configuration declaration if not withi Line 8373  a configuration declaration if not withi
8373                 (insert ";")                 (insert ";")
8374                 t)                 t)
8375                ((equal aspect "CONFIGURATION")                ((equal aspect "CONFIGURATION")
8376                 (vhdl-template-field "library name" "." nil nil nil nil "work")                 (vhdl-template-field "library name" "." nil nil nil nil
8377                                        (vhdl-work-library))
8378                 (vhdl-template-field "configuration name" ";"))                 (vhdl-template-field "configuration name" ";"))
8379                (t (backward-delete-char 1) (insert ";") t))))))                (t (delete-backward-char 1) (insert ";") t))))))
8380    
8381    
8382  (defun vhdl-template-configuration-decl ()  (defun vhdl-template-configuration-decl ()
# Line 6051  a configuration declaration if not withi Line 8384  a configuration declaration if not withi
8384    (interactive)    (interactive)
8385    (let ((margin (current-indentation))    (let ((margin (current-indentation))
8386          (start (point))          (start (point))
         (case-fold-search t)  
8387          entity-exists string name position)          entity-exists string name position)
8388      (vhdl-insert-keyword "CONFIGURATION ")      (vhdl-insert-keyword "CONFIGURATION ")
8389      (when (setq name (vhdl-template-field "name" nil t start (point)))      (when (setq name (vhdl-template-field "name" nil t start (point)))
8390        (vhdl-insert-keyword " OF ")        (vhdl-insert-keyword " OF ")
8391        (save-excursion        (save-excursion
8392          (vhdl-ext-syntax-table          (vhdl-prepare-search-1
8393           (setq entity-exists (re-search-backward           (setq entity-exists (vhdl-re-search-backward
8394                                "\\<entity \\(\\w*\\) is\\>" nil t))                                "\\<entity \\(\\w*\\) is\\>" nil t))
8395           (setq string (match-string 1))))           (setq string (match-string 1))))
8396        (if (and entity-exists (not (equal string "")))        (if (and entity-exists (not (equal string "")))
# Line 6114  a configuration declaration if not withi Line 8446  a configuration declaration if not withi
8446    (backward-word 1)    (backward-word 1)
8447    (vhdl-case-word 1)    (vhdl-case-word 1)
8448    (forward-char 1)    (forward-char 1)
8449    (vhdl-indent-line))    (indent-according-to-mode))
8450    
8451  (defun vhdl-template-disconnect ()  (defun vhdl-template-disconnect ()
8452    "Insert a disconnect statement."    "Insert a disconnect statement."
# Line 6130  a configuration declaration if not withi Line 8462  a configuration declaration if not withi
8462  (defun vhdl-template-else ()  (defun vhdl-template-else ()
8463    "Insert an else statement."    "Insert an else statement."
8464    (interactive)    (interactive)
8465    (let ((case-fold-search t)    (let (margin)
8466          margin)      (vhdl-prepare-search-1
     (vhdl-ext-syntax-table  
8467       (vhdl-insert-keyword "ELSE")       (vhdl-insert-keyword "ELSE")
8468       (if (save-excursion       (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t))
8469             (re-search-backward "\\(\\<when\\>\\|;\\)" nil t)                (equal "WHEN" (upcase (match-string 1))))
            (equal "WHEN" (upcase (match-string 1))))  
8470           (insert " ")           (insert " ")
8471         (vhdl-indent-line)         (indent-according-to-mode)
8472         (setq margin (current-indentation))         (setq margin (current-indentation))
8473         (insert "\n")         (insert "\n")
8474         (indent-to (+ margin vhdl-basic-offset))))))         (indent-to (+ margin vhdl-basic-offset))))))
# Line 6149  a configuration declaration if not withi Line 8479  a configuration declaration if not withi
8479    (let ((start (point))    (let ((start (point))
8480          margin)          margin)
8481      (vhdl-insert-keyword "ELSIF ")      (vhdl-insert-keyword "ELSIF ")
8482      (when vhdl-conditions-in-parenthesis (insert "("))      (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams))
8483      (when (vhdl-template-field "condition" nil t start (point))        (when vhdl-conditions-in-parenthesis (insert "("))
8484        (when vhdl-conditions-in-parenthesis (insert ")"))        (when (vhdl-template-field "condition" nil t start (point))
8485        (vhdl-indent-line)          (when vhdl-conditions-in-parenthesis (insert ")"))
8486        (setq margin (current-indentation))          (indent-according-to-mode)
8487        (vhdl-insert-keyword          (setq margin (current-indentation))
8488         (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))          (vhdl-insert-keyword
8489        (indent-to (+ margin vhdl-basic-offset)))))           (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n"))
8490            (indent-to (+ margin vhdl-basic-offset))))))
8491    
8492  (defun vhdl-template-entity ()  (defun vhdl-template-entity ()
8493    "Insert an entity."    "Insert an entity."
# Line 6190  a configuration declaration if not withi Line 8521  a configuration declaration if not withi
8521    (interactive)    (interactive)
8522    (let ((start (point)))    (let ((start (point)))
8523      (vhdl-insert-keyword "EXIT ")      (vhdl-insert-keyword "EXIT ")
8524      (unless (vhdl-template-field "[loop label]" nil t)      (if (vhdl-template-field "[loop label]" nil t start (point))
8525            (let ((position (point)))
8526              (vhdl-insert-keyword " WHEN ")
8527              (when vhdl-conditions-in-parenthesis (insert "("))
8528              (if (vhdl-template-field "[condition]" nil t)
8529                  (when vhdl-conditions-in-parenthesis (insert ")"))
8530                (delete-region position (point))))
8531        (delete-char -1))        (delete-char -1))
     (let ((position (point)))  
       (vhdl-insert-keyword " WHEN ")  
       (when vhdl-conditions-in-parenthesis (insert "("))  
       (if (vhdl-template-field "[condition]" nil t)  
           (when vhdl-conditions-in-parenthesis (insert ")"))  
         (delete-region position (point))))  
8532      (insert ";")))      (insert ";")))
8533    
8534  (defun vhdl-template-file ()  (defun vhdl-template-file ()
# Line 6212  a configuration declaration if not withi Line 8543  a configuration declaration if not withi
8543          (vhdl-insert-keyword " OPEN ")          (vhdl-insert-keyword " OPEN ")
8544          (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"          (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
8545                                       nil t)                                       nil t)
8546            (backward-delete-char 6)))            (delete-backward-char 6)))
8547        (vhdl-insert-keyword " IS ")        (vhdl-insert-keyword " IS ")
8548        (when (vhdl-standard-p '87)        (when (vhdl-standard-p '87)
8549          (vhdl-template-field "[IN | OUT]" " " t))          (vhdl-template-field "[IN | OUT]" " " t))
# Line 6223  a configuration declaration if not withi Line 8554  a configuration declaration if not withi
8554  (defun vhdl-template-for ()  (defun vhdl-template-for ()
8555    "Insert a block or component configuration if within a configuration    "Insert a block or component configuration if within a configuration
8556  declaration, a configuration specification if within an architecture  declaration, a configuration specification if within an architecture
8557  declarative part (and not within a subprogram), and a for-loop otherwise."  declarative part (and not within a subprogram), a for-loop if within a
8558    sequential statement part (subprogram or process), and a for-generate
8559    otherwise."
8560    (interactive)    (interactive)
8561    (let ((case-fold-search t))    (vhdl-prepare-search-1
8562      (vhdl-ext-syntax-table     (cond
8563       (cond      ((vhdl-sequential-statement-p)      ; sequential statement
8564        ((and (save-excursion             ; configuration declaration       (vhdl-template-for-loop))
8565                (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))      ((and (save-excursion               ; configuration declaration
8566              (equal "CONFIGURATION" (upcase (match-string 1))))              (re-search-backward "^\\(configuration\\|end\\)\\>" nil t))
8567         (if (eq (vhdl-decision-query            (equal "CONFIGURATION" (upcase (match-string 1))))
8568                  "for" "(b)lock or (c)omponent configuration?" t) ?c)       (if (eq (vhdl-decision-query
8569             (vhdl-template-component-conf)                "for" "(b)lock or (c)omponent configuration?" t) ?c)
8570           (vhdl-template-block-configuration)))           (vhdl-template-component-conf)
8571        ((and (save-excursion         (vhdl-template-block-configuration)))
8572                (re-search-backward       ; architecture declarative part      ((and (save-excursion
8573                 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))              (re-search-backward         ; architecture declarative part
8574              (equal "ARCHITECTURE" (upcase (match-string 1)))               "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t))
8575              (not (and (save-excursion   ; not subprogram            (equal "ARCHITECTURE" (upcase (match-string 1))))
8576                          (re-search-backward       (vhdl-template-configuration-spec))
8577                           "^\\s-*\\(architecture\\|begin\\|end\\)\\>" nil t))      (t (vhdl-template-for-generate))))) ; concurrent statement
                       (equal "BEGIN" (upcase (match-string 1)))  
                       (save-excursion  
                         (re-search-backward  
                          "^\\s-*\\(function\\|procedure\\)\\>" nil t)))))  
        (vhdl-template-configuration-spec))  
       ((vhdl-sequential-statement-p)    ; sequential statement  
        (vhdl-template-for-loop))  
       (t (vhdl-template-for-generate)))))) ; concurrent statement  
8578    
8579  (defun vhdl-template-for-generate ()  (defun vhdl-template-for-generate ()
8580    "Insert a for-generate."    "Insert a for-generate."
8581    (interactive)    (interactive)
8582    (let ((margin (current-indentation))    (let ((margin (current-indentation))
8583          (start (point))          (start (point))
8584          label string position)          label position)
8585      (vhdl-insert-keyword ": FOR ")      (vhdl-insert-keyword ": FOR ")
8586      (setq position (point-marker))      (setq position (point-marker))
8587      (goto-char start)      (goto-char start)
# Line 6295  declarative part (and not within a subpr Line 8620  declarative part (and not within a subpr
8620        (forward-line -1)        (forward-line -1)
8621        (indent-to (+ margin vhdl-basic-offset)))))        (indent-to (+ margin vhdl-basic-offset)))))
8622    
 (defun vhdl-template-footer ()  
   "Insert a VHDL file footer."  
   (interactive)  
   (unless (equal vhdl-file-footer "")  
     (save-excursion  
       (goto-char (point-max))  
       (insert "\n")  
       (vhdl-insert-string-or-file vhdl-file-footer))))  
   
8623  (defun vhdl-template-function (&optional kind)  (defun vhdl-template-function (&optional kind)
8624    "Insert a function declaration or body."    "Insert a function declaration or body."
8625    (interactive)    (interactive)
# Line 6313  declarative part (and not within a subpr Line 8629  declarative part (and not within a subpr
8629      (vhdl-insert-keyword "FUNCTION ")      (vhdl-insert-keyword "FUNCTION ")
8630      (when (setq name (vhdl-template-field "name" nil t start (point)))      (when (setq name (vhdl-template-field "name" nil t start (point)))
8631        (vhdl-template-argument-list t)        (vhdl-template-argument-list t)
8632        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
8633        (end-of-line)        (end-of-line)
8634        (insert "\n")        (insert "\n")
8635        (indent-to (+ margin vhdl-basic-offset))        (indent-to (+ margin vhdl-basic-offset))
# Line 6321  declarative part (and not within a subpr Line 8637  declarative part (and not within a subpr
8637        (vhdl-template-field "type")        (vhdl-template-field "type")
8638        (if (if kind (eq kind 'body)        (if (if kind (eq kind 'body)
8639              (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))              (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
8640            (progn (vhdl-insert-keyword " IS")            (progn (vhdl-insert-keyword " IS\n")
8641                   (vhdl-template-begin-end                   (vhdl-template-begin-end
8642                    (unless (vhdl-standard-p '87) "FUNCTION") name margin)                    (unless (vhdl-standard-p '87) "FUNCTION") name margin)
8643                   (vhdl-comment-block))                   (vhdl-comment-block))
# Line 6347  declarative part (and not within a subpr Line 8663  declarative part (and not within a subpr
8663  (defun vhdl-template-generic ()  (defun vhdl-template-generic ()
8664    "Insert generic declaration, or generic map in instantiation statements."    "Insert generic declaration, or generic map in instantiation statements."
8665    (interactive)    (interactive)
8666    (let ((start (point))    (let ((start (point)))
8667          (case-fold-search t))      (vhdl-prepare-search-1
     (vhdl-ext-syntax-table  
8668       (cond       (cond
8669        ((and (save-excursion             ; entity declaration        ((and (save-excursion             ; entity declaration
8670                (re-search-backward "^\\(entity\\|end\\)\\>" nil t))                (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
# Line 6358  declarative part (and not within a subpr Line 8673  declarative part (and not within a subpr
8673        ((or (save-excursion        ((or (save-excursion
8674               (or (beginning-of-line)               (or (beginning-of-line)
8675                   (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))                   (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
8676             (equal 'statement-cont (car (car (vhdl-get-syntactic-context)))))             (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
8677         (vhdl-insert-keyword "GENERIC ")         (vhdl-insert-keyword "GENERIC ")
8678         (vhdl-template-map start))         (vhdl-template-map start))
8679        (t (vhdl-template-generic-list nil t))))))        (t (vhdl-template-generic-list nil t))))))
# Line 6392  declarative part (and not within a subpr Line 8707  declarative part (and not within a subpr
8707        (vhdl-template-field "entity class list" ");")        (vhdl-template-field "entity class list" ");")
8708        (vhdl-comment-insert-inline))))        (vhdl-comment-insert-inline))))
8709    
 (defun vhdl-template-header ()  
   "Insert a VHDL file header."  
   (interactive)  
   (unless (equal vhdl-file-header "")  
     (let ((case-fold-search t)  
           (project-name (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))  
           (project-desc (or (nth 2 (aget vhdl-project-alist vhdl-project)) ""))  
           eot)  
       (vhdl-ext-syntax-table  
        (save-excursion  
          (save-restriction  
            (widen)  
            (goto-char (point-min))  
            (vhdl-insert-string-or-file vhdl-file-header)  
            (setq eot (point))  
            (narrow-to-region (point-min) eot)  
            (goto-char (point-min))  
            (while (search-forward "<projectdesc>" nil t)  
              (replace-match project-desc t t))  
            (goto-char (point-min))  
            (while (search-forward "<filename>" nil t)  
              (replace-match (buffer-name) t t))  
            (goto-char (point-min))  
            (while (search-forward "<author>" nil t)  
              (replace-match "" t t)  
              (insert (user-full-name))  
              (when user-mail-address (insert "  <" user-mail-address ">")))  
            (goto-char (point-min))  
            (while (search-forward "<login>" nil t)  
              (replace-match (user-login-name) t t))  
            (goto-char (point-min))  
            (while (search-forward "<project>" nil t)  
              (replace-match project-name t t))  
            (goto-char (point-min))  
            (while (search-forward "<company>" nil t)  
              (replace-match vhdl-company-name t t))  
            (goto-char (point-min))  
            (while (search-forward "<platform>" nil t)  
              (replace-match vhdl-platform-spec t t))  
            (goto-char (point-min))  
            ;; Replace <RCS> with $, so that RCS for the source is  
            ;; not over-enthusiastic with replacements  
            (while (search-forward "<RCS>" nil t)  
              (replace-match "$" nil t))  
            (goto-char (point-min))  
            (while (search-forward "<date>" nil t)  
              (replace-match "" t t)  
              (vhdl-template-insert-date))  
            (goto-char (point-min))  
            (let (string)  
              (while  
                  (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" nil t)  
                (setq string (read-string (concat (match-string 1) ": ")))  
                (replace-match string t t)))))  
        (goto-char (point-min))  
        (when (search-forward "<cursor>" nil t)  
          (replace-match "" t t))  
        (when (or (not project-name) (equal project-name ""))  
          (message "You can specify a project title in custom variable `vhdl-project-alist'"))  
        (when (or (not project-desc) (equal project-desc ""))  
          (message "You can specify a project description in custom variable `vhdl-project-alist'"))  
        (when (equal vhdl-company-name "")  
          (message "You can specify a company name in custom variable `vhdl-company-name'"))  
        (when (equal vhdl-platform-spec "")  
          (message "You can specify a platform in custom variable `vhdl-platform-spec'"))))))  
   
8710  (defun vhdl-template-if ()  (defun vhdl-template-if ()
8711    "Insert a sequential if statement or an if-generate statement."    "Insert a sequential if statement or an if-generate statement."
8712    (interactive)    (interactive)
# Line 6473  declarative part (and not within a subpr Line 8722  declarative part (and not within a subpr
8722    (interactive)    (interactive)
8723    (let ((margin (current-indentation))    (let ((margin (current-indentation))
8724          (start (point))          (start (point))
8725          label string position)          label position)
8726      (vhdl-insert-keyword ": IF ")      (vhdl-insert-keyword ": IF ")
8727      (setq position (point-marker))      (setq position (point-marker))
8728      (goto-char start)      (goto-char start)
# Line 6622  declarative part (and not within a subpr Line 8871  declarative part (and not within a subpr
8871                (insert "\n")                (insert "\n")
8872                (indent-to margin))                (indent-to margin))
8873              (delete-region end-pos (point))              (delete-region end-pos (point))
8874              (backward-delete-char 1)              (delete-backward-char 1)
8875              (insert ")")              (insert ")")
8876              (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1))              (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
8877              t)              t)
8878          (when (and optional secondary) (delete-region start (point)))          (when (and optional secondary) (delete-region start (point)))
8879          nil))))          nil))))
# Line 6632  declarative part (and not within a subpr Line 8881  declarative part (and not within a subpr
8881  (defun vhdl-template-modify (&optional noerror)  (defun vhdl-template-modify (&optional noerror)
8882    "Actualize modification date."    "Actualize modification date."
8883    (interactive)    (interactive)
8884    (let ((case-fold-search t))    (vhdl-prepare-search-2
8885      (vhdl-ext-syntax-table     (save-excursion
8886       (save-excursion       (goto-char (point-min))
8887         (goto-char (point-min))       (if (re-search-forward vhdl-modify-date-prefix-string nil t)
8888         (if (re-search-forward vhdl-modify-date-prefix-string nil t)           (progn (delete-region (point) (progn (end-of-line) (point)))
8889             (progn (kill-line)                  (vhdl-template-insert-date))
8890                    (vhdl-template-insert-date))         (unless noerror
8891           (unless noerror           (error (concat "ERROR:  Modification date prefix string \""
8892             (error (concat "Modification date prefix string \""                          vhdl-modify-date-prefix-string "\" not found")))))))
                           vhdl-modify-date-prefix-string "\" not found"))))))))  
8893    
8894  (defun vhdl-template-modify-noerror ()  (defun vhdl-template-modify-noerror ()
8895    "Call `vhdl-template-modify' with NOERROR non-nil."    "Call `vhdl-template-modify' with NOERROR non-nil."
# Line 6685  declarative part (and not within a subpr Line 8933  declarative part (and not within a subpr
8933  (defun vhdl-template-next ()  (defun vhdl-template-next ()
8934    "Insert a next statement."    "Insert a next statement."
8935    (interactive)    (interactive)
8936    (vhdl-insert-keyword "NEXT ")    (let ((start (point)))
8937    (unless (vhdl-template-field "[loop label]" nil t)      (vhdl-insert-keyword "NEXT ")
8938      (delete-char -1))      (if (vhdl-template-field "[loop label]" nil t start (point))
8939    (let ((position (point)))          (let ((position (point)))
8940      (vhdl-insert-keyword " WHEN ")            (vhdl-insert-keyword " WHEN ")
8941      (when vhdl-conditions-in-parenthesis (insert "("))            (when vhdl-conditions-in-parenthesis (insert "("))
8942      (if (vhdl-template-field "[condition]" nil t)            (if (vhdl-template-field "[condition]" nil t)
8943          (when vhdl-conditions-in-parenthesis (insert ")"))                (when vhdl-conditions-in-parenthesis (insert ")"))
8944        (delete-region position (point)))              (delete-region position (point))))
8945          (delete-char -1))
8946      (insert ";")))      (insert ";")))
8947    
8948  (defun vhdl-template-others ()  (defun vhdl-template-others ()
8949    "Insert an others aggregate."    "Insert an others aggregate."
8950    (interactive)    (interactive)
8951    (vhdl-insert-keyword "(OTHERS => '')")    (let ((start (point)))
8952    (backward-char 2))      (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook))
8953            (progn (unless vhdl-template-invoked-by-hook (insert "("))
8954                   (vhdl-insert-keyword "OTHERS => '")
8955                   (when (vhdl-template-field "value" nil t start (point))
8956                     (insert "')")))
8957          (vhdl-insert-keyword "OTHERS "))))
8958    
8959  (defun vhdl-template-package (&optional kind)  (defun vhdl-template-package (&optional kind)
8960    "Insert a package specification or body."    "Insert a package specification or body."
# Line 6711  declarative part (and not within a subpr Line 8965  declarative part (and not within a subpr
8965      (vhdl-insert-keyword "PACKAGE ")      (vhdl-insert-keyword "PACKAGE ")
8966      (setq body (if kind (eq kind 'body)      (setq body (if kind (eq kind 'body)
8967                   (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))                   (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)))
8968      (when body (vhdl-insert-keyword "BODY "))      (when body
8969      (when (setq name (vhdl-template-field "name" nil t start (point)))        (vhdl-insert-keyword "BODY ")
8970          (when (save-excursion
8971                  (vhdl-prepare-search-1
8972                   (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t)))
8973            (insert (setq name (match-string 1)))))
8974        (when (or name
8975                  (setq name (vhdl-template-field "name" nil t start (point))))
8976        (vhdl-insert-keyword " IS\n")        (vhdl-insert-keyword " IS\n")
8977        (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))        (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
8978        (indent-to (+ margin vhdl-basic-offset))        (indent-to (+ margin vhdl-basic-offset))
# Line 6739  declarative part (and not within a subpr Line 8999  declarative part (and not within a subpr
8999  (defun vhdl-template-port ()  (defun vhdl-template-port ()
9000    "Insert a port declaration, or port map in instantiation statements."    "Insert a port declaration, or port map in instantiation statements."
9001    (interactive)    (interactive)
9002    (let ((start (point))    (let ((start (point)))
9003          (case-fold-search t))      (vhdl-prepare-search-1
     (vhdl-ext-syntax-table  
9004       (cond       (cond
9005        ((and (save-excursion             ; entity declaration        ((and (save-excursion             ; entity declaration
9006                (re-search-backward "^\\(entity\\|end\\)\\>" nil t))                (re-search-backward "^\\(entity\\|end\\)\\>" nil t))
# Line 6750  declarative part (and not within a subpr Line 9009  declarative part (and not within a subpr
9009        ((or (save-excursion        ((or (save-excursion
9010               (or (beginning-of-line)               (or (beginning-of-line)
9011                   (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))                   (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+")))
9012             (equal 'statement-cont (car (car (vhdl-get-syntactic-context)))))             (equal 'statement-cont (caar (vhdl-get-syntactic-context))))
9013         (vhdl-insert-keyword "PORT ")         (vhdl-insert-keyword "PORT ")
9014         (vhdl-template-map start))         (vhdl-template-map start))
9015        (t (vhdl-template-port-list nil))))))        (t (vhdl-template-port-list nil))))))
# Line 6772  declarative part (and not within a subpr Line 9031  declarative part (and not within a subpr
9031        (forward-word 1)        (forward-word 1)
9032        (forward-char 1))        (forward-char 1))
9033      (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))      (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS"))
9034        (insert "\n")
9035      (vhdl-template-begin-end "PROCEDURAL" label margin)      (vhdl-template-begin-end "PROCEDURAL" label margin)
9036      (vhdl-comment-block)))      (vhdl-comment-block)))
9037    
# Line 6788  declarative part (and not within a subpr Line 9048  declarative part (and not within a subpr
9048              (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))              (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))
9049            (progn (vhdl-insert-keyword " IS")            (progn (vhdl-insert-keyword " IS")
9050                   (when vhdl-auto-align                   (when vhdl-auto-align
9051                     (vhdl-align-noindent-region start (point) 1))                     (vhdl-align-region-groups start (point) 1))
9052                   (end-of-line)                   (end-of-line) (insert "\n")
9053                   (vhdl-template-begin-end                   (vhdl-template-begin-end
9054                    (unless (vhdl-standard-p '87) "PROCEDURE")                    (unless (vhdl-standard-p '87) "PROCEDURE")
9055                    name margin)                    name margin)
9056                   (vhdl-comment-block))                   (vhdl-comment-block))
9057          (insert ";")          (insert ";")
9058          (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1))          (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
9059          (end-of-line)))))          (end-of-line)))))
9060    
9061  (defun vhdl-template-procedure-decl ()  (defun vhdl-template-procedure-decl ()
# Line 6813  declarative part (and not within a subpr Line 9073  declarative part (and not within a subpr
9073    (interactive)    (interactive)
9074    (let ((margin (current-indentation))    (let ((margin (current-indentation))
9075          (start (point))          (start (point))
         (case-fold-search t)  
9076          label seq input-signals clock reset final-pos)          label seq input-signals clock reset final-pos)
9077      (setq seq (if kind (eq kind 'seq)      (setq seq (if kind (eq kind 'seq)
9078                  (eq (vhdl-decision-query                  (eq (vhdl-decision-query
# Line 6843  declarative part (and not within a subpr Line 9102  declarative part (and not within a subpr
9102                          (vhdl-template-field "reset name") "<reset>")))                          (vhdl-template-field "reset name") "<reset>")))
9103        (insert ")"))        (insert ")"))
9104      (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))      (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS"))
9105        (insert "\n")
9106      (vhdl-template-begin-end "PROCESS" label margin)      (vhdl-template-begin-end "PROCESS" label margin)
9107      (when seq (setq reset (vhdl-template-seq-process clock reset)))      (when seq (setq reset (vhdl-template-seq-process clock reset)))
9108      (when vhdl-prompt-for-comments      (when vhdl-prompt-for-comments
9109        (setq final-pos (point-marker))        (setq final-pos (point-marker))
9110        (vhdl-ext-syntax-table        (vhdl-prepare-search-2
9111         (when (and (re-search-backward "\\<begin\\>" nil t)         (when (and (vhdl-re-search-backward "\\<begin\\>" nil t)
9112                    (re-search-backward "\\<process\\>" nil t))                    (vhdl-re-search-backward "\\<process\\>" nil t))
9113           (end-of-line -0)           (end-of-line -0)
9114           (if (bobp)           (if (bobp)
9115               (progn (insert "\n") (forward-line -1))               (progn (insert "\n") (forward-line -1))
# Line 6975  declarative part (and not within a subpr Line 9235  declarative part (and not within a subpr
9235        (vhdl-insert-keyword "END RECORD")        (vhdl-insert-keyword "END RECORD")
9236        (unless (vhdl-standard-p '87) (and name (insert " " name)))        (unless (vhdl-standard-p '87) (and name (insert " " name)))
9237        (insert ";")        (insert ";")
9238        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1)))))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9239    
9240  (defun vhdl-template-report ()  (defun vhdl-template-report ()
9241    "Insert a report statement."    "Insert a report statement."
# Line 6984  declarative part (and not within a subpr Line 9244  declarative part (and not within a subpr
9244      (vhdl-insert-keyword "REPORT ")      (vhdl-insert-keyword "REPORT ")
9245      (if (equal "\"\"" (vhdl-template-field      (if (equal "\"\"" (vhdl-template-field
9246                         "string expression" nil t start (point) t))                         "string expression" nil t start (point) t))
9247          (backward-delete-char 2)          (delete-backward-char 2)
9248        (setq start (point))        (setq start (point))
9249        (vhdl-insert-keyword " SEVERITY ")        (vhdl-insert-keyword " SEVERITY ")
9250        (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)        (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
# Line 6994  declarative part (and not within a subpr Line 9254  declarative part (and not within a subpr
9254  (defun vhdl-template-return ()  (defun vhdl-template-return ()
9255    "Insert a return statement."    "Insert a return statement."
9256    (interactive)    (interactive)
9257    (vhdl-insert-keyword "RETURN ")    (let ((start (point)))
9258    (unless (vhdl-template-field "[expression]" nil t)      (vhdl-insert-keyword "RETURN ")
9259      (delete-char -1))      (unless (vhdl-template-field "[expression]" nil t start (point))
9260    (insert ";"))        (delete-char -1))
9261        (insert ";")))
9262    
9263  (defun vhdl-template-selected-signal-asst ()  (defun vhdl-template-selected-signal-asst ()
9264    "Insert a selected signal assignment."    "Insert a selected signal assignment."
# Line 7033  declarative part (and not within a subpr Line 9294  declarative part (and not within a subpr
9294          (fixup-whitespace)          (fixup-whitespace)
9295          (delete-char -2))          (delete-char -2))
9296        (insert ";")        (insert ";")
9297        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1)))))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
9298    
9299  (defun vhdl-template-signal ()  (defun vhdl-template-signal ()
9300    "Insert a signal declaration."    "Insert a signal declaration."
# Line 7131  declarative part (and not within a subpr Line 9392  declarative part (and not within a subpr
9392                      "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)                      "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)
9393                     ""))))                     ""))))
9394          (cond ((equal definition "")          (cond ((equal definition "")
9395                 (backward-delete-char 4)                 (delete-backward-char 4)
9396                 (insert ";"))                 (insert ";"))
9397                ((equal definition "ARRAY")                ((equal definition "ARRAY")
9398                 (kill-word -1)                 (kill-word -1)
# Line 7157  declarative part (and not within a subpr Line 9418  declarative part (and not within a subpr
9418  (defun vhdl-template-use ()  (defun vhdl-template-use ()
9419    "Insert a use clause."    "Insert a use clause."
9420    (interactive)    (interactive)
9421    (let ((start (point))    (let ((start (point)))
9422          (case-fold-search t))      (vhdl-prepare-search-1
     (vhdl-ext-syntax-table  
9423       (vhdl-insert-keyword "USE ")       (vhdl-insert-keyword "USE ")
9424       (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))       (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>"))
9425         (vhdl-insert-keyword "..ALL;")         (vhdl-insert-keyword "..ALL;")
# Line 7173  declarative part (and not within a subpr Line 9433  declarative part (and not within a subpr
9433    "Insert a variable declaration."    "Insert a variable declaration."
9434    (interactive)    (interactive)
9435    (let ((start (point))    (let ((start (point))
         (case-fold-search t)  
9436          (in-arglist (vhdl-in-argument-list-p)))          (in-arglist (vhdl-in-argument-list-p)))
9437      (vhdl-ext-syntax-table      (vhdl-prepare-search-2
9438       (if (or (save-excursion       (if (or (save-excursion
9439                 (and (re-search-backward                 (and (vhdl-re-search-backward
9440                       "\\<function\\|procedure\\|process\\|procedural\\|end\\>"                       "\\<function\\|procedure\\|process\\|procedural\\|end\\>"
9441                       nil t)                       nil t)
9442                      (not (progn (backward-word 1) (looking-at "\\<end\\>")))))                      (not (progn (backward-word 1) (looking-at "\\<end\\>")))))
# Line 7212  declarative part (and not within a subpr Line 9471  declarative part (and not within a subpr
9471    "Indent correctly if within a case statement."    "Indent correctly if within a case statement."
9472    (interactive)    (interactive)
9473    (let ((position (point))    (let ((position (point))
         (case-fold-search t)  
9474          margin)          margin)
9475      (vhdl-ext-syntax-table      (vhdl-prepare-search-2
9476       (if (and (= (current-column) (current-indentation))       (if (and (= (current-column) (current-indentation))
9477                (re-search-forward "\\<end\\>" nil t)                (vhdl-re-search-forward "\\<end\\>" nil t)
9478                (looking-at "\\s-*\\<case\\>"))                (looking-at "\\s-*\\<case\\>"))
9479           (progn           (progn
9480             (setq margin (current-indentation))             (setq margin (current-indentation))
# Line 7253  declarative part (and not within a subpr Line 9511  declarative part (and not within a subpr
9511  (defun vhdl-template-with ()  (defun vhdl-template-with ()
9512    "Insert a with statement (i.e. selected signal assignment)."    "Insert a with statement (i.e. selected signal assignment)."
9513    (interactive)    (interactive)
9514    (let ((case-fold-search t))    (vhdl-prepare-search-1
9515      (vhdl-ext-syntax-table     (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)"))
9516       (if (save-excursion              (equal ";" (match-string 1)))
9517             (re-search-backward "\\(\\<limit\\>\\|;\\)")         (vhdl-template-selected-signal-asst)
9518             (equal ";" (match-string 1)))       (vhdl-insert-keyword "WITH "))))
          (vhdl-template-selected-signal-asst)  
        (vhdl-insert-keyword "WITH ")))))  
9519    
9520  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9521  ;; Special templates  ;; Special templates
# Line 7338  declarative part (and not within a subpr Line 9594  declarative part (and not within a subpr
9594  (defun vhdl-template-standard-package (library package)  (defun vhdl-template-standard-package (library package)
9595    "Insert specification of a standard package.  Include a library    "Insert specification of a standard package.  Include a library
9596  specification, if not already there."  specification, if not already there."
9597    (let ((margin (current-indentation))    (let ((margin (current-indentation)))
9598          (case-fold-search t))      (unless (equal library "std")
9599      (save-excursion        (unless (or (save-excursion
9600        (vhdl-ext-syntax-table                      (vhdl-prepare-search-1
9601         (and (not (bobp))                       (and (not (bobp))
9602              (re-search-backward                            (re-search-backward
9603               (concat "^\\s-*\\(library\\s-+\\(\\(\\w\\|\\s_\\)+,\\s-+\\)*"                             (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*"
9604                       library "\\|end\\)\\>") nil t))))                                     library "\\|end\\)\\>") nil t)
9605      (unless (and (match-string 1) (string-match "library" (match-string 1)))                            (match-string 2))))
9606        (vhdl-insert-keyword "LIBRARY ")                    (equal (downcase library) "work"))
9607        (insert library ";\n")          (vhdl-insert-keyword "LIBRARY ")
9608        (indent-to margin))          (insert library ";\n")
9609      (vhdl-insert-keyword "USE ")          (indent-to margin))
9610      (insert library "." package)        (vhdl-insert-keyword "USE ")
9611      (vhdl-insert-keyword ".ALL;")))        (insert library "." package)
9612          (vhdl-insert-keyword ".ALL;"))))
9613    
9614  (defun vhdl-template-package-math-complex ()  (defun vhdl-template-package-math-complex ()
9615    "Insert specification of `math_complex' package."    "Insert specification of `math_complex' package."
# Line 7437  specification, if not already there." Line 9694  specification, if not already there."
9694    (vhdl-template-directive "synthesis_off"))    (vhdl-template-directive "synthesis_off"))
9695    
9696  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9697    ;; Header and footer templates
9698    
9699    (defun vhdl-template-header (&optional file-title)
9700      "Insert a VHDL file header."
9701      (interactive)
9702      (unless (equal vhdl-file-header "")
9703        (let (pos)
9704          (save-excursion
9705            (goto-char (point-min))
9706            (vhdl-insert-string-or-file vhdl-file-header)
9707            (setq pos (point-marker)))
9708          (vhdl-template-replace-header-keywords
9709           (point-min-marker) pos file-title))))
9710    
9711    (defun vhdl-template-footer ()
9712      "Insert a VHDL file footer."
9713      (interactive)
9714      (unless (equal vhdl-file-footer "")
9715        (let (pos)
9716          (save-excursion
9717            (goto-char (point-max))
9718            (setq pos (point-marker))
9719            (vhdl-insert-string-or-file vhdl-file-footer)
9720            (unless (= (preceding-char) ?\n)
9721              (insert "\n")))
9722          (vhdl-template-replace-header-keywords pos (point-max-marker)))))
9723    
9724    (defun vhdl-template-replace-header-keywords (beg end &optional file-title
9725                                                      is-model)
9726      "Replace keywords in header and footer."
9727      (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) ""))
9728            (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) ""))
9729            pos)
9730        (vhdl-prepare-search-2
9731         (save-excursion
9732           (goto-char beg)
9733           (while (search-forward "<projectdesc>" end t)
9734             (replace-match project-desc t t))
9735           (goto-char beg)
9736           (while (search-forward "<filename>" end t)
9737             (replace-match (buffer-name) t t))
9738           (goto-char beg)
9739           (while (search-forward "<copyright>" end t)
9740             (replace-match vhdl-copyright-string t t))
9741           (goto-char beg)
9742           (while (search-forward "<author>" end t)
9743             (replace-match "" t t)
9744             (insert (user-full-name))
9745             (when user-mail-address (insert "  <" user-mail-address ">")))
9746           (goto-char beg)
9747           (while (search-forward "<login>" end t)
9748             (replace-match (user-login-name) t t))
9749           (goto-char beg)
9750           (while (search-forward "<project>" end t)
9751             (replace-match project-title t t))
9752           (goto-char beg)
9753           (while (search-forward "<company>" end t)
9754             (replace-match vhdl-company-name t t))
9755           (goto-char beg)
9756           (while (search-forward "<platform>" end t)
9757             (replace-match vhdl-platform-spec t t))
9758           (goto-char beg)
9759           (while (search-forward "<standard>" end t)
9760             (replace-match
9761              (concat "VHDL" (cond ((vhdl-standard-p '87) "'87")
9762                                   ((vhdl-standard-p '93) "'93"))
9763                      (when (vhdl-standard-p 'ams) ", VHDL-AMS")
9764                      (when (vhdl-standard-p 'math) ", Math Packages")) t t))
9765           (goto-char beg)
9766           ;; Replace <RCS> with $, so that RCS for the source is
9767           ;; not over-enthusiastic with replacements
9768           (while (search-forward "<RCS>" end t)
9769             (replace-match "$" nil t))
9770           (goto-char beg)
9771           (while (search-forward "<date>" end t)
9772             (replace-match "" t t)
9773             (vhdl-template-insert-date))
9774           (goto-char beg)
9775           (while (search-forward "<year>" end t)
9776             (replace-match (format-time-string "%Y" nil) t t))
9777           (goto-char beg)
9778           (when file-title
9779             (while (search-forward "<title string>" end t)
9780               (replace-match file-title t t))
9781             (goto-char beg))
9782           (let (string)
9783             (while
9784                 (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t)
9785               (setq string (read-string (concat (match-string 1) ": ")))
9786               (replace-match string t t)))
9787           (goto-char beg)
9788           (when (and (not is-model) (search-forward "<cursor>" end t))
9789             (replace-match "" t t)
9790             (setq pos (point))))
9791         (when pos (goto-char pos))
9792         (unless is-model
9793           (when (or (not project-title) (equal project-title ""))
9794             (message "You can specify a project title in user option `vhdl-project-alist'"))
9795           (when (or (not project-desc) (equal project-desc ""))
9796             (message "You can specify a project description in user option `vhdl-project-alist'"))
9797           (when (equal vhdl-platform-spec "")
9798             (message "You can specify a platform in user option `vhdl-platform-spec'"))
9799           (when (equal vhdl-company-name "")
9800             (message "You can specify a company name in user option `vhdl-company-name'"))))))
9801    
9802    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9803  ;; Comment templates and functions  ;; Comment templates and functions
9804    
9805  (defun vhdl-comment-indent ()  (defun vhdl-comment-indent ()
# Line 7482  If starting after end-comment-column, st Line 9845  If starting after end-comment-column, st
9845          (forward-line 1)          (forward-line 1)
9846          (message "Enter CR if commenting out a line of code.")          (message "Enter CR if commenting out a line of code.")
9847          (setq code t))          (setq code t))
9848        (when (not code)        (unless code
9849          (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?          (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset?
9850        (setq unread-command-events        (setq unread-command-events
9851              (list (vhdl-character-to-event next-input)))))) ; pushback the char              (list (vhdl-character-to-event next-input)))))) ; pushback the char
# Line 7491  If starting after end-comment-column, st Line 9854  If starting after end-comment-column, st
9854    "Add 2 comment lines at the current indent, making a display comment."    "Add 2 comment lines at the current indent, making a display comment."
9855    (interactive)    (interactive)
9856    (let ((margin (current-indentation)))    (let ((margin (current-indentation)))
9857      (when (not line-exists) (vhdl-comment-display-line))      (unless line-exists (vhdl-comment-display-line))
9858      (insert "\n") (indent-to margin)      (insert "\n") (indent-to margin)
9859      (insert "\n") (indent-to margin)      (insert "\n") (indent-to margin)
9860      (vhdl-comment-display-line)      (vhdl-comment-display-line)
# Line 7523  If starting after end-comment-column, st Line 9886  If starting after end-comment-column, st
9886        (insert "  ")        (insert "  ")
9887        (indent-to comment-column)        (indent-to comment-column)
9888        (insert "-- ")        (insert "-- ")
9889        (if (or (and string (progn (insert string) t))        (if (not (or (and string (progn (insert string) t))
9890                (vhdl-template-field "[comment]" nil t))                     (vhdl-template-field "[comment]" nil t)))
9891            (when (> (current-column) end-comment-column)            (delete-region position (point))
9892              (setq position (point-marker))          (while (= (preceding-char) ? ) (delete-backward-char 1))
9893              (re-search-backward "-- ")  ;       (when (> (current-column) end-comment-column)
9894              (insert "\n")  ;         (setq position (point-marker))
9895              (indent-to comment-column)  ;         (re-search-backward "-- ")
9896              (goto-char position))  ;         (insert "\n")
9897          (delete-region position (point))))))  ;         (indent-to comment-column)
9898    ;         (goto-char position))
9899            ))))
9900    
9901  (defun vhdl-comment-block ()  (defun vhdl-comment-block ()
9902    "Insert comment for code block."    "Insert comment for code block."
9903    (when vhdl-prompt-for-comments    (when vhdl-prompt-for-comments
9904      (let ((final-pos (point-marker))      (let ((final-pos (point-marker)))
9905            (case-fold-search t))        (vhdl-prepare-search-2
       (vhdl-ext-syntax-table  
9906         (when (and (re-search-backward "^\\s-*begin\\>" nil t)         (when (and (re-search-backward "^\\s-*begin\\>" nil t)
9907                    (re-search-backward                    (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t))
                    "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>"  
                    nil t))  
9908           (let (margin)           (let (margin)
9909             (back-to-indentation)             (back-to-indentation)
9910             (setq margin (current-column))             (setq margin (current-column))
# Line 7567  If starting after end-comment-column, st Line 9929  If starting after end-comment-column, st
9929      (beginning-of-line)      (beginning-of-line)
9930      (setq beg (point))      (setq beg (point))
9931      (if (looking-at comment-start)      (if (looking-at comment-start)
9932          (comment-region beg end -1)          (comment-region beg end '(4))
9933        (comment-region beg end))))        (comment-region beg end))))
9934    
9935  (defun vhdl-comment-uncomment-line (&optional arg)  (defun vhdl-comment-uncomment-line (&optional arg)
# Line 7612  If starting after end-comment-column, st Line 9974  If starting after end-comment-column, st
9974    "Insert a begin ... end pair with optional name after the end.    "Insert a begin ... end pair with optional name after the end.
9975  Point is left between them."  Point is left between them."
9976    (let (position)    (let (position)
     (insert "\n")  
9977      (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))      (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n"))
9978      (indent-to margin)      (indent-to margin)
9979      (vhdl-insert-keyword "BEGIN")      (vhdl-insert-keyword "BEGIN")
# Line 7639  Point is left between them." Line 10000  Point is left between them."
10000          (start (point))          (start (point))
10001          (end-pos (point))          (end-pos (point))
10002          not-empty interface semicolon-pos)          not-empty interface semicolon-pos)
10003      (when (not vhdl-argument-list-indent)      (unless vhdl-argument-list-indent
10004        (setq margin (+ (current-indentation) vhdl-basic-offset))        (setq margin (+ (current-indentation) vhdl-basic-offset))
10005        (insert "\n")        (insert "\n")
10006        (indent-to margin))        (indent-to margin))
# Line 7649  Point is left between them." Line 10010  Point is left between them."
10010      (while (vhdl-template-field "[names]" nil t)      (while (vhdl-template-field "[names]" nil t)
10011        (setq not-empty t)        (setq not-empty t)
10012        (insert " : ")        (insert " : ")
10013        (when (not is-function)        (unless is-function
10014          (if (and interface (equal (upcase interface) "CONSTANT"))          (if (and interface (equal (upcase interface) "CONSTANT"))
10015              (vhdl-insert-keyword "IN ")              (vhdl-insert-keyword "IN ")
10016            (vhdl-template-field "[IN | OUT | INOUT]" " " t)))            (vhdl-template-field "[IN | OUT | INOUT]" " " t)))
# Line 7667  Point is left between them." Line 10028  Point is left between them."
10028      (when semicolon-pos (goto-char semicolon-pos))      (when semicolon-pos (goto-char semicolon-pos))
10029      (if not-empty      (if not-empty
10030          (progn (delete-char 1) (insert ")"))          (progn (delete-char 1) (insert ")"))
10031        (backward-delete-char 2))))        (delete-backward-char 2))))
10032    
10033  (defun vhdl-template-generic-list (optional &optional no-value)  (defun vhdl-template-generic-list (optional &optional no-value)
10034    "Read from user a generic spec argument list."    "Read from user a generic spec argument list."
# Line 7675  Point is left between them." Line 10036  Point is left between them."
10036          (start (point)))          (start (point)))
10037      (vhdl-insert-keyword "GENERIC (")      (vhdl-insert-keyword "GENERIC (")
10038      (setq margin (current-column))      (setq margin (current-column))
10039      (when (not vhdl-argument-list-indent)      (unless vhdl-argument-list-indent
10040        (let ((position (point)))        (let ((position (point)))
10041          (back-to-indentation)          (back-to-indentation)
10042          (setq margin (+ (current-column) vhdl-basic-offset))          (setq margin (+ (current-column) vhdl-basic-offset))
# Line 7689  Point is left between them." Line 10050  Point is left between them."
10050        (if (not vhdl-generics)        (if (not vhdl-generics)
10051            (if optional            (if optional
10052                (progn (vhdl-line-kill-entire) (end-of-line -0)                (progn (vhdl-line-kill-entire) (end-of-line -0)
10053                       (when (not vhdl-argument-list-indent)                       (unless vhdl-argument-list-indent
10054                         (vhdl-line-kill-entire) (end-of-line -0)))                         (vhdl-line-kill-entire) (end-of-line -0)))
10055              (vhdl-template-undo start (point))              (vhdl-template-undo start (point))
10056              nil )              nil )
# Line 7716  Point is left between them." Line 10077  Point is left between them."
10077            (goto-char semicolon-pos)            (goto-char semicolon-pos)
10078            (insert ")")            (insert ")")
10079            (end-of-line)            (end-of-line)
10080            (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1))            (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
10081            t)))))            t)))))
10082    
10083  (defun vhdl-template-port-list (optional)  (defun vhdl-template-port-list (optional)
# Line 7725  Point is left between them." Line 10086  Point is left between them."
10086          margin vhdl-ports object)          margin vhdl-ports object)
10087      (vhdl-insert-keyword "PORT (")      (vhdl-insert-keyword "PORT (")
10088      (setq margin (current-column))      (setq margin (current-column))
10089      (when (not vhdl-argument-list-indent)      (unless vhdl-argument-list-indent
10090        (let ((position (point)))        (let ((position (point)))
10091          (back-to-indentation)          (back-to-indentation)
10092          (setq margin (+ (current-column) vhdl-basic-offset))          (setq margin (+ (current-column) vhdl-basic-offset))
# Line 7741  Point is left between them." Line 10102  Point is left between them."
10102      (if (not vhdl-ports)      (if (not vhdl-ports)
10103          (if optional          (if optional
10104              (progn (vhdl-line-kill-entire) (end-of-line -0)              (progn (vhdl-line-kill-entire) (end-of-line -0)
10105                     (when (not vhdl-argument-list-indent)                     (unless vhdl-argument-list-indent
10106                       (vhdl-line-kill-entire) (end-of-line -0)))                       (vhdl-line-kill-entire) (end-of-line -0)))
10107            (vhdl-template-undo start (point))            (vhdl-template-undo start (point))
10108            nil)            nil)
# Line 7769  Point is left between them." Line 10130  Point is left between them."
10130          (goto-char semicolon-pos)          (goto-char semicolon-pos)
10131          (insert ")")          (insert ")")
10132          (end-of-line)          (end-of-line)
10133          (when vhdl-auto-align (vhdl-align-noindent-region start end-pos 1))          (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1))
10134          t))))          t))))
10135    
10136  (defun vhdl-template-generate-body (margin label)  (defun vhdl-template-generate-body (margin label)
10137    "Insert body for generate template."    "Insert body for generate template."
10138    (vhdl-insert-keyword " GENERATE")    (vhdl-insert-keyword " GENERATE")
10139    (if (not (vhdl-standard-p '87))  ;   (if (not (vhdl-standard-p '87))
10140        (vhdl-template-begin-end "GENERATE" label margin)  ;       (vhdl-template-begin-end "GENERATE" label margin)
10141      (insert "\n\n")    (insert "\n\n")
10142      (indent-to margin)    (indent-to margin)
10143      (vhdl-insert-keyword "END GENERATE ")    (vhdl-insert-keyword "END GENERATE ")
10144      (insert label ";")    (insert label ";")
10145      (end-of-line 0)    (end-of-line 0)
10146      (indent-to (+ margin vhdl-basic-offset))))    (indent-to (+ margin vhdl-basic-offset)))
10147    
10148  (defun vhdl-template-insert-date ()  (defun vhdl-template-insert-date ()
10149    "Insert date in appropriate format."    "Insert date in appropriate format."
10150    (interactive)    (interactive)
10151    (insert    (insert
10152     (cond     (cond
10153      ;; 'american, 'european', 'scientific kept for backward compatibility      ;; 'american, 'european, 'scientific kept for backward compatibility
10154      ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))      ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil))
10155      ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))      ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil))
10156      ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))      ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil))
# Line 7805  if in comment and past end-comment-colum Line 10166  if in comment and past end-comment-colum
10166    (cond ((vhdl-in-comment-p)    (cond ((vhdl-in-comment-p)
10167           (self-insert-command count)           (self-insert-command count)
10168           (cond ((>= (current-column) (+ 2 end-comment-column))           (cond ((>= (current-column) (+ 2 end-comment-column))
10169                  (backward-word 1)                  (backward-char 1)
10170                    (skip-chars-backward "^ \t\n")
10171                  (indent-new-comment-line)                  (indent-new-comment-line)
10172                  (forward-word 1)                  (skip-chars-forward "^ \t\n")
10173                  (forward-char 1))                  (forward-char 1))
10174                 ((>= (current-column) end-comment-column)                 ((>= (current-column) end-comment-column)
10175                  (indent-new-comment-line))                  (indent-new-comment-line))
10176                 (t nil)))                 (t nil)))
10177          ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))          ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z))
10178               (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))               (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z)))
10179           (vhdl-ext-syntax-table           (vhdl-prepare-search-1
10180            (let ((case-fold-search t))            (or (expand-abbrev) (vhdl-fix-case-word -1)))
             (expand-abbrev)))  
10181           (self-insert-command count))           (self-insert-command count))
10182          (t (self-insert-command count))))          (t (self-insert-command count))))
10183    
# Line 7843  with double-quotes is to be inserted.  D Line 10204  with double-quotes is to be inserted.  D
10204      (when (and (equal string "") optional begin end)      (when (and (equal string "") optional begin end)
10205        (vhdl-template-undo begin end)        (vhdl-template-undo begin end)
10206        (message "Template aborted"))        (message "Template aborted"))
10207      (when (not (equal string ""))      (unless (equal string "")
10208        (insert string)        (insert string)
10209        (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords        (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords
10210                                vhdl-keywords-regexp))                                vhdl-keywords-regexp)
10211          (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types
10212                                  vhdl-types-regexp)
10213          (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes
10214                                  (concat "'" vhdl-attributes-regexp))
10215          (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values
10216                                  vhdl-enum-values-regexp))
10217      (when (or (not (equal string "")) (not optional))      (when (or (not (equal string "")) (not optional))
10218        (insert (or follow-string "")))        (insert (or follow-string "")))
10219      (if (equal string "") nil string)))      (if (equal string "") nil string)))
# Line 7861  with double-quotes is to be inserted.  D Line 10228  with double-quotes is to be inserted.  D
10228        (if (and optional (eq char ?\r))        (if (and optional (eq char ?\r))
10229            (progn (insert " ")            (progn (insert " ")
10230                   (unexpand-abbrev)                   (unexpand-abbrev)
10231                   (throw 'abort "Template aborted"))                   (throw 'abort "ERROR:  Template aborted"))
10232          char))))          char))))
10233    
10234  (defun vhdl-insert-keyword (keyword)  (defun vhdl-insert-keyword (keyword)
# Line 7878  with double-quotes is to be inserted.  D Line 10245  with double-quotes is to be inserted.  D
10245    
10246  (defun vhdl-minibuffer-tab (&optional prefix-arg)  (defun vhdl-minibuffer-tab (&optional prefix-arg)
10247    "If preceeding character is part of a word or a paren then hippie-expand,    "If preceeding character is part of a word or a paren then hippie-expand,
10248  else if right of non whitespace on line then tab-to-tab-stop,  else insert tab (used for word completion in VHDL minibuffer)."
 else indent line in proper way for current major mode (used for word  
 completion in VHDL minibuffer)."  
10249    (interactive "P")    (interactive "P")
10250    (cond ((= (char-syntax (preceding-char)) ?w)    (cond
10251           (let ((case-fold-search (not vhdl-word-completion-case-sensitive))     ;; expand word
10252                 (case-replace nil))     ((= (char-syntax (preceding-char)) ?w)
10253             (vhdl-expand-abbrev prefix-arg)))      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10254          ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))            (case-replace nil)
10255           (let ((case-fold-search (not vhdl-word-completion-case-sensitive))            (hippie-expand-only-buffers
10256                 (case-replace nil))             (or (and (boundp 'hippie-expand-only-buffers)
10257             (vhdl-expand-paren prefix-arg)))                      hippie-expand-only-buffers)
10258          ((> (current-column) (current-indentation))                 '(vhdl-mode))))
10259           (tab-to-tab-stop))        (vhdl-expand-abbrev prefix-arg)))
10260          (t (if (eq indent-line-function 'indent-to-left-margin)     ;; expand parenthesis
10261                 (insert-tab prefix-arg)     ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
10262               (if prefix-arg      (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
10263                   (funcall indent-line-function prefix-arg)            (case-replace nil))
10264                 (funcall indent-line-function))))))        (vhdl-expand-paren prefix-arg)))
10265       ;; insert tab
10266       (t (insert-tab))))
10267    
10268  (defun vhdl-template-search-prompt ()  (defun vhdl-template-search-prompt ()
10269    "Search for left out template prompts and query again."    "Search for left out template prompts and query again."
10270    (interactive)    (interactive)
10271    (let ((case-fold-search t))    (vhdl-prepare-search-2
10272      (vhdl-ext-syntax-table     (when (or (re-search-forward
10273       (when (or (re-search-forward                (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
10274                  (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)               (re-search-backward
10275                 (re-search-backward                (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
10276                  (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))       (let ((string (match-string 1)))
10277         (let ((string (match-string 1)))         (replace-match "")
10278           (replace-match "")         (vhdl-template-field string)))))
          (vhdl-template-field string))))))  
10279    
10280  (defun vhdl-template-undo (begin end)  (defun vhdl-template-undo (begin end)
10281    "Undo aborted template by deleting region and unexpanding the keyword."    "Undo aborted template by deleting region and unexpanding the keyword."
# Line 7923  completion in VHDL minibuffer)." Line 10289  completion in VHDL minibuffer)."
10289  (defun vhdl-insert-string-or-file (string)  (defun vhdl-insert-string-or-file (string)
10290    "Insert STRING or file contents if STRING is an existing file name."    "Insert STRING or file contents if STRING is an existing file name."
10291    (unless (equal string "")    (unless (equal string "")
10292      (cond ((file-exists-p string)      (let ((file-name
10293             (forward-char (cadr (insert-file-contents string))))             (progn (string-match "^\\([^\n]+\\)" string)
10294            (t (insert string)))))                    (vhdl-resolve-env-variable (match-string 1 string)))))
10295          (if (file-exists-p file-name)
10296               (forward-char (cadr (insert-file-contents file-name)))
10297            (insert string)))))
10298    
10299    (defun vhdl-beginning-of-block ()
10300      "Move cursor to the beginning of the enclosing block."
10301      (let (pos)
10302        (save-excursion
10303          (beginning-of-line)
10304          ;; search backward for block beginning or end
10305          (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10306                                 ;; not consider subprogram declarations
10307                                 (or (and (match-string 5)
10308                                          (save-match-data
10309                                            (save-excursion
10310                                              (goto-char (match-end 5))
10311                                              (forward-word 1) (forward-sexp)
10312                                              (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10313                                            (match-string 1)))
10314                                     ;; not consider configuration specifications
10315                                     (and (match-string 6)
10316                                          (save-match-data
10317                                            (save-excursion
10318                                              (vhdl-end-of-block)
10319                                              (beginning-of-line)
10320                                              (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10321                     (match-string 2))
10322            ;; skip subblock if block end found
10323            (vhdl-beginning-of-block)))
10324        (when pos (goto-char pos))))
10325    
10326    (defun vhdl-end-of-block ()
10327      "Move cursor to the end of the enclosing block."
10328      (let (pos)
10329        (save-excursion
10330          (end-of-line)
10331          ;; search forward for block beginning or end
10332          (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
10333                                 ;; not consider subprogram declarations
10334                                 (or (and (match-string 5)
10335                                          (save-match-data
10336                                            (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
10337                                            (match-string 1)))
10338                                     ;; not consider configuration specifications
10339                                     (and (match-string 6)
10340                                          (save-match-data
10341                                            (save-excursion
10342                                              (vhdl-end-of-block)
10343                                              (beginning-of-line)
10344                                              (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
10345                     (not (match-string 2)))
10346            ;; skip subblock if block beginning found
10347            (vhdl-end-of-block)))
10348        (when pos (goto-char pos))))
10349    
10350  (defun vhdl-sequential-statement-p ()  (defun vhdl-sequential-statement-p ()
10351    "Check if point is within sequential statement part."    "Check if point is within sequential statement part."
10352    (save-excursion    (let ((start (point)))
10353      (let ((case-fold-search t)      (save-excursion
10354            (start (point)))        (vhdl-prepare-search-2
10355        (vhdl-ext-syntax-table         ;; is sequential statement if ...
10356         (set-match-data nil)         (and (re-search-backward "^\\s-*begin\\>" nil t)
10357         (while (and (re-search-backward "^\\s-*\\(begin\\|end\\(\\s-*\\(case\\|if\\|loop\\)\\)?\\)\\>"              ;; ... point is between "begin" and "end" of ...
10358                                         nil t)              (progn (vhdl-end-of-block)
10359                     (match-string 2)))                     (< start (point)))
10360         (and (match-data)              ;; ... a sequential block
10361              (equal "BEGIN" (upcase (match-string 1)))              (progn (vhdl-beginning-of-block)
10362              (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(\\w+\\s-+\\)?\\(function\\|procedure\\|process\\|procedural\\|end\\)\\>"                     (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
                                 nil t)  
             (not (equal "END" (upcase (match-string 3)))))))))  
10363    
10364  (defun vhdl-in-argument-list-p ()  (defun vhdl-in-argument-list-p ()
10365    "Check if within an argument list."    "Check if within an argument list."
10366    (save-excursion    (save-excursion
10367      (let ((case-fold-search t))      (vhdl-prepare-search-2
10368        (vhdl-ext-syntax-table       (or (string-match "arglist"
10369         (or (string-match "arglist"                         (format "%s" (caar (vhdl-get-syntactic-context))))
10370                           (format "%s" (car (car (vhdl-get-syntactic-context)))))           (progn (beginning-of-line)
10371             (progn (beginning-of-line)                  (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
                   (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")  
                   ))))))  
10372    
10373  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10374  ;; Abbrev hooks  ;; Abbrev hooks
# Line 7960  completion in VHDL minibuffer)." Line 10376  completion in VHDL minibuffer)."
10376  (defun vhdl-hooked-abbrev (func)  (defun vhdl-hooked-abbrev (func)
10377    "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,    "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
10378  but not if inside a comment or quote)."  but not if inside a comment or quote)."
10379    (if (or (vhdl-in-comment-p)    (if (or (vhdl-in-literal)
           (vhdl-in-string-p)  
10380            (save-excursion            (save-excursion
10381              (forward-word -1)              (forward-word -1)
10382              (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))              (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
# Line 7984  but not if inside a comment or quote)." Line 10399  but not if inside a comment or quote)."
10399            (when (stringp caught) (message caught)))            (when (stringp caught) (message caught)))
10400          (when (= invoke-char ?-) (setq abbrev-start-location (point)))          (when (= invoke-char ?-) (setq abbrev-start-location (point)))
10401          ;; delete CR which is still in event queue          ;; delete CR which is still in event queue
10402          (if (string-match "XEmacs" emacs-version)          (if vhdl-xemacs
10403              (enqueue-eval-event 'delete-char -1)              (enqueue-eval-event 'delete-char -1)
10404            (setq unread-command-events   ; push back a delete char            (setq unread-command-events   ; push back a delete char
10405                  (list (vhdl-character-to-event ?\177))))))))                  (list (vhdl-character-to-event ?\177))))))))
# Line 8049  but not if inside a comment or quote)." Line 10464  but not if inside a comment or quote)."
10464    (vhdl-hooked-abbrev 'vhdl-template-nature))    (vhdl-hooked-abbrev 'vhdl-template-nature))
10465  (defun vhdl-template-next-hook ()  (defun vhdl-template-next-hook ()
10466    (vhdl-hooked-abbrev 'vhdl-template-next))    (vhdl-hooked-abbrev 'vhdl-template-next))
10467    (defun vhdl-template-others-hook ()
10468      (vhdl-hooked-abbrev 'vhdl-template-others))
10469  (defun vhdl-template-package-hook ()  (defun vhdl-template-package-hook ()
10470    (vhdl-hooked-abbrev 'vhdl-template-package))    (vhdl-hooked-abbrev 'vhdl-template-package))
10471  (defun vhdl-template-port-hook ()  (defun vhdl-template-port-hook ()
# Line 8119  but not if inside a comment or quote)." Line 10536  but not if inside a comment or quote)."
10536             (completing-read "Construct name: "             (completing-read "Construct name: "
10537                              vhdl-template-construct-alist nil t))))                              vhdl-template-construct-alist nil t))))
10538    (vhdl-template-insert-fun    (vhdl-template-insert-fun
10539     (car (cdr (assoc name vhdl-template-construct-alist)))))     (cadr (assoc name vhdl-template-construct-alist))))
10540    
10541  (defun vhdl-template-insert-package (name)  (defun vhdl-template-insert-package (name)
10542    "Insert the built-in package template with NAME."    "Insert the built-in package template with NAME."
# Line 8128  but not if inside a comment or quote)." Line 10545  but not if inside a comment or quote)."
10545             (completing-read "Package name: "             (completing-read "Package name: "
10546                              vhdl-template-package-alist nil t))))                              vhdl-template-package-alist nil t))))
10547    (vhdl-template-insert-fun    (vhdl-template-insert-fun
10548     (car (cdr (assoc name vhdl-template-package-alist)))))     (cadr (assoc name vhdl-template-package-alist))))
10549    
10550  (defun vhdl-template-insert-directive (name)  (defun vhdl-template-insert-directive (name)
10551    "Insert the built-in directive template with NAME."    "Insert the built-in directive template with NAME."
# Line 8137  but not if inside a comment or quote)." Line 10554  but not if inside a comment or quote)."
10554             (completing-read "Directive name: "             (completing-read "Directive name: "
10555                              vhdl-template-directive-alist nil t))))                              vhdl-template-directive-alist nil t))))
10556    (vhdl-template-insert-fun    (vhdl-template-insert-fun
10557     (car (cdr (assoc name vhdl-template-directive-alist)))))     (cadr (assoc name vhdl-template-directive-alist))))
10558    
10559  (defun vhdl-template-insert-fun (fun)  (defun vhdl-template-insert-fun (fun)
10560    "Call FUN to insert a built-in template."    "Call FUN to insert a built-in template."
# Line 8154  but not if inside a comment or quote)." Line 10571  but not if inside a comment or quote)."
10571    (interactive    (interactive
10572     (let ((completion-ignore-case t))     (let ((completion-ignore-case t))
10573       (list (completing-read "Model name: " vhdl-model-alist))))       (list (completing-read "Model name: " vhdl-model-alist))))
10574    (vhdl-indent-line)    (indent-according-to-mode)
10575    (let ((start (point-marker))    (let ((start (point-marker))
10576          (margin (current-indentation))          (margin (current-indentation))
         (case-fold-search t)  
10577          model position prompt string end)          model position prompt string end)
10578      (vhdl-ext-syntax-table      (vhdl-prepare-search-2
10579       (when (setq model (assoc model-name vhdl-model-alist))       (when (setq model (assoc model-name vhdl-model-alist))
10580         ;; insert model         ;; insert model
10581         (beginning-of-line)         (beginning-of-line)
# Line 8184  but not if inside a comment or quote)." Line 10600  but not if inside a comment or quote)."
10600         (unless (equal "" vhdl-reset-name)         (unless (equal "" vhdl-reset-name)
10601           (while (re-search-forward "<reset>" end t)           (while (re-search-forward "<reset>" end t)
10602             (replace-match vhdl-reset-name)))             (replace-match vhdl-reset-name)))
10603           ;; replace header prompts
10604           (vhdl-template-replace-header-keywords start end nil t)
10605         (goto-char start)         (goto-char start)
10606         ;; query prompts         ;; query other prompts
10607         (while (re-search-forward         (while (re-search-forward
10608                 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)                 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
10609           (unless (equal "cursor" (match-string 1))           (unless (equal "cursor" (match-string 1))
# Line 8234  but not if inside a comment or quote)." Line 10652  but not if inside a comment or quote)."
10652  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10653    
10654  (defvar vhdl-port-list nil  (defvar vhdl-port-list nil
10655    "Variable to hold last PORT map parsed.")    "Variable to hold last port map parsed.")
10656  ;; structure: (parenthesised expression means list of such entries)  ;; structure: (parenthesised expression means list of such entries)
10657  ;; ((generic-names) generic-type generic-init generic-comment)  ;; (ent-name
10658  ;; ((port-names) port-object port-direct port-type port-comment)  ;;  ((generic-names) generic-type generic-init generic-comment group-comment)
10659    ;;  ((port-names) port-object port-direct port-type port-comment group-comment)
10660    ;;  (lib-name pack-key))
10661    
10662  (defun vhdl-parse-string (string &optional optional)  (defun vhdl-parse-string (string &optional optional)
10663    "Check that the text following point matches the regexp in STRING.    "Check that the text following point matches the regexp in STRING."
 END is the point beyond which matching/searching should not go."  
10664    (if (looking-at string)    (if (looking-at string)
10665        (re-search-forward string nil t)        (goto-char (match-end 0))
10666      (unless optional      (unless optional
10667        (throw 'parse (format "Syntax error near line %s" (vhdl-current-line))))        (throw 'parse (format "ERROR:  Syntax error near line %s, expecting \"%s\""
10668                                (vhdl-current-line) string)))
10669      nil))      nil))
10670    
10671  (defun vhdl-replace-string (regexp-cons string)  (defun vhdl-replace-string (regexp-cons string)
10672    "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."    "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
10673    (vhdl-ext-syntax-table    (vhdl-prepare-search-1
10674     (if (string-match (car regexp-cons) string)     (if (string-match (car regexp-cons) string)
10675         (replace-match (cdr regexp-cons) t nil string)         (funcall vhdl-file-name-case
10676                    (replace-match (cdr regexp-cons) t nil string))
10677       string)))       string)))
10678    
10679  (defun vhdl-port-flatten ()  (defun vhdl-parse-group-comment ()
10680      "Parse comment and empty lines between groups of lines."
10681      (let ((start (point))
10682            string)
10683        (vhdl-forward-comment (point-max))
10684        (setq string (buffer-substring-no-properties start (point)))
10685        ;; strip off leading blanks and first newline
10686        (while (string-match "^\\(\\s-+\\)" string)
10687          (setq string (concat (substring string 0 (match-beginning 1))
10688                               (substring string (match-end 1)))))
10689        (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
10690            (substring string 1)
10691          string)))
10692    
10693    (defun vhdl-paste-group-comment (string indent)
10694      "Paste comment and empty lines from STRING between groups of lines
10695    with INDENT."
10696      (let ((pos (point-marker)))
10697        (when (> indent 0)
10698          (while (string-match "^\\(--\\)" string)
10699            (setq string (concat (substring string 0 (match-beginning 1))
10700                                 (make-string indent ? )
10701                                 (substring string (match-beginning 1))))))
10702        (beginning-of-line)
10703        (insert string)
10704        (goto-char pos)))
10705    
10706    (defvar vhdl-port-flattened nil
10707      "Indicates whether a port has been flattened.")
10708    
10709    (defun vhdl-port-flatten (&optional as-alist)
10710    "Flatten port list so that only one generic/port exists per line."    "Flatten port list so that only one generic/port exists per line."
10711    (interactive)    (interactive)
10712    (if (not vhdl-port-list)    (if (not vhdl-port-list)
10713        (error "No port read")        (error "ERROR:  No port has been read")
10714      (message "Flattening port...")      (message "Flattening port...")
10715      (let ((new-vhdl-port-list (list (car vhdl-port-list)))      (let ((new-vhdl-port-list (list (car vhdl-port-list)))
10716            (old-vhdl-port-list (cdr vhdl-port-list))            (old-vhdl-port-list (cdr vhdl-port-list))
10717            old-port-list new-port-list old-port new-port names)            old-port-list new-port-list old-port new-port names)
10718        ;; traverse port list and flatten entries        ;; traverse port list and flatten entries
10719        (while old-vhdl-port-list        (while (cdr old-vhdl-port-list)
10720          (setq old-port-list (car old-vhdl-port-list))          (setq old-port-list (car old-vhdl-port-list))
10721          (setq new-port-list nil)          (setq new-port-list nil)
10722          (while old-port-list          (while old-port-list
10723            (setq old-port (car old-port-list))            (setq old-port (car old-port-list))
10724            (setq names (car old-port))            (setq names (car old-port))
10725            (while names            (while names
10726              (setq new-port (cons (list (car names)) (cdr old-port)))              (setq new-port (cons (if as-alist (car names) (list (car names)))
10727                                     (cdr old-port)))
10728              (setq new-port-list (append new-port-list (list new-port)))              (setq new-port-list (append new-port-list (list new-port)))
10729              (setq names (cdr names)))              (setq names (cdr names)))
10730            (setq old-port-list (cdr old-port-list)))            (setq old-port-list (cdr old-port-list)))
10731          (setq old-vhdl-port-list (cdr old-vhdl-port-list))          (setq old-vhdl-port-list (cdr old-vhdl-port-list))
10732          (setq new-vhdl-port-list (append new-vhdl-port-list          (setq new-vhdl-port-list (append new-vhdl-port-list
10733                                           (list new-port-list))))                                           (list new-port-list))))
10734        (setq vhdl-port-list new-vhdl-port-list)        (setq vhdl-port-list
10735                (append new-vhdl-port-list (list old-vhdl-port-list))
10736                vhdl-port-flattened t)
10737        (message "Flattening port...done"))))        (message "Flattening port...done"))))
10738    
10739    (defvar vhdl-port-reversed-direction nil
10740      "Indicates whether port directions are reversed.")
10741    
10742    (defun vhdl-port-reverse-direction ()
10743      "Reverse direction for all ports (useful in testbenches)."
10744      (interactive)
10745      (if (not vhdl-port-list)
10746          (error "ERROR:  No port has been read")
10747        (message "Reversing port directions...")
10748        (let ((port-list (nth 2 vhdl-port-list))
10749              port-dir-car port-dir)
10750          ;; traverse port list and reverse directions
10751          (while port-list
10752            (setq port-dir-car (cddr (car port-list))
10753                  port-dir (car port-dir-car))
10754            (setcar port-dir-car
10755                    (cond ((equal port-dir "in") "out")
10756                          ((equal port-dir "out") "in")
10757                          (t port-dir)))
10758            (setq port-list (cdr port-list)))
10759          (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
10760          (message "Reversing port directions...done"))))
10761    
10762  (defun vhdl-port-copy ()  (defun vhdl-port-copy ()
10763    "Get generic and port information from an entity or component declaration."    "Get generic and port information from an entity or component declaration."
10764    (interactive)    (interactive)
   (message "Reading port...")  
10765    (save-excursion    (save-excursion
10766      (let ((case-fold-search t)      (let (parse-error end-of-list
10767            parse-error end-of-list            decl-type name generic-list port-list context-clause
10768            name generics ports            object names direct type init comment group-comment)
10769            object names direct type init comment)        (vhdl-prepare-search-2
       (vhdl-ext-syntax-table  
10770         (setq         (setq
10771          parse-error          parse-error
10772          (catch 'parse          (catch 'parse
10773            ;; check if within entity or component declaration            ;; check if within entity or component declaration
10774              (end-of-line)
10775            (when (or (not (re-search-backward            (when (or (not (re-search-backward
10776                            "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))                            "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
10777                      (equal "end" (match-string 1)))                      (equal "END" (upcase (match-string 1))))
10778              (throw 'parse "Not within entity or component declaration"))              (throw 'parse "ERROR:  Not within an entity or component declaration"))
10779              (setq decl-type (downcase (match-string-no-properties 1)))
10780            (forward-word 1)            (forward-word 1)
10781            (vhdl-parse-string "\\s-*\\(\\w+\\)\\s-*\\(is\\)?\\s-*$")            (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
10782            (setq name (match-string 1))            (setq name (match-string-no-properties 1))
10783              (message "Reading port of %s \"%s\"..." decl-type name)
10784            (vhdl-forward-syntactic-ws)            (vhdl-forward-syntactic-ws)
10785            ;; parse generic clause            ;; parse generic clause
10786            (when (vhdl-parse-string "generic[ \t\n]*(" t)            (when (vhdl-parse-string "generic[ \t\n]*(" t)
10787              (vhdl-forward-syntactic-ws)              ;; parse group comment and spacing
10788              (setq end-of-list (looking-at ")"))              (setq group-comment (vhdl-parse-group-comment))
10789                (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
10790              (while (not end-of-list)              (while (not end-of-list)
10791                ;; parse names                ;; parse names
10792                (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")                (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")
10793                (setq names (list (match-string 1)))                (setq names (list (match-string-no-properties 1)))
10794                (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)                (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
10795                  (setq names (append names (list (match-string 1)))))                  (setq names
10796                          (append names (list (match-string-no-properties 1)))))
10797                ;; parse type                ;; parse type
10798                (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")                (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
10799                (setq type (match-string 1))                (setq type (match-string-no-properties 1))
10800                (setq comment nil)                (setq comment nil)
10801                (while (looking-at "(")                (while (looking-at "(")
10802                  (setq type                  (setq type
10803                        (concat type                        (concat type
10804                                (buffer-substring                                (buffer-substring-no-properties
10805                                 (point) (progn (forward-sexp) (point)))                                 (point) (progn (forward-sexp) (point)))
10806                                (and (vhdl-parse-string "\\([^():;\n]*\\)" t)                                (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
10807                                     (match-string 1)))))                                     (match-string-no-properties 1)))))
10808                ;; special case: closing parenthesis is on separate line                ;; special case: closing parenthesis is on separate line
10809                (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))                (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
10810                  (setq comment (substring type (match-beginning 2)))                  (setq comment (substring type (match-beginning 2)))
10811                  (setq type (substring type 0 (match-beginning 1))))                  (setq type (substring type 0 (match-beginning 1))))
10812                ;; strip of trailing whitespace                ;; strip of trailing group-comment
10813                (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)                (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
10814                (setq type (substring type 0 (match-end 1)))                (setq type (substring type 0 (match-end 1)))
10815                ;; parse initialization expression                ;; parse initialization expression
10816                (setq init nil)                (setq init nil)
10817                (when (vhdl-parse-string ":=[ \t\n]*" t)                (when (vhdl-parse-string ":=[ \t\n]*" t)
10818                  (vhdl-parse-string "\\([^();\n]*\\)")                  (vhdl-parse-string "\\([^();\n]*\\)")
10819                  (setq init (match-string 1))                  (setq init (match-string-no-properties 1))
10820                  (while (looking-at "(")                  (while (looking-at "(")
10821                    (setq init                    (setq init
10822                          (concat init                          (concat init
10823                                  (buffer-substring                                  (buffer-substring-no-properties
10824                                   (point) (progn (forward-sexp) (point)))                                   (point) (progn (forward-sexp) (point)))
10825                                  (and (vhdl-parse-string "\\([^();\n]*\\)" t)                                  (and (vhdl-parse-string "\\([^();\n]*\\)" t)
10826                                       (match-string 1))))))                                       (match-string-no-properties 1))))))
10827                ;; special case: closing parenthesis is on separate line                ;; special case: closing parenthesis is on separate line
10828                (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))                (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
10829                  (setq comment (substring init (match-beginning 2)))                  (setq comment (substring init (match-beginning 2)))
# Line 8353  END is the point beyond which matching/s Line 10833  END is the point beyond which matching/s
10833                ;; parse inline comment, special case: as above, no initial.                ;; parse inline comment, special case: as above, no initial.
10834                (unless comment                (unless comment
10835                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10836                                     (match-string 1))))                                     (match-string-no-properties 1))))
10837                (vhdl-forward-syntactic-ws)                (vhdl-forward-syntactic-ws)
10838                (setq end-of-list (vhdl-parse-string ")" t))                (setq end-of-list (vhdl-parse-string ")" t))
10839                (vhdl-parse-string ";\\s-*")                (vhdl-parse-string "\\s-*;\\s-*")
10840                ;; parse inline comment                ;; parse inline comment
10841                (unless comment                (unless comment
10842                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10843                                     (match-string 1))))                                     (match-string-no-properties 1))))
               (vhdl-forward-syntactic-ws)  
10844                ;; save everything in list                ;; save everything in list
10845                (setq generics (append generics                (setq generic-list (append generic-list
10846                                       (list (list names type init comment))))))                                           (list (list names type init
10847                                                         comment group-comment))))
10848                  ;; parse group comment and spacing
10849                  (setq group-comment (vhdl-parse-group-comment))))
10850            ;; parse port clause            ;; parse port clause
10851            (when (vhdl-parse-string "port[ \t\n]*(" t)            (when (vhdl-parse-string "port[ \t\n]*(" t)
10852              (vhdl-forward-syntactic-ws)              ;; parse group comment and spacing
10853              (setq end-of-list (looking-at ")"))              (setq group-comment (vhdl-parse-group-comment))
10854                (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
10855              (while (not end-of-list)              (while (not end-of-list)
10856                ;; parse object                ;; parse object
10857                (setq object                (setq object
10858                      (and (vhdl-parse-string                      (and (vhdl-parse-string "\\(signal\\|quantity\\|terminal\\)[ \t\n]*" t)
10859                            "\\(signal\\|quantity\\|terminal\\)[ \t\n]*" t)                           (match-string-no-properties 1)))
10860                           (match-string 1)))                ;; parse names (accept extended identifiers)
10861                ;; parse names                (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
10862                (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")                (setq names (list (match-string-no-properties 1)))
10863                (setq names (list (match-string 1)))                (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
10864                (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)                  (setq names (append names (list (match-string-no-properties 1)))))
                 (setq names (append names (list (match-string 1)))))  
10865                ;; parse direction                ;; parse direction
10866                (vhdl-parse-string ":[ \t\n]*")                (vhdl-parse-string ":[ \t\n]*")
10867                (setq direct                (setq direct
10868                      (and (vhdl-parse-string "\\(IN\\|OUT\\|INOUT\\)[ \t\n]+" t)                      (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
10869                           (match-string 1)))                           (match-string-no-properties 1)))
10870                ;; parse type                ;; parse type
10871                (vhdl-parse-string "\\([^();\n]+\\)")                (vhdl-parse-string "\\([^();\n]+\\)")
10872                (setq type (match-string 1))                (setq type (match-string-no-properties 1))
10873                (setq comment nil)                (setq comment nil)
10874                (while (looking-at "(")                (while (looking-at "(")
10875                  (setq type (concat type                  (setq type (concat type
10876                                     (buffer-substring                                     (buffer-substring-no-properties
10877                                      (point) (progn (forward-sexp) (point)))                                      (point) (progn (forward-sexp) (point)))
10878                                     (and (vhdl-parse-string "\\([^();\n]*\\)" t)                                     (and (vhdl-parse-string "\\([^();\n]*\\)" t)
10879                                          (match-string 1)))))                                          (match-string-no-properties 1)))))
10880                ;; special case: closing parenthesis is on separate line                ;; special case: closing parenthesis is on separate line
10881                (when (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)                (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
10882                  (setq comment (substring type (match-beginning 2)))                  (setq comment (substring type (match-beginning 2)))
10883                  (setq type (substring type 0 (match-beginning 1))))                  (setq type (substring type 0 (match-beginning 1))))
10884                ;; strip of trailing whitespace                ;; strip of trailing group-comment
10885                (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)                (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
10886                (setq type (substring type 0 (match-end 1)))                (setq type (substring type 0 (match-end 1)))
10887                (vhdl-forward-syntactic-ws)                (vhdl-forward-syntactic-ws)
10888                (setq end-of-list (vhdl-parse-string ")" t))                (setq end-of-list (vhdl-parse-string ")" t))
10889                (vhdl-parse-string ";\\s-*")                (vhdl-parse-string "\\s-*;\\s-*")
10890                ;; parse inline comment                ;; parse inline comment
10891                (unless comment                (unless comment
10892                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
10893                                     (match-string 1))))                                     (match-string-no-properties 1))))
               (vhdl-forward-syntactic-ws)  
10894                ;; save everything in list                ;; save everything in list
10895                (setq ports                (setq port-list (append port-list
10896                      (append ports                                        (list (list names object direct type
10897                              (list (list names object direct type comment))))))                                                    comment group-comment))))
10898                  ;; parse group comment and spacing
10899                  (setq group-comment (vhdl-parse-group-comment))))
10900    ;         (vhdl-parse-string "end\\>")
10901              ;; parse context clause
10902              (setq context-clause (vhdl-scan-context-clause))
10903    ;         ;; add surrounding package to context clause
10904    ;         (when (and (equal decl-type "component")
10905    ;                    (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
10906    ;           (setq context-clause
10907    ;                 (append context-clause
10908    ;                         (list (cons (vhdl-work-library)
10909    ;                                     (match-string-no-properties 1))))))
10910              (message "Reading port of %s \"%s\"...done" decl-type name)
10911            nil)))            nil)))
10912        ;; finish parsing        ;; finish parsing
10913        (if parse-error        (if parse-error
10914            (error parse-error)            (error parse-error)
10915          (setq vhdl-port-list (list name generics ports))          (setq vhdl-port-list (list name generic-list port-list context-clause)
10916          (message "Reading port...done")))))                vhdl-port-reversed-direction nil
10917                  vhdl-port-flattened nil)))))
10918    
10919    (defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
10920      "Paste a context clause."
10921      (let ((margin (current-indentation))
10922            (clause-list (nth 3 vhdl-port-list))
10923            clause)
10924        (while clause-list
10925          (setq clause (car clause-list))
10926          (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
10927                                                    (downcase exclude-pack-name)))
10928                      (save-excursion
10929                        (re-search-backward
10930                         (concat "^\\s-*use\\s-+" (car clause)
10931                                 "\." (cdr clause) "\\>") nil t)))
10932            (vhdl-template-standard-package (car clause) (cdr clause))
10933            (insert "\n"))
10934          (setq clause-list (cdr clause-list)))))
10935    
10936  (defun vhdl-port-paste-generic (&optional no-init)  (defun vhdl-port-paste-generic (&optional no-init)
10937    "Paste a generic clause."    "Paste a generic clause."
10938    (let ((margin (current-indentation))    (let ((margin (current-indentation))
10939          list-margin start names generic          (generic-list (nth 1 vhdl-port-list))
10940          (generics-list (nth 1 vhdl-port-list)))          list-margin start names generic)
10941      ;; paste generic clause      ;; paste generic clause
10942      (when generics-list      (when generic-list
10943        (setq start (point))        (setq start (point))
10944        (vhdl-insert-keyword "GENERIC (")        (vhdl-insert-keyword "GENERIC (")
10945        (unless vhdl-argument-list-indent        (unless vhdl-argument-list-indent
10946          (insert "\n") (indent-to (+ margin vhdl-basic-offset)))          (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10947        (setq list-margin (current-column))        (setq list-margin (current-column))
10948        (while generics-list        (while generic-list
10949            (setq generic (car generic-list))
10950            ;; paste group comment and spacing
10951            (when (memq vhdl-include-group-comments '(decl always))
10952              (vhdl-paste-group-comment (nth 4 generic) list-margin))
10953          ;; paste names          ;; paste names
         (setq generic (car generics-list))  
10954          (setq names (nth 0 generic))          (setq names (nth 0 generic))
10955          (while names          (while names
10956            (insert (car names))            (insert (car names))
# Line 8446  END is the point beyond which matching/s Line 10961  END is the point beyond which matching/s
10961          ;; paste initialization          ;; paste initialization
10962          (when (and (not no-init) (nth 2 generic))          (when (and (not no-init) (nth 2 generic))
10963            (insert " := " (nth 2 generic)))            (insert " := " (nth 2 generic)))
10964          (unless (cdr generics-list) (insert ")"))          (unless (cdr generic-list) (insert ")"))
10965          (insert ";")          (insert ";")
10966          ;; paste comment          ;; paste comment
10967          (when (and vhdl-include-port-comments (nth 3 generic))          (when (and vhdl-include-port-comments (nth 3 generic))
10968            (vhdl-comment-insert-inline (nth 3 generic) t))            (vhdl-comment-insert-inline (nth 3 generic) t))
10969          (setq generics-list (cdr generics-list))          (setq generic-list (cdr generic-list))
10970          (when generics-list (insert "\n") (indent-to list-margin)))          (when generic-list (insert "\n") (indent-to list-margin)))
10971        ;; align generic clause        ;; align generic clause
10972        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1 t)))))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
10973    
10974  (defun vhdl-port-paste-port ()  (defun vhdl-port-paste-port ()
10975    "Paste a port clause."    "Paste a port clause."
10976    (let ((margin (current-indentation))    (let ((margin (current-indentation))
10977          list-margin start names port          (port-list (nth 2 vhdl-port-list))
10978          (ports-list (nth 2 vhdl-port-list)))          list-margin start names port)
10979      ;; paste port clause      ;; paste port clause
10980      (when ports-list      (when port-list
10981        (setq start (point))        (setq start (point))
10982        (vhdl-insert-keyword "PORT (")        (vhdl-insert-keyword "PORT (")
10983        (unless vhdl-argument-list-indent        (unless vhdl-argument-list-indent
10984          (insert "\n") (indent-to (+ margin vhdl-basic-offset)))          (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
10985        (setq list-margin (current-column))        (setq list-margin (current-column))
10986        (while ports-list        (while port-list
10987          (setq port (car ports-list))          (setq port (car port-list))
10988            ;; paste group comment and spacing
10989            (when (memq vhdl-include-group-comments '(decl always))
10990              (vhdl-paste-group-comment (nth 5 port) list-margin))
10991          ;; paste object          ;; paste object
10992          (when (nth 1 port) (insert (nth 1 port) " "))          (when (nth 1 port) (insert (nth 1 port) " "))
10993          ;; paste names          ;; paste names
# Line 8483  END is the point beyond which matching/s Line 11001  END is the point beyond which matching/s
11001          (when (nth 2 port) (insert (nth 2 port) " "))          (when (nth 2 port) (insert (nth 2 port) " "))
11002          ;; paste type          ;; paste type
11003          (insert (nth 3 port))          (insert (nth 3 port))
11004          (unless (cdr ports-list) (insert ")"))          (unless (cdr port-list) (insert ")"))
11005          (insert ";")          (insert ";")
11006          ;; paste comment          ;; paste comment
11007          (when (and vhdl-include-port-comments (nth 4 port))          (when (and vhdl-include-port-comments (nth 4 port))
11008            (vhdl-comment-insert-inline (nth 4 port) t))            (vhdl-comment-insert-inline (nth 4 port) t))
11009          (setq ports-list (cdr ports-list))          (setq port-list (cdr port-list))
11010          (when ports-list (insert "\n") (indent-to list-margin)))          (when port-list (insert "\n") (indent-to list-margin)))
11011        ;; align port clause        ;; align port clause
11012        (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1)))))        (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
11013    
11014  (defun vhdl-port-paste-declaration (kind)  (defun vhdl-port-paste-declaration (kind &optional no-indent)
11015    "Paste as an entity or component declaration."    "Paste as an entity or component declaration."
11016    (vhdl-indent-line)    (unless no-indent (indent-according-to-mode))
11017    (let ((margin (current-indentation))    (let ((margin (current-indentation))
11018          (name (nth 0 vhdl-port-list)))          (name (nth 0 vhdl-port-list)))
11019      (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))      (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
11020      (insert name)      (insert name)
11021      (if (eq kind 'entity) (vhdl-insert-keyword " IS"))      (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
11022        ;; paste generic and port clause          (vhdl-insert-keyword " IS"))
11023        ;; paste generic and port clause
11024      (when (nth 1 vhdl-port-list)      (when (nth 1 vhdl-port-list)
11025        (insert "\n")        (insert "\n")
11026        (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))        (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
# Line 8528  END is the point beyond which matching/s Line 11047  END is the point beyond which matching/s
11047        (unless (vhdl-standard-p '87) (insert " " name)))        (unless (vhdl-standard-p '87) (insert " " name)))
11048      (insert ";")))      (insert ";")))
11049    
11050  (defun vhdl-port-paste-entity ()  (defun vhdl-port-paste-entity (&optional no-indent)
11051    "Paste as an entity declaration."    "Paste as an entity declaration."
11052    (interactive)    (interactive)
11053    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11054        (error "No port read")        (error "ERROR:  No port read")
11055      (message "Pasting port as entity...")      (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
11056      (vhdl-port-paste-declaration 'entity)      (vhdl-port-paste-declaration 'entity no-indent)
11057      (message "Pasting port as entity...done")))      (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
11058    
11059  (defun vhdl-port-paste-component ()  (defun vhdl-port-paste-component (&optional no-indent)
11060    "Paste as a component declaration."    "Paste as a component declaration."
11061    (interactive)    (interactive)
11062    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11063        (error "No port read")        (error "ERROR:  No port read")
11064      (message "Pasting port as component...")      (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
11065      (vhdl-port-paste-declaration 'component)      (vhdl-port-paste-declaration 'component no-indent)
11066      (message "Pasting port as component...done")))      (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
11067    
11068  (defun vhdl-port-paste-generic-map (&optional secondary no-constants)  (defun vhdl-port-paste-generic-map (&optional secondary no-constants)
11069    "Paste as a generic map."    "Paste as a generic map."
11070    (interactive)    (interactive)
11071    (unless secondary (vhdl-indent-line))    (unless secondary (indent-according-to-mode))
11072    (let ((margin (current-indentation))    (let ((margin (current-indentation))
11073          list-margin start generic          list-margin start generic
11074          (generics-list (nth 1 vhdl-port-list)))          (generic-list (nth 1 vhdl-port-list)))
11075      (when generics-list      (when generic-list
11076        (setq start (point))        (setq start (point))
11077        (vhdl-insert-keyword "GENERIC MAP (")        (vhdl-insert-keyword "GENERIC MAP (")
11078        (if (not vhdl-association-list-with-formals)        (if (not vhdl-association-list-with-formals)
11079            ;; paste list of actual generics            ;; paste list of actual generics
11080            (while generics-list            (while generic-list
11081              (insert (or (nth 2 (car generics-list)) " "))              (insert (if no-constants
11082              (setq generics-list (cdr generics-list))                        (car (nth 0 (car generic-list)))
11083              (insert (if generics-list ", " ")")))                      (or (nth 2 (car generic-list)) " ")))
11084                (setq generic-list (cdr generic-list))
11085                (insert (if generic-list ", " ")")))
11086          (unless vhdl-argument-list-indent          (unless vhdl-argument-list-indent
11087            (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))))            (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11088          (setq list-margin (current-column))          (setq list-margin (current-column))
11089          (while generics-list          (while generic-list
11090            (setq generic (car generics-list))            (setq generic (car generic-list))
11091              ;; paste group comment and spacing
11092              (when (eq vhdl-include-group-comments 'always)
11093                (vhdl-paste-group-comment (nth 4 generic) list-margin))
11094            ;; paste formal and actual generic            ;; paste formal and actual generic
11095            (insert (car (nth 0 generic)) " => "            (insert (car (nth 0 generic)) " => "
11096                    (if no-constants                    (if no-constants
11097                        (car (nth 0 generic))                        (car (nth 0 generic))
11098                      (or (nth 2 generic) "")))                      (or (nth 2 generic) "")))
11099            (setq generics-list (cdr generics-list))            (setq generic-list (cdr generic-list))
11100            (insert (if generics-list "," ")"))            (insert (if generic-list "," ")"))
11101            ;; paste comment            ;; paste comment
11102            (when (and vhdl-include-port-comments (nth 3 generic))            (when (or vhdl-include-type-comments
11103              (vhdl-comment-insert-inline (nth 3 generic) t))                      (and vhdl-include-port-comments (nth 3 generic)))
11104            (when generics-list (insert "\n") (indent-to list-margin)))              (vhdl-comment-insert-inline
11105                 (concat
11106                  (when vhdl-include-type-comments
11107                    (concat "[" (nth 1 generic) "] "))
11108                  (when vhdl-include-port-comments (nth 3 generic))) t))
11109              (when generic-list (insert "\n") (indent-to list-margin)))
11110          ;; align generic map          ;; align generic map
11111          (when vhdl-auto-align          (when vhdl-auto-align
11112            (vhdl-align-noindent-region start (point) 1 t))))))            (vhdl-align-region-groups start (point) 1 t))))))
11113    
11114  (defun vhdl-port-paste-port-map ()  (defun vhdl-port-paste-port-map ()
11115    "Paste as a port map."    "Paste as a port map."
11116    (let ((margin (current-indentation))    (let ((margin (current-indentation))
11117          list-margin start port          list-margin start port
11118          (ports-list (nth 2 vhdl-port-list)))          (port-list (nth 2 vhdl-port-list)))
11119      (when ports-list      (when port-list
11120        (setq start (point))        (setq start (point))
11121        (vhdl-insert-keyword "PORT MAP (")        (vhdl-insert-keyword "PORT MAP (")
11122        (if (not vhdl-association-list-with-formals)        (if (not vhdl-association-list-with-formals)
11123            ;; paste list of actual ports            ;; paste list of actual ports
11124            (while ports-list            (while port-list
11125              (insert (vhdl-replace-string vhdl-actual-port-name              (insert (vhdl-replace-string vhdl-actual-port-name
11126                                           (car (nth 0 (car ports-list)))))                                           (car (nth 0 (car port-list)))))
11127              (setq ports-list (cdr ports-list))              (setq port-list (cdr port-list))
11128              (insert (if ports-list ", " ");")))              (insert (if port-list ", " ");")))
11129          (unless vhdl-argument-list-indent          (unless vhdl-argument-list-indent
11130            (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))))            (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11131          (setq list-margin (current-column))          (setq list-margin (current-column))
11132          (while ports-list          (while port-list
11133            (setq port (car ports-list))            (setq port (car port-list))
11134              ;; paste group comment and spacing
11135              (when (eq vhdl-include-group-comments 'always)
11136                (vhdl-paste-group-comment (nth 5 port) list-margin))
11137            ;; paste formal and actual port            ;; paste formal and actual port
11138            (insert (car (nth 0 port)) " => ")            (insert (car (nth 0 port)) " => ")
11139            (insert (vhdl-replace-string vhdl-actual-port-name            (insert (vhdl-replace-string vhdl-actual-port-name
11140                                         (car (nth 0 port))))                                         (car (nth 0 port))))
11141            (setq ports-list (cdr ports-list))            (setq port-list (cdr port-list))
11142            (insert (if ports-list "," ");"))            (insert (if port-list "," ");"))
11143            ;; paste comment            ;; paste comment
11144            (when (or vhdl-include-direction-comments            (when (or vhdl-include-direction-comments
11145                        vhdl-include-type-comments
11146                      (and vhdl-include-port-comments (nth 4 port)))                      (and vhdl-include-port-comments (nth 4 port)))
11147              (vhdl-comment-insert-inline              (vhdl-comment-insert-inline
11148               (concat               (concat
11149                (if vhdl-include-direction-comments                (cond ((and vhdl-include-direction-comments
11150                    (format "%-4s" (or (concat (nth 2 port) " ") "")) "")                            vhdl-include-type-comments)
11151                (if vhdl-include-port-comments (nth 4 port) "")) t))                       (concat "[" (format "%-4s" (concat (nth 2 port) " "))
11152            (when ports-list (insert "\n") (indent-to list-margin)))                               (nth 3 port) "] "))
11153                        ((and vhdl-include-direction-comments (nth 2 port))
11154                         (format "%-6s" (concat "[" (nth 2 port) "] ")))
11155                        (vhdl-include-direction-comments "      ")
11156                        (vhdl-include-type-comments
11157                         (concat "[" (nth 3 port) "] ")))
11158                  (when vhdl-include-port-comments (nth 4 port))) t))
11159              (when port-list (insert "\n") (indent-to list-margin)))
11160          ;; align port clause          ;; align port clause
11161          (when vhdl-auto-align          (when vhdl-auto-align
11162            (vhdl-align-noindent-region start (point) 1))))))            (vhdl-align-region-groups start (point) 1))))))
11163    
11164  (defun vhdl-port-paste-instance (&optional name)  (defun vhdl-port-paste-instance (&optional name no-indent title)
11165    "Paste as an instantiation."    "Paste as an instantiation."
11166    (interactive)    (interactive)
11167    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11168        (error "No port read")        (error "ERROR:  No port read")
11169      (let ((orig-vhdl-port-list vhdl-port-list))      (let ((orig-vhdl-port-list vhdl-port-list))
11170        ;; flatten local copy of port list (must be flat for port mapping)        ;; flatten local copy of port list (must be flat for port mapping)
11171        (vhdl-port-flatten)        (vhdl-port-flatten)
11172        (vhdl-indent-line)        (unless no-indent (indent-according-to-mode))
11173        (let ((margin (current-indentation))        (let ((margin (current-indentation)))
             list-margin start generic port  
             (generics-list (nth 1 vhdl-port-list))  
             (ports-list (nth 2 vhdl-port-list)))  
11174          ;; paste instantiation          ;; paste instantiation
11175          (if name          (cond (name
11176              (insert name ": ")                 (insert name))
11177            (if (equal (cdr vhdl-instance-name) "")                ((equal (cdr vhdl-instance-name) "")
11178                (vhdl-template-field "instance name" ": ")                 (setq name (vhdl-template-field "instance name")))
11179              (insert (vhdl-replace-string vhdl-instance-name                ((string-match "\%d" (cdr vhdl-instance-name))
11180                                           (nth 0 vhdl-port-list)) ": ")))                 (let ((n 1))
11181          (message "Pasting port as instantiation...")                   (while (save-excursion
11182          (if (vhdl-standard-p '87)                            (setq name (format (vhdl-replace-string
11183                                                  vhdl-instance-name
11184                                                  (nth 0 vhdl-port-list)) n))
11185                              (goto-char (point-min))
11186                              (vhdl-re-search-forward name nil t))
11187                       (setq n (1+ n)))
11188                     (insert name)))
11189                  (t (insert (vhdl-replace-string vhdl-instance-name
11190                                                  (nth 0 vhdl-port-list)))))
11191            (message "Pasting port as instantiation \"%s\"..." name)
11192            (insert ": ")
11193            (when title
11194              (save-excursion
11195                (beginning-of-line)
11196                (indent-to vhdl-basic-offset)
11197                (insert "-- instance \"" name "\"\n")))
11198            (if (not (vhdl-use-direct-instantiation))
11199              (insert (nth 0 vhdl-port-list))              (insert (nth 0 vhdl-port-list))
11200            (vhdl-insert-keyword "ENTITY ")            (vhdl-insert-keyword "ENTITY ")
11201            (insert "work." (nth 0 vhdl-port-list)))            (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
11202          (when (nth 1 vhdl-port-list)          (when (nth 1 vhdl-port-list)
11203            (insert "\n") (indent-to (+ margin vhdl-basic-offset))            (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11204            (vhdl-port-paste-generic-map t t))            (vhdl-port-paste-generic-map t t))
11205          (when (nth 2 vhdl-port-list)          (when (nth 2 vhdl-port-list)
11206            (insert "\n") (indent-to (+ margin vhdl-basic-offset))            (insert "\n") (indent-to (+ margin vhdl-basic-offset))
11207            (vhdl-port-paste-port-map))            (vhdl-port-paste-port-map))
11208          (message "Pasting port as instantiation...done"))          (message "Pasting port as instantiation \"%s\"...done" name))
11209          (setq vhdl-port-list orig-vhdl-port-list))))
11210    
11211    (defun vhdl-port-paste-constants (&optional no-indent)
11212      "Paste generics as constants."
11213      (interactive)
11214      (if (not vhdl-port-list)
11215          (error "ERROR:  No port read")
11216        (let ((orig-vhdl-port-list vhdl-port-list))
11217          (message "Pasting port as constants...")
11218          ;; flatten local copy of port list (must be flat for constant initial.)
11219          (vhdl-port-flatten)
11220          (unless no-indent (indent-according-to-mode))
11221          (let ((margin (current-indentation))
11222                start generic name
11223                (generic-list (nth 1 vhdl-port-list)))
11224            (when generic-list
11225              (setq start (point))
11226              (while generic-list
11227                (setq generic (car generic-list))
11228                ;; paste group comment and spacing
11229                (when (memq vhdl-include-group-comments '(decl always))
11230                  (vhdl-paste-group-comment (nth 4 generic) margin))
11231                (vhdl-insert-keyword "CONSTANT ")
11232                ;; paste generic constants
11233                (setq name (nth 0 generic))
11234                (when name
11235                  (insert (car name))
11236                  ;; paste type
11237                  (insert " : " (nth 1 generic))
11238                  ;; paste initialization
11239                  (when (nth 2 generic)
11240                    (insert " := " (nth 2 generic)))
11241                  (insert ";")
11242                  ;; paste comment
11243                  (when (and vhdl-include-port-comments (nth 3 generic))
11244                    (vhdl-comment-insert-inline (nth 3 generic) t))
11245                  (setq generic-list (cdr generic-list))
11246                  (when generic-list (insert "\n") (indent-to margin))))
11247                ;; align signal list
11248              (when vhdl-auto-align
11249                (vhdl-align-region-groups start (point) 1))))
11250          (message "Pasting port as constants...done")
11251        (setq vhdl-port-list orig-vhdl-port-list))))        (setq vhdl-port-list orig-vhdl-port-list))))
11252    
11253  (defun vhdl-port-paste-signals (&optional initialize)  (defun vhdl-port-paste-signals (&optional initialize no-indent)
11254    "Paste ports as internal signals."    "Paste ports as internal signals."
11255    (interactive)    (interactive)
11256    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11257        (error "No port read")        (error "ERROR:  No port read")
11258      (message "Pasting port as signals...")      (message "Pasting port as signals...")
11259      (vhdl-indent-line)      (unless no-indent (indent-according-to-mode))
11260      (let ((margin (current-indentation))      (let ((margin (current-indentation))
11261            start port names            start port names
11262            (ports-list (nth 2 vhdl-port-list)))            (port-list (nth 2 vhdl-port-list)))
11263        (when ports-list        (when port-list
11264          (setq start (point))          (setq start (point))
11265          (while ports-list          (while port-list
11266            (setq port (car ports-list))            (setq port (car port-list))
11267              ;; paste group comment and spacing
11268              (when (memq vhdl-include-group-comments '(decl always))
11269                (vhdl-paste-group-comment (nth 5 port) margin))
11270            ;; paste object            ;; paste object
11271            (if (nth 1 port)            (if (nth 1 port)
11272                (insert (nth 1 port) " ")                (insert (nth 1 port) " ")
# Line 8682  END is the point beyond which matching/s Line 11280  END is the point beyond which matching/s
11280            ;; paste type            ;; paste type
11281            (insert " : " (nth 3 port))            (insert " : " (nth 3 port))
11282            ;; paste initialization (inputs only)            ;; paste initialization (inputs only)
11283            (when (and initialize (equal "in" (nth 2 port)))            (when (and initialize (equal "IN" (upcase (nth 2 port))))
11284              (insert              (insert " := " (if (string-match "(.+)" (nth 3 port))
11285               " := "                                 "(others => '0')" "'0'")))
              (if (string-match "(.+)" (nth 3 port)) "(others => '0')" "'0'")))  
11286            (insert ";")            (insert ";")
11287            ;; paste comment            ;; paste comment
11288            (when (and vhdl-include-port-comments (nth 4 port))            (when (or vhdl-include-direction-comments
11289              (vhdl-comment-insert-inline (nth 4 port) t))                      (and vhdl-include-port-comments (nth 4 port)))
11290            (setq ports-list (cdr ports-list))              (vhdl-comment-insert-inline
11291            (when ports-list (insert "\n") (indent-to margin)))               (concat
11292                  (cond ((and vhdl-include-direction-comments (nth 2 port))
11293                         (format "%-6s" (concat "[" (nth 2 port) "] ")))
11294                        (vhdl-include-direction-comments "      "))
11295                  (when vhdl-include-port-comments (nth 4 port))) t))
11296              (setq port-list (cdr port-list))
11297              (when port-list (insert "\n") (indent-to margin)))
11298          ;; align signal list          ;; align signal list
11299          (when vhdl-auto-align (vhdl-align-noindent-region start (point) 1))))          (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11300      (message "Pasting port as signals...done")))      (message "Pasting port as signals...done")))
11301    
11302  (defun vhdl-port-paste-constants ()  (defun vhdl-port-paste-initializations (&optional no-indent)
11303    "Paste generics as constants."    "Paste ports as signal initializations."
11304    (interactive)    (interactive)
11305    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11306        (error "No port read")        (error "ERROR:  No port read")
11307      (let ((orig-vhdl-port-list vhdl-port-list))      (let ((orig-vhdl-port-list vhdl-port-list))
11308        (message "Pasting port as constants...")        (message "Pasting port as initializations...")
11309        ;; flatten local copy of port list (must be flat for constant initial.)        ;; flatten local copy of port list (must be flat for signal initial.)
11310        (vhdl-port-flatten)        (vhdl-port-flatten)
11311        (vhdl-indent-line)        (unless no-indent (indent-according-to-mode))
11312        (let ((margin (current-indentation))        (let ((margin (current-indentation))
11313              start generic name              start port name
11314              (generics-list (nth 1 vhdl-port-list)))              (port-list (nth 2 vhdl-port-list)))
11315          (when generics-list          (when port-list
11316            (setq start (point))            (setq start (point))
11317            (while generics-list            (while port-list
11318              (setq generic (car generics-list))              (setq port (car port-list))
11319              (vhdl-insert-keyword "CONSTANT ")              ;; paste actual port signal (inputs only)
11320              ;; paste generic constants              (when (equal "IN" (upcase (nth 2 port)))
11321              (setq name (nth 0 generic))                (setq name (car (nth 0 port)))
11322              (when name                (insert (vhdl-replace-string vhdl-actual-port-name name))
               (insert (car name))  
               ;; paste type  
               (insert " : " (nth 1 generic))  
11323                ;; paste initialization                ;; paste initialization
11324                (when (nth 2 generic)                (insert " <= " (if (string-match "(.+)" (nth 3 port))
11325                  (insert " := " (nth 2 generic)))                                   "(others => '0')" "'0'") ";"))
11326                (insert ";")              (setq port-list (cdr port-list))
11327                ;; paste comment              (when (and port-list
11328                (when (and vhdl-include-port-comments (nth 3 generic))                         (equal "IN" (upcase (nth 2 (car port-list)))))
11329                  (vhdl-comment-insert-inline (nth 3 generic) t))                (insert "\n") (indent-to margin)))
11330                (setq generics-list (cdr generics-list))            ;; align signal list
11331                (when generics-list (insert "\n") (indent-to margin))))            (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
11332              ;; align signal list        (message "Pasting port as initializations...done")
           (when vhdl-auto-align  
             (vhdl-align-noindent-region start (point) 1))))  
       (message "Pasting port as constants...done")  
11333        (setq vhdl-port-list orig-vhdl-port-list))))        (setq vhdl-port-list orig-vhdl-port-list))))
11334    
11335  (defun vhdl-port-paste-testbench ()  (defun vhdl-port-paste-testbench ()
11336    "Paste as a bare-bones test bench."    "Paste as a bare-bones testbench."
11337    (interactive)    (interactive)
11338    (if (not vhdl-port-list)    (if (not vhdl-port-list)
11339        (error "No port read")        (error "ERROR:  No port read")
     (message "Pasting port as test bench...")  
11340      (let ((case-fold-search t)      (let ((case-fold-search t)
11341            (ent-name (vhdl-replace-string vhdl-testbench-entity-name            (ent-name (vhdl-replace-string vhdl-testbench-entity-name
11342                                           (nth 0 vhdl-port-list)))                                           (nth 0 vhdl-port-list)))
11343            (source-buffer (current-buffer))            (source-buffer (current-buffer))
11344            arch-name ent-file-name arch-file-name no-entity position)            arch-name config-name ent-file-name arch-file-name
11345              ent-buffer arch-buffer position)
11346        ;; open entity file        ;; open entity file
11347        (when (not (eq vhdl-testbench-create-files 'none))        (unless (eq vhdl-testbench-create-files 'none)
         (string-match "\\.[^.]*\\'" (buffer-file-name (current-buffer)))  
11348          (setq ent-file-name          (setq ent-file-name
11349                (concat ent-name                (concat ent-name "." (file-name-extension (buffer-file-name))))
11350                        (substring (buffer-file-name (current-buffer))          (if (file-exists-p ent-file-name)
                                  (match-beginning 0))))  
         (when (file-exists-p ent-file-name)  
           (if (y-or-n-p  
                (concat "File `" ent-file-name "' exists; overwrite? "))  
               (progn (delete-file ent-file-name)  
                      (when (get-file-buffer ent-file-name)  
                        (set-buffer ent-file-name)  
                        (set-buffer-modified-p nil)  
                        (kill-buffer ent-file-name)))  
             (if (eq vhdl-testbench-create-files 'separate)  
                 (setq no-entity t)  
               (error "Pasting port as test bench...aborted"))))  
         (unless no-entity  
           (set-buffer source-buffer)  
           (find-file ent-file-name)))  
       (let ((margin 0))  
         (unless (and (eq vhdl-testbench-create-files 'separate) no-entity)  
           ;; paste entity header  
           (unless (equal "" vhdl-testbench-entity-header)  
             (vhdl-insert-string-or-file vhdl-testbench-entity-header))  
           (vhdl-comment-display-line) (insert "\n\n") (indent-to margin)  
           ;; paste std_logic_1164 package  
           (vhdl-insert-keyword "LIBRARY ")  
           (insert "ieee;\n") (indent-to margin)  
           (vhdl-insert-keyword "USE ")  
           (insert "ieee.std_logic_1164.")  
           (vhdl-insert-keyword "ALL;")  
           (insert "\n\n") (indent-to margin) (vhdl-comment-display-line)  
           (insert "\n\n") (indent-to margin)  
           ;; paste entity declaration  
           (vhdl-insert-keyword "ENTITY ")  
           (insert ent-name)  
           (vhdl-insert-keyword " IS")  
           (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))  
           (insert "\n") (indent-to margin)  
           (vhdl-insert-keyword "END ")  
           (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))  
           (insert ent-name ";")  
           (insert "\n\n") (indent-to margin)  
           (vhdl-comment-display-line) (insert "\n"))  
         ;; get architecture name  
         (setq arch-name  
               (if (equal (cdr vhdl-testbench-architecture-name) "")  
                   (read-from-minibuffer "architecture name: "  
                                         nil vhdl-minibuffer-local-map)  
                 (vhdl-replace-string vhdl-testbench-architecture-name  
                                      (nth 0 vhdl-port-list))))  
         ;; open architecture file  
         (when (eq vhdl-testbench-create-files 'separate)  
           (save-buffer)  
           (string-match "\\.[^.]*\\'" (buffer-file-name (current-buffer)))  
           (setq arch-file-name  
                 (concat arch-name  
                         (substring (buffer-file-name (current-buffer))  
                                    (match-beginning 0))))  
           (when (file-exists-p arch-file-name)  
11351              (if (y-or-n-p              (if (y-or-n-p
11352                   (concat "File `" ent-file-name "' exists; overwrite? "))                   (concat "File \"" ent-file-name "\" exists; overwrite? "))
11353                  (progn (delete-file arch-file-name)                  (progn (find-file ent-file-name)
11354                         (when (get-file-buffer arch-file-name)                         (erase-buffer)
11355                           (set-buffer (get-file-buffer arch-file-name))                         (set-buffer-modified-p nil))
11356                           (set-buffer-modified-p nil)                (if (eq vhdl-testbench-create-files 'separate)
11357                           (kill-buffer arch-file-name)))                    (setq ent-file-name nil)
11358                (error "Pasting port as test bench...aborted")))                  (error "ERROR:  Pasting port as testbench...aborted")))
11359            (set-buffer source-buffer)            (find-file ent-file-name)))
11360            (find-file arch-file-name)        (unless (and (eq vhdl-testbench-create-files 'separate)
11361            ;; paste architecture header                     (null ent-file-name))
11362            (unless (equal "" vhdl-testbench-architecture-header)          ;; paste entity header
11363              (vhdl-insert-string-or-file vhdl-testbench-architecture-header))          (if vhdl-testbench-include-header
11364            (vhdl-comment-display-line)              (progn (vhdl-template-header
11365            (insert "\n"))                      (concat "Testbench for design \""
11366          (insert "\n") (indent-to margin)                              (nth 0 vhdl-port-list) "\""))
11367          ;; paste architecture body                     (goto-char (point-max)))
11368          (vhdl-insert-keyword "ARCHITECTURE ")            (vhdl-comment-display-line) (insert "\n\n"))
11369          (insert arch-name)          ;; paste std_logic_1164 package
11370          (vhdl-insert-keyword " OF ")          (when vhdl-testbench-include-library
11371              (vhdl-template-package-std-logic-1164)
11372              (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
11373            ;; paste entity declaration
11374            (vhdl-insert-keyword "ENTITY ")
11375          (insert ent-name)          (insert ent-name)
11376          (vhdl-insert-keyword " IS")          (vhdl-insert-keyword " IS")
11377          (insert "\n\n") (indent-to margin)          (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
         ;; paste component declaration  
         (when (vhdl-standard-p '87)  
           (vhdl-port-paste-component)  
           (insert "\n\n") (indent-to margin))  
         ;; paste constants  
         (when (nth 1 vhdl-port-list)  
           (vhdl-port-paste-constants)  
           (insert "\n\n") (indent-to margin))  
         ;; paste internal signals  
         (vhdl-port-paste-signals vhdl-testbench-initialize-signals)  
         ;; paste custom declarations  
         (unless (equal "" vhdl-testbench-declarations)  
           (insert "\n\n")  
           (vhdl-insert-string-or-file vhdl-testbench-declarations)  
           (delete-indentation))  
         (setq position (point))  
         (insert "\n\n") (indent-to margin)  
         (vhdl-comment-display-line) (insert "\n")  
         (goto-char position)  
         (vhdl-template-begin-end  
          (unless (vhdl-standard-p '87) "ARCHITECTURE")  
          arch-name margin t)  
         ;; paste instantiation  
         (vhdl-port-paste-instance  
          (vhdl-replace-string vhdl-testbench-dut-name  
                               (nth 0 vhdl-port-list)))  
11378          (insert "\n")          (insert "\n")
11379          ;; paste custom statements          (vhdl-insert-keyword "END ")
11380          (unless (equal "" vhdl-testbench-statements)          (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
11381            (insert ent-name ";")
11382            (insert "\n\n")
11383            (vhdl-comment-display-line) (insert "\n"))
11384          ;; get architecture name
11385          (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
11386                              (read-from-minibuffer "architecture name: "
11387                                                    nil vhdl-minibuffer-local-map)
11388                            (vhdl-replace-string vhdl-testbench-architecture-name
11389                                                 (nth 0 vhdl-port-list))))
11390          (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
11391          ;; open architecture file
11392          (if (not (eq vhdl-testbench-create-files 'separate))
11393            (insert "\n")            (insert "\n")
11394            (vhdl-insert-string-or-file vhdl-testbench-statements))          (setq ent-buffer (current-buffer))
11395            (setq arch-file-name
11396                  (concat ent-name "_" arch-name "."
11397                          (file-name-extension (buffer-file-name))))
11398            (when (and (file-exists-p arch-file-name)
11399                       (not (y-or-n-p (concat "File \"" arch-file-name
11400                                              "\" exists; overwrite? "))))
11401              (error "ERROR:  Pasting port as testbench...aborted"))
11402            (find-file arch-file-name)
11403            (erase-buffer)
11404            (set-buffer-modified-p nil)
11405            ;; paste architecture header
11406            (if vhdl-testbench-include-header
11407                (progn (vhdl-template-header
11408                        (concat "Testbench architecture for design \""
11409                                (nth 0 vhdl-port-list) "\""))
11410                       (goto-char (point-max)))
11411              (vhdl-comment-display-line) (insert "\n\n")))
11412          ;; paste architecture body
11413          (vhdl-insert-keyword "ARCHITECTURE ")
11414          (insert arch-name)
11415          (vhdl-insert-keyword " OF ")
11416          (insert ent-name)
11417          (vhdl-insert-keyword " IS")
11418          (insert "\n\n") (indent-to vhdl-basic-offset)
11419          ;; paste component declaration
11420          (unless (vhdl-use-direct-instantiation)
11421            (vhdl-port-paste-component t)
11422            (insert "\n\n") (indent-to vhdl-basic-offset))
11423          ;; paste constants
11424          (when (nth 1 vhdl-port-list)
11425            (insert "-- component generics\n") (indent-to vhdl-basic-offset)
11426            (vhdl-port-paste-constants t)
11427            (insert "\n\n") (indent-to vhdl-basic-offset))
11428          ;; paste internal signals
11429          (insert "-- component ports\n") (indent-to vhdl-basic-offset)
11430          (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
11431          (insert "\n")
11432          ;; paste custom declarations
11433          (unless (equal "" vhdl-testbench-declarations)
11434          (insert "\n")          (insert "\n")
11435          (indent-to (+ margin vhdl-basic-offset))          (vhdl-insert-string-or-file vhdl-testbench-declarations))
11436          (when (not (eq vhdl-testbench-create-files 'none))        (setq position (point))
11437            (save-buffer))        (insert "\n\n")
11438          (message "Pasting port as test bench...done")))))        (vhdl-comment-display-line) (insert "\n")
11439          (when vhdl-testbench-include-configuration
11440            (setq config-name (vhdl-replace-string
11441                               vhdl-testbench-configuration-name
11442                               (concat ent-name " " arch-name)))
11443            (insert "\n")
11444            (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
11445            (vhdl-insert-keyword " OF ") (insert ent-name)
11446            (vhdl-insert-keyword " IS\n")
11447            (indent-to vhdl-basic-offset)
11448            (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
11449            (indent-to vhdl-basic-offset)
11450            (vhdl-insert-keyword "END FOR;\n")
11451            (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
11452            (vhdl-comment-display-line) (insert "\n"))
11453          (goto-char position)
11454          (vhdl-template-begin-end
11455           (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
11456          ;; paste instantiation
11457          (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
11458          (vhdl-port-paste-instance
11459           (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
11460          (insert "\n")
11461          ;; paste custom statements
11462          (unless (equal "" vhdl-testbench-statements)
11463            (insert "\n")
11464            (vhdl-insert-string-or-file vhdl-testbench-statements))
11465          (insert "\n")
11466          (indent-to vhdl-basic-offset)
11467          (unless (eq vhdl-testbench-create-files 'none)
11468            (setq arch-buffer (current-buffer))
11469            (when ent-buffer (set-buffer ent-buffer) (save-buffer))
11470            (set-buffer arch-buffer) (save-buffer))
11471          (message
11472           (concat (format "Pasting port as testbench \"%s(%s)\"...done"
11473                           ent-name arch-name)
11474                   (and ent-file-name
11475                        (format "\n  File created: \"%s\"" ent-file-name))
11476                   (and arch-file-name
11477                        (format "\n  File created: \"%s\"" arch-file-name)))))))
11478    
11479    
11480    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11481    ;;; Subprogram interface translation
11482    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11483    
11484    (defvar vhdl-subprog-list nil
11485      "Variable to hold last subprogram interface parsed.")
11486    ;; structure: (parenthesised expression means list of such entries)
11487    ;; (subprog-name kind
11488    ;;  ((names) object direct type init comment group-comment)
11489    ;;  return-type return-comment group-comment)
11490    
11491    (defvar vhdl-subprog-flattened nil
11492      "Indicates whether an subprogram interface has been flattened.")
11493    
11494    (defun vhdl-subprog-flatten ()
11495      "Flatten interface list so that only one parameter exists per line."
11496      (interactive)
11497      (if (not vhdl-subprog-list)
11498          (error "ERROR:  No subprogram interface has been read")
11499        (message "Flattening subprogram interface...")
11500        (let ((old-subprog-list (nth 2 vhdl-subprog-list))
11501              new-subprog-list old-subprog new-subprog names)
11502          ;; traverse parameter list and flatten entries
11503          (while old-subprog-list
11504            (setq old-subprog (car old-subprog-list))
11505            (setq names (car old-subprog))
11506            (while names
11507              (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
11508              (setq new-subprog-list (append new-subprog-list (list new-subprog)))
11509              (setq names (cdr names)))
11510            (setq old-subprog-list (cdr old-subprog-list)))
11511          (setq vhdl-subprog-list
11512                (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
11513                      new-subprog-list (nth 3 vhdl-subprog-list)
11514                      (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
11515                vhdl-subprog-flattened t)
11516        (message "Flattening subprogram interface...done"))))
11517    
11518    (defun vhdl-subprog-copy ()
11519      "Get interface information from a subprogram specification."
11520      (interactive)
11521      (save-excursion
11522        (let (parse-error pos end-of-list
11523              name kind param-list object names direct type init
11524              comment group-comment
11525              return-type return-comment return-group-comment)
11526          (vhdl-prepare-search-2
11527           (setq
11528            parse-error
11529            (catch 'parse
11530              ;; check if within function declaration
11531              (setq pos (point))
11532              (end-of-line)
11533              (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
11534              (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
11535                           (goto-char (match-end 0))
11536                           (save-excursion (backward-char)
11537                                        (forward-sexp)
11538                                        (<= pos (point))))
11539                (throw 'parse "ERROR:  Not within a subprogram specification"))
11540              (setq name (match-string-no-properties 5))
11541              (setq kind (if (match-string 2) 'procedure 'function))
11542              (setq end-of-list (not (match-string 7)))
11543              (message "Reading interface of subprogram \"%s\"..." name)
11544              ;; parse parameter list
11545              (setq group-comment (vhdl-parse-group-comment))
11546              (setq end-of-list (or end-of-list
11547                                    (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
11548              (while (not end-of-list)
11549                ;; parse object
11550                (setq object
11551                      (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
11552                             (match-string-no-properties 1)))
11553                ;; parse names (accept extended identifiers)
11554                (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
11555                (setq names (list (match-string-no-properties 1)))
11556                (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
11557                  (setq names (append names (list (match-string-no-properties 1)))))
11558                ;; parse direction
11559                (vhdl-parse-string ":[ \t\n]*")
11560                (setq direct
11561                      (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
11562                           (match-string-no-properties 1)))
11563                ;; parse type
11564                (vhdl-parse-string "\\([^():;\n]+\\)")
11565                (setq type (match-string-no-properties 1))
11566                (setq comment nil)
11567                (while (looking-at "(")
11568                  (setq type
11569                        (concat type
11570                                (buffer-substring-no-properties
11571                                 (point) (progn (forward-sexp) (point)))
11572                                (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
11573                                     (match-string-no-properties 1)))))
11574                ;; special case: closing parenthesis is on separate line
11575                (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
11576                  (setq comment (substring type (match-beginning 2)))
11577                  (setq type (substring type 0 (match-beginning 1))))
11578                ;; strip off trailing group-comment
11579                (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
11580                (setq type (substring type 0 (match-end 1)))
11581                ;; parse initialization expression
11582                (setq init nil)
11583                (when (vhdl-parse-string ":=[ \t\n]*" t)
11584                  (vhdl-parse-string "\\([^();\n]*\\)")
11585                  (setq init (match-string-no-properties 1))
11586                  (while (looking-at "(")
11587                    (setq init
11588                          (concat init
11589                                  (buffer-substring-no-properties
11590                                   (point) (progn (forward-sexp) (point)))
11591                                  (and (vhdl-parse-string "\\([^();\n]*\\)" t)
11592                                       (match-string-no-properties 1))))))
11593                ;; special case: closing parenthesis is on separate line
11594                (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
11595                  (setq comment (substring init (match-beginning 2)))
11596                  (setq init (substring init 0 (match-beginning 1)))
11597                  (vhdl-forward-syntactic-ws))
11598                (skip-chars-forward " \t")
11599                ;; parse inline comment, special case: as above, no initial.
11600                (unless comment
11601                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11602                                     (match-string-no-properties 1))))
11603                (vhdl-forward-syntactic-ws)
11604                (setq end-of-list (vhdl-parse-string ")\\s-*" t))
11605                ;; parse inline comment
11606                (unless comment
11607                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11608                                     (match-string-no-properties 1))))
11609                (setq return-group-comment (vhdl-parse-group-comment))
11610                (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
11611                ;; parse return type
11612                (when (match-string 3)
11613                  (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
11614                  (setq return-type (match-string-no-properties 1))
11615                  (when (and return-type
11616                             (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
11617                    (setq return-comment (substring return-type (match-beginning 2)))
11618                    (setq return-type (substring return-type 0 (match-beginning 1))))
11619                  ;; strip of trailing group-comment
11620                  (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
11621                  (setq return-type (substring return-type 0 (match-end 1)))
11622                  ;; parse return comment
11623                  (unless return-comment
11624                    (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11625                                              (match-string-no-properties 1)))))
11626                ;; parse inline comment
11627                (unless comment
11628                  (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
11629                                     (match-string-no-properties 1))))
11630                ;; save everything in list
11631                (setq param-list (append param-list
11632                                         (list (list names object direct type init
11633                                                     comment group-comment))))
11634                ;; parse group comment and spacing
11635                (setq group-comment (vhdl-parse-group-comment)))
11636              (message "Reading interface of subprogram \"%s\"...done" name)
11637              nil)))
11638          ;; finish parsing
11639          (if parse-error
11640              (error parse-error)
11641            (setq vhdl-subprog-list
11642                  (list name kind param-list return-type return-comment
11643                        return-group-comment)
11644                  vhdl-subprog-flattened nil)))))
11645    
11646    (defun vhdl-subprog-paste-specification (kind)
11647      "Paste as a subprogram specification."
11648      (indent-according-to-mode)
11649      (let ((margin (current-column))
11650            (param-list (nth 2 vhdl-subprog-list))
11651            list-margin start names param)
11652        ;; paste keyword and name
11653        (vhdl-insert-keyword
11654         (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
11655        (insert (nth 0 vhdl-subprog-list))
11656        (if (not param-list)
11657            (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11658          (setq start (point))
11659          ;; paste parameter list
11660          (insert " (")
11661          (unless vhdl-argument-list-indent
11662            (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11663          (setq list-margin (current-column))
11664          (while param-list
11665            (setq param (car param-list))
11666            ;; paste group comment and spacing
11667            (when (memq vhdl-include-group-comments (list kind 'always))
11668              (vhdl-paste-group-comment (nth 6 param) list-margin))
11669            ;; paste object
11670            (when (nth 1 param) (insert (nth 1 param) " "))
11671            ;; paste names
11672            (setq names (nth 0 param))
11673            (while names
11674              (insert (car names))
11675              (setq names (cdr names))
11676              (when names (insert ", ")))
11677            ;; paste direction
11678            (insert " : ")
11679            (when (nth 2 param) (insert (nth 2 param) " "))
11680            ;; paste type
11681            (insert (nth 3 param))
11682            ;; paste initialization
11683            (when (nth 4 param) (insert " := " (nth 4 param)))
11684            ;; terminate line
11685            (if (cdr param-list)
11686                (insert ";")
11687              (insert ")")
11688              (when (null (nth 3 vhdl-subprog-list))
11689                (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
11690            ;; paste comment
11691            (when (and vhdl-include-port-comments (nth 5 param))
11692              (vhdl-comment-insert-inline (nth 5 param) t))
11693            (setq param-list (cdr param-list))
11694            (when param-list (insert "\n") (indent-to list-margin)))
11695          (when (nth 3 vhdl-subprog-list)
11696            (insert "\n") (indent-to list-margin)
11697            ;; paste group comment and spacing
11698            (when (memq vhdl-include-group-comments (list kind 'always))
11699              (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
11700            ;; paste return type
11701            (insert "return " (nth 3 vhdl-subprog-list))
11702            (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
11703            (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
11704              (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
11705          ;; align parameter list
11706          (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
11707        ;; paste body
11708        (when (eq kind 'body)
11709          (insert "\n")
11710          (vhdl-template-begin-end
11711           (unless (vhdl-standard-p '87)
11712             (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
11713           (nth 0 vhdl-subprog-list) margin))))
11714    
11715    (defun vhdl-subprog-paste-declaration ()
11716      "Paste as a subprogram declaration."
11717      (interactive)
11718      (if (not vhdl-subprog-list)
11719          (error "ERROR:  No subprogram interface read")
11720        (message "Pasting interface as subprogram declaration \"%s\"..."
11721                 (car vhdl-subprog-list))
11722        ;; paste specification
11723        (vhdl-subprog-paste-specification 'decl)
11724        (message "Pasting interface as subprogram declaration \"%s\"...done"
11725                 (car vhdl-subprog-list))))
11726    
11727    (defun vhdl-subprog-paste-body ()
11728      "Paste as a subprogram body."
11729      (interactive)
11730      (if (not vhdl-subprog-list)
11731          (error "ERROR:  No subprogram interface read")
11732        (message "Pasting interface as subprogram body \"%s\"..."
11733                 (car vhdl-subprog-list))
11734        ;; paste specification and body
11735        (vhdl-subprog-paste-specification 'body)
11736        (message "Pasting interface as subprogram body \"%s\"...done"
11737                 (car vhdl-subprog-list))))
11738    
11739    (defun vhdl-subprog-paste-call ()
11740      "Paste as a subprogram call."
11741      (interactive)
11742      (if (not vhdl-subprog-list)
11743          (error "ERROR:  No subprogram interface read")
11744        (let ((orig-vhdl-subprog-list vhdl-subprog-list)
11745              param-list margin list-margin param start)
11746          ;; flatten local copy of interface list (must be flat for parameter mapping)
11747          (vhdl-subprog-flatten)
11748          (setq param-list (nth 2 vhdl-subprog-list))
11749          (indent-according-to-mode)
11750          (setq margin (current-indentation))
11751          (message "Pasting interface as subprogram call \"%s\"..."
11752                   (car vhdl-subprog-list))
11753          ;; paste name
11754          (insert (nth 0 vhdl-subprog-list))
11755          (if (not param-list)
11756              (insert ";")
11757            (setq start (point))
11758            ;; paste parameter list
11759            (insert " (")
11760            (unless vhdl-argument-list-indent
11761              (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
11762            (setq list-margin (current-column))
11763            (while param-list
11764              (setq param (car param-list))
11765              ;; paste group comment and spacing
11766              (when (eq vhdl-include-group-comments 'always)
11767                (vhdl-paste-group-comment (nth 6 param) list-margin))
11768              ;; paste formal port
11769              (insert (car (nth 0 param)) " => ")
11770              (setq param-list (cdr param-list))
11771              (insert (if param-list "," ");"))
11772              ;; paste comment
11773              (when (and vhdl-include-port-comments (nth 5 param))
11774                (vhdl-comment-insert-inline (nth 5 param)))
11775              (when param-list (insert "\n") (indent-to list-margin)))
11776            ;; align parameter list
11777            (when vhdl-auto-align
11778              (vhdl-align-region-groups start (point) 1)))
11779          (message "Pasting interface as subprogram call \"%s\"...done"
11780                   (car vhdl-subprog-list))
11781          (setq vhdl-subprog-list orig-vhdl-subprog-list))))
11782    
11783    
11784  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 8923  expressions (e.g. for index ranges of ty Line 11835  expressions (e.g. for index ranges of ty
11835    
11836  ;; override `he-list-beg' from `hippie-exp'  ;; override `he-list-beg' from `hippie-exp'
11837  (unless (and (boundp 'viper-mode) viper-mode)  (unless (and (boundp 'viper-mode) viper-mode)
  (require 'hippie-exp)  
11838   (defalias 'he-list-beg 'vhdl-he-list-beg))   (defalias 'he-list-beg 'vhdl-he-list-beg))
11839    
11840  ;; function for expanding abbrevs and dabbrevs  ;; function for expanding abbrevs and dabbrevs
11841    (defun vhdl-expand-abbrev (arg))
11842  (fset 'vhdl-expand-abbrev (make-hippie-expand-function  (fset 'vhdl-expand-abbrev (make-hippie-expand-function
11843                             '(try-expand-dabbrev                             '(try-expand-dabbrev
11844                               try-expand-dabbrev-all-buffers                               try-expand-dabbrev-all-buffers
11845                               vhdl-try-expand-abbrev)))                               vhdl-try-expand-abbrev)))
11846    
11847  ;; function for expanding parenthesis  ;; function for expanding parenthesis
11848    (defun vhdl-expand-paren (arg))
11849  (fset 'vhdl-expand-paren (make-hippie-expand-function  (fset 'vhdl-expand-paren (make-hippie-expand-function
11850                            '(try-expand-list                            '(try-expand-list
11851                              try-expand-list-all-buffers)))                              try-expand-list-all-buffers)))
# Line 8943  expressions (e.g. for index ranges of ty Line 11856  expressions (e.g. for index ranges of ty
11856  (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)  (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
11857    "Convert all words matching word-regexp in region to lower or upper case,    "Convert all words matching word-regexp in region to lower or upper case,
11858  depending on parameter upper-case."  depending on parameter upper-case."
11859    (let ((case-fold-search t)    (let ((case-replace nil)
         (case-replace nil)  
11860          (last-update 0))          (last-update 0))
11861      (vhdl-ext-syntax-table      (vhdl-prepare-search-2
11862       (save-excursion       (save-excursion
11863         (goto-char end)         (goto-char end)
11864         (setq end (point-marker))         (setq end (point-marker))
11865         (goto-char beg)         (goto-char beg)
11866         (while (re-search-forward word-regexp end t)         (while (re-search-forward word-regexp end t)
11867           (or (vhdl-in-comment-p)           (or (vhdl-in-literal)
              (vhdl-in-string-p)  
11868               (if upper-case               (if upper-case
11869                   (upcase-word -1)                   (upcase-word -1)
11870                 (downcase-word -1)))                 (downcase-word -1)))
11871           (when (and count vhdl-progress-interval           (when (and count vhdl-progress-interval (not noninteractive)
11872                      (< vhdl-progress-interval                      (< vhdl-progress-interval
11873                         (- (nth 1 (current-time)) last-update)))                         (- (nth 1 (current-time)) last-update)))
11874             (message "Fixing case... (%2d%s)"             (message "Fixing case... (%2d%s)"
11875                      (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))                      (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg)))
11876                      "%")                      "%")
11877             (setq last-update (nth 1 (current-time)))))             (setq last-update (nth 1 (current-time)))))
11878         (goto-char end)))         (goto-char end)))))
     (and count vhdl-progress-interval (message "Fixing case...done"))))  
11879    
11880  (defun vhdl-fix-case-region (beg end &optional arg)  (defun vhdl-fix-case-region (beg end &optional arg)
11881    "Convert all VHDL words in region to lower or upper case, depending on    "Convert all VHDL words in region to lower or upper case, depending on
11882  variables vhdl-upper-case-{keywords,types,attributes,enum-values}."  options vhdl-upper-case-{keywords,types,attributes,enum-values}."
11883    (interactive "r\nP")    (interactive "r\nP")
11884    (vhdl-fix-case-region-1    (vhdl-fix-case-region-1
11885     beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)     beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0)
# Line 8978  variables vhdl-upper-case-{keywords,type Line 11888  variables vhdl-upper-case-{keywords,type
11888    (vhdl-fix-case-region-1    (vhdl-fix-case-region-1
11889     beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)     beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2)
11890    (vhdl-fix-case-region-1    (vhdl-fix-case-region-1
11891     beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3))     beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3)
11892      (when vhdl-progress-interval (message "Fixing case...done")))
11893    
11894  (defun vhdl-fix-case-buffer ()  (defun vhdl-fix-case-buffer ()
11895    "Convert all VHDL words in buffer to lower or upper case, depending on    "Convert all VHDL words in buffer to lower or upper case, depending on
11896  variables vhdl-upper-case-{keywords,types,attributes,enum-values}."  options vhdl-upper-case-{keywords,types,attributes,enum-values}."
11897    (interactive)    (interactive)
11898    (vhdl-fix-case-region (point-min) (point-max)))    (vhdl-fix-case-region (point-min) (point-max)))
11899    
11900    (defun vhdl-fix-case-word (&optional arg)
11901      "Convert word after cursor to upper case if necessary."
11902      (interactive "p")
11903      (save-excursion
11904        (when arg (backward-word 1))
11905        (vhdl-prepare-search-1
11906         (when (and vhdl-upper-case-keywords
11907                    (looking-at vhdl-keywords-regexp))
11908           (upcase-word 1))
11909         (when (and vhdl-upper-case-types
11910                    (looking-at vhdl-types-regexp))
11911           (upcase-word 1))
11912         (when (and vhdl-upper-case-attributes
11913                    (looking-at vhdl-attributes-regexp))
11914           (upcase-word 1))
11915         (when (and vhdl-upper-case-enum-values
11916                    (looking-at vhdl-enum-values-regexp))
11917           (upcase-word 1)))))
11918    
11919  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11920  ;; Line handling functions  ;; Line handling functions
11921    
# Line 9051  variables vhdl-upper-case-{keywords,type Line 11981  variables vhdl-upper-case-{keywords,type
11981    (end-of-line -0)    (end-of-line -0)
11982    (newline-and-indent))    (newline-and-indent))
11983    
11984    (defun vhdl-delete-indentation ()
11985      "Join lines.  That is, call `delete-indentation' with `fill-prefix' so that
11986    it works within comments too."
11987      (interactive)
11988      (let ((fill-prefix "-- "))
11989        (delete-indentation)))
11990    
11991    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11992    ;; Move functions
11993    
11994    (defun vhdl-forward-same-indent ()
11995      "Move forward to next line with same indent."
11996      (interactive)
11997      (let ((pos (point))
11998            (indent (current-indentation)))
11999        (beginning-of-line 2)
12000        (while (and (not (eobp))
12001                    (or (looking-at "^\\s-*\\(--.*\\)?$")
12002                        (> (current-indentation) indent)))
12003          (beginning-of-line 2))
12004        (if (= (current-indentation) indent)
12005            (back-to-indentation)
12006          (message "No following line with same indent found in this block")
12007          (goto-char pos)
12008          nil)))
12009    
12010    (defun vhdl-backward-same-indent ()
12011      "Move backward to previous line with same indent."
12012      (interactive)
12013      (let ((pos (point))
12014            (indent (current-indentation)))
12015        (beginning-of-line -0)
12016        (while (and (not (bobp))
12017                    (or (looking-at "^\\s-*\\(--.*\\)?$")
12018                        (> (current-indentation) indent)))
12019          (beginning-of-line -0))
12020        (if (= (current-indentation) indent)
12021            (back-to-indentation)
12022          (message "No preceding line with same indent found in this block")
12023          (goto-char pos)
12024          nil)))
12025    
12026  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12027  ;;; Project  ;; Statistics
12028    
12029    (defun vhdl-statistics-buffer ()
12030      "Get some file statistics."
12031      (interactive)
12032      (let ((no-stats 0)
12033            (no-code-lines 0)
12034            (no-lines (count-lines (point-min) (point-max))))
12035        (save-excursion
12036          ;; count statements
12037          (goto-char (point-min))
12038          (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t)
12039            (if (match-string 1)
12040                (goto-char (match-end 1))
12041              (setq no-stats (1+ no-stats))))
12042          ;; count code lines
12043          (goto-char (point-min))
12044          (while (not (eobp))
12045            (unless (looking-at "^\\s-*\\(--.*\\)?$")
12046              (setq no-code-lines (1+ no-code-lines)))
12047            (beginning-of-line 2)))
12048        ;; print results
12049        (message "\n\
12050    File statistics: \"%s\"\n\
12051    ---------------------\n\
12052    # statements  : %5d\n\
12053    # code lines  : %5d\n\
12054    # total lines : %5d\n\ "
12055                 (buffer-file-name) no-stats no-code-lines no-lines)
12056        (unless vhdl-emacs-21 (vhdl-show-messages))))
12057    
12058  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12059    ;; Help functions
12060    
12061  (defun vhdl-project-switch (name)  (defun vhdl-re-search-forward (regexp &optional bound noerror count)
12062    "Switch to project NAME."    "Like `re-search-forward', but does not match within literals."
12063    (setq vhdl-project name)    (let (pos)
12064    (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))      (save-excursion
12065      (speedbar-refresh)))        (while (and (setq pos (re-search-forward regexp bound noerror count))
12066                      (vhdl-in-literal))))
12067        (when pos (goto-char pos))
12068        pos))
12069    
12070    (defun vhdl-re-search-backward (regexp &optional bound noerror count)
12071      "Like `re-search-backward', but does not match within literals."
12072      (let (pos)
12073        (save-excursion
12074          (while (and (setq pos (re-search-backward regexp bound noerror count))
12075                      (vhdl-in-literal))))
12076        (when pos (goto-char pos))
12077        pos))
12078    
12079    
12080  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12081  ;;; Compilation  ;;; Project
12082  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; (using `compile.el')  
12083    
12084  (defun vhdl-compile-init ()  (defun vhdl-set-project (name)
12085    "Initialize for compilation."    "Set current project to NAME."
12086    (unless compilation-error-regexp-alist    (interactive
12087      (setq compilation-error-regexp-alist     (list (let ((completion-ignore-case t))
12088            (let ((commands-alist vhdl-compiler-alist)             (completing-read "Project name: " vhdl-project-alist nil t))))
12089                  regexp-alist sublist)    (cond ((equal name "")
12090              (while commands-alist           (setq vhdl-project nil)
12091                (setq sublist (nth 5 (car commands-alist)))           (message "Current VHDL project: None"))
12092                (unless (equal "" (car sublist))          ((assoc name vhdl-project-alist)
12093                  (setq regexp-alist           (setq vhdl-project name)
12094                        (cons (list (nth 0 sublist)           (message "Current VHDL project: \"%s\"" name))
12095                                    (if (= 0 (nth 1 sublist))          (t
12096                                        (if (string-match           (vhdl-warning (format "Unknown VHDL project: \"%s\"" name))))
12097                                              "XEmacs" emacs-version) 9 nil)    (vhdl-speedbar-update-current-project))
12098                                      (nth 1 sublist))  
12099                                    (nth 2 sublist))  (defun vhdl-toggle-project (name token indent)
12100                              regexp-alist)))    "Set current project to NAME or unset if NAME is current project."
12101                (setq commands-alist (cdr commands-alist)))    (vhdl-set-project (if (equal name vhdl-project) "" name)))
             regexp-alist)))  
   (unless compilation-file-regexp-alist  
     (setq compilation-file-regexp-alist  
           (let ((commands-alist vhdl-compiler-alist)  
                 regexp-alist)  
             (while commands-alist  
               (unless (equal "" (car (nth 6 (car commands-alist))))  
                 (setq regexp-alist  
                       (append regexp-alist  
                               (list (nth 6 (car commands-alist))))))  
               (setq commands-alist (cdr commands-alist)))  
             regexp-alist))))  
   
 (defun vhdl-compile ()  
   "Compile current buffer using the VHDL compiler specified in  
 `vhdl-compiler'."  
   (interactive)  
   (vhdl-compile-init)  
   (let* ((command-elem (assoc vhdl-compiler vhdl-compiler-alist))  
          (command (nth 1 command-elem))  
          (default-directory (expand-file-name (nth 4 command-elem))))  
     (when command  
       (compile (concat command " " vhdl-compiler-options  
                        (unless (string-equal vhdl-compiler-options "") " ")  
                        (buffer-file-name))))))  
12102    
12103  (defun vhdl-make ()  (defun vhdl-export-project (file-name)
12104    "Call make command for compilation of all updated source files (requires    "Write project setup for current project."
12105  `Makefile')."    (interactive
12106    (interactive)     (let ((name (vhdl-resolve-env-variable
12107    (vhdl-compile-init)                  (vhdl-replace-string
12108    (let* ((command-elem (assoc vhdl-compiler vhdl-compiler-alist))                   (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12109           (command (nth 2 command-elem))                   (concat (subst-char-in-string
12110           (default-directory (expand-file-name (nth 4 command-elem))))                            ?  ?_ (or (vhdl-project-p)
12111      (if (equal command "")                                      (error "ERROR:  No current project")))
12112          (compile "make")                           " " (user-login-name))))))
12113        (compile command))))       (list (read-file-name
12114                "Write project file: "
12115                (when (file-name-absolute-p name) "") nil nil name))))
12116      (setq file-name (abbreviate-file-name file-name))
12117      (let ((orig-buffer (current-buffer)))
12118        (unless (file-exists-p (file-name-directory file-name))
12119          (make-directory (file-name-directory file-name) t))
12120        (if (not (file-writable-p file-name))
12121            (error "ERROR:  File not writable: \"%s\"" file-name)
12122          (set-buffer (find-file-noselect file-name t t))
12123          (erase-buffer)
12124          (insert ";; -*- Emacs-Lisp -*-\n\n"
12125                  ";;; " (file-name-nondirectory file-name)
12126                  " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n"
12127                  ";; Project : " vhdl-project "\n"
12128                  ";; Saved   : " (format-time-string "%Y-%m-%d %T ")
12129                  (user-login-name) "\n\n\n"
12130                  ";; project name\n"
12131                  "(setq vhdl-project \"" vhdl-project "\")\n\n"
12132                  ";; project setup\n"
12133                  "(aput 'vhdl-project-alist vhdl-project\n'")
12134          (pp (aget vhdl-project-alist vhdl-project) (current-buffer))
12135          (insert ")\n")
12136          (save-buffer)
12137          (kill-buffer (current-buffer))
12138          (set-buffer orig-buffer))))
12139    
12140  (defun vhdl-generate-makefile ()  (defun vhdl-import-project (file-name &optional auto not-make-current)
12141    "Generate new `Makefile'."    "Read project setup and set current project."
12142    (interactive)    (interactive
12143    (vhdl-compile-init)     (let ((name (vhdl-resolve-env-variable
12144    (let* ((command-elem (assoc vhdl-compiler vhdl-compiler-alist))                  (vhdl-replace-string
12145           (command (nth 3 command-elem))                   (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name))
12146           (default-directory (expand-file-name (nth 4 command-elem))))                   (concat "" " " (user-login-name))))))
12147      (if (not (equal command ""))       (list (read-file-name
12148          (compile command)              "Read project file: " (when (file-name-absolute-p name) "") nil t
12149        (error "No such command specified for `%s'" vhdl-compiler))))              (file-name-directory name)))))
12150      (when (file-exists-p file-name)
12151        (condition-case ()
12152            (let ((current-project vhdl-project))
12153              (load-file file-name)
12154              (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10)
12155                (adelete 'vhdl-project-alist vhdl-project)
12156                (error))
12157              (when not-make-current
12158                (setq vhdl-project current-project))
12159              (vhdl-update-mode-menu)
12160              (vhdl-speedbar-refresh)
12161              (unless not-make-current
12162                (message "Current VHDL project: \"%s\"%s"
12163                         vhdl-project (if auto " (auto-loaded)" ""))))
12164          (error (vhdl-warning
12165                  (format "ERROR:  Invalid project setup file: \"%s\"" file-name))))))
12166    
12167    (defun vhdl-duplicate-project ()
12168      "Duplicate setup of current project."
12169      (interactive)
12170      (let ((new-name (read-from-minibuffer "New project name: "))
12171            (project-entry (aget vhdl-project-alist vhdl-project t)))
12172        (setq vhdl-project-alist
12173              (append vhdl-project-alist
12174                      (list (cons new-name project-entry))))
12175        (vhdl-update-mode-menu)))
12176    
12177    (defun vhdl-auto-load-project ()
12178      "Automatically load project setup at startup."
12179      (let ((file-name-list vhdl-project-file-name)
12180            file-list list-length)
12181        (while file-name-list
12182          (setq file-list
12183                (append file-list
12184                        (file-expand-wildcards
12185                         (vhdl-resolve-env-variable
12186                          (vhdl-replace-string
12187                           (cons "\\(.*\\) \\(.*\\)" (car file-name-list))
12188                           (concat "\*" " " (user-login-name)))))))
12189          (setq list-length (or list-length (length file-list)))
12190          (setq file-name-list (cdr file-name-list)))
12191        (while file-list
12192          (vhdl-import-project (expand-file-name (car file-list)) t
12193                               (not (> list-length 0)))
12194          (setq list-length (1- list-length))
12195          (setq file-list (cdr file-list)))))
12196    
12197    ;; automatically load project setup when idle after startup
12198    (when (memq 'startup vhdl-project-auto-load)
12199      (if noninteractive
12200          (vhdl-auto-load-project)
12201        (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project)))
12202    
12203    
12204  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 9141  variables vhdl-upper-case-{keywords,type Line 12206  variables vhdl-upper-case-{keywords,type
12206  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12207  ;; (using `hideshow.el')  ;; (using `hideshow.el')
12208    
12209  (defun vhdl-forward-unit (&optional count)  (defconst vhdl-hs-start-regexp
12210    "Find begin and end of VHDL design units (for hideshow)."    (concat
12211    (interactive "p")     "\\(^\\)\\s-*\\("
12212    (let ((case-fold-search t))     ;; generic/port clause
12213      (if (< count 0)     "\\(generic\\|port\\)[ \t\n]*(\\|"
12214          (re-search-backward     ;; component
12215           "^\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)     "component\\>\\|"
12216        (re-search-forward "^end\\>" nil t))))     ;; component instantiation
12217       "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*"
12218  (when (string-match "XEmacs" emacs-version)     "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12219    (require 'hideshow))     "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*"
12220       "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|"
12221  (unless (assq 'vhdl-mode hs-special-modes-alist)     ;; subprogram
12222    (setq hs-special-modes-alist     "\\(function\\|procedure\\)\\>\\|"
12223          (cons     ;; process, block
12224           '(vhdl-mode     "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|"
12225             "\\(^\\)\\(architecture\\|ARCHITECTURE\\|configuration\\|CONFIGURATION\\|entity\\|ENTITY\\|package\\|PACKAGE\\)\\>"     ;; configuration declaration
12226             "\\(^\\)\\(end\\|END\\)\\>"     "configuration\\>"
12227             "--\\( \\|$\\)"     "\\)")
12228             vhdl-forward-unit)    "Regexp to match start of construct to hide.")
12229           hs-special-modes-alist)))  
12230    (defun vhdl-hs-forward-sexp-func (count)
12231      "Find end of construct to hide (for hideshow). Only searches forward."
12232      (let ((pos (point)))
12233        (vhdl-prepare-search-2
12234         (beginning-of-line)
12235         (cond
12236          ;; generic/port clause
12237          ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(")
12238           (goto-char (match-end 0))
12239           (backward-char)
12240           (forward-sexp))
12241          ;; component declaration
12242          ((looking-at "^\\s-*component\\>")
12243           (re-search-forward "^\\s-*end\\s-+component\\>" nil t))
12244          ;; component instantiation
12245          ((looking-at
12246            (concat
12247             "^\\s-*\\w+\\s-*:[ \t\n]*"
12248             "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?"
12249             "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*"
12250             "\\(generic\\|port\\)\\s-+map[ \t\n]*("))
12251           (goto-char (match-end 0))
12252           (backward-char)
12253           (forward-sexp)
12254           (setq pos (point))
12255           (vhdl-forward-syntactic-ws)
12256           (when (looking-at "port\\s-+map[ \t\n]*(")
12257             (goto-char (match-end 0))
12258             (backward-char)
12259             (forward-sexp)
12260             (setq pos (point)))
12261           (goto-char pos))
12262          ;; subprogram declaration/body
12263          ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)")
12264           (goto-char (match-end 0))
12265           (vhdl-forward-syntactic-ws)
12266           (when (looking-at "(")
12267             (forward-sexp))
12268           (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t)
12269                       (vhdl-in-literal)))
12270           ;; subprogram body
12271           (when (match-string 2)
12272             (re-search-forward "^\\s-*\\<begin\\>" nil t)
12273             (backward-word 1)
12274             (vhdl-forward-sexp)))
12275          ;; block (recursive)
12276          ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>")
12277           (goto-char (match-end 0))
12278           (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t)
12279                       (match-beginning 2))
12280             (vhdl-hs-forward-sexp-func count)))
12281          ;; process
12282          ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>")
12283           (re-search-forward "^\\s-*end\\s-+process\\>" nil t))
12284          ;; configuration declaration
12285          ((looking-at "^\\s-*configuration\\>")
12286           (forward-word 4)
12287           (vhdl-forward-sexp))
12288          (t (goto-char pos))))))
12289    
12290  (defun vhdl-hideshow-init ()  (defun vhdl-hideshow-init ()
12291    "Initialize `hideshow'."    "Initialize `hideshow'."
12292    (if vhdl-hide-all-init    (when vhdl-hideshow-menu
12293        (add-hook 'hs-minor-mode-hook 'hs-hide-all)      (vhdl-hs-minor-mode 1)))
12294      (remove-hook 'hs-minor-mode-hook 'hs-hide-all))  
12295    (if vhdl-hideshow-menu  (defun vhdl-hs-minor-mode (&optional arg)
12296        (hs-minor-mode 1)    "Toggle hideshow minor mode and update menu bar."
12297      (when (boundp 'hs-minor-mode) (hs-minor-mode 0))))    (interactive "P")
12298      (require 'hideshow)
12299      ;; check for hideshow version 5.x
12300      (if (not (boundp 'hs-block-start-mdata-select))
12301          (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)")
12302        ;; initialize hideshow
12303        (unless (assoc 'vhdl-mode hs-special-modes-alist)
12304          (setq hs-special-modes-alist
12305                (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
12306                            'vhdl-hs-forward-sexp-func nil)
12307                      hs-special-modes-alist)))
12308        (make-local-variable 'hs-minor-mode-hook)
12309        (if vhdl-hide-all-init
12310            (add-hook 'hs-minor-mode-hook 'hs-hide-all)
12311          (remove-hook 'hs-minor-mode-hook 'hs-hide-all))
12312        (hs-minor-mode arg)
12313        (vhdl-mode-line-update)))           ; hack to update menu bar
12314    
12315    
12316  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
# Line 9179  variables vhdl-upper-case-{keywords,type Line 12319  variables vhdl-upper-case-{keywords,type
12319  ;; (using `font-lock.el')  ;; (using `font-lock.el')
12320    
12321  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12322  ;; Help functions for translate-off region highlighting  ;; Help functions
12323    
12324  (defun vhdl-within-translate-off ()  (defun vhdl-within-translate-off ()
12325    "Return point if within translate-off region, else nil."    "Return point if within translate-off region, else nil."
# Line 9217  variables vhdl-upper-case-{keywords,type Line 12357  variables vhdl-upper-case-{keywords,type
12357        (save-restriction        (save-restriction
12358          (narrow-to-region (point-min) limit)          (narrow-to-region (point-min) limit)
12359          ;; match item          ;; match item
12360          (when (looking-at "\\s-*\\(\\w+\\)")          (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)")
12361            (save-match-data            (save-match-data
12362              (goto-char (match-end 1))              (goto-char (match-end 1))
12363              ;; move to next item              ;; move to next item
# Line 9236  variables vhdl-upper-case-{keywords,type Line 12376  variables vhdl-upper-case-{keywords,type
12376  (defvar vhdl-font-lock-keywords nil  (defvar vhdl-font-lock-keywords nil
12377    "Regular expressions to highlight in VHDL Mode.")    "Regular expressions to highlight in VHDL Mode.")
12378    
12379  (defconst vhdl-font-lock-keywords-0  (defvar vhdl-font-lock-keywords-0
12380    (list    ;; set in `vhdl-font-lock-init' because dependent on user options
    ;; highlight template prompts  
    (list (concat "\\(<" vhdl-template-prompt-syntax ">\\)")  
          1 'vhdl-font-lock-prompt-face t)  
   
    ;; highlight directives  
    '("--\\s-*pragma\\s-+\\(.*\\)$" 1 vhdl-font-lock-directive-face t)  
    )  
12381    "For consideration as a value of `vhdl-font-lock-keywords'.    "For consideration as a value of `vhdl-font-lock-keywords'.
12382  This does highlighting of template prompts and directives (pragmas).")  This does highlighting of template prompts and directives (pragmas).")
12383    
12384  (defvar vhdl-font-lock-keywords-1 nil  (defvar vhdl-font-lock-keywords-1 nil
12385    ;; set in `vhdl-font-lock-init' because dependent on custom variables    ;; set in `vhdl-font-lock-init' because dependent on user options
12386    "For consideration as a value of `vhdl-font-lock-keywords'.    "For consideration as a value of `vhdl-font-lock-keywords'.
12387  This does highlighting of keywords and standard identifiers.")  This does highlighting of keywords and standard identifiers.")
12388    
# Line 9259  This does highlighting of keywords and s Line 12392  This does highlighting of keywords and s
12392     (list     (list
12393      (concat      (concat
12394       "^\\s-*\\("       "^\\s-*\\("
12395       "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\|\\)\\|"       "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|"
12396       "\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\|component"       "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component"
12397       "\\)\\s-+\\(\\w+\\)")       "\\)\\s-+\\(\\w+\\)")
12398      5 'font-lock-function-name-face)      5 'font-lock-function-name-face)
12399    
# Line 9272  This does highlighting of keywords and s Line 12405  This does highlighting of keywords and s
12405     ;; highlight labels of common constructs     ;; highlight labels of common constructs
12406     (list     (list
12407      (concat      (concat
12408       "^\\s-*\\(\\w+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\("       "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\("
12409       "assert\\|block\\|case\\|component\\|configuration\\|entity\\|exit\\|"       "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|"
12410       "for\\|if\\|loop\\|next\\|null\\|postponed\\|process\\|"       "postponed\\|process\\|"
12411       (when (vhdl-standard-p 'ams) "procedural\\|")       (when (vhdl-standard-p 'ams) "procedural\\|")
12412       "with\\|while"       "with\\|while"
12413       "\\)\\>\\|[^\n]*<=\\)")       "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\)*\\s-*<=\\)")
12414      1 'font-lock-function-name-face)      1 'font-lock-function-name-face)
12415    
12416     ;; highlight label and component name of component instantiations     ;; highlight label and component name of component instantiations
12417     (list     (list
12418      (concat      (concat
12419       "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(component\\s-+\\|\\)\\(\\w+\\)"       "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)"
12420       "\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>")       "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)")
12421      '(1 font-lock-function-name-face) '(3 font-lock-function-name-face))      '(1 font-lock-function-name-face) '(2 font-lock-function-name-face))
12422    
12423       ;; highlight label and instantiated unit of component instantiations
12424       (list
12425        (concat
12426         "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*"
12427         "\\(component\\|configuration\\|entity\\)\\s-+"
12428         "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?")
12429        '(1 font-lock-function-name-face) '(3 font-lock-function-name-face)
12430        '(5 font-lock-function-name-face nil t)
12431        '(7 font-lock-function-name-face nil t))
12432    
12433     ;; highlight names and labels at end of constructs     ;; highlight names and labels at end of constructs
12434     (list     (list
12435      (concat      (concat
12436       "^\\s-*end\\s-+\\(\\("       "^\\s-*end\\s-+\\(\\("
12437       "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"       "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|"
12438       "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\|\\)\\|"       "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|"
12439       "procedure\\|\\(postponed\\s-+\\|\\)process\\|"       "procedure\\|\\(postponed\\s-+\\)?process\\|"
12440       (when (vhdl-standard-p 'ams) "procedural\\|")       (when (vhdl-standard-p 'ams) "procedural\\|")
12441       "units"       "units"
12442       "\\)\\>\\|\\)\\s-*\\(\\w*\\)")       "\\)\\s-+\\)?\\(\\w*\\)")
12443      5 'font-lock-function-name-face)      5 'font-lock-function-name-face)
12444    
12445     ;; highlight labels in exit and next statements     ;; highlight labels in exit and next statements
# Line 9311  This does highlighting of keywords and s Line 12454  This does highlighting of keywords and s
12454       "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")       "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:")
12455      1 'font-lock-function-name-face)      1 'font-lock-function-name-face)
12456    
12457     ;; highlight labels in component specifications     ;; highlight labels in block and component specifications
12458     (list     (list
12459      (concat      (concat
12460       "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:"       "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*"
12461       "\\(\\s-\\|\n\\)*\\(\\w+\\)")       "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)")
12462      '(1 font-lock-function-name-face) '(4 font-lock-function-name-face))      '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t))
12463    
12464       ;; highlight names in library clauses
12465       (list "^\\s-*library\\>"
12466             '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face)))
12467    
12468       ;; highlight names in use clauses
12469       (list
12470        (concat
12471         "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?"
12472         "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?")
12473        '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t)
12474        '(7 font-lock-function-name-face nil t))
12475    
12476     ;; highlight attribute name in attribute declarations/specifications     ;; highlight attribute name in attribute declarations/specifications
12477     (list     (list
# Line 9327  This does highlighting of keywords and s Line 12482  This does highlighting of keywords and s
12482     ;; highlight type/nature name in (sub)type/(sub)nature declarations     ;; highlight type/nature name in (sub)type/(sub)nature declarations
12483     (list     (list
12484      (concat      (concat
12485       "^\\s-*\\(sub\\|\\)\\(nature\\|type\\)\\s-+\\(\\w+\\)")       "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)")
12486      3 'font-lock-type-face)      3 'font-lock-type-face)
12487    
12488     ;; highlight signal/variable/constant declaration names     ;; highlight signal/variable/constant declaration names
# Line 9345  This does highlighting of keywords and s Line 12500  This does highlighting of keywords and s
12500  ;                 (skip-chars-backward "^-(\n\";")  ;                 (skip-chars-backward "^-(\n\";")
12501             (goto-char (match-end 1)) (1 font-lock-variable-name-face)))             (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12502    
12503     ;; highlight alias/group declaration names and for-loop/-generate variables     ;; highlight formal parameters in component instantiations and subprogram
12504     (list "\\<\\(alias\\|for\\|group\\)\\s-+\\w+\\s-+\\(in\\|is\\)\\>"     ;; calls
12505       (list "\\(=>\\)"
12506             '(vhdl-font-lock-match-item
12507               (progn (goto-char (match-beginning 1))
12508                      (skip-syntax-backward " ")
12509                      (while (= (preceding-char) ?\)) (backward-sexp))
12510                      (skip-syntax-backward "w_")
12511                      (skip-syntax-backward " ")
12512                      (when (memq (preceding-char) '(?n ?N))
12513                        (goto-char (point-max))))
12514               (goto-char (match-end 1)) (1 font-lock-variable-name-face)))
12515    
12516       ;; highlight alias/group/quantity declaration names and for-loop/-generate
12517       ;; variables
12518       (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>"
12519           '(vhdl-font-lock-match-item           '(vhdl-font-lock-match-item
12520             (progn (goto-char (match-end 1)) (match-beginning 2))             (progn (goto-char (match-end 1)) (match-beginning 2))
12521             nil (1 font-lock-variable-name-face)))             nil (1 font-lock-variable-name-face)))
# Line 9355  This does highlighting of keywords and s Line 12524  This does highlighting of keywords and s
12524  This does context sensitive highlighting of names and labels.")  This does context sensitive highlighting of names and labels.")
12525    
12526  (defvar vhdl-font-lock-keywords-3 nil  (defvar vhdl-font-lock-keywords-3 nil
12527    ;; set in `vhdl-font-lock-init' because dependent on custom variables    ;; set in `vhdl-font-lock-init' because dependent on user options
12528    "For consideration as a value of `vhdl-font-lock-keywords'.    "For consideration as a value of `vhdl-font-lock-keywords'.
12529  This does highlighting of words with special syntax.")  This does highlighting of words with special syntax.")
12530    
12531  (defvar vhdl-font-lock-keywords-4 nil  (defvar vhdl-font-lock-keywords-4 nil
12532    ;; set in `vhdl-font-lock-init' because dependent on custom variables    ;; set in `vhdl-font-lock-init' because dependent on user options
12533    "For consideration as a value of `vhdl-font-lock-keywords'.    "For consideration as a value of `vhdl-font-lock-keywords'.
12534  This does highlighting of additional reserved words.")  This does highlighting of additional reserved words.")
12535    
# Line 9424  This does background highlighting of tra Line 12593  This does background highlighting of tra
12593   'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)   'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face)
12594    
12595  (defface vhdl-font-lock-prompt-face  (defface vhdl-font-lock-prompt-face
12596    '((((class color) (background light)) (:foreground "Red" :weight bold))    '((((class color) (background light)) (:foreground "Red" :bold t))
12597      (((class color) (background dark)) (:foreground "Pink" :weight bold))      (((class color) (background dark)) (:foreground "Pink" :bold t))
12598      (t (:inverse-video t)))      (t (:inverse-video t)))
12599    "Font lock mode face used to highlight prompts."    "Font lock mode face used to highlight prompts."
12600    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
# Line 9434  This does background highlighting of tra Line 12603  This does background highlighting of tra
12603  (defface vhdl-font-lock-attribute-face  (defface vhdl-font-lock-attribute-face
12604    '((((class color) (background light)) (:foreground "Orchid"))    '((((class color) (background light)) (:foreground "Orchid"))
12605      (((class color) (background dark)) (:foreground "LightSteelBlue"))      (((class color) (background dark)) (:foreground "LightSteelBlue"))
12606      (t (:slant italic :weight bold)))      (t (:italic t :bold t)))
12607    "Font lock mode face used to highlight standardized attributes."    "Font lock mode face used to highlight standardized attributes."
12608    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
12609    :group 'font-lock-highlighting-faces)    :group 'font-lock-highlighting-faces)
12610    
12611  (defface vhdl-font-lock-enumvalue-face  (defface vhdl-font-lock-enumvalue-face
12612    '((((class color) (background light)) (:foreground "Gold4"))    '((((class color) (background light)) (:foreground "SaddleBrown"))
12613      (((class color) (background dark)) (:foreground "BurlyWood"))      (((class color) (background dark)) (:foreground "BurlyWood"))
12614      (t (:slant italic :weight bold)))      (t (:italic t :bold t)))
12615    "Font lock mode face used to highlight standardized enumeration values."    "Font lock mode face used to highlight standardized enumeration values."
12616    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
12617    :group 'font-lock-highlighting-faces)    :group 'font-lock-highlighting-faces)
12618    
12619  (defface vhdl-font-lock-function-face  (defface vhdl-font-lock-function-face
12620    '((((class color) (background light)) (:foreground "Orchid4"))    '((((class color) (background light)) (:foreground "Cyan4"))
12621      (((class color) (background dark)) (:foreground "Orchid1"))      (((class color) (background dark)) (:foreground "Orchid1"))
12622      (t (:slant italic :weight bold)))      (t (:italic t :bold t)))
12623    "Font lock mode face used to highlight standardized functions and packages."    "Font lock mode face used to highlight standardized functions and packages."
12624    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
12625    :group 'font-lock-highlighting-faces)    :group 'font-lock-highlighting-faces)
# Line 9458  This does background highlighting of tra Line 12627  This does background highlighting of tra
12627  (defface vhdl-font-lock-directive-face  (defface vhdl-font-lock-directive-face
12628    '((((class color) (background light)) (:foreground "CadetBlue"))    '((((class color) (background light)) (:foreground "CadetBlue"))
12629      (((class color) (background dark)) (:foreground "Aquamarine"))      (((class color) (background dark)) (:foreground "Aquamarine"))
12630      (t (:slant italic :weight bold)))      (t (:italic t :bold t)))
12631    "Font lock mode face used to highlight directives."    "Font lock mode face used to highlight directives."
12632    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
12633    :group 'font-lock-highlighting-faces)    :group 'font-lock-highlighting-faces)
12634    
12635  (defface vhdl-font-lock-reserved-words-face  (defface vhdl-font-lock-reserved-words-face
12636    '((((class color) (background light)) (:foreground "Orange" :weight bold))    '((((class color) (background light)) (:foreground "Orange" :bold t))
12637      (((class color) (background dark)) (:foreground "Yellow" :weight bold))      (((class color) (background dark)) (:foreground "Yellow" :bold t))
12638      (t ()))      (t ()))
12639    "Font lock mode face used to highlight additional reserved words."    "Font lock mode face used to highlight additional reserved words."
12640    :group 'vhdl-highlight-faces    :group 'vhdl-highlight-faces
# Line 9483  This does background highlighting of tra Line 12652  This does background highlighting of tra
12652  (let ((syntax-alist vhdl-special-syntax-alist))  (let ((syntax-alist vhdl-special-syntax-alist))
12653    (while syntax-alist    (while syntax-alist
12654      (eval `(defface ,(vhdl-function-name      (eval `(defface ,(vhdl-function-name
12655                        "vhdl-font-lock" (car (car syntax-alist)) "face")                        "vhdl-font-lock" (caar syntax-alist) "face")
12656               '((((class color) (background light))               '((((class color) (background light))
12657                  (:foreground ,(nth 2 (car syntax-alist))))                  (:foreground ,(nth 2 (car syntax-alist))))
12658                 (((class color) (background dark))                 (((class color) (background dark))
# Line 9500  This does background highlighting of tra Line 12669  This does background highlighting of tra
12669    
12670  (defun vhdl-font-lock-init ()  (defun vhdl-font-lock-init ()
12671    "Initialize fontification."    "Initialize fontification."
12672       ;; highlight template prompts and directives
12673      (setq vhdl-font-lock-keywords-0
12674            (list (list (concat "\\(^\\|[ \t(.']\\)\\(<"
12675                                vhdl-template-prompt-syntax ">\\)")
12676                        2 'vhdl-font-lock-prompt-face t)
12677                  (list (concat "--\\s-*"
12678                                vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$")
12679                        2 'vhdl-font-lock-directive-face t)))
12680    ;; highlight keywords and standardized types, attributes, enumeration    ;; highlight keywords and standardized types, attributes, enumeration
12681    ;; values, and subprograms    ;; values, and subprograms
12682    (setq vhdl-font-lock-keywords-1    (setq vhdl-font-lock-keywords-1
# Line 9553  This does background highlighting of tra Line 12730  This does background highlighting of tra
12730    (when (fboundp 'font-lock-unset-defaults)    (when (fboundp 'font-lock-unset-defaults)
12731      (font-lock-unset-defaults))         ; not implemented in XEmacs      (font-lock-unset-defaults))         ; not implemented in XEmacs
12732    (font-lock-set-defaults)    (font-lock-set-defaults)
12733    (font-lock-fontify-buffer))    (font-lock-mode nil)
12734      (font-lock-mode t))
12735    
12736  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12737  ;; Initialization for postscript printing  ;; Initialization for postscript printing
# Line 9595  This does background highlighting of tra Line 12773  This does background highlighting of tra
12773    
12774  (defun vhdl-ps-print-init ()  (defun vhdl-ps-print-init ()
12775    "Initialize postscript printing."    "Initialize postscript printing."
12776    (if (string-match "XEmacs" emacs-version)    (if vhdl-xemacs
12777        (vhdl-ps-print-settings)        (when (boundp 'ps-print-color-p)
12778            (vhdl-ps-print-settings))
12779      (make-local-variable 'ps-print-hook)      (make-local-variable 'ps-print-hook)
12780      (add-hook 'ps-print-hook 'vhdl-ps-print-settings)))      (add-hook 'ps-print-hook 'vhdl-ps-print-settings)))
12781    
# Line 9611  This does background highlighting of tra Line 12790  This does background highlighting of tra
12790  ;; Variables  ;; Variables
12791    
12792  (defvar vhdl-entity-alist nil  (defvar vhdl-entity-alist nil
12793    "Cache with entities and corresponding architectures and configurations for    "Cache with entities and corresponding architectures for each
12794  each visited directory.")  project/directory.")
12795    ;; structure: (parenthesised expression means list of such entries)
12796    ;; (cache-key
12797    ;;   (ent-key ent-name ent-file ent-line
12798    ;;     (arch-key arch-name arch-file arch-line
12799    ;;       (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key
12800    ;;                 inst-arch-key inst-conf-key inst-lib-key)
12801    ;;       (lib-name pack-key))
12802    ;;     (lib-name pack-key))
12803    
12804    (defvar vhdl-config-alist nil
12805      "Cache with configurations for each project/directory.")
12806  ;; structure: (parenthesised expression means list of such entries)  ;; structure: (parenthesised expression means list of such entries)
12807  ;; (directory-name  ;; (cache-key
12808  ;;   (ent-name ent-file ent-line  ;;   (conf-key conf-name conf-file conf-line ent-key arch-key
12809  ;;     (arch-name arch-file arch-line  ;;     (inst-key inst-comp-name inst-ent-key inst-arch-key
12810  ;;       (inst-name inst-file inst-line inst-ent-name inst-arch-name))  ;;               inst-conf-key inst-lib-key)
12811  ;;     (conf-name conf-file conf-line))  ;;     (lib-name pack-key)))
12812    
12813  (defvar vhdl-package-alist nil  (defvar vhdl-package-alist nil
12814    "Cache with packages for each visited directory.")    "Cache with packages for each project/directory.")
12815  ;; structure: (parenthesised expression means list of such entries)  ;; structure: (parenthesised expression means list of such entries)
12816  ;; (directory-name  ;; (cache-key
12817  ;;   (pack-name pack-file pack-line pack-body-file pack-body-line))  ;;   (pack-key pack-name pack-file pack-line
12818    ;;     (comp-key comp-name comp-file comp-line)
12819    ;;     (func-key func-name func-file func-line)
12820    ;;     (lib-name pack-key)
12821    ;;     pack-body-file pack-body-line
12822    ;;     (func-key func-name func-body-file func-body-line)
12823    ;;     (lib-name pack-key)))
12824    
12825  (defvar vhdl-ent-inst-alist nil  (defvar vhdl-ent-inst-alist nil
12826    "Cache with instantiated entities for each visited directory.")    "Cache with instantiated entities for each project/directory.")
12827    ;; structure: (parenthesised expression means list of such entries)
12828    ;; (cache-key (inst-ent-key))
12829    
12830    (defvar vhdl-file-alist nil
12831      "Cache with design units in each file for each project/directory.")
12832  ;; structure: (parenthesised expression means list of such entries)  ;; structure: (parenthesised expression means list of such entries)
12833  ;; (directory-name (inst-ent-name))  ;; (cache-key
12834    ;;   (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
12835    ;;              (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
12836    
12837  (defvar vhdl-project-entity-alist nil  (defvar vhdl-directory-alist nil
12838    "Cache with entities and corresponding architectures and configurations for    "Cache with source directories for each project.")
12839  each visited project.")  ;; structure: (parenthesised expression means list of such entries)
12840  ;; same structure as `vhdl-entity-alist'  ;; (cache-key (directory))
   
 (defvar vhdl-project-package-alist nil  
   "Cache with packages for each visited directory.")  
 ;; same structure as `vhdl-package-alist'  
   
 (defvar vhdl-project-ent-inst-list nil  
   "Cache with instantiated entities for each visited directory.")  
 ;; same structure as `vhdl-ent-inst-alist'  
12841    
12842  (defvar vhdl-speedbar-shown-units-alist nil  (defvar vhdl-speedbar-shown-unit-alist nil
12843    "Alist of design units simultaneously open in the current speedbar for each    "Alist of design units simultaneously open in the current speedbar for each
12844  directory and project.")  directory and project.")
12845    
12846  (defvar vhdl-speedbar-last-file-name nil  (defvar vhdl-speedbar-shown-project-list nil
12847    "Last file for which design units were highlighted.")    "List of projects simultaneously open in the current speedbar.")
12848    
12849  (defvar vhdl-file-alist nil  (defvar vhdl-updated-project-list nil
12850    "Cache with design units in each file.")    "List of projects and directories with updated files.")
12851  ;; structure (parenthesised expression means list of such entries)  
12852  ;; (file-name (ent-list) (arch-list) (conf-list) (pack-list) (inst-list))  (defvar vhdl-modified-file-list nil
12853      "List of modified files to be rescanned for hierarchy updating.")
12854    
12855    (defvar vhdl-speedbar-hierarchy-depth 0
12856      "Depth of instantiation hierarchy to display.")
12857    
12858    (defvar vhdl-speedbar-show-projects nil
12859      "Non-nil means project hierarchy is displayed in speedbar, directory
12860    hierarchy otherwise.")
12861    
12862    (defun vhdl-get-end-of-unit ()
12863      "Return position of end of current unit."
12864      (let ((pos (point)))
12865        (save-excursion
12866          (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1)
12867                      (save-excursion
12868                        (goto-char (match-beginning 0))
12869                        (vhdl-backward-syntactic-ws)
12870                        (and (/= (preceding-char) ?\;) (not (bobp))))))
12871          (re-search-backward "^[ \t]*end\\>" pos 1)
12872          (point))))
12873    
12874    (defun vhdl-match-string-downcase (num &optional string)
12875      "Like `match-string-no-properties' with down-casing."
12876      (let ((match (match-string-no-properties num string)))
12877        (and match (downcase match))))
12878    
 ;; help function  
 (defsubst vhdl-speedbar-project-p ()  
   "Return non-nil if a project is displayed, i.e. directories or files are  
 specified."  
   (nth 1 (aget vhdl-project-alist vhdl-project)))  
12879    
12880  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12881  ;; Scan functions  ;; Scan functions
12882    
12883  (defun vhdl-scan-file-contents (name &optional num-string)  (defun vhdl-scan-context-clause ()
12884    "Scan contents of VHDL files in FILE-LIST."    "Scan the context clause that preceeds a design unit."
12885    (string-match "\\(.*/\\)\\(.*\\)" name)    (let (lib-alist)
12886        (save-excursion
12887          (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
12888            (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t)
12889                        (equal "USE" (upcase (match-string 1))))
12890              (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+")
12891                (setq lib-alist (cons (cons (match-string-no-properties 1)
12892                                            (vhdl-match-string-downcase 2))
12893                                      lib-alist))))))
12894        lib-alist))
12895    
12896    (defun vhdl-scan-directory-contents (name &optional project update num-string
12897                                              non-final)
12898      "Scan contents of VHDL files in directory or file pattern DIR-NAME."
12899      (string-match "\\(.*[/\\]\\)\\(.*\\)" name)
12900  ;   (unless (file-directory-p (match-string 1 name))  ;   (unless (file-directory-p (match-string 1 name))
12901  ;     (message "No such directory: \"%s\"" (match-string 1 name)))  ;     (message "No such directory: \"%s\"" (match-string 1 name)))
12902    (let* ((is-directory (= (match-beginning 2) (match-end 2)))    (let* ((dir-name (match-string 1 name))
12903             (file-pattern (match-string 2 name))
12904             (is-directory (= 0 (length file-pattern)))
12905           (file-list           (file-list
12906            (if is-directory            (if update
12907                (nreverse (vhdl-get-source-files t name))                (list name)
12908              (vhdl-directory-files (match-string 1 name) t              (if is-directory
12909                                    (wildcard-to-regexp (match-string 2 name)))))                  (vhdl-get-source-files t dir-name)
12910           (case-fold-search t)                (vhdl-directory-files
12911           (source-buffer (current-buffer))                 dir-name t (wildcard-to-regexp file-pattern)))))
12912           ent-alist pack-alist ent-inst-list no-files)           (key (or project dir-name))
12913             (file-exclude-regexp
12914              (or (nth 3 (aget vhdl-project-alist project)) ""))
12915             (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit))
12916             (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit)))
12917             (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit)))
12918             ent-alist conf-alist pack-alist ent-inst-list file-alist
12919             tmp-list tmp-entry no-files files-exist big-files)
12920        (when (or project update)
12921          (setq ent-alist (aget vhdl-entity-alist key t)
12922                conf-alist (aget vhdl-config-alist key t)
12923                pack-alist (aget vhdl-package-alist key t)
12924                ent-inst-list (car (aget vhdl-ent-inst-alist key t))
12925                file-alist (aget vhdl-file-alist key t)))
12926      (when (and (not is-directory) (null file-list))      (when (and (not is-directory) (null file-list))
12927        (message "No such file: \"%s\"" name))        (message "No such file: \"%s\"" name))
12928      (save-excursion      (setq files-exist file-list)
12929        (when file-list      (when file-list
12930          (setq no-files (length file-list))        (setq no-files (length file-list))
12931          ;; do for all files        (message "Scanning %s %s\"%s\"..."
12932          (while file-list                 (if is-directory "directory" "files") (or num-string "") name)
12933          ;; exclude files
12934          (unless (equal file-exclude-regexp "")
12935            (let ((case-fold-search nil)
12936                  file-tmp-list)
12937              (while file-list
12938                (unless (string-match file-exclude-regexp (car file-list))
12939                  (setq file-tmp-list (cons (car file-list) file-tmp-list)))
12940                (setq file-list (cdr file-list)))
12941              (setq file-list (nreverse file-tmp-list))))
12942          ;; do for all files
12943          (while file-list
12944            (unless noninteractive
12945            (message "Scanning %s %s\"%s\"... (%2d%s)"            (message "Scanning %s %s\"%s\"... (%2d%s)"
12946                     (if is-directory "directory" "files")                     (if is-directory "directory" "files")
12947                     (or num-string "") name                     (or num-string "") name
12948                     (/ (* 100 (- no-files (length file-list))) no-files) "%")                     (/ (* 100 (- no-files (length file-list))) no-files) "%"))
12949            (let ((file-name (abbreviate-file-name (car file-list)))          (let ((file-name (abbreviate-file-name (car file-list)))
12950                  opened arch-name ent-name                ent-list arch-list arch-ent-list conf-list
12951                  ent-list arch-list conf-list pack-list inst-list)                pack-list pack-body-list inst-list inst-ent-list)
12952              ;; open file            ;; scan file
12953              (if (find-buffer-visiting file-name)            (vhdl-visit-file
12954                  (set-buffer (find-buffer-visiting file-name))             file-name nil
12955                (set-buffer (find-file-noselect file-name nil t))             (vhdl-prepare-search-2
12956                (setq opened t))              (save-excursion
12957              (modify-syntax-entry ?_ "w" (syntax-table))                ;; scan for design units
12958              ;; scan for entities                (if (and limit-design-file-size
12959              (goto-char (point-min))                         (< limit-design-file-size (buffer-size)))
12960              (while (re-search-forward "^\\s-*entity\\s-+\\(\\w+\\)" nil t)                    (progn (message "WARNING:  Scan limit (design units: file size) reached in file:\n  \"%s\"" file-name)
12961                (let* ((ent-entry (aget ent-alist (match-string 1)))                           (setq big-files t))
12962                       (arch-alist (nth 2 ent-entry))                  ;; scan for entities
12963                       (conf-alist (nth 3 ent-entry)))                  (goto-char (point-min))
12964                  (setq ent-list (cons (match-string 1) ent-list))                  (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
12965                  (aput 'ent-alist (match-string 1)                    (let* ((ent-name (match-string-no-properties 1))
12966                        (list file-name (vhdl-current-line)                           (ent-key (downcase ent-name))
12967                              arch-alist conf-alist nil))))                           (ent-entry (aget ent-alist ent-key t))
12968              ;; scan for architectures and instantiations                           (arch-alist (nth 3 ent-entry))
12969              (goto-char (point-min))                           (lib-alist (vhdl-scan-context-clause)))
12970              (while (re-search-forward                      (if (nth 1 ent-entry)
12971                      (concat                          (vhdl-warning-when-idle
12972                       "^\\s-*\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|"                           "Entity declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
12973                       "\\(\\w+\\)\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\w+\\.\\)?"                           ent-name  (nth 1 ent-entry) (nth 2 ent-entry)
12974                       "\\(\\w+\\)\\(\\s-*(\\(\\w+\\))\\)?\\(\\s-\\|\n\\|--.*\n\\)*"                           file-name (vhdl-current-line))
12975                       "\\(generic\\|port\\)\\s-+map\\>\\)")                        (setq ent-list (cons ent-key ent-list))
12976                      nil t)                        (aput 'ent-alist ent-key
12977                (if (match-string 2)                              (list ent-name file-name (vhdl-current-line)
12978                    ;; architecture found                                    arch-alist lib-alist)))))
12979                    (let* ((ent-entry (aget ent-alist (match-string 3)))                  ;; scan for architectures
12980                           (arch-alist (nth 2 ent-entry))                  (goto-char (point-min))
12981                           (conf-alist (nth 3 ent-entry)))                  (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
12982                      (setq arch-name (match-string 2))                    (let* ((arch-name (match-string-no-properties 1))
12983                      (setq ent-name (match-string 3))                           (arch-key (downcase arch-name))
12984                      (setq arch-list (cons arch-name arch-list))                           (ent-name (match-string-no-properties 2))
12985                      (vhdl-aappend 'arch-alist arch-name                           (ent-key (downcase ent-name))
12986                                    (list file-name (vhdl-current-line) nil))                           (ent-entry (aget ent-alist ent-key t))
12987                      (setq ent-entry (list (nth 0 ent-entry) (nth 1 ent-entry)                           (arch-alist (nth 3 ent-entry))
12988                                            arch-alist conf-alist nil))                           (arch-entry (aget arch-alist arch-key t))
12989                      (aput 'ent-alist ent-name ent-entry))                           (lib-arch-alist (vhdl-scan-context-clause)))
12990                  ;; instantiation found                      (if arch-entry
12991                  (let* ((ent-entry (aget ent-alist ent-name))                          (vhdl-warning-when-idle
12992                         (arch-alist (nth 2 ent-entry))                           "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
12993                         (arch-entry (aget arch-alist arch-name))                           arch-name ent-name (nth 1 arch-entry)
12994                         (inst-alist (nth 2 arch-entry))                           (nth 2 arch-entry) file-name (vhdl-current-line))
12995                         (inst-name (match-string 4))                        (setq arch-list (cons arch-key arch-list)
12996                         (inst-ent-name (match-string 7))                              arch-ent-list (cons ent-key arch-ent-list))
12997                         (inst-arch-name (match-string 9))                        (aput 'arch-alist arch-key
12998                         (conf-alist (nth 3 ent-entry)))                              (list arch-name file-name (vhdl-current-line) nil
12999                    (re-search-backward ":" nil t)                                    lib-arch-alist))
13000                    (setq inst-list (cons inst-name inst-list))                        (aput 'ent-alist ent-key
13001                    (vhdl-aappend 'inst-alist inst-name                              (list (or (nth 0 ent-entry) ent-name)
13002                                  (list file-name (vhdl-current-line)                                    (nth 1 ent-entry) (nth 2 ent-entry)
13003                                        inst-ent-name inst-arch-name))                                    (vhdl-sort-alist arch-alist)
13004                    (setq arch-entry                                    (nth 4 ent-entry))))))
13005                          (list (nth 0 arch-entry) (nth 1 arch-entry)                  ;; scan for configurations
13006                                inst-alist))                  (goto-char (point-min))
13007                    (vhdl-aappend 'arch-alist arch-name arch-entry)                  (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13008                    (setq ent-entry (list (nth 0 ent-entry) (nth 1 ent-entry)                    (let* ((conf-name (match-string-no-properties 1))
13009                                          arch-alist conf-alist nil))                           (conf-key (downcase conf-name))
13010                    (aput 'ent-alist ent-name ent-entry)                           (conf-entry (aget conf-alist conf-key t))
13011                    (unless (member inst-ent-name ent-inst-list)                           (ent-name (match-string-no-properties 2))
13012                      (setq ent-inst-list                           (ent-key (downcase ent-name))
13013                            (cons inst-ent-name ent-inst-list))))))                           (lib-alist (vhdl-scan-context-clause))
13014              ;; scan for configurations                           (conf-line (vhdl-current-line))
13015              (goto-char (point-min))                           (end-of-unit (vhdl-get-end-of-unit))
13016              (while (re-search-forward                           arch-key comp-conf-list inst-key-list
13017                      "^\\s-*configuration\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)"                           inst-comp-key inst-ent-key inst-arch-key
13018                      nil t)                           inst-conf-key inst-lib-key)
13019                (let* ((ent-entry (aget ent-alist (match-string 2)))                      (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)")
13020                       (arch-alist (nth 2 ent-entry))                        (setq arch-key (vhdl-match-string-downcase 1)))
13021                       (conf-alist (nth 3 ent-entry)))                      (if conf-entry
13022                  (setq conf-list (cons (match-string 1) conf-list))                          (vhdl-warning-when-idle
13023                  (vhdl-aappend 'conf-alist (match-string 1)                           "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13024                                (list file-name (vhdl-current-line)))                           conf-name ent-name (nth 1 conf-entry)
13025                  (setq ent-entry (list (nth 0 ent-entry) (nth 1 ent-entry)                           (nth 2 conf-entry) file-name conf-line)
13026                                        arch-alist conf-alist nil))                        (setq conf-list (cons conf-key conf-list))
13027                  (aput 'ent-alist (match-string 2) ent-entry)))                        ;; scan for subconfigurations and subentities
13028              ;; scan for packages                        (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t)
13029              (goto-char (point-min))                          (setq inst-comp-key (vhdl-match-string-downcase 3)
13030              (while (re-search-forward                                inst-key-list (split-string
13031                      "^\\s-*package\\s-+\\(body\\s-+\\)?\\(\\w+\\)" nil t)                                               (vhdl-match-string-downcase 1)
13032                (let ((pack-entry (aget pack-alist (match-string 2))))                                               "[ \t\n]*,[ \t\n]*"))
13033                  (setq pack-list (cons (match-string 2) pack-list))                          (vhdl-forward-syntactic-ws)
13034                  (aput 'pack-alist (match-string 2)                          (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?")
13035                        (if (not (match-string 1))                            (setq
13036                            (list file-name (vhdl-current-line)                             inst-lib-key (vhdl-match-string-downcase 3)
13037                                  (nth 2 pack-entry) (nth 3 pack-entry))                             inst-ent-key (and (match-string 2)
13038                          (list (nth 0 pack-entry) (nth 1 pack-entry)                                               (vhdl-match-string-downcase 4))
13039                                file-name (vhdl-current-line))))))                             inst-arch-key (and (match-string 2)
13040              (setq file-list (cdr file-list))                                                (vhdl-match-string-downcase 6))
13041              ;; add design units to variable `vhdl-file-alist'                             inst-conf-key (and (not (match-string 2))
13042              (aput 'vhdl-file-alist file-name                                                (vhdl-match-string-downcase 4)))
13043                    (list ent-list arch-list conf-list pack-list inst-list))                            (while inst-key-list
13044              ;; close file                              (setq comp-conf-list
13045              (if opened                                    (cons (list (car inst-key-list)
13046                  (kill-buffer (current-buffer))                                                inst-comp-key inst-ent-key
13047                (when (not vhdl-underscore-is-part-of-word)                                                inst-arch-key inst-conf-key
13048                  (modify-syntax-entry ?_ "_" vhdl-mode-syntax-table)))                                                inst-lib-key)
13049              (set-buffer source-buffer)))                                          comp-conf-list))
13050          ;; sort entities and packages                              (setq inst-key-list (cdr inst-key-list)))))
13051          (setq ent-alist                        (aput 'conf-alist conf-key
13052                (sort ent-alist                              (list conf-name file-name conf-line ent-key
13053                      (function (lambda (a b) (string-lessp (car a) (car b))))))                                    arch-key comp-conf-list lib-alist)))))
13054          (setq pack-alist                  ;; scan for packages
13055                (sort pack-alist                  (goto-char (point-min))
13056                      (function (lambda (a b) (string-lessp (car a) (car b))))))                  (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t)
13057          ;; put directory contents into cache                    (let* ((pack-name (match-string-no-properties 2))
13058          (when ent-alist                           (pack-key (downcase pack-name))
13059            (aput 'vhdl-entity-alist name ent-alist))                           (is-body (match-string-no-properties 1))
13060          (when pack-alist                           (pack-entry (aget pack-alist pack-key t))
13061            (aput 'vhdl-package-alist name pack-alist))                           (pack-line (vhdl-current-line))
13062          (when ent-inst-list                           (end-of-unit (vhdl-get-end-of-unit))
13063            (aput 'vhdl-ent-inst-alist name (list ent-inst-list)))                           comp-name func-name comp-alist func-alist lib-alist)
13064          (message "Scanning %s %s\"%s\"...done"                      (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13065                   (if is-directory "directory" "files") (or num-string "") name)                          (vhdl-warning-when-idle
13066          t))))                           "Package%s declared twice (used 1.): \"%s\"\n  1. in \"%s\" (line %d)\n  2. in \"%s\" (line %d)"
13067                             (if is-body " body" "") pack-name
13068                             (if is-body (nth 6 pack-entry) (nth 1 pack-entry))
13069                             (if is-body (nth 7 pack-entry) (nth 2 pack-entry))
13070                             file-name (vhdl-current-line))
13071                          ;; scan for context clauses
13072                          (setq lib-alist (vhdl-scan-context-clause))
13073                          ;; scan for component and subprogram declarations/bodies
13074                          (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t)
13075                            (if (equal (upcase (match-string 1)) "COMPONENT")
13076                                (setq comp-name (match-string-no-properties 2)
13077                                      comp-alist
13078                                      (cons (list (downcase comp-name) comp-name
13079                                                  file-name (vhdl-current-line))
13080                                            comp-alist))
13081                              (setq func-name (match-string-no-properties 2)
13082                                    func-alist
13083                                    (cons (list (downcase func-name) func-name
13084                                                file-name (vhdl-current-line))
13085                                          func-alist))))
13086                          (setq func-alist (nreverse func-alist))
13087                          (setq comp-alist (nreverse comp-alist))
13088                          (if is-body
13089                              (setq pack-body-list (cons pack-key pack-body-list))
13090                            (setq pack-list (cons pack-key pack-list)))
13091                          (aput
13092                           'pack-alist pack-key
13093                           (if is-body
13094                               (list (or (nth 0 pack-entry) pack-name)
13095                                     (nth 1 pack-entry) (nth 2 pack-entry)
13096                                     (nth 3 pack-entry) (nth 4 pack-entry)
13097                                     (nth 5 pack-entry)
13098                                     file-name pack-line func-alist lib-alist)
13099                             (list pack-name file-name pack-line
13100                                   comp-alist func-alist lib-alist
13101                                   (nth 6 pack-entry) (nth 7 pack-entry)
13102                                   (nth 8 pack-entry) (nth 9 pack-entry))))))))
13103                  ;; scan for hierarchy
13104                  (if (and limit-hier-file-size
13105                           (< limit-hier-file-size (buffer-size)))
13106                      (progn (message "WARNING:  Scan limit (hierarchy: file size) reached in file:\n  \"%s\"" file-name)
13107                             (setq big-files t))
13108                    ;; scan for architectures
13109                    (goto-char (point-min))
13110                    (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
13111                      (let* ((ent-name (match-string-no-properties 2))
13112                             (ent-key (downcase ent-name))
13113                             (arch-name (match-string-no-properties 1))
13114                             (arch-key (downcase arch-name))
13115                             (ent-entry (aget ent-alist ent-key t))
13116                             (arch-alist (nth 3 ent-entry))
13117                             (arch-entry (aget arch-alist arch-key t))
13118                             (beg-of-unit (point))
13119                             (end-of-unit (vhdl-get-end-of-unit))
13120                             (inst-no 0)
13121                             inst-alist)
13122                        ;; scan for contained instantiations
13123                        (while (and (re-search-forward
13124                                     (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
13125                                             "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|"
13126                                             "component[ \t\n]+\\(\\w+\\)\\|"
13127                                             "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\)") end-of-unit t)
13128                                    (or (not limit-hier-inst-no)
13129                                        (<= (setq inst-no (1+ inst-no))
13130                                            limit-hier-inst-no)))
13131                          (let* ((inst-name (match-string-no-properties 1))
13132                                 (inst-key (downcase inst-name))
13133                                 (inst-comp-name
13134                                  (or (match-string-no-properties 3)
13135                                      (match-string-no-properties 6)))
13136                                 (inst-ent-key
13137                                  (or (and (match-string 8)
13138                                           (vhdl-match-string-downcase 11))
13139                                      (and inst-comp-name
13140                                           (downcase inst-comp-name))))
13141                                 (inst-arch-key (vhdl-match-string-downcase 13))
13142                                 (inst-conf-key
13143                                  (and (not (match-string 8))
13144                                       (vhdl-match-string-downcase 11)))
13145                                 (inst-lib-key (vhdl-match-string-downcase 10)))
13146                            (goto-char (match-end 1))
13147                            (setq inst-list (cons inst-key inst-list)
13148                                  inst-ent-list (cons inst-ent-key inst-ent-list))
13149                            (setq inst-alist
13150                                  (append
13151                                   inst-alist
13152                                   (list (list inst-key inst-name file-name
13153                                               (vhdl-current-line) inst-comp-name
13154                                               inst-ent-key inst-arch-key
13155                                               inst-conf-key inst-lib-key))))))
13156                        ;; scan for contained configuration specifications
13157                        (goto-char beg-of-unit)
13158                        (while (re-search-forward
13159                                (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*"
13160                                        "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t)
13161                          (let* ((inst-comp-name (match-string-no-properties 3))
13162                                 (inst-ent-key
13163                                  (and (match-string 6)
13164                                       (vhdl-match-string-downcase 9)))
13165                                 (inst-arch-key (vhdl-match-string-downcase 11))
13166                                 (inst-conf-key
13167                                  (and (not (match-string 6))
13168                                       (vhdl-match-string-downcase 9)))
13169                                 (inst-lib-key (vhdl-match-string-downcase 8))
13170                                 (inst-key-list
13171                                  (split-string (vhdl-match-string-downcase 1)
13172                                                "[ \t\n]*,[ \t\n]*"))
13173                                 (tmp-inst-alist inst-alist)
13174                                 inst-entry)
13175                            (while tmp-inst-alist
13176                              (when (and (or (equal "all" (car inst-key-list))
13177                                             (member (nth 0 (car tmp-inst-alist))
13178                                                     inst-key-list))
13179                                         (equal
13180                                          (downcase
13181                                           (or (nth 4 (car tmp-inst-alist)) ""))
13182                                          (downcase inst-comp-name)))
13183                                (setq inst-entry (car tmp-inst-alist))
13184                                (setq inst-ent-list
13185                                      (cons (or inst-ent-key (nth 5 inst-entry))
13186                                            (vhdl-delete
13187                                             (nth 5 inst-entry) inst-ent-list)))
13188                                (setq inst-entry
13189                                      (list (nth 0 inst-entry) (nth 1 inst-entry)
13190                                            (nth 2 inst-entry) (nth 3 inst-entry)
13191                                            (nth 4 inst-entry)
13192                                            (or inst-ent-key (nth 5 inst-entry))
13193                                            (or inst-arch-key (nth 6 inst-entry))
13194                                            inst-conf-key inst-lib-key))
13195                                (setcar tmp-inst-alist inst-entry))
13196                              (setq tmp-inst-alist (cdr tmp-inst-alist)))))
13197                        ;; save in cache
13198                        (aput 'arch-alist arch-key
13199                              (list (nth 0 arch-entry) (nth 1 arch-entry)
13200                                    (nth 2 arch-entry) inst-alist
13201                                    (nth 4 arch-entry)))
13202                        (aput 'ent-alist ent-key
13203                              (list (nth 0 ent-entry) (nth 1 ent-entry)
13204                                    (nth 2 ent-entry) (vhdl-sort-alist arch-alist)
13205                                    (nth 4 ent-entry)))
13206                        (when (and limit-hier-inst-no
13207                                   (> inst-no limit-hier-inst-no))
13208                          (message "WARNING:  Scan limit (hierarchy: instances per architecture) reached in file:\n  \"%s\"" file-name)
13209                          (setq big-files t))
13210                        (goto-char end-of-unit))))
13211                  ;; remember design units for this file
13212                  (aput 'file-alist file-name
13213                        (list ent-list arch-list arch-ent-list conf-list
13214                              pack-list pack-body-list inst-list inst-ent-list))
13215                  (setq ent-inst-list (append inst-ent-list ent-inst-list))))))
13216            (setq file-list (cdr file-list))))
13217        (when (or (and (not project) files-exist)
13218                  (and project (not non-final)))
13219          ;; consistency checks:
13220          ;; check whether each architecture has a corresponding entity
13221          (setq tmp-list ent-alist)
13222          (while tmp-list
13223            (when (null (nth 2 (car tmp-list)))
13224              (setq tmp-entry (car (nth 4 (car tmp-list))))
13225              (vhdl-warning-when-idle
13226               "Architecture of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
13227               (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry)
13228               (nth 3 tmp-entry)))
13229            (setq tmp-list (cdr tmp-list)))
13230          ;; check whether configuration has a corresponding entity/architecture
13231          (setq tmp-list conf-alist)
13232          (while tmp-list
13233            (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t))
13234                (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t)
13235                  (setq tmp-entry (car tmp-list))
13236                  (vhdl-warning-when-idle
13237                   "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n  in \"%s\" (line %d)"
13238                   (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry)
13239                   (nth 2 tmp-entry) (nth 3 tmp-entry)))
13240              (setq tmp-entry (car tmp-list))
13241              (vhdl-warning-when-idle
13242               "Configuration of non-existing entity: \"%s\" of \"%s\"\n  in \"%s\" (line %d)"
13243               (nth 1 tmp-entry) (nth 4 tmp-entry)
13244               (nth 2 tmp-entry) (nth 3 tmp-entry)))
13245            (setq tmp-list (cdr tmp-list)))
13246          ;; check whether each package body has a package declaration
13247          (setq tmp-list pack-alist)
13248          (while tmp-list
13249            (when (null (nth 2 (car tmp-list)))
13250              (setq tmp-entry (car tmp-list))
13251              (vhdl-warning-when-idle
13252               "Package body of non-existing package: \"%s\"\n  in \"%s\" (line %d)"
13253               (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry)))
13254            (setq tmp-list (cdr tmp-list)))
13255          ;; sort lists
13256          (setq ent-alist (vhdl-sort-alist ent-alist))
13257          (setq conf-alist (vhdl-sort-alist conf-alist))
13258          (setq pack-alist (vhdl-sort-alist pack-alist))
13259          ;; remember updated directory/project
13260          (add-to-list 'vhdl-updated-project-list (or project dir-name)))
13261        ;; clear directory alists
13262        (unless project
13263          (adelete 'vhdl-entity-alist key)
13264          (adelete 'vhdl-config-alist key)
13265          (adelete 'vhdl-package-alist key)
13266          (adelete 'vhdl-ent-inst-alist key)
13267          (adelete 'vhdl-file-alist key))
13268        ;; put directory contents into cache
13269        (aput 'vhdl-entity-alist key ent-alist)
13270        (aput 'vhdl-config-alist key conf-alist)
13271        (aput 'vhdl-package-alist key pack-alist)
13272        (aput 'vhdl-ent-inst-alist key (list ent-inst-list))
13273        (aput 'vhdl-file-alist key file-alist)
13274        ;; final messages
13275        (message "Scanning %s %s\"%s\"...done"
13276                 (if is-directory "directory" "files") (or num-string "") name)
13277        (unless project (message "Scanning directory...done"))
13278        (when big-files
13279          (vhdl-warning-when-idle "Scanning is incomplete.\n  --> see user option `vhdl-speedbar-scan-limit'"))
13280        ;; save cache when scanned non-interactively
13281        (when (or (not project) (not non-final))
13282          (when (and noninteractive vhdl-speedbar-save-cache)
13283            (vhdl-save-cache key)))
13284        t))
13285    
13286  (defun vhdl-scan-project-contents (project &optional rescan)  (defun vhdl-scan-project-contents (project)
13287    "Scan the contents of all VHDL files found in the directories and files    "Scan the contents of all VHDL files found in the directories and files
13288  of PROJECT."  of PROJECT."
13289    (let ((dir-list-tmp (nth 1 (aget vhdl-project-alist project)))    (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '("")))
13290          dir-list pro-ent-alist pro-pack-alist pro-ent-inst-list          (default-dir (vhdl-resolve-env-variable
13291          dir name num-dir act-dir)                        (nth 1 (aget vhdl-project-alist project))))
13292      ;; resolve environment variables and path wildcards          (file-exclude-regexp
13293              (or (nth 3 (aget vhdl-project-alist project)) ""))
13294            dir-list-tmp dir dir-name num-dir act-dir recursive)
13295        ;; clear project alists
13296        (adelete 'vhdl-entity-alist project)
13297        (adelete 'vhdl-config-alist project)
13298        (adelete 'vhdl-package-alist project)
13299        (adelete 'vhdl-ent-inst-alist project)
13300        (adelete 'vhdl-file-alist project)
13301        ;; expand directory names by default-directory
13302        (message "Collecting source files...")
13303        (while dir-list
13304          (setq dir (vhdl-resolve-env-variable (car dir-list)))
13305          (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir)
13306          (setq recursive (match-string 1 dir)
13307                dir-name (match-string 3 dir))
13308          (setq dir-list-tmp
13309                (cons (concat recursive
13310                              (if (file-name-absolute-p dir-name) "" default-dir)
13311                              dir-name)
13312                      dir-list-tmp))
13313          (setq dir-list (cdr dir-list)))
13314        ;; resolve path wildcards
13315      (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))      (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp))
13316      ;; expand directories      ;; expand directories
13317      (while dir-list-tmp      (while dir-list-tmp
13318        (setq dir (car dir-list-tmp))        (setq dir (car dir-list-tmp))
13319        ;; get subdirectories        ;; get subdirectories
13320        (if (string-match "-r \\(.*/\\)" dir)        (if (string-match "-r \\(.*[/\\]\\)" dir)
13321            (setq dir-list (append dir-list (vhdl-get-subdirs            (setq dir-list (append dir-list (vhdl-get-subdirs
13322                                             (match-string 1 dir))))                                             (match-string 1 dir))))
13323          (setq dir-list (append dir-list (list dir))))          (setq dir-list (append dir-list (list dir))))
13324        (setq dir-list-tmp (cdr dir-list-tmp)))        (setq dir-list-tmp (cdr dir-list-tmp)))
13325      ;; get entities and packages of each directory in DIR-LIST      ;; exclude files
13326      (setq num-dir (length dir-list)      (unless (equal file-exclude-regexp "")
13327          (let ((case-fold-search nil))
13328            (while dir-list
13329              (unless (string-match file-exclude-regexp (car dir-list))
13330                (setq dir-list-tmp (cons (car dir-list) dir-list-tmp)))
13331              (setq dir-list (cdr dir-list)))
13332            (setq dir-list (nreverse dir-list-tmp))))
13333        (message "Collecting source files...done")
13334        ;; scan for design units for each directory in DIR-LIST
13335        (setq dir-list-tmp nil
13336              num-dir (length dir-list)
13337            act-dir 1)            act-dir 1)
13338      (while dir-list      (while dir-list
13339        (setq name (abbreviate-file-name (car dir-list)))        (setq dir-name (abbreviate-file-name
13340        (or (and (not rescan)                        (expand-file-name (car dir-list))))
13341                 (or (assoc name vhdl-entity-alist)        (vhdl-scan-directory-contents dir-name project nil
13342                     (assoc name vhdl-package-alist)))                                      (format "(%s/%s) " act-dir num-dir)
13343            (vhdl-scan-file-contents name (format "(%s/%s) " act-dir num-dir)))                                      (cdr dir-list))
13344        ;; merge entities and corresponding architectures and configurations        (add-to-list 'dir-list-tmp (file-name-directory dir-name))
       (let ((ent-alist (aget vhdl-entity-alist name)))  
         (while ent-alist  
           (let* ((ent-name (car (car ent-alist)))  
                  (ent-entry (cdr (car ent-alist)))  
                  (pro-ent-entry (aget pro-ent-alist ent-name)))  
             (aput 'pro-ent-alist ent-name  
                   (list (or (nth 0 pro-ent-entry) (nth 0 ent-entry))  
                         (or (nth 1 pro-ent-entry) (nth 1 ent-entry))  
                         (append (nth 2 pro-ent-entry) (nth 2 ent-entry))  
                         (append (nth 3 pro-ent-entry) (nth 3 ent-entry)))))  
           (setq ent-alist (cdr ent-alist))))  
       ;; merge packages and corresponding package bodies  
       (let ((pack-alist (aget vhdl-package-alist name)))  
         (while pack-alist  
           (let* ((pack-name (car (car pack-alist)))  
                  (pack-entry (cdr (car pack-alist)))  
                  (pro-pack-entry (aget pro-pack-alist pack-name)))  
             (aput 'pro-pack-alist pack-name  
                   (list (or (nth 0 pro-pack-entry) (nth 0 pack-entry))  
                         (or (nth 1 pro-pack-entry) (nth 1 pack-entry))  
                         (or (nth 2 pro-pack-entry) (nth 2 pack-entry))  
                         (or (nth 3 pro-pack-entry) (nth 3 pack-entry)))))  
           (setq pack-alist (cdr pack-alist))))  
       ;; merge list of instantiated entities  
       (setq pro-ent-inst-list  
             (append pro-ent-inst-list  
                     (copy-alist  
                      (car (aget vhdl-ent-inst-alist name)))))  
13345        (setq dir-list (cdr dir-list)        (setq dir-list (cdr dir-list)
13346              act-dir (1+ act-dir)))              act-dir (1+ act-dir)))
13347      ;; sort lists and put them into the caches      (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp)))
13348      (when pro-ent-alist      (message "Scanning project \"%s\"...done" project)))
13349        (aput 'vhdl-project-entity-alist project  
13350              (sort pro-ent-alist  (defun vhdl-update-file-contents (file-name)
13351                    (function (lambda (a b) (string-lessp (car a) (car b)))))))    "Update hierarchy information by contents of current buffer."
13352      (when pro-pack-alist    (setq file-name (abbreviate-file-name file-name))
13353        (aput 'vhdl-project-package-alist project    (let* ((dir-name (file-name-directory file-name))
13354              (sort pro-pack-alist           (directory-alist vhdl-directory-alist)
13355                    (function (lambda (a b) (string-lessp (car a) (car b)))))))           updated)
13356      (when pro-ent-inst-list      (while directory-alist
13357        (aput 'vhdl-project-ent-inst-list project pro-ent-inst-list))))        (when (member dir-name (nth 1 (car directory-alist)))
13358            (let* ((vhdl-project (nth 0 (car directory-alist)))
13359  (defun vhdl-get-hierarchy (ent-name arch-name level indent &optional ent-hier)                 (project (vhdl-project-p))
13360    "Get instantiation hierarchy beginning in architecture ARCH-NAME of                 (ent-alist (aget vhdl-entity-alist (or project dir-name) t))
13361  entity ENT-NAME."                 (conf-alist (aget vhdl-config-alist (or project dir-name) t))
13362    (let* ((ent-alist (if (vhdl-speedbar-project-p)                 (pack-alist (aget vhdl-package-alist (or project dir-name) t))
13363                          (aget vhdl-project-entity-alist vhdl-project)                 (ent-inst-list (car (aget vhdl-ent-inst-alist
13364                        (aget vhdl-entity-alist                                           (or project dir-name) t)))
13365                              (abbreviate-file-name                 (file-alist (aget vhdl-file-alist (or project dir-name) t))
13366                               (file-name-as-directory                 (file-entry (aget file-alist file-name t))
13367                                (speedbar-line-path (1- indent)))))))                 (ent-list (nth 0 file-entry))
13368           (ent-entry (aget ent-alist ent-name))                 (arch-list (nth 1 file-entry))
13369           (arch-entry (if arch-name (aget (nth 2 ent-entry) arch-name)                 (arch-ent-list (nth 2 file-entry))
13370                         (cdr (car (last (nth 2 ent-entry))))))                 (conf-list (nth 3 file-entry))
13371           (inst-list (nth 2 arch-entry))                 (pack-list (nth 4 file-entry))
13372           inst-entry inst-ent-entry inst-arch-entry hier-list)                 (pack-body-list (nth 5 file-entry))
13373                   (inst-ent-list (nth 7 file-entry))
13374                   (cache-key (or project dir-name))
13375                   arch-alist key ent-key entry)
13376              ;; delete design units previously contained in this file:
13377              ;; entities
13378              (while ent-list
13379                (setq key (car ent-list)
13380                      entry (aget ent-alist key t))
13381                (when (equal file-name (nth 1 entry))
13382                  (if (nth 3 entry)
13383                      (aput 'ent-alist key
13384                            (list (nth 0 entry) nil nil (nth 3 entry) nil))
13385                    (adelete 'ent-alist key)))
13386                (setq ent-list (cdr ent-list)))
13387              ;; architectures
13388              (while arch-list
13389                (setq key (car arch-list)
13390                      ent-key (car arch-ent-list)
13391                      entry (aget ent-alist ent-key t)
13392                      arch-alist (nth 3 entry))
13393                (when (equal file-name (nth 1 (aget arch-alist key t)))
13394                  (adelete 'arch-alist key)
13395                  (if (or (nth 1 entry) arch-alist)
13396                      (aput 'ent-alist ent-key
13397                            (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13398                                  arch-alist (nth 4 entry)))
13399                    (adelete 'ent-alist ent-key)))
13400                (setq arch-list (cdr arch-list)
13401                      arch-ent-list (cdr arch-ent-list)))
13402              ;; configurations
13403              (while conf-list
13404                (setq key (car conf-list))
13405                (when (equal file-name (nth 1 (aget conf-alist key t)))
13406                  (adelete 'conf-alist key))
13407                (setq conf-list (cdr conf-list)))
13408              ;; package declarations
13409              (while pack-list
13410                (setq key (car pack-list)
13411                      entry (aget pack-alist key t))
13412                (when (equal file-name (nth 1 entry))
13413                  (if (nth 6 entry)
13414                      (aput 'pack-alist key
13415                            (list (nth 0 entry) nil nil nil nil nil
13416                                  (nth 6 entry) (nth 7 entry) (nth 8 entry)
13417                                  (nth 9 entry)))
13418                    (adelete 'pack-alist key)))
13419                (setq pack-list (cdr pack-list)))
13420              ;; package bodies
13421              (while pack-body-list
13422                (setq key (car pack-body-list)
13423                      entry (aget pack-alist key t))
13424                (when (equal file-name (nth 6 entry))
13425                  (if (nth 1 entry)
13426                      (aput 'pack-alist key
13427                            (list (nth 0 entry) (nth 1 entry) (nth 2 entry)
13428                                  (nth 3 entry) (nth 4 entry) (nth 5 entry)
13429                                  nil nil nil nil))
13430                    (adelete 'pack-alist key)))
13431                (setq pack-body-list (cdr pack-body-list)))
13432              ;; instantiated entities
13433              (while inst-ent-list
13434                (setq ent-inst-list
13435                      (vhdl-delete (car inst-ent-list) ent-inst-list))
13436                (setq inst-ent-list (cdr inst-ent-list)))
13437              ;; update caches
13438              (vhdl-aput 'vhdl-entity-alist cache-key ent-alist)
13439              (vhdl-aput 'vhdl-config-alist cache-key conf-alist)
13440              (vhdl-aput 'vhdl-package-alist cache-key pack-alist)
13441              (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list))
13442              ;; scan file
13443              (vhdl-scan-directory-contents file-name project t)
13444              (when (or (and vhdl-speedbar-show-projects project)
13445                        (and (not vhdl-speedbar-show-projects) (not project)))
13446                (vhdl-speedbar-refresh project))
13447              (setq updated t)))
13448          (setq directory-alist (cdr directory-alist)))
13449        updated))
13450    
13451    (defun vhdl-update-hierarchy ()
13452      "Update directory and hierarchy information in speedbar."
13453      (let ((file-list (reverse vhdl-modified-file-list))
13454            updated)
13455        (when (and vhdl-speedbar-update-on-saving file-list)
13456          (while file-list
13457            (setq updated
13458                  (or (vhdl-update-file-contents (car file-list))
13459                      updated))
13460            (setq file-list (cdr file-list)))
13461          (setq vhdl-modified-file-list nil)
13462          (when updated (message "Updating hierarchy...done")))))
13463    
13464    ;; structure (parenthesised expression means list of such entries)
13465    ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
13466    ;;  comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
13467    ;;  comp-lib-name level)
13468    (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key
13469                                         conf-inst-alist level indent
13470                                         &optional include-top ent-hier)
13471      "Get instantiation hierarchy beginning in architecture ARCH-KEY of
13472    entity ENT-KEY."
13473      (let* ((ent-entry (aget ent-alist ent-key t))
13474             (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t)
13475                           (cdar (last (nth 3 ent-entry)))))
13476             (inst-alist (nth 3 arch-entry))
13477             inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry
13478             hier-list subcomp-list tmp-list inst-key inst-comp-name
13479             inst-ent-key inst-arch-key inst-conf-key inst-lib-key)
13480      (when (= level 0) (message "Extract design hierarchy..."))      (when (= level 0) (message "Extract design hierarchy..."))
13481      (when (member ent-name ent-hier)      (when include-top
13482        (error (format "Instantiation loop detected; component \"%s\" instantiates itself"        (setq level (1+ level)))
13483                       ent-name)))      (when (member ent-key ent-hier)
13484      (while inst-list        (error "ERROR:  Instantiation loop detected, component instantiates itself: \"%s\"" ent-key))
13485        (setq inst-entry (car inst-list))      ;; check configured architecture (already checked during scanning)
13486        (setq inst-ent-entry (aget ent-alist (nth 3 inst-entry)))  ;     (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry)))
13487        (setq inst-arch-entry  ;       (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key))
13488              (if (nth 4 inst-entry)      ;; process all instances
13489                  (cons (nth 4 inst-entry)      (while inst-alist
13490                        (aget (nth 2 inst-ent-entry) (nth 4 inst-entry)))        (setq inst-entry (car inst-alist)
13491                (car (last (nth 2 inst-ent-entry)))))              inst-key (nth 0 inst-entry)
13492                inst-comp-name (nth 4 inst-entry)
13493                inst-conf-key (nth 7 inst-entry))
13494          ;; search entry in configuration's instantiations list
13495          (setq tmp-list conf-inst-alist)
13496          (while (and tmp-list
13497                      (not (and (member (nth 0 (car tmp-list))
13498                                        (list "all" inst-key))
13499                                (equal (nth 1 (car tmp-list))
13500                                       (downcase (or inst-comp-name ""))))))
13501            (setq tmp-list (cdr tmp-list)))
13502          (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key))
13503          (setq inst-conf-entry (aget conf-alist inst-conf-key t))
13504          (when (and inst-conf-key (not inst-conf-entry))
13505            (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key))
13506          ;; determine entity
13507          (setq inst-ent-key
13508                (or (nth 2 (car tmp-list))  ; from configuration
13509                    (nth 3 inst-conf-entry) ; from subconfiguration
13510                    (nth 3 (aget conf-alist (nth 7 inst-entry) t))
13511                                            ; from configuration spec.
13512                    (nth 5 inst-entry)))    ; from direct instantiation
13513          (setq inst-ent-entry (aget ent-alist inst-ent-key t))
13514          ;; determine architecture
13515          (setq inst-arch-key
13516                (or (nth 3 (car tmp-list))          ; from configuration
13517                    (nth 4 inst-conf-entry)         ; from subconfiguration
13518                    (nth 6 inst-entry)              ; from direct instantiation
13519                    (nth 4 (aget conf-alist (nth 7 inst-entry)))
13520                                                    ; from configuration spec.
13521                    (caar (nth 3 inst-ent-entry)))) ; random (simplified MRA)
13522          (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t))
13523          ;; set library
13524          (setq inst-lib-key
13525                (or (nth 5 (car tmp-list))          ; from configuration
13526                    (nth 8 inst-entry)))            ; from direct instantiation
13527          ;; gather information for this instance
13528          (setq comp-entry
13529                (list (nth 1 inst-entry)
13530                      (cons (nth 2 inst-entry) (nth 3 inst-entry))
13531                      (or (nth 0 inst-ent-entry) (nth 4 inst-entry))
13532                      (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry))
13533                      (or (nth 0 inst-arch-entry) inst-arch-key)
13534                      (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))
13535                      (or (nth 0 inst-conf-entry) inst-conf-key)
13536                      (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry))
13537                      inst-lib-key level))
13538          ;; get subcomponent hierarchy
13539          (setq subcomp-list (vhdl-get-hierarchy
13540                              ent-alist conf-alist
13541                              inst-ent-key inst-arch-key inst-conf-key
13542                              (nth 5 inst-conf-entry)
13543                              (1+ level) indent nil (cons ent-key ent-hier)))
13544          ;; add to list
13545          (setq hier-list (append hier-list (list comp-entry) subcomp-list))
13546          (setq inst-alist (cdr inst-alist)))
13547        (when include-top
13548        (setq hier-list        (setq hier-list
13549              (append              (cons (list nil nil (nth 0 ent-entry)
13550               hier-list                          (cons (nth 1 ent-entry) (nth 2 ent-entry))
13551               (cons (list (nth 0 inst-entry)                          (nth 0 arch-entry)
13552                           (cons (nth 1 inst-entry) (nth 2 inst-entry))                          (cons (nth 1 arch-entry) (nth 2 arch-entry))
13553                           (nth 3 inst-entry)                          nil nil
13554                           (cons (nth 0 inst-ent-entry) (nth 1 inst-ent-entry))                          nil (1- level))
13555                           (nth 0 inst-arch-entry)                    hier-list)))
13556                           (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry))      (when (or (= level 0) (and include-top (= level 1))) (message ""))
                          level)  
                    (vhdl-get-hierarchy (nth 3 inst-entry) (nth 4 inst-entry)  
                                        (1+ level) indent  
                                        (cons ent-name ent-hier)))))  
       (setq inst-list (cdr inst-list)))  
     (when (= level 0) (message "Extract design hierarchy...done"))  
13557      hier-list))      hier-list))
13558    
13559  (defun vhdl-get-instantiations (ent-name indent)  (defun vhdl-get-instantiations (ent-key indent)
13560    "Get all instantiations of entity ENT-NAME."    "Get all instantiations of entity ENT-KEY."
13561    (let ((ent-alist (if (vhdl-speedbar-project-p)    (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t))
                        (aget vhdl-project-entity-alist vhdl-project)  
                      (aget vhdl-entity-alist  
                            (abbreviate-file-name  
                             (file-name-as-directory  
                              (speedbar-line-path indent))))))  
13562          arch-alist inst-alist ent-inst-list          arch-alist inst-alist ent-inst-list
13563          ent-entry arch-entry inst-entry)          ent-entry arch-entry inst-entry)
13564      (while ent-alist      (while ent-alist
13565        (setq ent-entry (car ent-alist))        (setq ent-entry (car ent-alist))
13566        (setq arch-alist (nth 3 ent-entry))        (setq arch-alist (nth 4 ent-entry))
13567        (while arch-alist        (while arch-alist
13568          (setq arch-entry (car arch-alist))          (setq arch-entry (car arch-alist))
13569          (setq inst-alist (nth 3 arch-entry))          (setq inst-alist (nth 4 arch-entry))
13570          (while inst-alist          (while inst-alist
13571            (setq inst-entry (car inst-alist))            (setq inst-entry (car inst-alist))
13572            (when (equal ent-name (nth 3 inst-entry))            (when (equal ent-key (nth 5 inst-entry))
13573              (setq ent-inst-list              (setq ent-inst-list
13574                    (cons (list (nth 0 inst-entry)                    (cons (list (nth 1 inst-entry)
13575                                (cons (nth 1 inst-entry) (nth 2 inst-entry))                                (cons (nth 2 inst-entry) (nth 3 inst-entry))
13576                                (nth 0 ent-entry)                                (nth 1 ent-entry)
13577                                (cons (nth 1 ent-entry) (nth 2 ent-entry))                                (cons (nth 2 ent-entry) (nth 3 ent-entry))
13578                                (nth 0 arch-entry)                                (nth 1 arch-entry)
13579                                (cons (nth 1 arch-entry) (nth 2 arch-entry)))                                (cons (nth 2 arch-entry) (nth 3 arch-entry)))
13580                                ent-inst-list)))                          ent-inst-list)))
13581            (setq inst-alist (cdr inst-alist)))            (setq inst-alist (cdr inst-alist)))
13582          (setq arch-alist (cdr arch-alist)))          (setq arch-alist (cdr arch-alist)))
13583        (setq ent-alist (cdr ent-alist)))        (setq ent-alist (cdr ent-alist)))
13584      (nreverse ent-inst-list)))      (nreverse ent-inst-list)))
13585    
13586  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13587  ;; Add hierarchy browser functionality to speedbar.  ;; Caching in file
13588    
13589    (defun vhdl-save-caches ()
13590      "Save all updated hierarchy caches to file."
13591      (interactive)
13592      (condition-case nil
13593          (when vhdl-speedbar-save-cache
13594            ;; update hierarchy
13595            (vhdl-update-hierarchy)
13596            (let ((project-list vhdl-updated-project-list))
13597              (message "Saving hierarchy caches...")
13598              ;; write updated project caches
13599              (while project-list
13600                (vhdl-save-cache (car project-list))
13601                (setq project-list (cdr project-list)))
13602              (message "Saving hierarchy caches...done")))
13603        (error (progn (vhdl-warning "ERROR:  An error occured while saving the hierarchy caches")
13604                      (sit-for 2)))))
13605    
13606    (defun vhdl-save-cache (key)
13607      "Save current hierarchy cache to file."
13608      (let* ((orig-buffer (current-buffer))
13609             (vhdl-project key)
13610             (project (vhdl-project-p))
13611             (default-directory key)
13612             (directory (abbreviate-file-name (vhdl-default-directory)))
13613             (file-name (vhdl-resolve-env-variable
13614                         (vhdl-replace-string
13615                          (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
13616                          (concat
13617                           (subst-char-in-string ?  ?_ (or project "dir"))
13618                           " " (user-login-name)))))
13619             (file-dir-name (expand-file-name file-name directory))
13620             (cache-key (or project directory))
13621             (key (if project "project" "directory")))
13622        (unless (file-exists-p (file-name-directory file-dir-name))
13623          (make-directory (file-name-directory file-dir-name) t))
13624        (if (not (file-writable-p file-dir-name))
13625            (progn (vhdl-warning (format "File not writable: \"%s\""
13626                                         (abbreviate-file-name file-dir-name)))
13627                   (sit-for 2))
13628          (message "Saving cache: \"%s\"" file-dir-name)
13629          (set-buffer (find-file-noselect file-dir-name t t))
13630          (erase-buffer)
13631          (insert ";; -*- Emacs-Lisp -*-\n\n"
13632                  ";;; " (file-name-nondirectory file-name)
13633                  " - design hierarchy cache file for Emacs VHDL Mode "
13634                  vhdl-version "\n")
13635          (insert "\n;; " (if project "Project  " "Directory") " : ")
13636          (if project (insert project) (prin1 directory (current-buffer)))
13637          (insert "\n;; Saved     : " (format-time-string "%Y-%m-%d %T ")
13638                  (user-login-name) "\n\n"
13639                  "\n;; version number\n"
13640                  "(setq vhdl-cache-version \"" vhdl-version "\")\n"
13641                  "\n;; " (if project "project" "directory") " name"
13642                  "\n(setq " key " ")
13643          (prin1 (or project directory) (current-buffer))
13644          (insert ")\n")
13645          (when (member 'hierarchy vhdl-speedbar-save-cache)
13646            (insert "\n;; entity and architecture cache\n"
13647                    "(aput 'vhdl-entity-alist " key " '")
13648            (print (aget vhdl-entity-alist cache-key t) (current-buffer))
13649            (insert ")\n\n;; configuration cache\n"
13650                    "(aput 'vhdl-config-alist " key " '")
13651            (print (aget vhdl-config-alist cache-key t) (current-buffer))
13652            (insert ")\n\n;; package cache\n"
13653                    "(aput 'vhdl-package-alist " key " '")
13654            (print (aget vhdl-package-alist cache-key t) (current-buffer))
13655            (insert ")\n\n;; instantiated entities cache\n"
13656                    "(aput 'vhdl-ent-inst-alist " key " '")
13657            (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer))
13658            (insert ")\n\n;; design units per file cache\n"
13659                    "(aput 'vhdl-file-alist " key " '")
13660            (print (aget vhdl-file-alist cache-key t) (current-buffer))
13661            (when project
13662              (insert ")\n\n;; source directories in project cache\n"
13663                      "(aput 'vhdl-directory-alist " key " '")
13664              (print (aget vhdl-directory-alist cache-key t) (current-buffer)))
13665            (insert ")\n"))
13666          (when (member 'display vhdl-speedbar-save-cache)
13667            (insert "\n;; shown design units cache\n"
13668                    "(aput 'vhdl-speedbar-shown-unit-alist " key " '")
13669            (print (aget vhdl-speedbar-shown-unit-alist cache-key t)
13670                   (current-buffer))
13671            (insert ")\n"))
13672          (setq vhdl-updated-project-list
13673                (delete cache-key vhdl-updated-project-list))
13674          (save-buffer)
13675          (kill-buffer (current-buffer))
13676          (set-buffer orig-buffer))))
13677    
13678    (defun vhdl-load-cache (key)
13679      "Load hierarchy cache information from file."
13680      (let* ((vhdl-project key)
13681             (default-directory key)
13682             (directory (vhdl-default-directory))
13683             (file-name (vhdl-resolve-env-variable
13684                         (vhdl-replace-string
13685                          (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name)
13686                          (concat
13687                           (subst-char-in-string ?  ?_ (or (vhdl-project-p) "dir"))
13688                           " " (user-login-name)))))
13689             (file-dir-name (expand-file-name file-name directory))
13690             vhdl-cache-version)
13691        (unless (memq 'vhdl-save-caches kill-emacs-hook)
13692          (add-hook 'kill-emacs-hook 'vhdl-save-caches))
13693        (when (file-exists-p file-dir-name)
13694          (condition-case ()
13695              (progn (load-file file-dir-name)
13696                     (string< (mapconcat
13697                               (lambda (a) (format "%3d" (string-to-int a)))
13698                               (split-string "3.31.14" "\\.") "")
13699                              (mapconcat
13700                               (lambda (a) (format "%3d" (string-to-int a)))
13701                               (split-string vhdl-cache-version "\\.") "")))
13702            (error (progn (vhdl-warning (format "ERROR:  Corrupted cache file: \"%s\"" file-dir-name))
13703                          nil))))))
13704    
13705    (defun vhdl-require-hierarchy-info ()
13706      "Make sure that hierarchy information is available.  Load cache or scan files
13707    if required."
13708      (if (vhdl-project-p)
13709          (unless (or (assoc vhdl-project vhdl-file-alist)
13710                      (vhdl-load-cache vhdl-project))
13711            (vhdl-scan-project-contents vhdl-project))
13712        (let ((directory (abbreviate-file-name default-directory)))
13713          (unless (or (assoc directory vhdl-file-alist)
13714                      (vhdl-load-cache directory))
13715            (vhdl-scan-directory-contents directory)))))
13716    
13717    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13718    ;; Add hierarchy browser functionality to speedbar
13719    
13720  (defvar vhdl-speedbar-key-map nil  (defvar vhdl-speedbar-key-map nil
13721    "Keymap used when in the VHDL hierarchy browser mode.")    "Keymap used when in the VHDL hierarchy browser mode.")
13722    
13723  (defvar vhdl-speedbar-menu-items  (defvar vhdl-speedbar-menu-items nil
   '(["Edit Design Unit" speedbar-edit-line t]  
     ["Expand Hierarchy" speedbar-expand-line  
      (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]  
     ["Contract Hierarchy" speedbar-contract-line  
      (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.-. "))]  
     ["Rescan Hierarchy" vhdl-speedbar-rescan-hierarchy t]  
     "--"  
     ["Copy Port" vhdl-speedbar-port-copy  
      (save-excursion  
        (beginning-of-line) (looking-at "[0-9]+: *\\[[-+?]\\] "))])  
13724    "Additional menu-items to add to speedbar frame.")    "Additional menu-items to add to speedbar frame.")
13725    
13726  (defun vhdl-speedbar-initialize ()  (defun vhdl-speedbar-initialize ()
# Line 9979  entity ENT-NAME." Line 13730  entity ENT-NAME."
13730    ;; VHDL file extensions (extracted from `auto-mode-alist')    ;; VHDL file extensions (extracted from `auto-mode-alist')
13731    (let ((mode-alist auto-mode-alist))    (let ((mode-alist auto-mode-alist))
13732      (while mode-alist      (while mode-alist
13733        (when (eq (cdr (car mode-alist)) 'vhdl-mode)        (when (eq (cdar mode-alist) 'vhdl-mode)
13734          (speedbar-add-supported-extension (car (car mode-alist))))          (speedbar-add-supported-extension (caar mode-alist)))
13735        (setq mode-alist (cdr mode-alist))))        (setq mode-alist (cdr mode-alist))))
13736    ;; hierarchy browser settings    ;; hierarchy browser settings
13737    (when (boundp 'speedbar-mode-functions-list)    (when (boundp 'speedbar-mode-functions-list)
13738        ;; special functions
13739      (speedbar-add-mode-functions-list      (speedbar-add-mode-functions-list
13740       '("vhdl hierarchy"       '("vhdl directory"
13741         (speedbar-item-info . vhdl-speedbar-item-info)         (speedbar-item-info . vhdl-speedbar-item-info)
13742         (speedbar-line-path . speedbar-files-line-path)))         (speedbar-line-path . speedbar-files-line-path)))
13743        (speedbar-add-mode-functions-list
13744         '("vhdl project"
13745           (speedbar-item-info . vhdl-speedbar-item-info)
13746           (speedbar-line-path . vhdl-speedbar-line-project)))
13747        ;; keymap
13748      (unless vhdl-speedbar-key-map      (unless vhdl-speedbar-key-map
13749        (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap))        (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap))
13750        (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line)        (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line)
13751        (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line)        (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line)
13752        (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line)        (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line)
13753        (define-key vhdl-speedbar-key-map "-" 'speedbar-contract-line)        (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line)
13754        (define-key vhdl-speedbar-key-map "s" 'vhdl-speedbar-rescan-hierarchy)        (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level)
13755        (define-key vhdl-speedbar-key-map "c" 'vhdl-speedbar-port-copy))        (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all)
13756          (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy)
13757          (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component)
13758          (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design)
13759          (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy)
13760          (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches)
13761          (let ((key 0))
13762            (while (<= key 9)
13763              (define-key vhdl-speedbar-key-map (int-to-string key)
13764                `(lambda () (interactive) (vhdl-speedbar-set-depth ,key)))
13765              (setq key (1+ key)))))
13766      (define-key speedbar-key-map "h"      (define-key speedbar-key-map "h"
13767        (lambda () (interactive)        (lambda () (interactive)
13768          (speedbar-change-initial-expansion-list "vhdl hierarchy")))          (speedbar-change-initial-expansion-list "vhdl directory")))
13769      (speedbar-add-expansion-list '("vhdl hierarchy" vhdl-speedbar-menu-items      (define-key speedbar-key-map "H"
13770                                     vhdl-speedbar-key-map        (lambda () (interactive)
13771                                     vhdl-speedbar-display-hierarchy))          (speedbar-change-initial-expansion-list "vhdl project")))
13772        ;; menu
13773        (unless vhdl-speedbar-menu-items
13774          (setq
13775           vhdl-speedbar-menu-items
13776           `(["Edit" speedbar-edit-line t]
13777             ["Expand" speedbar-expand-line
13778              (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))]
13779             ["Contract" vhdl-speedbar-contract-level t]
13780             ["Expand All" vhdl-speedbar-expand-all t]
13781             ["Contract All" vhdl-speedbar-contract-all t]
13782             ,(let ((key 0) (menu-list '("Hierarchy Depth")))
13783                (while (<= key 9)
13784                  (setq menu-list
13785                        (cons `[,(if (= key 0) "All" (int-to-string key))
13786                                (vhdl-speedbar-set-depth ,key)
13787                                :style radio
13788                                :selected (= vhdl-speedbar-hierarchy-depth ,key)
13789                                :keys ,(int-to-string key)]
13790                              menu-list))
13791                  (setq key (1+ key)))
13792                (nreverse menu-list))
13793             "--"
13794             ["Copy Port/Subprogram" vhdl-speedbar-port-copy
13795              (or (vhdl-speedbar-check-unit 'entity)
13796                  (vhdl-speedbar-check-unit 'subprogram))]
13797             ["Place Component" vhdl-speedbar-place-component
13798              (vhdl-speedbar-check-unit 'entity)]
13799             ["Make" vhdl-speedbar-make-design
13800              (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))]
13801             ["Generate Makefile" vhdl-speedbar-generate-makefile
13802              (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
13803             ["Rescan Directory" vhdl-speedbar-rescan-hierarchy
13804              :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
13805              ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)]
13806             ["Rescan Project" vhdl-speedbar-rescan-hierarchy
13807              :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
13808              ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects]
13809             ["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
13810        ;; hook-ups
13811        (speedbar-add-expansion-list
13812         '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map
13813           vhdl-speedbar-display-directory))
13814        (speedbar-add-expansion-list
13815         '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map
13816           vhdl-speedbar-display-projects))
13817      (setq speedbar-stealthy-function-list      (setq speedbar-stealthy-function-list
13818            (cons '("vhdl hierarchy" vhdl-speedbar-update-current-unit)            (append
13819                  speedbar-stealthy-function-list))             '(("vhdl directory" vhdl-speedbar-update-current-unit)
13820      (when vhdl-speedbar-show-hierarchy               ("vhdl project" vhdl-speedbar-update-current-project
13821        (setq speedbar-initial-expansion-list-name "vhdl hierarchy"))))                vhdl-speedbar-update-current-unit)
13822    ;            ("files" (lambda () (setq speedbar-ignored-path-regexp
13823    ;                                      (speedbar-extension-list-to-regex
13824    ;                                       speedbar-ignored-path-expressions))))
13825                 )
13826               speedbar-stealthy-function-list))
13827        (when (eq vhdl-speedbar-display-mode 'directory)
13828          (setq speedbar-initial-expansion-list-name "vhdl directory"))
13829        (when (eq vhdl-speedbar-display-mode 'project)
13830          (setq speedbar-initial-expansion-list-name "vhdl project"))
13831        (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy)))
13832    
13833  (defun vhdl-speedbar (&optional arg)  (defun vhdl-speedbar (&optional arg)
13834    "Open/close speedbar."    "Open/close speedbar."
13835    (interactive)    (interactive)
13836    (if (not (fboundp 'speedbar))    (if (not (fboundp 'speedbar))
13837        (error "WARNING:  Speedbar is only available in newer Emacs versions")        (error "WARNING:  Speedbar is not available or not installed")
13838      (condition-case ()                  ; due to bug in `speedbar-el' v0.7.2a      (condition-case ()
13839          (speedbar-frame-mode arg)          (speedbar-frame-mode arg)
13840        (error (error "WARNING:  Install included `speedbar.el' patch first")))))        (error (error "WARNING:  An error occurred while opening speedbar")))))
   
 ;; initialize speedbar for VHDL Mode  
 (if (not (boundp 'speedbar-frame))  
     (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)  
   (vhdl-speedbar-initialize)  
   (when speedbar-frame (speedbar-refresh)))  
13841    
13842  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13843  ;; Display functions  ;; Display functions
13844    
13845    (defvar vhdl-speedbar-last-selected-project nil
13846      "Name of last selected project.")
13847    
13848  ;; macros must be defined in the file they are used (copied from `speedbar.el')  ;; macros must be defined in the file they are used (copied from `speedbar.el')
13849  (defmacro speedbar-with-writable (&rest forms)  (defmacro speedbar-with-writable (&rest forms)
13850    "Allow the buffer to be writable and evaluate FORMS."    "Allow the buffer to be writable and evaluate FORMS."
# Line 10033  entity ENT-NAME." Line 13852  entity ENT-NAME."
13852          (cons 'progn forms)))          (cons 'progn forms)))
13853  (put 'speedbar-with-writable 'lisp-indent-function 0)  (put 'speedbar-with-writable 'lisp-indent-function 0)
13854    
13855  (defun vhdl-speedbar-display-hierarchy (directory depth &optional rescan)  (defun vhdl-speedbar-display-directory (directory depth &optional rescan)
13856    "Display directory and hierarchy information in speedbar."    "Display directory and hierarchy information in speedbar."
13857      (setq vhdl-speedbar-show-projects nil)
13858      (setq speedbar-ignored-path-regexp
13859            (speedbar-extension-list-to-regex speedbar-ignored-path-expressions))
13860    (setq directory (abbreviate-file-name (file-name-as-directory directory)))    (setq directory (abbreviate-file-name (file-name-as-directory directory)))
13861    (setq speedbar-last-selected-file nil)    (setq speedbar-last-selected-file nil)
13862    (speedbar-with-writable    (speedbar-with-writable
13863     (save-excursion      (condition-case nil
13864       (if (vhdl-speedbar-project-p)          (progn
13865           (progn            ;; insert directory path
13866             ;; insert project title            (speedbar-directory-buttons directory depth)
13867             (vhdl-speedbar-make-title-line "Project:" 0)            ;; insert subdirectories
13868             (let ((start (point)))            (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)
13869               (insert "p:")            ;; scan and insert hierarchy of current directory
13870               (put-text-property start (point) 'invisible t)            (vhdl-speedbar-insert-dir-hierarchy directory depth
13871               (setq start (point))                                                speedbar-power-click)
13872               (insert vhdl-project)            ;; expand subdirectories
13873               (put-text-property start (point) 'face 'speedbar-directory-face))            (when (= depth 0) (vhdl-speedbar-expand-dirs directory)))
13874             (insert-char ?\n 1)        (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly")))))
13875             ;; scan and insert hierarchy of project  
13876             (vhdl-speedbar-insert-project-hierarchy vhdl-project  (defun vhdl-speedbar-display-projects (project depth &optional rescan)
13877                                                     speedbar-power-click))    "Display projects and hierarchy information in speedbar."
13878         ;; insert directory path    (setq vhdl-speedbar-show-projects t)
13879         (speedbar-directory-buttons directory depth)    (setq speedbar-ignored-path-regexp ".")
13880         ;; insert subdirectories    (setq speedbar-last-selected-file nil)
13881         (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth)    (setq vhdl-speedbar-last-selected-project nil)
13882         ;; scan and insert hierarchy of current directory    (speedbar-with-writable
13883         (vhdl-speedbar-insert-dir-hierarchy directory depth      (condition-case nil
13884                                             speedbar-power-click)          ;; insert projects
13885         ;; expand subdirectories          (vhdl-speedbar-insert-projects)
13886         (when (= depth 0) (vhdl-speedbar-expand-dirs directory))))))        (error (vhdl-warning-when-idle "ERROR:  Invalid hierarchy information, unable to display correctly"))))
13887      (setq speedbar-full-text-cache nil)) ; prevent caching
13888    
13889    (defun vhdl-speedbar-insert-projects ()
13890      "Insert all projects in speedbar."
13891      (vhdl-speedbar-make-title-line "Projects:")
13892      (let ((project-alist (if vhdl-project-sort
13893                               (vhdl-sort-alist (copy-alist vhdl-project-alist))
13894                             vhdl-project-alist))
13895            (vhdl-speedbar-update-current-unit nil))
13896        ;; insert projects
13897        (while project-alist
13898          (speedbar-make-tag-line
13899           'angle ?+ 'vhdl-speedbar-expand-project
13900           (caar project-alist) (caar project-alist)
13901           'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0)
13902          (setq project-alist (cdr project-alist)))
13903        (setq project-alist vhdl-project-alist)
13904        ;; expand projects
13905        (while project-alist
13906          (when (member (caar project-alist) vhdl-speedbar-shown-project-list)
13907            (goto-char (point-min))
13908            (when (re-search-forward
13909                   (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t)
13910              (goto-char (match-end 1))
13911              (speedbar-do-function-pointer)))
13912          (setq project-alist (cdr project-alist))))
13913    ;   (vhdl-speedbar-update-current-project)
13914    ;   (vhdl-speedbar-update-current-unit nil t)
13915      )
13916    
13917    (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
13918      "Insert hierarchy of project.  Rescan directories if RESCAN is non-nil,
13919    otherwise use cached data."
13920      (when (or rescan (and (not (assoc project vhdl-file-alist))
13921                            (not (vhdl-load-cache project))))
13922        (vhdl-scan-project-contents project))
13923      ;; insert design hierarchy
13924      (vhdl-speedbar-insert-hierarchy
13925       (aget vhdl-entity-alist project t)
13926       (aget vhdl-config-alist project t)
13927       (aget vhdl-package-alist project t)
13928       (car (aget vhdl-ent-inst-alist project t)) indent)
13929      (insert (int-to-string indent) ":\n")
13930      (put-text-property (- (point) 3) (1- (point)) 'invisible t)
13931      (put-text-property (1- (point)) (point) 'invisible nil)
13932      ;; expand design units
13933      (vhdl-speedbar-expand-units project))
13934    
13935    (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)
13936      "Insert hierarchy of DIRECTORY.  Rescan directory if RESCAN is non-nil,
13937    otherwise use cached data."
13938      (when (or rescan (and (not (assoc directory vhdl-file-alist))
13939                            (not (vhdl-load-cache directory))))
13940        (vhdl-scan-directory-contents directory))
13941      ;; insert design hierarchy
13942      (vhdl-speedbar-insert-hierarchy
13943       (aget vhdl-entity-alist directory t)
13944       (aget vhdl-config-alist directory t)
13945       (aget vhdl-package-alist directory t)
13946       (car (aget vhdl-ent-inst-alist directory t)) depth)
13947      ;; expand design units
13948      (vhdl-speedbar-expand-units directory)
13949      (aput 'vhdl-directory-alist directory (list (list directory))))
13950    
13951  (defun vhdl-speedbar-insert-hierarchy (ent-alist pack-alist  (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist
13952                                                   ent-inst-list depth)                                                   ent-inst-list depth)
13953    "Insert hierarchy of ENT-ALIST and PACK-ALIST."    "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST."
13954    (if (not (or ent-alist pack-alist))    (if (not (or ent-alist conf-alist pack-alist))
13955        (vhdl-speedbar-make-title-line "No design units!" depth)        (vhdl-speedbar-make-title-line "No VHDL design units!" depth)
13956      (let (ent-entry pack-entry)      (let (ent-entry conf-entry pack-entry)
13957        ;; insert entities        ;; insert entities
13958        (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))        (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth))
13959        (while ent-alist        (while ent-alist
13960          (setq ent-entry (car ent-alist))          (setq ent-entry (car ent-alist))
13961          (speedbar-make-tag-line          (speedbar-make-tag-line
13962           'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)           'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry)
13963           (nth 0 ent-entry) 'vhdl-speedbar-find-file           (nth 1 ent-entry) 'vhdl-speedbar-find-file
13964           (cons (nth 1 ent-entry) (nth 2 ent-entry))           (cons (nth 2 ent-entry) (nth 3 ent-entry))
13965           'vhdl-speedbar-entity-face depth)           'vhdl-speedbar-entity-face depth)
13966          (when (not (member (nth 0 ent-entry) ent-inst-list))          (unless (nth 2 ent-entry)
13967              (end-of-line 0) (insert "!") (forward-char 1))
13968            (unless (member (nth 0 ent-entry) ent-inst-list)
13969            (end-of-line 0) (insert " (top)") (forward-char 1))            (end-of-line 0) (insert " (top)") (forward-char 1))
13970          (setq ent-alist (cdr ent-alist)))          (setq ent-alist (cdr ent-alist)))
13971          ;; insert configurations
13972          (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth))
13973          (while conf-alist
13974            (setq conf-entry (car conf-alist))
13975            (speedbar-make-tag-line
13976             'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry)
13977             (nth 1 conf-entry) 'vhdl-speedbar-find-file
13978             (cons (nth 2 conf-entry) (nth 3 conf-entry))
13979             'vhdl-speedbar-configuration-face depth)
13980            (setq conf-alist (cdr conf-alist)))
13981        ;; insert packages        ;; insert packages
13982        (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))        (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth))
13983        (while pack-alist        (while pack-alist
13984          (setq pack-entry (car pack-alist))          (setq pack-entry (car pack-alist))
13985          (vhdl-speedbar-make-pack-line          (vhdl-speedbar-make-pack-line
13986           (nth 0 pack-entry)           (nth 0 pack-entry) (nth 1 pack-entry)
13987           (cons (nth 1 pack-entry) (nth 2 pack-entry))           (cons (nth 2 pack-entry) (nth 3 pack-entry))
13988           (cons (nth 3 pack-entry) (nth 4 pack-entry))           (cons (nth 7 pack-entry) (nth 8 pack-entry))
13989           depth)           depth)
13990          (setq pack-alist (cdr pack-alist))))))          (setq pack-alist (cdr pack-alist))))))
13991    
 (defun vhdl-speedbar-insert-project-hierarchy (project &optional rescan)  
   "Insert hierarchy of project.  Rescan directories if RESCAN is non-nil,  
 otherwise use cached data of directories."  
   (when (or rescan (and (not (assoc project vhdl-project-entity-alist))  
                         (not (assoc project vhdl-project-package-alist))))  
     (vhdl-scan-project-contents project rescan))  
     ;; insert design hierarchy in speedbar  
   (vhdl-speedbar-insert-hierarchy  
    (aget vhdl-project-entity-alist project)  
    (aget vhdl-project-package-alist project)  
    (aget vhdl-project-ent-inst-list project) 0)  
     ;; expand design units  
   (vhdl-speedbar-expand-units project))  
   
 (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan)  
   "Insert hierarchy of DIRECTORY.  Rescan directory if RESCAN is non-nil,  
 otherwise use cached data."  
   (when (or rescan (and (not (assoc directory vhdl-entity-alist))  
                         (not (assoc directory vhdl-package-alist))))  
     (vhdl-scan-file-contents directory))  
   (vhdl-speedbar-insert-hierarchy  
    (aget vhdl-entity-alist directory)  
    (aget vhdl-package-alist directory)  
    (car (aget vhdl-ent-inst-alist directory))  
    depth)  
   (vhdl-speedbar-expand-units directory))  
   
13992  (defun vhdl-speedbar-rescan-hierarchy ()  (defun vhdl-speedbar-rescan-hierarchy ()
13993    "Rescan hierarchy for the directory under the cursor or the current project."    "Rescan hierarchy for the directory or project under the cursor."
13994    (interactive)    (interactive)
13995    (cond    (let (key path)
13996     ;; the current project      (cond
13997     ((vhdl-speedbar-project-p)       ;; current project
13998      (vhdl-scan-project-contents vhdl-project t)       (vhdl-speedbar-show-projects
13999      (speedbar-refresh))        (setq key (vhdl-speedbar-line-project))
14000     ;; the top-level directory        (vhdl-scan-project-contents key))
14001     ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))       ;; top-level directory
14002      (re-search-forward "[0-9]+:" nil t)       ((save-excursion (beginning-of-line) (looking-at "[^0-9]"))
14003      (vhdl-scan-file-contents (abbreviate-file-name (speedbar-line-path)))        (re-search-forward "[0-9]+:" nil t)
14004      (speedbar-refresh))        (vhdl-scan-directory-contents
14005     ;; the current directory         (abbreviate-file-name (speedbar-line-path))))
14006     (t (let ((path (speedbar-line-path)))       ;; current directory
14007          (string-match "^\\(.+/\\)" path)       (t (setq path (speedbar-line-path))
14008          (vhdl-scan-file-contents (abbreviate-file-name (match-string 1 path)))          (string-match "^\\(.+[/\\]\\)" path)
14009          (speedbar-refresh)))))          (vhdl-scan-directory-contents
14010             (abbreviate-file-name (match-string 1 path)))))
14011        (vhdl-speedbar-refresh key)))
14012    
14013  (defun vhdl-speedbar-expand-dirs (directory)  (defun vhdl-speedbar-expand-dirs (directory)
14014    "Expand subdirectories in DIRECTORY according to    "Expand subdirectories in DIRECTORY according to
14015   `speedbar-shown-directories'."   `speedbar-shown-directories'."
14016    ;; (nicked from `speedbar-default-directory-list')    ;; (nicked from `speedbar-default-directory-list')
14017    (let ((sf (cdr (reverse speedbar-shown-directories))))    (let ((sf (cdr (reverse speedbar-shown-directories)))
14018            (vhdl-speedbar-update-current-unit nil))
14019      (setq speedbar-shown-directories      (setq speedbar-shown-directories
14020            (list (expand-file-name default-directory)))            (list (expand-file-name default-directory)))
14021      (while sf      (while sf
# Line 10150  otherwise use cached data." Line 14023  otherwise use cached data."
14023          (beginning-of-line)          (beginning-of-line)
14024          (when (looking-at "[0-9]+:\\s-*<")          (when (looking-at "[0-9]+:\\s-*<")
14025            (goto-char (match-end 0))            (goto-char (match-end 0))
14026            (let* ((position (point))            (speedbar-do-function-pointer)))
14027                   (directory (abbreviate-file-name        (setq sf (cdr sf))))
14028                               (file-name-as-directory (speedbar-line-file)))))    (vhdl-speedbar-update-current-unit nil t))
14029              (speedbar-do-function-pointer))))  
14030        (setq sf (cdr sf)))))  (defun vhdl-speedbar-expand-units (key)
14031      "Expand design units in directory/project KEY according to
14032  (defun vhdl-speedbar-expand-units (directory)  `vhdl-speedbar-shown-unit-alist'."
14033    "Expand design units in DIRECTORY according to    (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14034  `vhdl-speedbar-shown-units-alist'."          (vhdl-speedbar-update-current-unit nil)
14035    (let ((ent-alist (aget vhdl-speedbar-shown-units-alist directory)))          vhdl-updated-project-list)
14036      (adelete 'vhdl-speedbar-shown-units-alist directory)      (adelete 'vhdl-speedbar-shown-unit-alist key)
14037      (while ent-alist                    ; expand entities      (vhdl-prepare-search-1
14038        (vhdl-speedbar-goto-this-unit directory (car (car ent-alist)))       (while unit-alist                  ; expand units
14039        (beginning-of-line)         (vhdl-speedbar-goto-this-unit key (caar unit-alist))
14040        (let ((arch-alist (nth 1 (car ent-alist)))         (beginning-of-line)
14041              position)         (let ((arch-alist (nth 1 (car unit-alist)))
14042          (when (looking-at "[0-9]+:\\s-*\\[")               position)
14043            (goto-char (match-end 0))           (when (looking-at "^[0-9]+:\\s-*\\[")
14044            (setq position (point))             (goto-char (match-end 0))
14045            (speedbar-do-function-pointer)             (setq position (point))
14046            (while arch-alist             ; expand architectures             (speedbar-do-function-pointer)
14047              (goto-char position)             (select-frame speedbar-frame)
14048              (when (re-search-forward             (while arch-alist            ; expand architectures
14049                     (concat "[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"               (goto-char position)
14050                             (car arch-alist) "\\>\\)") nil t)               (when (re-search-forward
14051                (beginning-of-line)                      (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+"
14052                (when (looking-at "[0-9]+:\\s-*{")                              (car arch-alist) "\\>\\)") nil t)
14053                  (goto-char (match-end 0))                 (beginning-of-line)
14054                  (speedbar-do-function-pointer)))                 (when (looking-at "^[0-9]+:\\s-*{")
14055              (setq arch-alist (cdr arch-alist))))                   (goto-char (match-end 0))
14056          (setq ent-alist (cdr ent-alist))))))                   (speedbar-do-function-pointer)
14057                     (select-frame speedbar-frame)))
14058                 (setq arch-alist (cdr arch-alist))))
14059             (setq unit-alist (cdr unit-alist))))))
14060      (vhdl-speedbar-update-current-unit nil t))
14061    
14062    (defun vhdl-speedbar-contract-level ()
14063      "Contract current level in current directory/project."
14064      (interactive)
14065      (when (or (save-excursion
14066                  (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-"))
14067                (and (save-excursion
14068                       (beginning-of-line) (looking-at "^\\([0-9]+\\):"))
14069                     (re-search-backward
14070                      (format "^[0-%d]:\\s-*[[{<]-"
14071                              (max (1- (string-to-int (match-string 1))) 0)) nil t)))
14072        (goto-char (match-end 0))
14073        (speedbar-do-function-pointer)
14074        (speedbar-center-buffer-smartly)))
14075    
14076    (defun vhdl-speedbar-contract-all ()
14077      "Contract all expanded design units in current directory/project."
14078      (interactive)
14079      (if (and vhdl-speedbar-show-projects
14080               (save-excursion (beginning-of-line) (looking-at "^0:")))
14081          (progn (setq vhdl-speedbar-shown-project-list nil)
14082                 (vhdl-speedbar-refresh))
14083        (let ((key (vhdl-speedbar-line-key)))
14084          (adelete 'vhdl-speedbar-shown-unit-alist key)
14085          (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key))
14086          (when (memq 'display vhdl-speedbar-save-cache)
14087            (add-to-list 'vhdl-updated-project-list key)))))
14088    
14089    (defun vhdl-speedbar-expand-all ()
14090      "Expand all design units in current directory/project."
14091      (interactive)
14092      (let* ((key (vhdl-speedbar-line-key))
14093             (ent-alist (aget vhdl-entity-alist key t))
14094             (conf-alist (aget vhdl-config-alist key t))
14095             (pack-alist (aget vhdl-package-alist key t))
14096             arch-alist unit-alist subunit-alist)
14097        (add-to-list 'vhdl-speedbar-shown-project-list key)
14098        (while ent-alist
14099          (setq arch-alist (nth 4 (car ent-alist)))
14100          (setq subunit-alist nil)
14101          (while arch-alist
14102            (setq subunit-alist (cons (caar arch-alist) subunit-alist))
14103            (setq arch-alist (cdr arch-alist)))
14104          (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist))
14105          (setq ent-alist (cdr ent-alist)))
14106        (while conf-alist
14107          (setq unit-alist (cons (list (caar conf-alist)) unit-alist))
14108          (setq conf-alist (cdr conf-alist)))
14109        (while pack-alist
14110          (setq unit-alist (cons (list (caar pack-alist)) unit-alist))
14111          (setq pack-alist (cdr pack-alist)))
14112        (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14113        (vhdl-speedbar-refresh)
14114        (when (memq 'display vhdl-speedbar-save-cache)
14115          (add-to-list 'vhdl-updated-project-list key))))
14116    
14117    (defun vhdl-speedbar-expand-project (text token indent)
14118      "Expand/contract the project under the cursor."
14119      (cond
14120       ((string-match "+" text)             ; expand project
14121        (speedbar-change-expand-button-char ?-)
14122        (unless (member token vhdl-speedbar-shown-project-list)
14123          (setq vhdl-speedbar-shown-project-list
14124                (cons token vhdl-speedbar-shown-project-list)))
14125        (speedbar-with-writable
14126          (save-excursion
14127            (end-of-line) (forward-char 1)
14128            (vhdl-speedbar-insert-project-hierarchy token (1+ indent)
14129                                                    speedbar-power-click))))
14130       ((string-match "-" text)             ; contract project
14131        (speedbar-change-expand-button-char ?+)
14132        (setq vhdl-speedbar-shown-project-list
14133              (delete token vhdl-speedbar-shown-project-list))
14134        (speedbar-delete-subblock indent))
14135       (t (error "Nothing to display")))
14136      (when (equal (selected-frame) speedbar-frame)
14137        (speedbar-center-buffer-smartly)))
14138    
14139  (defun vhdl-speedbar-expand-entity (text token indent)  (defun vhdl-speedbar-expand-entity (text token indent)
14140    "Expand/contract the entity under the cursor."    "Expand/contract the entity under the cursor."
14141    (cond    (cond
14142     ((string-match "+" text)             ; expand entity     ((string-match "+" text)             ; expand entity
14143      (let* ((ent-alist (if (vhdl-speedbar-project-p)      (let* ((key (vhdl-speedbar-line-key indent))
14144                            (aget vhdl-project-entity-alist vhdl-project)             (ent-alist (aget vhdl-entity-alist key t))
14145                          (aget vhdl-entity-alist             (ent-entry (aget ent-alist token t))
14146                                (abbreviate-file-name             (arch-alist (nth 3 ent-entry))
                                (file-name-as-directory  
                                 (speedbar-line-path indent))))))  
            (arch-alist (nth 2 (aget ent-alist token)))  
            (conf-alist (nth 3 (aget ent-alist token)))  
14147             (inst-alist (vhdl-get-instantiations token indent))             (inst-alist (vhdl-get-instantiations token indent))
14148             arch-entry conf-entry inst-entry)             (subpack-alist (nth 4 ent-entry))
14149        (if (not (or arch-alist conf-alist inst-alist))             arch-entry inst-entry)
14150          (if (not (or arch-alist inst-alist subpack-alist))
14151            (speedbar-change-expand-button-char ??)            (speedbar-change-expand-button-char ??)
14152          (speedbar-change-expand-button-char ?-)          (speedbar-change-expand-button-char ?-)
14153          ;; add entity to `vhdl-speedbar-shown-units-alist'          ;; add entity to `vhdl-speedbar-shown-unit-alist'
14154          (let* ((directory (if (vhdl-speedbar-project-p)          (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14155                                vhdl-project            (aput 'unit-alist token nil)
14156                              (abbreviate-file-name            (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
                              (file-name-as-directory (speedbar-line-path)))))  
                (ent-alist (aget vhdl-speedbar-shown-units-alist directory)))  
           (aput 'ent-alist (speedbar-line-text) nil)  
           (aput 'vhdl-speedbar-shown-units-alist directory ent-alist))  
14157          (speedbar-with-writable          (speedbar-with-writable
14158            (save-excursion           (save-excursion
14159              (end-of-line) (forward-char 1)             (end-of-line) (forward-char 1)
14160              ;; insert architectures             ;; insert architectures
14161              (when arch-alist             (when arch-alist
14162                (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))               (vhdl-speedbar-make-title-line "Architectures:" (1+ indent)))
14163              (while arch-alist             (while arch-alist
14164                (setq arch-entry (car arch-alist))               (setq arch-entry (car arch-alist))
14165                (speedbar-make-tag-line               (speedbar-make-tag-line
14166                 'curly ?+ 'vhdl-speedbar-expand-architecture                'curly ?+ 'vhdl-speedbar-expand-architecture
14167                 (cons token (nth 0 arch-entry))                (cons token (nth 0 arch-entry))
14168                 (nth 0 arch-entry) 'vhdl-speedbar-find-file                (nth 1 arch-entry) 'vhdl-speedbar-find-file
14169                 (cons (nth 1 arch-entry) (nth 2 arch-entry))                (cons (nth 2 arch-entry) (nth 3 arch-entry))
14170                 'vhdl-speedbar-architecture-face (1+ indent))                'vhdl-speedbar-architecture-face (1+ indent))
14171                (setq arch-alist (cdr arch-alist)))               (setq arch-alist (cdr arch-alist)))
14172              ;; insert configurations             ;; insert instantiations
14173              (when conf-alist             (when inst-alist
14174                (vhdl-speedbar-make-title-line "Configurations:" (1+ indent)))               (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent)))
14175              (while conf-alist             (while inst-alist
14176                (setq conf-entry (car conf-alist))               (setq inst-entry (car inst-alist))
14177                (speedbar-make-tag-line               (vhdl-speedbar-make-inst-line
14178                 nil nil nil                (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry)
14179                 (cons token (nth 0 conf-entry))                (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry)
14180                 (nth 0 conf-entry) 'vhdl-speedbar-find-file                nil nil nil (1+ indent) 0 " in ")
14181                 (cons (nth 1 conf-entry) (nth 2 conf-entry))               (setq inst-alist (cdr inst-alist)))
14182                 'vhdl-speedbar-configuration-face (1+ indent))             ;; insert required packages
14183                (setq conf-alist (cdr conf-alist)))             (vhdl-speedbar-insert-subpackages
14184              ;; insert instantiations              subpack-alist (1+ indent) indent)))
14185              (when inst-alist          (when (memq 'display vhdl-speedbar-save-cache)
14186                (vhdl-speedbar-make-title-line "Instantiations:" (1+ indent)))            (add-to-list 'vhdl-updated-project-list key))
14187              (while inst-alist          (vhdl-speedbar-update-current-unit t t))))
               (setq inst-entry (car inst-alist))  
               (vhdl-speedbar-make-inst-line  
                (nth 0 inst-entry) (nth 1 inst-entry)  
                (nth 2 inst-entry) (nth 3 inst-entry)  
                (nth 4 inst-entry) (nth 5 inst-entry) (1+ indent) 0)  
               (setq inst-alist (cdr inst-alist)))))  
         (setq speedbar-last-selected-file nil)  
         (save-excursion (speedbar-stealthy-updates)))))  
14188     ((string-match "-" text)             ; contract entity     ((string-match "-" text)             ; contract entity
14189      (speedbar-change-expand-button-char ?+)      (speedbar-change-expand-button-char ?+)
14190      ;; remove entity from `vhdl-speedbar-shown-units-alist'      ;; remove entity from `vhdl-speedbar-shown-unit-alist'
14191      (let* ((directory (if (vhdl-speedbar-project-p)      (let* ((key (vhdl-speedbar-line-key indent))
14192                            vhdl-project             (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14193                          (abbreviate-file-name        (adelete 'unit-alist token)
14194                           (file-name-as-directory (speedbar-line-path)))))        (if unit-alist
14195             (ent-alist (aget vhdl-speedbar-shown-units-alist directory)))            (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14196        (adelete 'ent-alist (speedbar-line-text))          (adelete 'vhdl-speedbar-shown-unit-alist key))
14197        (if ent-alist        (speedbar-delete-subblock indent)
14198            (aput 'vhdl-speedbar-shown-units-alist directory ent-alist)        (when (memq 'display vhdl-speedbar-save-cache)
14199          (adelete 'vhdl-speedbar-shown-units-alist directory)))          (add-to-list 'vhdl-updated-project-list key))))
14200      (speedbar-delete-subblock indent))     (t (error "Nothing to display")))
14201     (t (error "No architectures, configurations, nor instantiations exist for this entity")))    (when (equal (selected-frame) speedbar-frame)
14202    (speedbar-center-buffer-smartly))      (speedbar-center-buffer-smartly)))
14203    
14204  (defun vhdl-speedbar-expand-architecture (text token indent)  (defun vhdl-speedbar-expand-architecture (text token indent)
14205    "Expand/contract the architecture under the cursor."    "Expand/contract the architecture under the cursor."
14206    (cond    (cond
14207     ((string-match "+" text)             ; expand architecture     ((string-match "+" text)             ; expand architecture
14208      (let ((hier-alist (vhdl-get-hierarchy (car token) (cdr token) 0 indent)))      (let* ((key (vhdl-speedbar-line-key (1- indent)))
14209        (if (not hier-alist)             (ent-alist (aget vhdl-entity-alist key t))
14210               (conf-alist (aget vhdl-config-alist key t))
14211               (hier-alist (vhdl-get-hierarchy
14212                            ent-alist conf-alist (car token) (cdr token) nil nil
14213                            0 (1- indent)))
14214               (ent-entry (aget ent-alist (car token) t))
14215               (arch-entry (aget (nth 3 ent-entry) (cdr token) t))
14216               (subpack-alist (nth 4 arch-entry))
14217               entry)
14218          (if (not (or hier-alist subpack-alist))
14219              (speedbar-change-expand-button-char ??)
14220            (speedbar-change-expand-button-char ?-)
14221            ;; add architecture to `vhdl-speedbar-shown-unit-alist'
14222            (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14223                   (arch-alist (nth 0 (aget unit-alist (car token) t))))
14224              (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist)))
14225              (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14226            (speedbar-with-writable
14227              (save-excursion
14228                (end-of-line) (forward-char 1)
14229                ;; insert instance hierarchy
14230                (when hier-alist
14231                  (vhdl-speedbar-make-title-line "Subcomponent hierarchy:"
14232                                                 (1+ indent)))
14233                (while hier-alist
14234                  (setq entry (car hier-alist))
14235                  (when (or (= vhdl-speedbar-hierarchy-depth 0)
14236                            (< (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14237                    (vhdl-speedbar-make-inst-line
14238                     (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14239                     (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14240                     (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": "))
14241                  (setq hier-alist (cdr hier-alist)))
14242                ;; insert required packages
14243                (vhdl-speedbar-insert-subpackages
14244                 subpack-alist (1+ indent) (1- indent))))
14245            (when (memq 'display vhdl-speedbar-save-cache)
14246              (add-to-list 'vhdl-updated-project-list key))
14247            (vhdl-speedbar-update-current-unit t t))))
14248       ((string-match "-" text)             ; contract architecture
14249        (speedbar-change-expand-button-char ?+)
14250        ;; remove architecture from `vhdl-speedbar-shown-unit-alist'
14251        (let* ((key (vhdl-speedbar-line-key (1- indent)))
14252               (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))
14253               (arch-alist (nth 0 (aget unit-alist (car token) t))))
14254          (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist)))
14255          (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14256          (speedbar-delete-subblock indent)
14257          (when (memq 'display vhdl-speedbar-save-cache)
14258            (add-to-list 'vhdl-updated-project-list key))))
14259       (t (error "Nothing to display")))
14260      (when (equal (selected-frame) speedbar-frame)
14261        (speedbar-center-buffer-smartly)))
14262    
14263    (defun vhdl-speedbar-expand-config (text token indent)
14264      "Expand/contract the configuration under the cursor."
14265      (cond
14266       ((string-match "+" text)             ; expand configuration
14267        (let* ((key (vhdl-speedbar-line-key indent))
14268               (conf-alist (aget vhdl-config-alist key t))
14269               (conf-entry (aget conf-alist token))
14270               (ent-alist (aget vhdl-entity-alist key t))
14271               (hier-alist (vhdl-get-hierarchy
14272                            ent-alist conf-alist (nth 3 conf-entry)
14273                            (nth 4 conf-entry) token (nth 5 conf-entry)
14274                            0 indent t))
14275               (subpack-alist (nth 6 conf-entry))
14276               entry)
14277          (if (not (or hier-alist subpack-alist))
14278            (speedbar-change-expand-button-char ??)            (speedbar-change-expand-button-char ??)
14279          (speedbar-change-expand-button-char ?-)          (speedbar-change-expand-button-char ?-)
14280          ;; add architecture to `vhdl-speedbar-shown-units-alist'          ;; add configuration to `vhdl-speedbar-shown-unit-alist'
14281          (let* ((path (speedbar-line-path))          (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14282                 (dummy (string-match "^\\(.+/\\)\\([^/ ]+\\)" path))            (aput 'unit-alist token nil)
14283                 (ent-name (match-string 2 path))            (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
                (directory (if (vhdl-speedbar-project-p)  
                               vhdl-project  
                             (abbreviate-file-name (match-string 1 path))))  
                (ent-alist (aget vhdl-speedbar-shown-units-alist directory))  
                (arch-alist (nth 0 (aget ent-alist ent-name t))))  
           (aput 'ent-alist ent-name  
                 (list (cons (speedbar-line-text) arch-alist)))  
           (aput 'vhdl-speedbar-shown-units-alist directory ent-alist))  
14284          (speedbar-with-writable          (speedbar-with-writable
14285           (save-excursion           (save-excursion
14286             (end-of-line) (forward-char 1)             (end-of-line) (forward-char 1)
14287             ;; insert instance hierarchy             ;; insert instance hierarchy
14288             (when hier-alist             (when hier-alist
14289               (vhdl-speedbar-make-title-line "Subcomponents:" (1+ indent)))               (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent)))
14290             (while hier-alist             (while hier-alist
14291               (let ((entry (car hier-alist)))               (setq entry (car hier-alist))
14292                 (when (or (= vhdl-speedbar-hierarchy-depth 0)
14293                           (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth))
14294                 (vhdl-speedbar-make-inst-line                 (vhdl-speedbar-make-inst-line
14295                  (nth 0 entry) (nth 1 entry)                  (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry)
14296                  (nth 2 entry) (nth 3 entry)                  (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry)
14297                  (nth 4 entry) (nth 5 entry)                  (nth 8 entry) (1+ indent) (nth 9 entry) ": "))
14298                  (1+ indent) (nth 6 entry))               (setq hier-alist (cdr hier-alist)))
14299                 (setq hier-alist (cdr hier-alist))))))             ;; insert required packages
14300          (setq speedbar-last-selected-file nil)             (vhdl-speedbar-insert-subpackages
14301          (save-excursion (speedbar-stealthy-updates)))))              subpack-alist (1+ indent) indent)))
14302     ((string-match "-" text)             ; contract architecture          (when (memq 'display vhdl-speedbar-save-cache)
14303              (add-to-list 'vhdl-updated-project-list key))
14304            (vhdl-speedbar-update-current-unit t t))))
14305       ((string-match "-" text)             ; contract configuration
14306      (speedbar-change-expand-button-char ?+)      (speedbar-change-expand-button-char ?+)
14307      ;; remove architecture from `vhdl-speedbar-shown-units-alist'      ;; remove configuration from `vhdl-speedbar-shown-unit-alist'
14308      (let* ((path (speedbar-line-path))      (let* ((key (vhdl-speedbar-line-key indent))
14309             (dummy (string-match "^\\(.+/\\)\\([^/ ]+\\)" path))             (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14310             (ent-name (match-string 2 path))        (adelete 'unit-alist token)
14311             (directory (if (vhdl-speedbar-project-p)        (if unit-alist
14312                            vhdl-project            (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14313                          (abbreviate-file-name (match-string 1 path))))          (adelete 'vhdl-speedbar-shown-unit-alist key))
14314             (ent-alist (aget vhdl-speedbar-shown-units-alist directory))        (speedbar-delete-subblock indent)
14315             (arch-alist (nth 0 (aget ent-alist ent-name t))))        (when (memq 'display vhdl-speedbar-save-cache)
14316        (aput 'ent-alist ent-name          (add-to-list 'vhdl-updated-project-list key))))
14317              (list (delete (speedbar-line-text) arch-alist)))     (t (error "Nothing to display")))
14318        (aput 'vhdl-speedbar-shown-units-alist directory ent-alist))    (when (equal (selected-frame) speedbar-frame)
14319      (speedbar-delete-subblock indent))      (speedbar-center-buffer-smartly)))
14320     (t (error "No component instantiations contained in this architecture")))  
14321    (speedbar-center-buffer-smartly))  (defun vhdl-speedbar-expand-package (text token indent)
14322      "Expand/contract the package under the cursor."
14323      (cond
14324       ((string-match "+" text)             ; expand package
14325        (let* ((key (vhdl-speedbar-line-key indent))
14326               (pack-alist (aget vhdl-package-alist key t))
14327               (pack-entry (aget pack-alist token t))
14328               (comp-alist (nth 3 pack-entry))
14329               (func-alist (nth 4 pack-entry))
14330               (func-body-alist (nth 8 pack-entry))
14331               (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry)))
14332               comp-entry func-entry func-body-entry)
14333          (if (not (or comp-alist func-alist subpack-alist))
14334              (speedbar-change-expand-button-char ??)
14335            (speedbar-change-expand-button-char ?-)
14336            ;; add package to `vhdl-speedbar-shown-unit-alist'
14337            (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14338              (aput 'unit-alist token nil)
14339              (aput 'vhdl-speedbar-shown-unit-alist key unit-alist))
14340            (speedbar-with-writable
14341              (save-excursion
14342                (end-of-line) (forward-char 1)
14343                ;; insert components
14344                (when comp-alist
14345                  (vhdl-speedbar-make-title-line "Components:" (1+ indent)))
14346                (while comp-alist
14347                  (setq comp-entry (car comp-alist))
14348                  (speedbar-make-tag-line
14349                   nil nil nil
14350                   (cons token (nth 0 comp-entry))
14351                   (nth 1 comp-entry) 'vhdl-speedbar-find-file
14352                   (cons (nth 2 comp-entry) (nth 3 comp-entry))
14353                   'vhdl-speedbar-entity-face (1+ indent))
14354                  (setq comp-alist (cdr comp-alist)))
14355                ;; insert subprograms
14356                (when func-alist
14357                  (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent)))
14358                (while func-alist
14359                  (setq func-entry (car func-alist)
14360                        func-body-entry (aget func-body-alist (car func-entry) t))
14361                  (when (nth 2 func-entry)
14362                    (vhdl-speedbar-make-subprogram-line
14363                     (nth 1 func-entry)
14364                     (cons (nth 2 func-entry) (nth 3 func-entry))
14365                     (cons (nth 1 func-body-entry) (nth 2 func-body-entry))
14366                     (1+ indent)))
14367                  (setq func-alist (cdr func-alist)))
14368               ;; insert required packages
14369               (vhdl-speedbar-insert-subpackages
14370                subpack-alist (1+ indent) indent)))
14371            (when (memq 'display vhdl-speedbar-save-cache)
14372              (add-to-list 'vhdl-updated-project-list key))
14373            (vhdl-speedbar-update-current-unit t t))))
14374       ((string-match "-" text)             ; contract package
14375        (speedbar-change-expand-button-char ?+)
14376        ;; remove package from `vhdl-speedbar-shown-unit-alist'
14377        (let* ((key (vhdl-speedbar-line-key indent))
14378               (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)))
14379          (adelete 'unit-alist token)
14380          (if unit-alist
14381              (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)
14382            (adelete 'vhdl-speedbar-shown-unit-alist key))
14383          (speedbar-delete-subblock indent)
14384          (when (memq 'display vhdl-speedbar-save-cache)
14385            (add-to-list 'vhdl-updated-project-list key))))
14386       (t (error "Nothing to display")))
14387      (when (equal (selected-frame) speedbar-frame)
14388        (speedbar-center-buffer-smartly)))
14389    
14390    (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent)
14391      "Insert required packages."
14392      (let* ((pack-alist (aget vhdl-package-alist
14393                               (vhdl-speedbar-line-key dir-indent) t))
14394             pack-key lib-name pack-entry)
14395        (when subpack-alist
14396          (vhdl-speedbar-make-title-line "Packages Used:" indent))
14397        (while subpack-alist
14398          (setq pack-key (cdar subpack-alist)
14399                lib-name (caar subpack-alist))
14400          (setq pack-entry (aget pack-alist pack-key t))
14401          (vhdl-speedbar-make-subpack-line
14402           (or (nth 0 pack-entry) pack-key) lib-name
14403           (cons (nth 1 pack-entry) (nth 2 pack-entry)) indent)
14404          (setq subpack-alist (cdr subpack-alist)))))
14405    
14406  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14407  ;; Display help functions  ;; Display help functions
14408    
14409  (defun vhdl-speedbar-update-current-unit (&optional no-position)  (defvar vhdl-speedbar-update-current-unit t
14410      "Non-nil means to run `vhdl-speedbar-update-current-unit'.")
14411    
14412    (defun vhdl-speedbar-update-current-project ()
14413      "Highlight project that is currently active."
14414      (when (and vhdl-speedbar-show-projects
14415                 (not (equal vhdl-speedbar-last-selected-project vhdl-project))
14416                 (and (boundp 'speedbar-frame)
14417                      (frame-live-p speedbar-frame)))
14418        (let ((last-frame (selected-frame))
14419              (project-alist vhdl-project-alist)
14420              pos)
14421          (select-frame speedbar-frame)
14422          (speedbar-with-writable
14423           (save-excursion
14424             (while project-alist
14425               (goto-char (point-min))
14426               (when (re-search-forward
14427                      (concat "<.> \\(" (caar project-alist) "\\)$") nil t)
14428                 (put-text-property (match-beginning 1) (match-end 1) 'face
14429                                    (if (equal (caar project-alist) vhdl-project)
14430                                        'speedbar-selected-face
14431                                      'speedbar-directory-face))
14432                 (when (equal (caar project-alist) vhdl-project)
14433                   (setq pos (1- (match-beginning 1)))))
14434               (setq project-alist (cdr project-alist))))
14435           (when pos (goto-char pos)))
14436          (select-frame last-frame)
14437          (setq vhdl-speedbar-last-selected-project vhdl-project)))
14438      t)
14439    
14440    (defun vhdl-speedbar-update-current-unit (&optional no-position always)
14441    "Highlight all design units that are contained in the current file.    "Highlight all design units that are contained in the current file.
14442  NO-POSITION non-nil means do not re-position cursor."  NO-POSITION non-nil means do not re-position cursor."
14443    (let ((last-frame (selected-frame))    (let ((last-frame (selected-frame))
14444          file-name position)          (project-list vhdl-speedbar-shown-project-list)
14445            file-alist pos file-name)
14446      ;; get current file name      ;; get current file name
14447      (select-frame speedbar-attached-frame)      (if (fboundp 'speedbar-select-attached-frame)
14448            (speedbar-select-attached-frame)
14449          (select-frame speedbar-attached-frame))
14450      (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))      (setq file-name (abbreviate-file-name (or (buffer-file-name) "")))
14451      (unless (equal file-name speedbar-last-selected-file)      (when (and vhdl-speedbar-update-current-unit
14452                   (or always (not (equal file-name speedbar-last-selected-file))))
14453          (if vhdl-speedbar-show-projects
14454              (while project-list
14455                (setq file-alist (append file-alist (aget vhdl-file-alist
14456                                                          (car project-list) t)))
14457                (setq project-list (cdr project-list)))
14458            (setq file-alist (aget vhdl-file-alist
14459                                   (abbreviate-file-name default-directory) t)))
14460        (select-frame speedbar-frame)        (select-frame speedbar-frame)
14461        (set-buffer speedbar-buffer)        (set-buffer speedbar-buffer)
14462        (speedbar-with-writable        (speedbar-with-writable
14463           (vhdl-prepare-search-1
14464          (save-excursion          (save-excursion
14465            ;; unhighlight last units            ;; unhighlight last units
14466            (let* ((file-entry            (let* ((file-entry (aget file-alist speedbar-last-selected-file t)))
                   (aget vhdl-file-alist speedbar-last-selected-file)))  
14467              (vhdl-speedbar-update-units              (vhdl-speedbar-update-units
14468               "\\[.\\]" (nth 0 file-entry)               "\\[.\\] " (nth 0 file-entry)
14469               speedbar-last-selected-file 'vhdl-speedbar-entity-face)               speedbar-last-selected-file 'vhdl-speedbar-entity-face)
14470              (vhdl-speedbar-update-units              (vhdl-speedbar-update-units
14471               "{.}" (nth 1 file-entry)               "{.} " (nth 1 file-entry)
14472               speedbar-last-selected-file 'vhdl-speedbar-architecture-face)               speedbar-last-selected-file 'vhdl-speedbar-architecture-face)
14473              (vhdl-speedbar-update-units              (vhdl-speedbar-update-units
14474               ">" (nth 2 file-entry)               "\\[.\\] " (nth 3 file-entry)
14475               speedbar-last-selected-file 'vhdl-speedbar-configuration-face)               speedbar-last-selected-file 'vhdl-speedbar-configuration-face)
14476              (vhdl-speedbar-update-units              (vhdl-speedbar-update-units
14477               ">" (nth 3 file-entry)               "[]>] " (nth 4 file-entry)
14478                 speedbar-last-selected-file 'vhdl-speedbar-package-face)
14479                (vhdl-speedbar-update-units
14480                 "\\[.\\].+(" '("body")
14481               speedbar-last-selected-file 'vhdl-speedbar-package-face)               speedbar-last-selected-file 'vhdl-speedbar-package-face)
14482              (vhdl-speedbar-update-units              (vhdl-speedbar-update-units
14483               ">" (nth 4 file-entry)               "> " (nth 6 file-entry)
14484               speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))               speedbar-last-selected-file 'vhdl-speedbar-instantiation-face))
14485            ;; highlight current units            ;; highlight current units
14486            (let* ((file-entry (aget vhdl-file-alist file-name)))            (let* ((file-entry (aget file-alist file-name t)))
14487              (vhdl-speedbar-update-units              (setq
14488               "\\[.\\]" (nth 0 file-entry)               pos (vhdl-speedbar-update-units
14489               file-name 'vhdl-speedbar-entity-selected-face)                    "\\[.\\] " (nth 0 file-entry)
14490              (setq position (or position (point-marker)))                    file-name 'vhdl-speedbar-entity-selected-face pos)
14491              (vhdl-speedbar-update-units               pos (vhdl-speedbar-update-units
14492               "{.}" (nth 1 file-entry)                    "{.} " (nth 1 file-entry)
14493               file-name 'vhdl-speedbar-architecture-selected-face)                    file-name 'vhdl-speedbar-architecture-selected-face pos)
14494              (setq position (or position (point-marker)))               pos (vhdl-speedbar-update-units
14495              (vhdl-speedbar-update-units                    "\\[.\\] " (nth 3 file-entry)
14496               ">" (nth 2 file-entry)                    file-name 'vhdl-speedbar-configuration-selected-face pos)
14497               file-name 'vhdl-speedbar-configuration-selected-face)               pos (vhdl-speedbar-update-units
14498              (setq position (or position (point-marker)))                    "[]>] " (nth 4 file-entry)
14499              (vhdl-speedbar-update-units                    file-name 'vhdl-speedbar-package-selected-face pos)
14500               ">" (nth 3 file-entry)               pos (vhdl-speedbar-update-units
14501               file-name 'vhdl-speedbar-package-selected-face)                    "\\[.\\].+(" '("body")
14502              (setq position (or position (point-marker)))                    file-name 'vhdl-speedbar-package-selected-face pos)
14503              (vhdl-speedbar-update-units               pos (vhdl-speedbar-update-units
14504               ">" (nth 4 file-entry)                    "> " (nth 6 file-entry)
14505               file-name 'vhdl-speedbar-instantiation-selected-face))))                    file-name 'vhdl-speedbar-instantiation-selected-face pos))))))
             (setq position (or position (point-marker)))  
14506        ;; move speedbar so the first highlighted unit is visible        ;; move speedbar so the first highlighted unit is visible
14507        (when (and position (not no-position))        (when (and pos (not no-position))
14508          (goto-char position)          (goto-char pos)
14509          (speedbar-center-buffer-smartly)          (speedbar-center-buffer-smartly)
14510          (speedbar-position-cursor-on-line))          (speedbar-position-cursor-on-line))
14511        (setq speedbar-last-selected-file file-name))        (setq speedbar-last-selected-file file-name))
14512      (select-frame last-frame)      (select-frame last-frame)
14513      t))      t))
14514    
14515  (defun vhdl-speedbar-update-units (text unit-list file-name face)  (defun vhdl-speedbar-update-units (text unit-list file-name face
14516                                            &optional pos)
14517    "Help function to highlight design units."    "Help function to highlight design units."
14518    (let (position)    (while unit-list
14519      (while unit-list      (goto-char (point-min))
14520        (goto-char (point-min))      (while (re-search-forward
14521        (while (re-search-forward              (concat text "\\(" (car unit-list) "\\)\\>") nil t)
14522                (concat text " \\(" (car unit-list) "\\)\\>") nil t)        (when (equal file-name (car (get-text-property
14523          (when (equal file-name (car (get-text-property                                     (match-beginning 1) 'speedbar-token)))
14524                                       (match-beginning 1) 'speedbar-token)))          (setq pos (or pos (point-marker)))
14525            (setq position (or position (point-marker)))          (put-text-property (match-beginning 1) (match-end 1) 'face face)))
14526            (put-text-property (match-beginning 1) (match-end 1) 'face face)))      (setq unit-list (cdr unit-list)))
14527        (setq unit-list (cdr unit-list)))    pos)
     (when position (goto-char position))))  
14528    
14529  (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker  (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker
14530                                      ent-name ent-file-marker                                                 ent-name ent-file-marker
14531                                      arch-name arch-file-marker                                                 arch-name arch-file-marker
14532                                      depth offset)                                                 conf-name conf-file-marker
14533                                                   lib-name depth offset delimiter)
14534    "Insert instantiation entry."    "Insert instantiation entry."
14535    (let ((start (point)))    (let ((start (point))
14536            visible-start)
14537      (insert (int-to-string depth) ":")      (insert (int-to-string depth) ":")
14538      (put-text-property start (point) 'invisible t)      (put-text-property start (point) 'invisible t)
14539        (setq visible-start (point))
14540        (insert-char ?  (* depth speedbar-indentation-width))
14541        (while (> offset 0)
14542          (insert "|")
14543          (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width))
14544          (setq offset (1- offset)))
14545        (put-text-property visible-start (point) 'invisible nil)
14546      (setq start (point))      (setq start (point))
14547      (insert-char ?  (+ depth (* offset vhdl-speedbar-hierarchy-indent)))      (insert ">")
14548      (insert "> ")      (speedbar-make-button start (point) nil nil nil)
14549      (put-text-property start (point) 'invisible nil)      (setq visible-start (point))
14550      (setq start (point))      (insert " ")
     (insert inst-name)  
     (speedbar-make-button  
      start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face  
      'vhdl-speedbar-find-file inst-file-marker)  
     (setq start (point))  
     (insert ": ")  
     (put-text-property start (point) 'invisible nil)  
     (setq start (point))  
     (insert ent-name)  
     (speedbar-make-button  
      start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face  
      'vhdl-speedbar-find-file ent-file-marker)  
14551      (setq start (point))      (setq start (point))
14552      (when arch-name      (if (not inst-name)
14553        (insert " (")          (insert "(top)")
14554        (put-text-property start (point) 'invisible nil)        (insert inst-name)
14555          (speedbar-make-button
14556           start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face
14557           'vhdl-speedbar-find-file inst-file-marker))
14558        (insert delimiter)
14559        (when ent-name
14560        (setq start (point))        (setq start (point))
14561        (insert arch-name)        (insert ent-name)
14562        (speedbar-make-button        (speedbar-make-button
14563         start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face         start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face
14564         'vhdl-speedbar-find-file arch-file-marker)         'vhdl-speedbar-find-file ent-file-marker)
14565          (when arch-name
14566            (insert " (")
14567            (setq start (point))
14568            (insert arch-name)
14569            (speedbar-make-button
14570             start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face
14571             'vhdl-speedbar-find-file arch-file-marker)
14572            (insert ")"))
14573          (when conf-name
14574            (insert " (")
14575            (setq start (point))
14576            (insert conf-name)
14577            (speedbar-make-button
14578             start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face
14579             'vhdl-speedbar-find-file conf-file-marker)
14580            (insert ")")))
14581        (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library)))))
14582        (setq start (point))        (setq start (point))
14583        (insert ")"))        (insert " (" lib-name ")")
14584      (put-text-property start (point) 'invisible nil)        (put-text-property (+ 2 start) (1- (point)) 'face
14585                             'vhdl-speedbar-library-face))
14586      (insert-char ?\n 1)      (insert-char ?\n 1)
14587      (put-text-property (1- (point)) (point) 'invisible nil)))      (put-text-property visible-start (point) 'invisible nil)))
14588    
14589  (defun vhdl-speedbar-make-pack-line (pack-name pack-file-marker  (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker
14590                                                 body-file-marker depth)                                                body-file-marker depth)
14591    "Insert package entry."    "Insert package entry."
14592    (let ((start (point)))    (let ((start (point))
14593            visible-start)
14594      (insert (int-to-string depth) ":")      (insert (int-to-string depth) ":")
14595      (put-text-property start (point) 'invisible t)      (put-text-property start (point) 'invisible t)
14596        (setq visible-start (point))
14597        (insert-char ?  (* depth speedbar-indentation-width))
14598        (put-text-property visible-start (point) 'invisible nil)
14599      (setq start (point))      (setq start (point))
14600      (insert-char ?  depth)      (insert "[+]")
14601      (insert "> ")      (speedbar-make-button
14602      (put-text-property start (point) 'invisible nil)       start (point) 'speedbar-button-face 'speedbar-highlight-face
14603         'vhdl-speedbar-expand-package pack-key)
14604        (setq visible-start (point))
14605        (insert-char ?  1 nil)
14606      (setq start (point))      (setq start (point))
14607      (insert pack-name)      (insert pack-name)
14608      (speedbar-make-button      (speedbar-make-button
14609       start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face       start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14610       'vhdl-speedbar-find-file pack-file-marker)       'vhdl-speedbar-find-file pack-file-marker)
14611        (unless (car pack-file-marker)
14612          (insert "!"))
14613      (when (car body-file-marker)      (when (car body-file-marker)
       (setq start (point))  
14614        (insert " (")        (insert " (")
       (put-text-property start (point) 'invisible nil)  
14615        (setq start (point))        (setq start (point))
14616        (insert "body")        (insert "body")
14617        (speedbar-make-button        (speedbar-make-button
14618         start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face         start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14619         'vhdl-speedbar-find-file body-file-marker)         'vhdl-speedbar-find-file body-file-marker)
14620        (setq start (point))        (insert ")"))
       (insert ")")  
       (put-text-property start (point) 'invisible nil))  
14621      (insert-char ?\n 1)      (insert-char ?\n 1)
14622      (put-text-property (1- (point)) (point) 'invisible nil)))      (put-text-property visible-start (point) 'invisible nil)))
14623    
14624  (defun vhdl-speedbar-make-title-line (text depth)  (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker
14625    "Insert design unit title entry."                                                    depth)
14626    (let ((start (point)))    "Insert used package entry."
14627      (let ((start (point))
14628            visible-start)
14629        (insert (int-to-string depth) ":")
14630        (put-text-property start (point) 'invisible t)
14631        (setq visible-start (point))
14632        (insert-char ?  (* depth speedbar-indentation-width))
14633        (put-text-property visible-start (point) 'invisible nil)
14634        (setq start (point))
14635        (insert ">")
14636        (speedbar-make-button start (point) nil nil nil)
14637        (setq visible-start (point))
14638        (insert " ")
14639        (setq start (point))
14640        (insert pack-name)
14641        (speedbar-make-button
14642         start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face
14643         'vhdl-speedbar-find-file pack-file-marker)
14644        (setq start (point))
14645        (insert " (" lib-name ")")
14646        (put-text-property (+ 2 start) (1- (point)) 'face
14647                           'vhdl-speedbar-library-face)
14648        (insert-char ?\n 1)
14649        (put-text-property visible-start (point) 'invisible nil)))
14650    
14651    (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker
14652                                                         func-body-file-marker
14653                                                         depth)
14654      "Insert subprogram entry."
14655      (let ((start (point))
14656            visible-start)
14657      (insert (int-to-string depth) ":")      (insert (int-to-string depth) ":")
14658      (put-text-property start (point) 'invisible t)      (put-text-property start (point) 'invisible t)
14659        (setq visible-start (point))
14660        (insert-char ?  (* depth speedbar-indentation-width))
14661        (put-text-property visible-start (point) 'invisible nil)
14662        (setq start (point))
14663        (insert ">")
14664        (speedbar-make-button start (point) nil nil nil)
14665        (setq visible-start (point))
14666        (insert " ")
14667      (setq start (point))      (setq start (point))
14668      (insert-char ?  depth)      (insert func-name)
14669      (put-text-property start (point) 'invisible nil)      (speedbar-make-button
14670         start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
14671         'vhdl-speedbar-find-file func-file-marker)
14672        (when (car func-body-file-marker)
14673          (insert " (")
14674          (setq start (point))
14675          (insert "body")
14676          (speedbar-make-button
14677           start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face
14678           'vhdl-speedbar-find-file func-body-file-marker)
14679          (insert ")"))
14680        (insert-char ?\n 1)
14681        (put-text-property visible-start (point) 'invisible nil)))
14682    
14683    (defun vhdl-speedbar-make-title-line (text &optional depth)
14684      "Insert design unit title entry."
14685      (let ((start (point))
14686            visible-start)
14687        (when depth
14688          (insert (int-to-string depth) ":")
14689          (put-text-property start (point) 'invisible t))
14690        (setq visible-start (point))
14691        (insert-char ?  (* (or depth 0) speedbar-indentation-width))
14692      (setq start (point))      (setq start (point))
14693      (insert text)      (insert text)
14694      (speedbar-make-button start (point) nil nil nil nil)      (speedbar-make-button start (point) nil nil nil nil)
14695      (insert-char ?\n 1)      (insert-char ?\n 1)
14696      (put-text-property start (point) 'invisible nil)))      (put-text-property visible-start (point) 'invisible nil)))
14697    
14698  (defun vhdl-speedbar-insert-dirs (files level)  (defun vhdl-speedbar-insert-dirs (files level)
14699    "Insert subdirectories."    "Insert subdirectories."
# Line 10509  NO-POSITION non-nil means do not re-posi Line 14725  NO-POSITION non-nil means do not re-posi
14725                (abbreviate-file-name                (abbreviate-file-name
14726                 (concat (speedbar-line-path indent) token "/"))                 (concat (speedbar-line-path indent) token "/"))
14727                (1+ indent) speedbar-power-click)))                (1+ indent) speedbar-power-click)))
14728           (setq speedbar-last-selected-file nil)           (vhdl-speedbar-update-current-unit t t))
          (save-excursion (speedbar-stealthy-updates)))  
14729          ((string-match "-" text)        ; we have to contract this node          ((string-match "-" text)        ; we have to contract this node
14730           (speedbar-reset-scanners)           (speedbar-reset-scanners)
14731           (let ((oldl speedbar-shown-directories)           (let ((oldl speedbar-shown-directories)
# Line 10524  NO-POSITION non-nil means do not re-posi Line 14739  NO-POSITION non-nil means do not re-posi
14739             (setq speedbar-shown-directories (nreverse newl)))             (setq speedbar-shown-directories (nreverse newl)))
14740           (speedbar-change-expand-button-char ?+)           (speedbar-change-expand-button-char ?+)
14741           (speedbar-delete-subblock indent))           (speedbar-delete-subblock indent))
14742          (t (error "Ooops...  not sure what to do")))          (t (error "Nothing to display")))
14743    (speedbar-center-buffer-smartly))    (when (equal (selected-frame) speedbar-frame)
14744        (speedbar-center-buffer-smartly)))
14745    
14746  (defun vhdl-speedbar-item-info ()  (defun vhdl-speedbar-item-info ()
14747    "Derive and display information about this line item."    "Derive and display information about this line item."
14748    (save-excursion    (save-excursion
14749      (beginning-of-line)      (beginning-of-line)
14750      ;; skip invisible number info      ;; skip invisible number info
14751      (when (looking-at "[0-9]+:") (goto-char (match-end 0)))      (when (looking-at "^[0-9]+:") (goto-char (match-end 0)))
     (when (looking-at "p:")  
       (message "Project \"%s\""  
                (nth 0 (aget vhdl-project-alist vhdl-project))))  
14752      (cond      (cond
14753       ;; directory entry       ;; project/directory entry
14754       ((looking-at "\\s-*<[-+?]> ") (speedbar-files-item-info))       ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$")
14755          (if vhdl-speedbar-show-projects
14756              (message "Project \"%s\"" (match-string-no-properties 1))
14757            (speedbar-files-item-info)))
14758       ;; design unit entry       ;; design unit entry
14759       ((looking-at "\\s-*\\([[{][-+?][]}]\\|>\\) ")       ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w")
14760        (goto-char (match-end 0))        (goto-char (match-end 1))
14761        (let ((face (get-text-property (point) 'face)))        (let ((face (get-text-property (point) 'face)))
14762          (message          (message
14763           "%s \"%s\" in \"%s\""           "%s \"%s\" in \"%s\""
14764           ;; design unit kind           ;; design unit kind
14765           (cond ((or (eq face 'vhdl-speedbar-entity-face)           (cond ((or (eq face 'vhdl-speedbar-entity-face)
14766                      (eq face 'vhdl-speedbar-entity-selected-face))                      (eq face 'vhdl-speedbar-entity-selected-face))
14767                  "Entity")                  (if (equal (match-string 2) ">") "Component" "Entity"))
14768                 ((or (eq face 'vhdl-speedbar-architecture-face)                 ((or (eq face 'vhdl-speedbar-architecture-face)
14769                      (eq face 'vhdl-speedbar-architecture-selected-face))                      (eq face 'vhdl-speedbar-architecture-selected-face))
14770                  "Architecture")                  "Architecture")
# Line 10561  NO-POSITION non-nil means do not re-posi Line 14777  NO-POSITION non-nil means do not re-posi
14777                 ((or (eq face 'vhdl-speedbar-instantiation-face)                 ((or (eq face 'vhdl-speedbar-instantiation-face)
14778                      (eq face 'vhdl-speedbar-instantiation-selected-face))                      (eq face 'vhdl-speedbar-instantiation-selected-face))
14779                  "Instantiation")                  "Instantiation")
14780                   ((eq face 'vhdl-speedbar-subprogram-face)
14781                    "Subprogram")
14782                 (t ""))                 (t ""))
14783           ;; design unit name           ;; design unit name
14784           (buffer-substring-no-properties           (buffer-substring-no-properties
14785            (point) (progn (looking-at"\\(\\w\\|_\\)+") (match-end 0)))            (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1))
14786              (match-end 1))
14787           ;; file name           ;; file name
14788           (abbreviate-file-name           (file-relative-name
14789            (or (car (get-text-property (point) 'speedbar-token)) "?"))))))))            (or (car (get-text-property (point) 'speedbar-token))
14790                  "?")
14791              (vhdl-default-directory)))))
14792         (t (message "")))))
14793    
14794    (defun vhdl-speedbar-line-text ()
14795      "Calls `speedbar-line-text' and removes text properties."
14796      (let ((string (speedbar-line-text)))
14797        (set-text-properties 0 (length string) nil string)
14798        string))
14799    
14800  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14801  ;; Help functions  ;; Help functions
14802    
14803  (defun vhdl-get-subdirs (directory)  (defun vhdl-speedbar-line-key (&optional indent)
14804    "Recursively get subdirectories of DIRECTORY."    "Get currently displayed directory of project name."
14805    (let ((dir-list (list (file-name-as-directory directory)))    (if vhdl-speedbar-show-projects
14806          subdir-list file-list)        (vhdl-speedbar-line-project)
14807      (setq file-list (vhdl-directory-files directory t "\\w.*"))      (abbreviate-file-name
14808      (while file-list       (file-name-as-directory (speedbar-line-path indent)))))
14809        (when (file-directory-p (car file-list))  
14810          (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list)))))  (defun vhdl-speedbar-line-project (&optional indent)
14811        (setq file-list (cdr file-list)))    "Get currently displayed project name."
14812      dir-list))    (and vhdl-speedbar-show-projects
14813           (save-excursion
14814             (end-of-line)
14815             (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t)
14816             (match-string-no-properties 1))))
14817    
14818    (defun vhdl-add-modified-file ()
14819      "Add file to `vhdl-modified-file-list'."
14820      (when vhdl-file-alist
14821        (add-to-list 'vhdl-modified-file-list (buffer-file-name)))
14822      nil)
14823    
14824  (defun vhdl-resolve-paths (path-list)  (defun vhdl-resolve-paths (path-list)
14825    "Resolve environment variables and path wildcards in PATH-LIST."    "Resolve path wildcards in PATH-LIST."
14826    (let (path-list-1 path-list-2 path-list-3 path-beg path-end dir)    (let (path-list-1 path-list-2 path-beg path-end dir)
14827      ;; resolve environment variables      ;; eliminate non-existent directories
14828      (while path-list      (while path-list
14829        (setq dir (car path-list))        (setq dir (car path-list))
14830        (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" dir)        (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir)
14831          (setq dir (concat (match-string 1 dir) (getenv (match-string 2 dir))        (if (file-directory-p (match-string 2 dir))
14832                            (match-string 4 dir))))            (setq path-list-1 (cons dir path-list-1))
14833        (setq path-list-1 (cons dir path-list-1))          (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir)))
14834        (setq path-list (cdr path-list)))        (setq path-list (cdr path-list)))
14835      ;; eliminate non-existent directories      ;; resolve path wildcards
14836      (while path-list-1      (while path-list-1
14837        (setq dir (car path-list-1))        (setq dir (car path-list-1))
14838        (string-match "\\(-r \\)?\\(\\([^?*]*/\\)*\\)" dir)        (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir)
       (if (file-directory-p (match-string 2 dir))  
           (setq path-list-2 (cons dir path-list-2))  
         (message "No such directory: \"%s\"" (match-string 2 dir)))  
       (setq path-list-1 (cdr path-list-1)))  
     ;; resolve path wildcards  
     (while path-list-2  
       (setq dir (car path-list-2))  
       (if (string-match  
            "\\(-r \\)?\\(\\([^?*]*/\\)*\\)\\([^/]*[?*][^/]*\\)\\(/.*\\)" dir)  
14839            (progn            (progn
14840              (setq path-beg (match-string 1 dir)              (setq path-beg (match-string 1 dir)
14841                    path-end (match-string 5 dir))                    path-end (match-string 5 dir))
14842              (setq path-list-2              (setq path-list-1
14843                    (append                    (append
14844                     (mapcar                     (mapcar
14845                      (function                      (function
# Line 10625  NO-POSITION non-nil means do not re-posi Line 14854  NO-POSITION non-nil means do not re-posi
14854                            (setq dir-list (cons (car all-list) dir-list)))                            (setq dir-list (cons (car all-list) dir-list)))
14855                          (setq all-list (cdr all-list)))                          (setq all-list (cdr all-list)))
14856                        dir-list))                        dir-list))
14857                     (cdr path-list-2))))                     (cdr path-list-1))))
14858          (string-match "\\(-r \\)?\\(.*\\)/.*" dir)          (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir)
14859          (when (file-directory-p (match-string 2 dir))          (when (file-directory-p (match-string 2 dir))
14860            (setq path-list-3 (cons dir path-list-3)))            (setq path-list-2 (cons dir path-list-2)))
14861          (setq path-list-2 (cdr path-list-2))))          (setq path-list-1 (cdr path-list-1))))
14862      path-list-3))      (nreverse path-list-2)))
   
 (defun vhdl-aappend (alist-symbol key value)  
   "Append a key-value pair to an alist.  
 Similar to `aput' but moves the key-value pair to the tail of the alist."  
   (let ((elem (aelement key value))  
         (alist (adelete alist-symbol key)))  
     (set alist-symbol (append alist elem))))  
14863    
14864  (defun vhdl-speedbar-goto-this-unit (directory unit)  (defun vhdl-speedbar-goto-this-unit (directory unit)
14865    "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."    "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil."
14866    (let ((dest (point)))    (let ((dest (point)))
14867      (if (and (if (vhdl-speedbar-project-p)      (if (and (if vhdl-speedbar-show-projects
14868                   (progn (goto-char (point-min)) t)                   (progn (goto-char (point-min)) t)
14869                 (speedbar-goto-this-file directory))                 (speedbar-goto-this-file directory))
14870               (re-search-forward (concat "[]}] " unit "\\>") nil t))               (re-search-forward (concat "[]}] " unit "\\>") nil t))
# Line 10652  Similar to `aput' but moves the key-valu Line 14874  Similar to `aput' but moves the key-valu
14874        nil)))        nil)))
14875    
14876  (defun vhdl-speedbar-find-file (text token indent)  (defun vhdl-speedbar-find-file (text token indent)
14877    "When user clicks on TEXT, load file with name and position in TOKEN."    "When user clicks on TEXT, load file with name and position in TOKEN.
14878    Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file
14879    is already shown in a buffer."
14880    (if (not (car token))    (if (not (car token))
14881        (error "Design unit does not exist")        (error "ERROR:  File cannot be found")
14882      (speedbar-find-file-in-frame (car token))      (let ((buffer (get-file-buffer (car token))))
14883      (goto-line (cdr token))        (speedbar-find-file-in-frame (car token))
14884      (recenter)        (when (or vhdl-speedbar-jump-to-unit buffer)
14885      (vhdl-speedbar-update-current-unit t)          (goto-line (cdr token))
14886      (speedbar-set-timer speedbar-update-speed)          (recenter))
14887      (speedbar-maybee-jump-to-attached-frame)))        (vhdl-speedbar-update-current-unit t t)
14888          (speedbar-set-timer speedbar-update-speed)
14889  (defun vhdl-speedbar-toggle-hierarchy ()        (speedbar-maybee-jump-to-attached-frame))))
   "Toggle between hierarchy and file browsing mode."  
   (interactive)  
   (if (not (boundp 'speedbar-mode-functions-list))  
       (error "WARNING:  Install included `speedbar.el' patch first")  
     (if (equal speedbar-initial-expansion-list-name "vhdl hierarchy")  
         (speedbar-change-initial-expansion-list "files")  
       (speedbar-change-initial-expansion-list "vhdl hierarchy"))))  
14890    
14891  (defun vhdl-speedbar-port-copy ()  (defun vhdl-speedbar-port-copy ()
14892    "Copy the port of the entity under the cursor."    "Copy the port of the entity/component or subprogram under the cursor."
14893    (interactive)    (interactive)
14894    (beginning-of-line)    (let ((is-entity (vhdl-speedbar-check-unit 'entity)))
14895    (if (re-search-forward "\\([0-9]\\)+:\\s-*\\[[-+?]\\] \\(\\(\\w\\|\\s_\\)+\\)"      (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram)))
14896                           (save-excursion (end-of-line) (point)) t)          (error "ERROR:  No entity/component or subprogram under cursor")
14897      (condition-case ()        (beginning-of-line)
14898          (let* ((indent (string-to-number (match-string 1)))        (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)")
14899                 (ent-name (match-string 2))            (condition-case info
14900                 (ent-alist (if (vhdl-speedbar-project-p)                (let ((token (get-text-property
14901                                (aget vhdl-project-entity-alist vhdl-project)                              (match-beginning 3) 'speedbar-token)))
14902                              (aget vhdl-entity-alist                  (vhdl-visit-file (car token) t
14903                                    (abbreviate-file-name                                   (progn (goto-line (cdr token))
14904                                     (file-name-as-directory                                          (end-of-line)
14905                                      (speedbar-line-path indent))))))                                          (if is-entity
14906                 (ent-entry (aget ent-alist ent-name))                                              (vhdl-port-copy)
14907                 (file-name (nth 0 ent-entry))                                            (vhdl-subprog-copy)))))
14908                 opened)              (error (error "ERROR:  %s not scanned successfully\n  (%s)"
14909            ;; open file                            (if is-entity "Port" "Interface") (cadr info))))
14910            (if (find-buffer-visiting file-name)          (error "ERROR:  No entity/component or subprogram on current line")))))
14911                (set-buffer (file-name-nondirectory file-name))  
14912              (set-buffer (find-file-noselect file-name nil t))  (defun vhdl-speedbar-place-component ()
14913              (modify-syntax-entry ?\- ". 12" (syntax-table))    "Place the entity/component under the cursor as component."
14914              (modify-syntax-entry ?\n ">" (syntax-table))    (interactive)
14915              (modify-syntax-entry ?\^M ">" (syntax-table))    (if (not (vhdl-speedbar-check-unit 'entity))
14916              (setq opened t))        (error "ERROR:  No entity/component under cursor.")
14917            ;; scan port      (vhdl-speedbar-port-copy)
14918            (goto-line (nth 1 ent-entry))      (if (fboundp 'speedbar-select-attached-frame)
14919            (end-of-line)          (speedbar-select-attached-frame)
14920            (vhdl-port-copy)        (select-frame speedbar-attached-frame))
14921            ;; close file      (vhdl-compose-place-component)
14922            (when opened (kill-buffer (current-buffer))))      (select-frame speedbar-frame)))
14923        (error (error "Port not scanned successfully")))  
14924      (error "No entity on current line")))  (defun vhdl-speedbar-make-design ()
14925      "Make (compile) design unit or directory/project under the cursor."
14926      (interactive)
14927      (if (not (save-excursion (beginning-of-line)
14928                               (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)")))
14929          (error "ERROR:  No primary design unit or directory/project under cursor")
14930        (let ((is-unit (match-string 2))
14931              (unit-name (vhdl-speedbar-line-text))
14932              (vhdl-project (vhdl-speedbar-line-project))
14933              (directory (file-name-as-directory
14934                          (or (speedbar-line-file) (speedbar-line-path)))))
14935          (if (fboundp 'speedbar-select-attached-frame)
14936              (speedbar-select-attached-frame)
14937            (select-frame speedbar-attached-frame))
14938          (let ((default-directory directory))
14939            (vhdl-make (and is-unit unit-name))))))
14940    
14941    (defun vhdl-speedbar-generate-makefile ()
14942      "Generate Makefile for directory/project under the cursor."
14943      (interactive)
14944      (let ((vhdl-project (vhdl-speedbar-line-project))
14945            (default-directory (file-name-as-directory
14946                                (or (speedbar-line-file) (speedbar-line-path)))))
14947        (vhdl-generate-makefile)))
14948    
14949    (defun vhdl-speedbar-check-unit (design-unit)
14950      "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its
14951    expansion function)."
14952        (save-excursion
14953          (speedbar-position-cursor-on-line)
14954          (cond ((eq design-unit 'entity)
14955                 (memq (get-text-property (match-end 0) 'face)
14956                       '(vhdl-speedbar-entity-face
14957                         vhdl-speedbar-entity-selected-face)))
14958                ((eq design-unit 'subprogram)
14959                 (eq (get-text-property (match-end 0) 'face)
14960                     'vhdl-speedbar-subprogram-face))
14961                (t nil))))
14962    
14963    (defun vhdl-speedbar-set-depth (depth)
14964      "Set hierarchy display depth to DEPTH and refresh speedbar."
14965      (setq vhdl-speedbar-hierarchy-depth depth)
14966      (speedbar-refresh))
14967    
14968  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14969  ;; Fontification  ;; Fontification
# Line 10733  Similar to `aput' but moves the key-valu Line 14992  Similar to `aput' but moves the key-valu
14992    "Face used for displaying package names."    "Face used for displaying package names."
14993    :group 'speedbar-faces)    :group 'speedbar-faces)
14994    
14995    (defface vhdl-speedbar-library-face
14996      '((((class color) (background light)) (:foreground "Purple"))
14997        (((class color) (background dark)) (:foreground "Orchid1")))
14998      "Face used for displaying library names."
14999      :group 'speedbar-faces)
15000    
15001  (defface vhdl-speedbar-instantiation-face  (defface vhdl-speedbar-instantiation-face
15002    '((((class color) (background light)) (:foreground "Brown"))    '((((class color) (background light)) (:foreground "Brown"))
15003      (((class color) (background dark)) (:foreground "Yellow")))      (((class color) (background dark)) (:foreground "Yellow")))
15004    "Face used for displaying instantiation names."    "Face used for displaying instantiation names."
15005    :group 'speedbar-faces)    :group 'speedbar-faces)
15006    
15007    (defface vhdl-speedbar-subprogram-face
15008      '((((class color) (background light)) (:foreground "Orchid4"))
15009        (((class color) (background dark)) (:foreground "BurlyWood2")))
15010      "Face used for displaying subprogram names."
15011      :group 'speedbar-faces)
15012    
15013  (defface vhdl-speedbar-entity-selected-face  (defface vhdl-speedbar-entity-selected-face
15014    '((((class color) (background light)) (:foreground "ForestGreen" :underline t))    '((((class color) (background light)) (:foreground "ForestGreen" :underline t))
15015      (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))      (((class color) (background dark)) (:foreground "PaleGreen" :underline t)))
# Line 10769  Similar to `aput' but moves the key-valu Line 15040  Similar to `aput' but moves the key-valu
15040    "Face used for displaying instantiation names."    "Face used for displaying instantiation names."
15041    :group 'speedbar-faces)    :group 'speedbar-faces)
15042    
15043    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15044    ;; Initialization
15045    
15046    ;; add speedbar
15047    (when (fboundp 'speedbar)
15048      (condition-case ()
15049          (when (and vhdl-speedbar-auto-open
15050                     (not (and (boundp 'speedbar-frame)
15051                               (frame-live-p speedbar-frame))))
15052            (speedbar-frame-mode 1)
15053            (if (fboundp 'speedbar-select-attached-frame)
15054                (speedbar-select-attached-frame)
15055              (select-frame speedbar-attached-frame)))
15056        (error (vhdl-warning-when-idle "ERROR:  An error occurred while opening speedbar"))))
15057    
15058    ;; initialize speedbar
15059    (if (not (boundp 'speedbar-frame))
15060        (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize)
15061      (vhdl-speedbar-initialize)
15062      (when speedbar-frame (vhdl-speedbar-refresh)))
15063    
15064    
15065    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15066    ;;; Structural composition
15067    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15068    
15069    (defun vhdl-get-components-package-name ()
15070      "Return the name of the components package."
15071      (let ((project (vhdl-project-p)))
15072        (if project
15073            (vhdl-replace-string (car vhdl-components-package-name)
15074                                 (subst-char-in-string ?  ?_ project))
15075          (cdr vhdl-components-package-name))))
15076    
15077    (defun vhdl-compose-new-component ()
15078      "Create entity and architecture for new component."
15079      (interactive)
15080      (let* ((case-fold-search t)
15081             (ent-name (read-from-minibuffer "entity name: "
15082                                             nil vhdl-minibuffer-local-map))
15083             (arch-name
15084              (if (equal (cdr vhdl-compose-architecture-name) "")
15085                  (read-from-minibuffer "architecture name: "
15086                                        nil vhdl-minibuffer-local-map)
15087                (vhdl-replace-string vhdl-compose-architecture-name ent-name)))
15088             ent-file-name arch-file-name ent-buffer arch-buffer project)
15089        (message "Creating component \"%s(%s)\"..." ent-name arch-name)
15090        ;; open entity file
15091        (unless (eq vhdl-compose-create-files 'none)
15092          (setq ent-file-name
15093                (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15094                        "." (file-name-extension (buffer-file-name))))
15095          (when (and (file-exists-p ent-file-name)
15096                     (not (y-or-n-p (concat "File \"" ent-file-name
15097                                            "\" exists; overwrite? "))))
15098            (error "ERROR:  Creating component...aborted"))
15099          (find-file ent-file-name)
15100          (erase-buffer)
15101          (set-buffer-modified-p nil))
15102        ;; insert header
15103        (if vhdl-compose-include-header
15104            (progn (vhdl-template-header)
15105                   (goto-char (point-max)))
15106          (vhdl-comment-display-line) (insert "\n\n"))
15107        ;; insert library clause
15108        (vhdl-template-package-std-logic-1164)
15109        (when vhdl-use-components-package
15110          (insert "\n")
15111          (vhdl-template-standard-package (vhdl-work-library)
15112                                          (vhdl-get-components-package-name)))
15113        (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")
15114        ;; insert entity declaration
15115        (vhdl-insert-keyword "ENTITY ") (insert ent-name)
15116        (vhdl-insert-keyword " IS\n")
15117        (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15118        (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n")
15119        (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15120        (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15121        (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n")
15122        (indent-to (* 2 vhdl-basic-offset)) (insert ");\n")
15123        (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
15124        (vhdl-insert-keyword "END ")
15125        (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
15126        (insert ent-name ";\n\n")
15127        (vhdl-comment-display-line) (insert "\n")
15128        ;; open architecture file
15129        (if (not (eq vhdl-compose-create-files 'separate))
15130            (insert "\n")
15131          (setq ent-buffer (current-buffer))
15132          (setq arch-file-name
15133                (concat (vhdl-replace-string vhdl-architecture-file-name
15134                                             (concat ent-name " " arch-name))
15135                        "." (file-name-extension (buffer-file-name))))
15136          (when (and (file-exists-p arch-file-name)
15137                     (not (y-or-n-p (concat "File \"" arch-file-name
15138                                            "\" exists; overwrite? "))))
15139            (error "ERROR:  Creating component...aborted"))
15140          (find-file arch-file-name)
15141          (erase-buffer)
15142          (set-buffer-modified-p nil)
15143          ;; insert header
15144          (if vhdl-compose-include-header
15145              (progn (vhdl-template-header)
15146                     (goto-char (point-max)))
15147            (vhdl-comment-display-line) (insert "\n\n")))
15148        ;; insert architecture body
15149        (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name)
15150        (vhdl-insert-keyword " OF ") (insert ent-name)
15151        (vhdl-insert-keyword " IS\n\n")
15152        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15153        (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n")
15154        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15155        (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation))
15156          (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15157          (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15158          (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n"))
15159        (vhdl-insert-keyword "BEGIN")
15160        (when vhdl-self-insert-comments
15161          (insert "  -- ")
15162          (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15163          (insert arch-name))
15164        (insert "\n\n")
15165        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15166        (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n")
15167        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15168        (vhdl-insert-keyword "END ")
15169        (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE "))
15170        (insert arch-name ";\n\n")
15171        ;; insert footer
15172        (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15173            (vhdl-template-footer)
15174          (vhdl-comment-display-line) (insert "\n"))
15175        (goto-char (point-min))
15176        (setq arch-buffer (current-buffer))
15177        (when ent-buffer (set-buffer ent-buffer) (save-buffer))
15178        (set-buffer arch-buffer) (save-buffer)
15179        (message
15180         (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name)
15181                 (and ent-file-name
15182                      (format "\n  File created: \"%s\"" ent-file-name))
15183                 (and arch-file-name
15184                      (format "\n  File created: \"%s\"" arch-file-name))))))
15185    
15186    (defun vhdl-compose-place-component ()
15187      "Place new component by pasting current port as component declaration and
15188    component instantiation."
15189      (interactive)
15190      (if (not vhdl-port-list)
15191          (error "ERROR:  No port has been read")
15192        (save-excursion
15193          (vhdl-prepare-search-2
15194           (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15195                       (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15196             (error "ERROR:  No architecture found"))
15197           (let* ((ent-name (match-string 1))
15198                  (ent-file-name
15199                   (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15200                           "." (file-name-extension (buffer-file-name))))
15201                  (orig-buffer (current-buffer)))
15202             (message "Placing component \"%s\"..." (nth 0 vhdl-port-list))
15203             ;; place component declaration
15204             (unless (or vhdl-use-components-package
15205                         (vhdl-use-direct-instantiation)
15206                         (save-excursion
15207                           (re-search-forward
15208                            (concat "^\\s-*component\\s-+"
15209                                    (car vhdl-port-list) "\\>") nil t)))
15210               (re-search-forward "^begin\\>" nil)
15211               (beginning-of-line)
15212               (skip-chars-backward " \t\n")
15213               (insert "\n\n") (indent-to vhdl-basic-offset)
15214               (vhdl-port-paste-component t))
15215             ;; place component instantiation
15216             (re-search-forward "^end\\>" nil)
15217             (beginning-of-line)
15218             (skip-chars-backward " \t\n")
15219             (insert "\n\n") (indent-to vhdl-basic-offset)
15220             (vhdl-port-paste-instance nil t t)
15221             ;; place use clause for used packages
15222             (when (nth 3 vhdl-port-list)
15223               ;; open entity file
15224               (when (file-exists-p ent-file-name)
15225                 (find-file ent-file-name))
15226               (goto-char (point-min))
15227               (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15228                 (error "ERROR:  Entity not found: \"%s\"" ent-name))
15229               (goto-char (match-beginning 0))
15230               (if (and (save-excursion
15231                          (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t))
15232                        (match-string 1))
15233                   (progn (goto-char (match-end 0))
15234                          (beginning-of-line 2))
15235                 (insert "\n")
15236                 (backward-char))
15237               (vhdl-port-paste-context-clause)
15238               (switch-to-buffer orig-buffer))
15239             (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list)))))))
15240    
15241    (defun vhdl-compose-wire-components ()
15242      "Connect components."
15243      (interactive)
15244      (save-excursion
15245        (vhdl-prepare-search-2
15246         (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)
15247                     (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t))
15248           (error "ERROR:  No architecture found"))
15249         (let* ((ent-name (match-string 1))
15250                (ent-file-name
15251                 (concat (vhdl-replace-string vhdl-entity-file-name ent-name)
15252                         "." (file-name-extension (buffer-file-name))))
15253                (arch-decl-pos (point-marker))
15254                (arch-stat-pos (re-search-forward "^begin\\>" nil))
15255                (arch-end-pos (re-search-forward "^end\\>" nil))
15256                (pack-name (vhdl-get-components-package-name))
15257                (pack-file-name
15258                 (concat (vhdl-replace-string vhdl-package-file-name pack-name)
15259                         "." (file-name-extension (buffer-file-name))))
15260                inst-name comp-name comp-ent-name comp-ent-file-name has-generic
15261                port-alist generic-alist inst-alist
15262                signal-name signal-entry signal-alist local-list written-list
15263                single-in-list multi-in-list single-out-list multi-out-list
15264                constant-name constant-entry constant-alist single-list multi-list
15265                port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
15266                generic-beg-pos generic-pos generic-inst-pos generic-end-pos
15267                signal-beg-pos signal-pos
15268                constant-temp-pos port-temp-pos signal-temp-pos)
15269           (message "Wiring components...")
15270           ;; process all instances
15271           (goto-char arch-stat-pos)
15272           (while (re-search-forward
15273                   (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\("
15274                           "\\(component[ \t\n]+\\)?\\(\\w+\\)"
15275                           "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|"
15276                           "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?"
15277                           "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t)
15278             (setq inst-name (match-string-no-properties 1)
15279                   comp-name (match-string-no-properties 4)
15280                   comp-ent-name (match-string-no-properties 12)
15281                   has-generic (or (match-string 7) (match-string 17)))
15282             ;; get port ...
15283             (if comp-name
15284                 ;; ... from component declaration
15285                 (vhdl-visit-file
15286                  (when vhdl-use-components-package pack-file-name) t
15287                  (save-excursion
15288                    (goto-char (point-min))
15289                    (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t)
15290                      (error "ERROR:  Component declaration not found: \"%s\"" comp-name))
15291                    (vhdl-port-copy)))
15292               ;; ... from entity declaration (direct instantiation)
15293               (setq comp-ent-file-name
15294                     (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name)
15295                             "." (file-name-extension (buffer-file-name))))
15296               (vhdl-visit-file
15297                comp-ent-file-name t
15298                (save-excursion
15299                  (goto-char (point-min))
15300                  (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t)
15301                    (error "ERROR:  Entity declaration not found: \"%s\"" comp-ent-name))
15302                  (vhdl-port-copy))))
15303             (vhdl-port-flatten t)
15304             (setq generic-alist (nth 1 vhdl-port-list)
15305                   port-alist (nth 2 vhdl-port-list))
15306             (setq constant-alist nil
15307                   signal-alist nil)
15308             (when has-generic
15309               ;; process all constants in generic map
15310               (vhdl-forward-syntactic-ws)
15311               (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15312                 (setq constant-name (match-string-no-properties 3))
15313                 (setq constant-entry
15314                       (cons constant-name
15315                             (if (match-string 1)
15316                                 (or (aget generic-alist (match-string 2) t)
15317                                     (error (format "ERROR:  Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
15318                               (cdar generic-alist))))
15319                 (setq constant-alist (cons constant-entry constant-alist))
15320                 (setq constant-name (downcase constant-name))
15321                 (if (or (member constant-name single-list)
15322                         (member constant-name multi-list))
15323                     (progn (setq single-list (delete constant-name single-list))
15324                            (add-to-list 'multi-list constant-name))
15325                   (add-to-list 'single-list constant-name))
15326                 (unless (match-string 1)
15327                   (setq generic-alist (cdr generic-alist)))
15328                 (vhdl-forward-syntactic-ws))
15329               (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t))
15330             ;; process all signals in port map
15331             (vhdl-forward-syntactic-ws)
15332             (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t)
15333               (setq signal-name (match-string-no-properties 3))
15334               (setq signal-entry (cons signal-name
15335                                        (if (match-string 1)
15336                                            (or (aget port-alist (match-string 2) t)
15337                                                (error (format "ERROR:  Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)))
15338                                          (cdar port-alist))))
15339               (setq signal-alist (cons signal-entry signal-alist))
15340               (setq signal-name (downcase signal-name))
15341               (if (equal (upcase (nth 2 signal-entry)) "IN")
15342                   ;; input signal
15343                   (cond
15344                    ((member signal-name local-list)
15345                     nil)
15346                    ((or (member signal-name single-out-list)
15347                         (member signal-name multi-out-list))
15348                     (setq single-out-list (delete signal-name single-out-list))
15349                     (setq multi-out-list (delete signal-name multi-out-list))
15350                     (add-to-list 'local-list signal-name))
15351                    ((member signal-name single-in-list)
15352                     (setq single-in-list (delete signal-name single-in-list))
15353                     (add-to-list 'multi-in-list signal-name))
15354                    ((not (member signal-name multi-in-list))
15355                     (add-to-list 'single-in-list signal-name)))
15356                 ;; output signal
15357                 (cond
15358                  ((member signal-name local-list)
15359                   nil)
15360                  ((or (member signal-name single-in-list)
15361                       (member signal-name multi-in-list))
15362                   (setq single-in-list (delete signal-name single-in-list))
15363                   (setq multi-in-list (delete signal-name multi-in-list))
15364                   (add-to-list 'local-list signal-name))
15365                  ((member signal-name single-out-list)
15366                   (setq single-out-list (delete signal-name single-out-list))
15367                   (add-to-list 'multi-out-list signal-name))
15368                  ((not (member signal-name multi-out-list))
15369                   (add-to-list 'single-out-list signal-name))))
15370               (unless (match-string 1)
15371                 (setq port-alist (cdr port-alist)))
15372               (vhdl-forward-syntactic-ws))
15373             (setq inst-alist (cons (list inst-name (nreverse constant-alist)
15374                                          (nreverse signal-alist)) inst-alist)))
15375           ;; prepare signal insertion
15376           (vhdl-goto-marker arch-decl-pos)
15377           (forward-line 1)
15378           (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t)
15379           (setq signal-pos (point-marker))
15380           (while (progn (vhdl-forward-syntactic-ws)
15381                         (looking-at "signal\\>"))
15382             (beginning-of-line 2)
15383             (delete-region signal-pos (point)))
15384           (setq signal-beg-pos signal-pos)
15385           ;; open entity file
15386           (when (file-exists-p ent-file-name)
15387             (find-file ent-file-name))
15388           (goto-char (point-min))
15389           (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t)
15390             (error "ERROR:  Entity not found: \"%s\"" ent-name))
15391           ;; prepare generic clause insertion
15392           (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t)
15393                        (match-string 1))
15394             (goto-char (match-beginning 0))
15395             (indent-to vhdl-basic-offset)
15396             (insert "generic ();\n\n")
15397             (backward-char 4))
15398           (backward-char)
15399           (setq generic-pos (point-marker))
15400           (forward-sexp) (end-of-line)
15401           (delete-region generic-pos (point)) (delete-char 1)
15402           (insert "(\n")
15403           (when multi-list
15404             (insert "\n")
15405             (indent-to (* 2 vhdl-basic-offset))
15406             (insert "-- global generics\n"))
15407           (setq generic-beg-pos (point-marker) generic-pos (point-marker)
15408                 generic-inst-pos (point-marker) generic-end-pos (point-marker))
15409           ;; prepare port clause insertion
15410           (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t)
15411                        (match-string 1))
15412             (goto-char (match-beginning 0))
15413             (indent-to vhdl-basic-offset)
15414             (insert "port ();\n\n")
15415             (backward-char 4))
15416           (backward-char)
15417           (setq port-in-pos (point-marker))
15418           (forward-sexp) (end-of-line)
15419           (delete-region port-in-pos (point)) (delete-char 1)
15420           (insert "(\n")
15421           (when (or multi-in-list multi-out-list)
15422             (insert "\n")
15423             (indent-to (* 2 vhdl-basic-offset))
15424             (insert "-- global ports\n"))
15425           (setq port-beg-pos (point-marker) port-in-pos (point-marker)
15426                 port-out-pos (point-marker) port-inst-pos (point-marker)
15427                 port-end-pos (point-marker))
15428           ;; insert generics, ports and signals
15429           (setq inst-alist (nreverse inst-alist))
15430           (while inst-alist
15431             (setq inst-name (nth 0 (car inst-alist))
15432                   constant-alist (nth 1 (car inst-alist))
15433                   signal-alist (nth 2 (car inst-alist))
15434                   constant-temp-pos generic-inst-pos
15435                   port-temp-pos port-inst-pos
15436                   signal-temp-pos signal-pos)
15437             ;; generics
15438             (while constant-alist
15439               (setq constant-name (downcase (caar constant-alist))
15440                     constant-entry (car constant-alist))
15441               (cond ((member constant-name written-list)
15442                      nil)
15443                     ((member constant-name multi-list)
15444                      (vhdl-goto-marker generic-pos)
15445                      (setq generic-end-pos
15446                            (vhdl-max-marker
15447                             generic-end-pos
15448                             (vhdl-compose-insert-generic constant-entry)))
15449                      (setq generic-pos (point-marker))
15450                      (add-to-list 'written-list constant-name))
15451                     (t
15452                      (vhdl-goto-marker
15453                       (vhdl-max-marker generic-inst-pos generic-pos))
15454                      (setq generic-end-pos
15455                            (vhdl-compose-insert-generic constant-entry))
15456                      (setq generic-inst-pos (point-marker))
15457                      (add-to-list 'written-list constant-name)))
15458               (setq constant-alist (cdr constant-alist)))
15459             (when (/= constant-temp-pos generic-inst-pos)
15460               (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
15461               (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15462               (insert "-- generics for \"" inst-name "\"\n")
15463               (vhdl-goto-marker generic-inst-pos))
15464             ;; ports and signals
15465             (while signal-alist
15466               (setq signal-name (downcase (caar signal-alist))
15467                     signal-entry (car signal-alist))
15468               (cond ((member signal-name written-list)
15469                      nil)
15470                     ((member signal-name multi-in-list)
15471                      (vhdl-goto-marker port-in-pos)
15472                      (setq port-end-pos
15473                            (vhdl-max-marker
15474                             port-end-pos (vhdl-compose-insert-port signal-entry)))
15475                      (setq port-in-pos (point-marker))
15476                      (add-to-list 'written-list signal-name))
15477                     ((member signal-name multi-out-list)
15478                      (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
15479                      (setq port-end-pos
15480                            (vhdl-max-marker
15481                             port-end-pos (vhdl-compose-insert-port signal-entry)))
15482                      (setq port-out-pos (point-marker))
15483                      (add-to-list 'written-list signal-name))
15484                     ((or (member signal-name single-in-list)
15485                          (member signal-name single-out-list))
15486                      (vhdl-goto-marker
15487                       (vhdl-max-marker
15488                        port-inst-pos
15489                        (vhdl-max-marker port-out-pos port-in-pos)))
15490                      (setq port-end-pos (vhdl-compose-insert-port signal-entry))
15491                      (setq port-inst-pos (point-marker))
15492                      (add-to-list 'written-list signal-name))
15493                     ((equal (upcase (nth 2 signal-entry)) "OUT")
15494                      (vhdl-goto-marker signal-pos)
15495                      (vhdl-compose-insert-signal signal-entry)
15496                      (setq signal-pos (point-marker))
15497                      (add-to-list 'written-list signal-name)))
15498               (setq signal-alist (cdr signal-alist)))
15499             (when (/= port-temp-pos port-inst-pos)
15500               (vhdl-goto-marker
15501                (vhdl-max-marker port-temp-pos
15502                                 (vhdl-max-marker port-in-pos port-out-pos)))
15503               (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15504               (insert "-- ports to \"" inst-name "\"\n")
15505               (vhdl-goto-marker port-inst-pos))
15506             (when (/= signal-temp-pos signal-pos)
15507               (vhdl-goto-marker signal-temp-pos)
15508               (insert "\n") (indent-to vhdl-basic-offset)
15509               (insert "-- outputs of \"" inst-name "\"\n")
15510               (vhdl-goto-marker signal-pos))
15511             (setq inst-alist (cdr inst-alist)))
15512           ;; finalize generic/port clause
15513           (vhdl-goto-marker generic-end-pos) (backward-char)
15514           (when (= generic-beg-pos generic-end-pos)
15515             (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15516             (insert ";") (backward-char))
15517           (insert ")")
15518           (vhdl-goto-marker port-end-pos) (backward-char)
15519           (when (= port-beg-pos port-end-pos)
15520             (insert "\n") (indent-to (* 2 vhdl-basic-offset))
15521             (insert ";") (backward-char))
15522           (insert ")")
15523           ;; align everything
15524           (when vhdl-auto-align
15525             (vhdl-goto-marker generic-beg-pos)
15526             (vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
15527             (vhdl-align-region-groups port-beg-pos port-end-pos 1)
15528             (vhdl-goto-marker signal-beg-pos)
15529             (vhdl-align-region-groups signal-beg-pos signal-pos))
15530           (switch-to-buffer (marker-buffer signal-beg-pos))
15531           (message "Wiring components...done")))))
15532    
15533    (defun vhdl-compose-insert-generic (entry)
15534      "Insert ENTRY as generic declaration."
15535      (let (pos)
15536        (indent-to (* 2 vhdl-basic-offset))
15537        (insert (nth 0 entry) " : " (nth 1 entry))
15538        (when (nth 2 entry)
15539          (insert " := " (nth 2 entry)))
15540        (insert ";")
15541        (setq pos (point-marker))
15542        (when (and vhdl-include-port-comments (nth 3 entry))
15543          (vhdl-comment-insert-inline (nth 3 entry) t))
15544        (insert "\n")
15545        pos))
15546    
15547    (defun vhdl-compose-insert-port (entry)
15548      "Insert ENTRY as port declaration."
15549      (let (pos)
15550        (indent-to (* 2 vhdl-basic-offset))
15551        (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";")
15552        (setq pos (point-marker))
15553        (when (and vhdl-include-port-comments (nth 4 entry))
15554          (vhdl-comment-insert-inline (nth 4 entry) t))
15555        (insert "\n")
15556        pos))
15557    
15558    (defun vhdl-compose-insert-signal (entry)
15559      "Insert ENTRY as signal declaration."
15560      (indent-to vhdl-basic-offset)
15561      (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";")
15562      (when (and vhdl-include-port-comments (nth 4 entry))
15563        (vhdl-comment-insert-inline (nth 4 entry) t))
15564      (insert "\n"))
15565    
15566    (defun vhdl-compose-components-package ()
15567      "Generate a package containing component declarations for all entities in the
15568    current project/directory."
15569      (interactive)
15570      (vhdl-require-hierarchy-info)
15571      (let* ((project (vhdl-project-p))
15572             (pack-name (vhdl-get-components-package-name))
15573             (pack-file-name
15574              (concat (vhdl-replace-string vhdl-package-file-name pack-name)
15575                      "." (file-name-extension (buffer-file-name))))
15576             (ent-alist (aget vhdl-entity-alist
15577                              (or project default-directory) t))
15578             (lazy-lock-minimum-size 0)
15579             clause-pos component-pos)
15580        (message "Generating components package \"%s\"..." pack-name)
15581        ;; open package file
15582        (when (and (file-exists-p pack-file-name)
15583                   (not (y-or-n-p (concat "File \"" pack-file-name
15584                                          "\" exists; overwrite? "))))
15585          (error "ERROR:  Generating components package...aborted"))
15586        (find-file pack-file-name)
15587        (erase-buffer)
15588        ;; insert header
15589        (if vhdl-compose-include-header
15590            (progn (vhdl-template-header
15591                    (concat "Components package (generated by Emacs VHDL Mode "
15592                            vhdl-version ")"))
15593                   (goto-char (point-max)))
15594          (vhdl-comment-display-line) (insert "\n\n"))
15595        ;; insert std_logic_1164 package
15596        (vhdl-template-package-std-logic-1164)
15597        (insert "\n") (setq clause-pos (point-marker))
15598        (insert "\n") (vhdl-comment-display-line) (insert "\n\n")
15599        ;; insert package declaration
15600        (vhdl-insert-keyword "PACKAGE ") (insert pack-name)
15601        (vhdl-insert-keyword " IS\n\n")
15602        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n")
15603        (indent-to vhdl-basic-offset) (insert "-- Component declarations\n")
15604        (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")
15605        (indent-to vhdl-basic-offset)
15606        (setq component-pos (point-marker))
15607        (insert "\n\n") (vhdl-insert-keyword "END ")
15608        (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE "))
15609        (insert pack-name ";\n\n")
15610        ;; insert footer
15611        (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
15612            (vhdl-template-footer)
15613          (vhdl-comment-display-line) (insert "\n"))
15614        ;; insert component declarations
15615        (while ent-alist
15616          (vhdl-visit-file (nth 2 (car ent-alist)) nil
15617                           (progn (goto-line (nth 3 (car ent-alist)))
15618                                  (end-of-line)
15619                                  (vhdl-port-copy)))
15620          (goto-char component-pos)
15621          (vhdl-port-paste-component t)
15622          (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset))
15623          (setq component-pos (point-marker))
15624          (goto-char clause-pos)
15625          (vhdl-port-paste-context-clause pack-name)
15626          (setq clause-pos (point-marker))
15627          (setq ent-alist (cdr ent-alist)))
15628        (goto-char (point-min))
15629        (save-buffer)
15630        (message "Generating components package \"%s\"...done\n  File created: \"%s\""
15631                 pack-name pack-file-name)))
15632    
15633    
15634    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15635    ;;; Compilation / Makefile generation
15636    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15637    ;; (using `compile.el')
15638    
15639    (defun vhdl-makefile-name ()
15640      "Return the Makefile name of the current project or the current compiler if
15641    no project is defined."
15642      (let ((project-alist (aget vhdl-project-alist vhdl-project))
15643            (compiler-alist (aget vhdl-compiler-alist vhdl-compiler)))
15644        (vhdl-replace-string
15645         (cons "\\(.*\\)\n\\(.*\\)"
15646               (or (nth 8 project-alist) (nth 8 compiler-alist)))
15647         (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist)))))
15648    
15649    (defun vhdl-compile-directory ()
15650      "Return the directory where compilation/make should be run."
15651      (let* ((project (aget vhdl-project-alist (vhdl-project-p t)))
15652             (compiler (aget vhdl-compiler-alist vhdl-compiler))
15653             (directory (vhdl-resolve-env-variable
15654                         (if project
15655                             (vhdl-replace-string
15656                              (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler))
15657                           (nth 6 compiler)))))
15658        (file-name-as-directory
15659         (if (file-name-absolute-p directory)
15660             directory
15661           (expand-file-name directory (vhdl-default-directory))))))
15662    
15663    (defun vhdl-uniquify (in-list)
15664      "Remove duplicate elements from IN-LIST."
15665      (let (out-list)
15666        (while in-list
15667          (add-to-list 'out-list (car in-list))
15668          (setq in-list (cdr in-list)))
15669        out-list))
15670    
15671    (defun vhdl-set-compiler (name)
15672      "Set current compiler to NAME."
15673      (interactive
15674       (list (let ((completion-ignore-case t))
15675               (completing-read "Compiler name: " vhdl-compiler-alist nil t))))
15676      (if (assoc name vhdl-compiler-alist)
15677          (progn (setq vhdl-compiler name)
15678                 (message "Current compiler: \"%s\"" vhdl-compiler))
15679        (vhdl-warning (format "Unknown compiler: \"%s\"" name))))
15680    
15681    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15682    ;; Compilation
15683    
15684    (defun vhdl-compile-init ()
15685      "Initialize for compilation."
15686      (when (or (null compilation-error-regexp-alist)
15687                (not (assoc (car (nth 11 (car vhdl-compiler-alist)))
15688                            compilation-error-regexp-alist)))
15689        ;; `compilation-error-regexp-alist'
15690        (let ((commands-alist vhdl-compiler-alist)
15691              regexp-alist sublist)
15692          (while commands-alist
15693            (setq sublist (nth 11 (car commands-alist)))
15694            (unless (or (equal "" (car sublist))
15695                        (assoc (car sublist) regexp-alist))
15696              (setq regexp-alist (cons (list (nth 0 sublist)
15697                                             (if (= 0 (nth 1 sublist))
15698                                                 (if vhdl-xemacs 9 nil)
15699                                               (nth 1 sublist))
15700                                             (nth 2 sublist) (nth 3 sublist))
15701                                       regexp-alist)))
15702            (setq commands-alist (cdr commands-alist)))
15703          (setq compilation-error-regexp-alist
15704                (append compilation-error-regexp-alist (nreverse regexp-alist))))
15705        ;; `compilation-file-regexp-alist'
15706        (let ((commands-alist vhdl-compiler-alist)
15707              regexp-alist sublist)
15708          ;; matches vhdl-mode file name output
15709          (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1)))
15710          (while commands-alist
15711            (setq sublist (nth 12 (car commands-alist)))
15712            (unless (or (equal "" (car sublist))
15713                        (assoc (car sublist) regexp-alist))
15714              (setq regexp-alist (cons sublist regexp-alist)))
15715            (setq commands-alist (cdr commands-alist)))
15716          (setq compilation-file-regexp-alist
15717                (append compilation-file-regexp-alist (nreverse regexp-alist))))))
15718    
15719    (defvar vhdl-compile-file-name nil
15720      "Name of file to be compiled.")
15721    
15722    (defun vhdl-compile-print-file-name ()
15723      "Function called within `compile' to print out file name for compilers that
15724    do not print any file names."
15725      (insert "Compiling \"" vhdl-compile-file-name "\"\n"))
15726    
15727    (defun vhdl-get-compile-options (project compiler file-name
15728                                             &optional file-options-only)
15729      "Get compiler options.  Returning nil means do not compile this file."
15730      (let* ((compiler-options (nth 1 compiler))
15731             (project-entry (aget (nth 4 project) vhdl-compiler))
15732             (project-options (nth 0 project-entry))
15733             (exception-list (and file-name (nth 2 project-entry)))
15734             (work-library (vhdl-work-library))
15735             (case-fold-search nil)
15736             file-options)
15737        (while (and exception-list
15738                    (not (string-match (caar exception-list) file-name)))
15739          (setq exception-list (cdr exception-list)))
15740        (if (and exception-list (not (cdar exception-list)))
15741            nil
15742          (if (and file-options-only (not exception-list))
15743              'default
15744            (setq file-options (cdar exception-list))
15745            ;; insert library name in compiler-specific options
15746            (setq compiler-options
15747                  (vhdl-replace-string (cons "\\(.*\\)" compiler-options)
15748                                       work-library))
15749            ;; insert compiler-specific options in project-specific options
15750            (when project-options
15751              (setq project-options
15752                    (vhdl-replace-string
15753                     (cons "\\(.*\\)\n\\(.*\\)" project-options)
15754                     (concat work-library "\n" compiler-options))))
15755            ;; insert project-specific options in file-specific options
15756            (when file-options
15757              (setq file-options
15758                    (vhdl-replace-string
15759                     (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options)
15760                     (concat work-library "\n" compiler-options "\n"
15761                             project-options))))
15762            ;; return options
15763            (or file-options project-options compiler-options)))))
15764    
15765    (defun vhdl-get-make-options (project compiler)
15766      "Get make options."
15767      (let* ((compiler-options (nth 3 compiler))
15768             (project-entry (aget (nth 4 project) vhdl-compiler))
15769             (project-options (nth 1 project-entry))
15770             (makefile-name (vhdl-makefile-name)))
15771        ;; insert Makefile name in compiler-specific options
15772        (setq compiler-options
15773              (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler))
15774                                   makefile-name))
15775        ;; insert compiler-specific options in project-specific options
15776        (when project-options
15777          (setq project-options
15778                (vhdl-replace-string
15779                 (cons "\\(.*\\)\n\\(.*\\)" project-options)
15780                 (concat makefile-name "\n" compiler-options))))
15781        ;; return options
15782        (or project-options compiler-options)))
15783    
15784    (defun vhdl-compile ()
15785      "Compile current buffer using the VHDL compiler specified in
15786    `vhdl-compiler'."
15787      (interactive)
15788      (vhdl-compile-init)
15789      (let* ((project (aget vhdl-project-alist vhdl-project))
15790             (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil)
15791                           (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
15792             (command (nth 0 compiler))
15793             (file-name (buffer-file-name))
15794             (options (vhdl-get-compile-options project compiler file-name))
15795             (default-directory (vhdl-compile-directory))
15796             compilation-process-setup-function)
15797        (unless (file-directory-p default-directory)
15798          (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
15799        ;; put file name into quotes if it contains spaces
15800        (when (string-match " " file-name)
15801          (setq file-name (concat "\"" file-name "\"")))
15802        ;; print out file name if compiler does not
15803        (setq vhdl-compile-file-name (buffer-file-name))
15804        (when (and (= 0 (nth 1 (nth 10 compiler)))
15805                   (= 0 (nth 1 (nth 11 compiler))))
15806          (setq compilation-process-setup-function 'vhdl-compile-print-file-name))
15807        ;; run compilation
15808        (if options
15809            (when command
15810              (compile (concat command " " options " " file-name)))
15811          (vhdl-warning "Your project settings tell me not to compile this file"))))
15812    
15813    (defun vhdl-make (&optional target)
15814      "Call make command for compilation of all updated source files (requires
15815    `Makefile').  Optional argument TARGET allows to compile the design
15816    specified by a target."
15817      (interactive)
15818      (vhdl-compile-init)
15819      (let* ((project (aget vhdl-project-alist vhdl-project))
15820             (compiler (or (aget vhdl-compiler-alist vhdl-compiler)
15821                           (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
15822             (command (nth 2 compiler))
15823             (options (vhdl-get-make-options project compiler))
15824             (default-directory (vhdl-compile-directory)))
15825        (unless (file-directory-p default-directory)
15826          (error "ERROR:  Compile directory does not exist: \"%s\"" default-directory))
15827        ;; run make
15828        (compile (concat (if (equal command "") "make" command)
15829                         " " options " " target))))
15830    
15831    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15832    ;; Makefile generation
15833    
15834    (defun vhdl-generate-makefile ()
15835      "Generate `Makefile'."
15836      (interactive)
15837      (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler)
15838                           (error "ERROR:  No such compiler: \"%s\"" vhdl-compiler)))
15839             (command (nth 4 compiler)))
15840        ;; generate makefile
15841        (if command
15842            (let ((default-directory (vhdl-compile-directory)))
15843              (compile (vhdl-replace-string
15844                        (cons "\\(.*\\) \\(.*\\)" command)
15845                        (concat (vhdl-makefile-name) " " (vhdl-work-library)))))
15846          (vhdl-generate-makefile-1))))
15847    
15848    (defun vhdl-get-packages (lib-alist work-library)
15849      "Get packages from LIB-ALIST that belong to WORK-LIBRARY."
15850      (let (pack-list)
15851        (while lib-alist
15852          (when (equal (downcase (caar lib-alist)) (downcase work-library))
15853            (setq pack-list (cons (cdar lib-alist) pack-list)))
15854          (setq lib-alist (cdr lib-alist)))
15855        pack-list))
15856    
15857    (defun vhdl-generate-makefile-1 ()
15858      "Generate Makefile for current project or directory."
15859      ;; scan hierarchy if required
15860      (if (vhdl-project-p)
15861          (unless (or (assoc vhdl-project vhdl-file-alist)
15862                      (vhdl-load-cache vhdl-project))
15863            (vhdl-scan-project-contents vhdl-project))
15864        (let ((directory (abbreviate-file-name default-directory)))
15865          (unless (or (assoc directory vhdl-file-alist)
15866                      (vhdl-load-cache directory))
15867            (vhdl-scan-directory-contents directory))))
15868      (let* ((directory (abbreviate-file-name (vhdl-default-directory)))
15869             (project (vhdl-project-p))
15870             (ent-alist (aget vhdl-entity-alist (or project directory) t))
15871             (conf-alist (aget vhdl-config-alist (or project directory) t))
15872             (pack-alist (aget vhdl-package-alist (or project directory) t))
15873             (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler)))
15874             (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list)))
15875             (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list)))
15876             (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list)))
15877             (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list)))
15878             (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list)))
15879             (adjust-case (nth 5 regexp-list))
15880             (work-library (downcase (vhdl-work-library)))
15881             (compile-directory (expand-file-name (vhdl-compile-directory)
15882                                                  default-directory))
15883             (makefile-name (vhdl-makefile-name))
15884             rule-alist arch-alist inst-alist
15885             target-list depend-list unit-list prim-list second-list subcomp-list
15886             lib-alist lib-body-alist pack-list all-pack-list
15887             ent-key ent-file-name arch-key arch-file-name ent-arch-key
15888             conf-key conf-file-name pack-key pack-file-name
15889             ent-entry arch-entry conf-entry pack-entry inst-entry
15890             pack-body-key pack-body-file-name inst-ent-key inst-conf-key
15891             tmp-key tmp-list rule)
15892        ;; check prerequisites
15893        (unless (file-exists-p compile-directory)
15894          (make-directory compile-directory t))
15895        (unless regexp-list
15896          (error "Please contact the VHDL Mode maintainer for support of \"%s\""
15897                 vhdl-compiler))
15898        (message "Generating makefile \"%s\"..." makefile-name)
15899        ;; rules for all entities
15900        (setq tmp-list ent-alist)
15901        (while ent-alist
15902          (setq ent-entry (car ent-alist)
15903                ent-key (nth 0 ent-entry))
15904          (when (nth 2 ent-entry)
15905            (setq ent-file-name (file-relative-name
15906                                 (nth 2 ent-entry) compile-directory)
15907                  arch-alist (nth 4 ent-entry)
15908                  lib-alist (nth 5 ent-entry)
15909                  rule (aget rule-alist ent-file-name)
15910                  target-list (nth 0 rule)
15911                  depend-list (nth 1 rule)
15912                  second-list nil
15913                  subcomp-list nil)
15914            (setq tmp-key (vhdl-replace-string
15915                           ent-regexp (funcall adjust-case ent-key)))
15916            (setq unit-list (cons (cons ent-key tmp-key) unit-list))
15917            ;; rule target for this entity
15918            (setq target-list (cons ent-key target-list))
15919            ;; rule dependencies for all used packages
15920            (setq pack-list (vhdl-get-packages lib-alist work-library))
15921            (setq depend-list (append depend-list pack-list))
15922            (setq all-pack-list pack-list)
15923            ;; add rule
15924            (aput 'rule-alist ent-file-name (list target-list depend-list))
15925            ;; rules for all corresponding architectures
15926            (while arch-alist
15927              (setq arch-entry (car arch-alist)
15928                    arch-key (nth 0 arch-entry)
15929                    ent-arch-key (concat ent-key "-" arch-key)
15930                    arch-file-name (file-relative-name (nth 2 arch-entry)
15931                                                       compile-directory)
15932                    inst-alist (nth 4 arch-entry)
15933                    lib-alist (nth 5 arch-entry)
15934                    rule (aget rule-alist arch-file-name)
15935                    target-list (nth 0 rule)
15936                    depend-list (nth 1 rule))
15937              (setq tmp-key (vhdl-replace-string
15938                             arch-regexp
15939                             (funcall adjust-case (concat arch-key " " ent-key))))
15940              (setq unit-list
15941                    (cons (cons ent-arch-key tmp-key) unit-list))
15942              (setq second-list (cons ent-arch-key second-list))
15943              ;; rule target for this architecture
15944              (setq target-list (cons ent-arch-key target-list))
15945              ;; rule dependency for corresponding entity
15946              (setq depend-list (cons ent-key depend-list))
15947              ;; rule dependencies for contained component instantiations
15948              (while inst-alist
15949                (setq inst-entry (car inst-alist))
15950                (when (or (null (nth 8 inst-entry))
15951                          (equal (downcase (nth 8 inst-entry)) work-library))
15952                  (setq inst-ent-key (or (nth 7 inst-entry)
15953                                         (nth 5 inst-entry)))
15954                  (setq depend-list (cons inst-ent-key depend-list)
15955                        subcomp-list (cons inst-ent-key subcomp-list)))
15956                (setq inst-alist (cdr inst-alist)))
15957              ;; rule dependencies for all used packages
15958              (setq pack-list (vhdl-get-packages lib-alist work-library))
15959              (setq depend-list (append depend-list pack-list))
15960              (setq all-pack-list (append all-pack-list pack-list))
15961              ;; add rule
15962              (aput 'rule-alist arch-file-name (list target-list depend-list))
15963              (setq arch-alist (cdr arch-alist)))
15964            (setq prim-list (cons (list ent-key second-list
15965                                        (append subcomp-list all-pack-list))
15966                                  prim-list)))
15967          (setq ent-alist (cdr ent-alist)))
15968        (setq ent-alist tmp-list)
15969        ;; rules for all configurations
15970        (setq tmp-list conf-alist)
15971        (while conf-alist
15972          (setq conf-entry (car conf-alist)
15973                conf-key (nth 0 conf-entry)
15974                conf-file-name (file-relative-name
15975                                (nth 2 conf-entry) compile-directory)
15976                ent-key (nth 4 conf-entry)
15977                arch-key (nth 5 conf-entry)
15978                inst-alist (nth 6 conf-entry)
15979                lib-alist (nth 7 conf-entry)
15980                rule (aget rule-alist conf-file-name)
15981                target-list (nth 0 rule)
15982                depend-list (nth 1 rule)
15983                subcomp-list (list ent-key))
15984          (setq tmp-key (vhdl-replace-string
15985                         conf-regexp (funcall adjust-case conf-key)))
15986          (setq unit-list (cons (cons conf-key tmp-key) unit-list))
15987          ;; rule target for this configuration
15988          (setq target-list (cons conf-key target-list))
15989          ;; rule dependency for corresponding entity and architecture
15990          (setq depend-list
15991                (cons ent-key (cons (concat ent-key "-" arch-key) depend-list)))
15992          ;; rule dependencies for used packages
15993          (setq pack-list (vhdl-get-packages lib-alist work-library))
15994          (setq depend-list (append depend-list pack-list))
15995          ;; rule dependencies for contained component configurations
15996          (while inst-alist
15997            (setq inst-entry (car inst-alist))
15998            (setq inst-ent-key (nth 2 inst-entry)
15999    ;              comp-arch-key (nth 2 inst-entry))
16000                  inst-conf-key (nth 4 inst-entry))
16001            (when (equal (downcase (nth 5 inst-entry)) work-library)
16002              (when inst-ent-key
16003                (setq depend-list (cons inst-ent-key depend-list)
16004                      subcomp-list (cons inst-ent-key subcomp-list)))
16005    ;           (when comp-arch-key
16006    ;             (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key)
16007    ;                                     depend-list)))
16008              (when inst-conf-key
16009                (setq depend-list (cons inst-conf-key depend-list)
16010                      subcomp-list (cons inst-conf-key subcomp-list))))
16011            (setq inst-alist (cdr inst-alist)))
16012          ;; add rule
16013          (aput 'rule-alist conf-file-name (list target-list depend-list))
16014          (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list))
16015                                prim-list))
16016          (setq conf-alist (cdr conf-alist)))
16017        (setq conf-alist tmp-list)
16018        ;; rules for all packages
16019        (setq tmp-list pack-alist)
16020        (while pack-alist
16021          (setq pack-entry (car pack-alist)
16022                pack-key (nth 0 pack-entry)
16023                pack-body-key nil)
16024          (when (nth 2 pack-entry)
16025            (setq pack-file-name (file-relative-name (nth 2 pack-entry)
16026                                                     compile-directory)
16027                  lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry)
16028                  rule (aget rule-alist pack-file-name)
16029                  target-list (nth 0 rule) depend-list (nth 1 rule))
16030            (setq tmp-key (vhdl-replace-string
16031                           pack-regexp (funcall adjust-case pack-key)))
16032            (setq unit-list (cons (cons pack-key tmp-key) unit-list))
16033            ;; rule target for this package
16034            (setq target-list (cons pack-key target-list))
16035            ;; rule dependencies for all used packages
16036            (setq pack-list (vhdl-get-packages lib-alist work-library))
16037            (setq depend-list (append depend-list pack-list))
16038            (setq all-pack-list pack-list)
16039            ;; add rule
16040            (aput 'rule-alist pack-file-name (list target-list depend-list))
16041            ;; rules for this package's body
16042            (when (nth 7 pack-entry)
16043              (setq pack-body-key (concat pack-key "-body")
16044                    pack-body-file-name (file-relative-name (nth 7 pack-entry)
16045                                                            compile-directory)
16046                    rule (aget rule-alist pack-body-file-name)
16047                    target-list (nth 0 rule)
16048                    depend-list (nth 1 rule))
16049              (setq tmp-key (vhdl-replace-string
16050                             pack-body-regexp (funcall adjust-case pack-key)))
16051              (setq unit-list
16052                    (cons (cons pack-body-key tmp-key) unit-list))
16053              ;; rule target for this package's body
16054              (setq target-list (cons pack-body-key target-list))
16055              ;; rule dependency for corresponding package declaration
16056              (setq depend-list (cons pack-key depend-list))
16057              ;; rule dependencies for all used packages
16058              (setq pack-list (vhdl-get-packages lib-body-alist work-library))
16059              (setq depend-list (append depend-list pack-list))
16060              (setq all-pack-list (append all-pack-list pack-list))
16061              ;; add rule
16062              (aput 'rule-alist pack-body-file-name
16063                    (list target-list depend-list)))
16064            (setq prim-list
16065                  (cons (list pack-key (when pack-body-key (list pack-body-key))
16066                              all-pack-list)
16067                        prim-list)))
16068          (setq pack-alist (cdr pack-alist)))
16069        (setq pack-alist tmp-list)
16070        ;; generate Makefile
16071        (let* ((project (aget vhdl-project-alist project))
16072               (compiler (aget vhdl-compiler-alist vhdl-compiler))
16073               (compiler-id (nth 9 compiler))
16074               (library-directory
16075                (vhdl-resolve-env-variable
16076                 (vhdl-replace-string
16077                  (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler)))
16078                  compiler-id)))
16079               (makefile-path-name (expand-file-name
16080                                    makefile-name compile-directory))
16081               (orig-buffer (current-buffer))
16082               cell second-list subcomp-list options unit-key unit-name)
16083          ;; sort lists
16084          (setq unit-list (vhdl-sort-alist unit-list))
16085          (setq prim-list (vhdl-sort-alist prim-list))
16086          (setq tmp-list rule-alist)
16087          (while tmp-list                   ; pre-sort rule targets
16088            (setq cell (cdar tmp-list))
16089            (setcar cell (sort (car cell) 'string<))
16090            (setq tmp-list (cdr tmp-list)))
16091          (setq rule-alist                  ; sort by first rule target
16092                (sort rule-alist
16093                      (function (lambda (a b)
16094                                  (string< (car (cadr a)) (car (cadr b)))))))
16095          ;; open and clear Makefile
16096          (set-buffer (find-file-noselect makefile-path-name t t))
16097          (erase-buffer)
16098          (insert "# -*- Makefile -*-\n"
16099                  "### " (file-name-nondirectory makefile-name)
16100                  " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version
16101                  "\n")
16102          (if project
16103              (insert "\n# Project   : " (nth 0 project))
16104            (insert "\n# Directory : \"" directory "\""))
16105          (insert "\n# Platform  : " vhdl-compiler
16106                  "\n# Generated : " (format-time-string "%Y-%m-%d %T ")
16107                  (user-login-name) "\n")
16108          ;; insert compile and option variable settings
16109          (insert "\n\n# Define compilation command and options\n"
16110                  "\nCOMPILE = " (nth 0 compiler)
16111                  "\nOPTIONS = " (vhdl-get-compile-options project compiler nil)
16112                  "\n")
16113          ;; insert library paths
16114          (setq library-directory
16115                (directory-file-name
16116                 (if (file-name-absolute-p library-directory)
16117                     library-directory
16118                   (file-relative-name
16119                    (expand-file-name library-directory directory)
16120                    compile-directory))))
16121          (insert "\n\n# Define library paths\n"
16122                  "\nLIBRARY-" work-library " = " library-directory "\n")
16123          ;; insert variable definitions for all library unit files
16124          (insert "\n\n# Define library unit files\n")
16125          (setq tmp-list unit-list)
16126          (while unit-list
16127            (insert "\nUNIT-" work-library "-" (caar unit-list)
16128                    " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list))
16129            (setq unit-list (cdr unit-list)))
16130          ;; insert variable definition for list of all library unit files
16131          (insert "\n\n\n# Define list of all library unit files\n"
16132                  "\nALL_UNITS =")
16133          (setq unit-list tmp-list)
16134          (while unit-list
16135            (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")")
16136            (setq unit-list (cdr unit-list)))
16137          (insert "\n")
16138          (setq unit-list tmp-list)
16139          ;; insert `make all' rule
16140          (insert "\n\n\n# Rule for compiling entire design\n"
16141                  "\nall :"
16142                  " \\\n\t\tlibrary"
16143                  " \\\n\t\t$(ALL_UNITS)\n")
16144          ;; insert `make clean' rule
16145          (insert "\n\n# Rule for cleaning entire design\n"
16146                  "\nclean : "
16147                  "\n\t-rm -f $(ALL_UNITS)\n")
16148          ;; insert `make library' rule
16149          (insert "\n\n# Rule for creating library directory\n"
16150                  "\nlibrary :"
16151                  " \\\n\t\t$(LIBRARY-" work-library ")\n"
16152                  "\n$(LIBRARY-" work-library ") :"
16153                  "\n\t"
16154                  (vhdl-replace-string
16155                   (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler))
16156                   (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library)))
16157                  "\n")
16158          ;; insert rule for each library unit
16159          (insert "\n\n# Rules for compiling single library units and their subhierarchy\n")
16160          (while prim-list
16161            (setq second-list (sort (nth 1 (car prim-list)) 'string<))
16162            (setq subcomp-list
16163                  (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<))
16164            (setq unit-key (caar prim-list)
16165                  unit-name (or (nth 0 (aget ent-alist unit-key t))
16166                                (nth 0 (aget conf-alist unit-key t))
16167                                (nth 0 (aget pack-alist unit-key t))))
16168            (insert "\n" unit-key)
16169            (unless (equal unit-key unit-name)
16170              (insert " \\\n" unit-name))
16171            (insert " :"
16172                    " \\\n\t\tlibrary"
16173                    " \\\n\t\t$(UNIT-" work-library "-" unit-key ")")
16174            (while second-list
16175              (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")")
16176              (setq second-list (cdr second-list)))
16177            (while subcomp-list
16178              (when (assoc (car subcomp-list) unit-list)
16179                (insert " \\\n\t\t" (car subcomp-list)))
16180              (setq subcomp-list (cdr subcomp-list)))
16181            (insert "\n")
16182            (setq prim-list (cdr prim-list)))
16183          ;; insert rule for each library unit file
16184          (insert "\n\n# Rules for compiling single library unit files\n")
16185          (while rule-alist
16186            (setq rule (car rule-alist))
16187            ;; get compiler options for this file
16188            (setq options
16189                  (vhdl-get-compile-options project compiler (nth 0 rule) t))
16190            ;; insert rule if file is supposed to be compiled
16191            (setq target-list (nth 1 rule)
16192                  depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<))
16193            ;; insert targets
16194            (setq tmp-list target-list)
16195            (while target-list
16196              (insert "\n$(UNIT-" work-library "-" (car target-list) ")"
16197                      (if (cdr target-list) " \\" " :"))
16198              (setq target-list (cdr target-list)))
16199            (setq target-list tmp-list)
16200            ;; insert file name as first dependency
16201            (insert " \\\n\t\t" (nth 0 rule))
16202            ;; insert dependencies (except if also target or unit does not exist)
16203            (while depend-list
16204              (when (and (not (member (car depend-list) target-list))
16205                         (assoc (car depend-list) unit-list))
16206                (insert " \\\n\t\t"
16207                        "$(UNIT-" work-library "-" (car depend-list) ")"))
16208              (setq depend-list (cdr depend-list)))
16209            ;; insert compile command
16210            (if options
16211                (insert "\n\t$(COMPILE) "
16212                        (if (eq options 'default) "$(OPTIONS)" options) " "
16213                        (nth 0 rule) "\n")
16214              (setq tmp-list target-list)
16215              (while target-list
16216                (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")"
16217                        (if (cdr target-list) " \\" "\n"))
16218                (setq target-list (cdr target-list)))
16219              (setq target-list tmp-list))
16220            (setq rule-alist (cdr rule-alist)))
16221          (insert "\n\n### " makefile-name " ends here\n")
16222          ;; run Makefile generation hook
16223          (run-hooks 'vhdl-makefile-generation-hook)
16224          (message "Generating makefile \"%s\"...done" makefile-name)
16225          ;; save and close file
16226          (if (file-writable-p makefile-path-name)
16227              (progn (save-buffer)
16228                     (kill-buffer (current-buffer))
16229                     (set-buffer orig-buffer)
16230                     (setq file-name-history
16231                           (cons makefile-path-name file-name-history)))
16232            (vhdl-warning-when-idle
16233             (format "File not writable: \"%s\""
16234                     (abbreviate-file-name makefile-path-name)))
16235            (switch-to-buffer (current-buffer))))))
16236    
16237    
16238  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16239  ;;; Bug reports  ;;; Bug reports
16240  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16241  ;; (using `reporter.el')  ;; (using `reporter.el')
16242    
16243  (defconst vhdl-mode-help-address "vhdl-mode@geocities.com"  (defconst vhdl-mode-help-address
16244      "Reto Zimmermann <reto@gnu.org>"
16245    "Address for VHDL Mode bug reports.")    "Address for VHDL Mode bug reports.")
16246    
16247    (defun vhdl-submit-bug-report ()
16248      "Submit via mail a bug report on VHDL Mode."
16249      (interactive)
16250      ;; load in reporter
16251      (and
16252       (y-or-n-p "Do you want to submit a report on VHDL Mode? ")
16253       (let ((reporter-prompt-for-summary-p t))
16254         (reporter-submit-bug-report
16255          vhdl-mode-help-address
16256          (concat "VHDL Mode " vhdl-version)
16257          (list
16258           ;; report all important user options
16259           'vhdl-offsets-alist
16260           'vhdl-comment-only-line-offset
16261           'tab-width
16262           'vhdl-electric-mode
16263           'vhdl-stutter-mode
16264           'vhdl-indent-tabs-mode
16265           'vhdl-project-alist
16266           'vhdl-project
16267           'vhdl-project-file-name
16268           'vhdl-project-auto-load
16269           'vhdl-project-sort
16270           'vhdl-compiler-alist
16271           'vhdl-compiler
16272           'vhdl-compile-use-local-error-regexp
16273           'vhdl-makefile-generation-hook
16274           'vhdl-default-library
16275           'vhdl-standard
16276           'vhdl-basic-offset
16277           'vhdl-upper-case-keywords
16278           'vhdl-upper-case-types
16279           'vhdl-upper-case-attributes
16280           'vhdl-upper-case-enum-values
16281           'vhdl-upper-case-constants
16282           'vhdl-use-direct-instantiation
16283           'vhdl-entity-file-name
16284           'vhdl-architecture-file-name
16285           'vhdl-package-file-name
16286           'vhdl-file-name-case
16287           'vhdl-electric-keywords
16288           'vhdl-optional-labels
16289           'vhdl-insert-empty-lines
16290           'vhdl-argument-list-indent
16291           'vhdl-association-list-with-formals
16292           'vhdl-conditions-in-parenthesis
16293           'vhdl-zero-string
16294           'vhdl-one-string
16295           'vhdl-file-header
16296           'vhdl-file-footer
16297           'vhdl-company-name
16298           'vhdl-copyright-string
16299           'vhdl-platform-spec
16300           'vhdl-date-format
16301           'vhdl-modify-date-prefix-string
16302           'vhdl-modify-date-on-saving
16303           'vhdl-reset-kind
16304           'vhdl-reset-active-high
16305           'vhdl-clock-rising-edge
16306           'vhdl-clock-edge-condition
16307           'vhdl-clock-name
16308           'vhdl-reset-name
16309           'vhdl-model-alist
16310           'vhdl-include-port-comments
16311           'vhdl-include-direction-comments
16312           'vhdl-include-type-comments
16313           'vhdl-include-group-comments
16314           'vhdl-actual-port-name
16315           'vhdl-instance-name
16316           'vhdl-testbench-entity-name
16317           'vhdl-testbench-architecture-name
16318           'vhdl-testbench-configuration-name
16319           'vhdl-testbench-dut-name
16320           'vhdl-testbench-include-header
16321           'vhdl-testbench-declarations
16322           'vhdl-testbench-statements
16323           'vhdl-testbench-initialize-signals
16324           'vhdl-testbench-include-library
16325           'vhdl-testbench-include-configuration
16326           'vhdl-testbench-create-files
16327           'vhdl-compose-create-files
16328           'vhdl-compose-include-header
16329           'vhdl-compose-architecture-name
16330           'vhdl-components-package-name
16331           'vhdl-use-components-package
16332           'vhdl-self-insert-comments
16333           'vhdl-prompt-for-comments
16334           'vhdl-inline-comment-column
16335           'vhdl-end-comment-column
16336           'vhdl-auto-align
16337           'vhdl-align-groups
16338           'vhdl-align-group-separate
16339           'vhdl-align-same-indent
16340           'vhdl-highlight-keywords
16341           'vhdl-highlight-names
16342           'vhdl-highlight-special-words
16343           'vhdl-highlight-forbidden-words
16344           'vhdl-highlight-verilog-keywords
16345           'vhdl-highlight-translate-off
16346           'vhdl-highlight-case-sensitive
16347           'vhdl-special-syntax-alist
16348           'vhdl-forbidden-words
16349           'vhdl-forbidden-syntax
16350           'vhdl-directive-keywords
16351           'vhdl-speedbar-auto-open
16352           'vhdl-speedbar-display-mode
16353           'vhdl-speedbar-scan-limit
16354           'vhdl-speedbar-jump-to-unit
16355           'vhdl-speedbar-update-on-saving
16356           'vhdl-speedbar-save-cache
16357           'vhdl-speedbar-cache-file-name
16358           'vhdl-index-menu
16359           'vhdl-source-file-menu
16360           'vhdl-hideshow-menu
16361           'vhdl-hide-all-init
16362           'vhdl-print-two-column
16363           'vhdl-print-customize-faces
16364           'vhdl-intelligent-tab
16365           'vhdl-indent-syntax-based
16366           'vhdl-word-completion-case-sensitive
16367           'vhdl-word-completion-in-minibuffer
16368           'vhdl-underscore-is-part-of-word
16369           'vhdl-mode-hook)
16370          (function
16371           (lambda ()
16372             (insert
16373              (if vhdl-special-indent-hook
16374                  (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"
16375                          "vhdl-special-indent-hook is set to '"
16376                          (format "%s" vhdl-special-indent-hook)
16377                          ".\nPerhaps this is your problem?\n"
16378                          "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")
16379                "\n"))))
16380          nil
16381          "Hi Reto,"))))
16382    
16383    
16384    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16385    ;;; Documentation
16386    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
16387    
16388    (defconst vhdl-doc-release-notes nil
16389      "\
16390    Release Notes for VHDL Mode 3.32
16391    ================================
16392    
16393      - New Features
16394      - Enhanced Features
16395      - User Options
16396      - Remarks
16397    
16398    
16399    New Features
16400    ------------
16401    
16402    STRUCTURAL COMPOSITION:
16403      - Enables simple structural composition similar to graphical editors.
16404        Simplifies the creation of higher design levels where subcomponents
16405        are simply sticked together:
16406          1. Create a skeleton for a new component
16407          2. Place subcomponents in it directly from the hierarchy browser
16408          3. Automatically connect all subcomponents and create the ports
16409             for the new component (based on names of actual ports)
16410      - Automatic generation of a components package (package containing
16411        component declarations for all entities).
16412      - Find more information in the online documentation (`C-c C-h').
16413    
16414    PORT TRANSLATION:
16415      - Reverse direction of ports (useful for testbenches).
16416    
16417    SUBPROGRAM TRANSLATION:
16418      - Copy/paste of subprogram interfaces (similar to port translation).
16419    
16420    CODE FILLING:
16421      - Condense code using code-sensitive block filling.
16422    
16423    CODE STATISTICS:
16424      - Calculate number of code lines and statements in a buffer.
16425    
16426    
16427    Enhanced Features
16428    -----------------
16429    
16430    TESTBENCH GENERATION:
16431      - Enhanced templates and user option default values.
16432    
16433    Emacs 21 compatibility/enhancements:
16434      - `lazy-lock-mode' is not used anymore (built-in `jit-lock-mode' is faster).
16435    
16436    And many other minor fixes and enhancements.
16437    
16438    
16439    User Options
16440    ------------
16441    
16442    `vhdl-project-file-name': (enhanced)
16443      Include user name in project setup file name.
16444    `vhdl-speedbar-cache-file-name': (enhanced, changed default)
16445      Include user name in cache file name.
16446    `vhdl-default-library': (new)
16447      Default working library if no project is active.
16448    `vhdl-architecture-file-name': (new)
16449      Specify how the architecture file name is obtained.
16450    `vhdl-package-file-name': (new)
16451      Specify how the package file name is obtained.
16452    `vhdl-file-name-case': (new)
16453      Allows to change case when deriving file names.
16454    `vhdl-compose-create-files': (new)
16455      Specify whether new files should be created for a new component.
16456    `vhdl-compose-include-header': (new)
16457      Specify whether a header is included in a new component's file.
16458    `vhdl-compose-architecture-name': (new)
16459      Specify how a new component's architecture name is obtained.
16460    `vhdl-components-package-name': (new)
16461      Specify how the name for the components package is obtained.
16462    `vhdl-use-components-package': (new)
16463      Specify whether component declarations go in a components package.
16464    `vhdl-use-direct-instantiation': (new)
16465      Specify whether to use VHDL'93 direct component instantiation.
16466    `vhdl-instance-name': (changed default)
16467      Allows insertion of a running number to generate unique instance names.
16468    `vhdl-testbench-entity-header', `vhdl-testbench-architecture-header':(obsolete)
16469      Headers are now automatically derived from the standard header.
16470    `vhdl-testbench-include-header': (new)
16471      Specify whether a header is included in testbench files.
16472    `vhdl-testbench-declaration', `vhdl-testbench-statements': (changed default)
16473      Non-empty default values for more complete testbench templates.
16474    
16475    
16476    Remarks
16477    -------
16478    
16479    - Changed key binding for `vhdl-comment-uncomment-region': `C-c c'
16480      (`C-c C-c ...' is now used for structural composition).
16481    
16482    - Automatic buffer highlighting (font-lock) is now controlled by option
16483      `global-font-lock-mode' in GNU Emacs (`font-lock-auto-fontify' in XEmacs).
16484      \(Important: You MUST customize this option in order to turn automatic
16485       buffer highlighting on.)
16486    ")
16487    
16488    
16489    (defconst vhdl-doc-keywords nil
16490      "\
16491    Reserved words in VHDL
16492    ----------------------
16493    
16494    VHDL'93 (IEEE Std 1076-1993):
16495      `vhdl-93-keywords'      : keywords
16496      `vhdl-93-types'         : standardized types
16497      `vhdl-93-attributes'    : standardized attributes
16498      `vhdl-93-enum-values'   : standardized enumeration values
16499      `vhdl-93-functions'     : standardized functions
16500      `vhdl-93-packages'      : standardized packages and libraries
16501    
16502    VHDL-AMS (IEEE Std 1076.1):
16503      `vhdl-ams-keywords'     : keywords
16504      `vhdl-ams-types'        : standardized types
16505      `vhdl-ams-attributes'   : standardized attributes
16506      `vhdl-ams-enum-values'  : standardized enumeration values
16507      `vhdl-ams-functions'    : standardized functions
16508    
16509    Math Packages (IEEE Std 1076.2):
16510      `vhdl-math-types'       : standardized types
16511      `vhdl-math-constants'   : standardized constants
16512      `vhdl-math-functions'   : standardized functions
16513      `vhdl-math-packages'    : standardized packages
16514    
16515    Forbidden words:
16516      `vhdl-verilog-keywords' : Verilog reserved words
16517    
16518    NOTE: click `mouse-2' on variable names above (not in XEmacs).")
16519    
16520    
16521    (defconst vhdl-doc-coding-style nil
16522      "\
16523    For VHDL coding style and naming convention guidelines, see the following
16524    references:
16525    
16526    \[1] Ben Cohen.
16527        \"VHDL Coding Styles and Methodologies\".
16528        Kluwer Academic Publishers, 1999.
16529        http://members.aol.com/vhdlcohen/vhdl/
16530    
16531    \[2] Michael Keating and Pierre Bricaud.
16532        \"Reuse Methodology Manual, Second Edition\".
16533        Kluwer Academic Publishers, 1999.
16534        http://www.openmore.com/openmore/rmm2.html
16535    
16536    \[3] European Space Agency.
16537        \"VHDL Modelling Guidelines\".
16538        ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps}
16539    
16540    Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist'
16541    to visually support naming conventions.")
16542    
16543    
16544  (defun vhdl-version ()  (defun vhdl-version ()
16545    "Echo the current version of VHDL Mode in the minibuffer."    "Echo the current version of VHDL Mode in the minibuffer."
16546    (interactive)    (interactive)
16547    (message "Using VHDL Mode version %s" vhdl-version)    (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp)
16548    (vhdl-keep-region-active))    (vhdl-keep-region-active))
16549    
16550  ;; get reporter-submit-bug-report when byte-compiling  (defun vhdl-doc-variable (variable)
16551  (eval-when-compile    "Display VARIABLE's documentation in *Help* buffer."
16552    (require 'reporter))    (interactive)
16553      (with-output-to-temp-buffer "*Help*"
16554        (princ (documentation-property variable 'variable-documentation))
16555        (unless vhdl-xemacs
16556          (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
16557        (save-excursion
16558          (set-buffer standard-output)
16559          (help-mode))
16560        (print-help-return-message)))
16561    
16562  (defun vhdl-submit-bug-report ()  (defun vhdl-doc-mode ()
16563    "Submit via mail a bug report on VHDL Mode."    "Display VHDL Mode documentation in *Help* buffer."
16564    (interactive)    (interactive)
16565    ;; load in reporter    (with-output-to-temp-buffer "*Help*"
16566    (and      (princ mode-name)
16567     (y-or-n-p "Do you want to submit a report on VHDL Mode? ")      (princ " mode:\n")
16568     (require 'reporter)      (princ (documentation 'vhdl-mode))
16569     (reporter-submit-bug-report      (unless vhdl-xemacs
16570      vhdl-mode-help-address        (help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
16571      (concat "VHDL Mode " vhdl-version)      (save-excursion
16572      (list        (set-buffer standard-output)
16573       ;; report all important variables        (help-mode))
16574       'vhdl-offsets-alist      (print-help-return-message)))
      'vhdl-comment-only-line-offset  
      'tab-width  
      'vhdl-electric-mode  
      'vhdl-stutter-mode  
      'vhdl-indent-tabs-mode  
      'vhdl-project-alist  
      'vhdl-project  
      'vhdl-compiler-alist  
      'vhdl-compiler  
      'vhdl-compiler-options  
      'vhdl-standard  
      'vhdl-basic-offset  
      'vhdl-upper-case-keywords  
      'vhdl-upper-case-types  
      'vhdl-upper-case-attributes  
      'vhdl-upper-case-enum-values  
      'vhdl-upper-case-constants  
      'vhdl-electric-keywords  
      'vhdl-optional-labels  
      'vhdl-insert-empty-lines  
      'vhdl-argument-list-indent  
      'vhdl-association-list-with-formals  
      'vhdl-conditions-in-parenthesis  
      'vhdl-zero-string  
      'vhdl-one-string  
      'vhdl-file-header  
      'vhdl-file-footer  
      'vhdl-company-name  
      'vhdl-platform-spec  
      'vhdl-date-format  
      'vhdl-modify-date-prefix-string  
      'vhdl-modify-date-on-saving  
      'vhdl-reset-kind  
      'vhdl-reset-active-high  
      'vhdl-clock-rising-edge  
      'vhdl-clock-edge-condition  
      'vhdl-clock-name  
      'vhdl-reset-name  
      'vhdl-model-alist  
      'vhdl-include-port-comments  
      'vhdl-include-direction-comments  
      'vhdl-actual-port-name  
      'vhdl-instance-name  
      'vhdl-testbench-entity-name  
      'vhdl-testbench-architecture-name  
      'vhdl-testbench-dut-name  
      'vhdl-testbench-entity-header  
      'vhdl-testbench-architecture-header  
      'vhdl-testbench-declarations  
      'vhdl-testbench-statements  
      'vhdl-testbench-initialize-signals  
      'vhdl-testbench-create-files  
      'vhdl-self-insert-comments  
      'vhdl-prompt-for-comments  
      'vhdl-inline-comment-column  
      'vhdl-end-comment-column  
      'vhdl-auto-align  
      'vhdl-align-groups  
      'vhdl-highlight-keywords  
      'vhdl-highlight-names  
      'vhdl-highlight-special-words  
      'vhdl-highlight-forbidden-words  
      'vhdl-highlight-verilog-keywords  
      'vhdl-highlight-translate-off  
      'vhdl-highlight-case-sensitive  
      'vhdl-special-syntax-alist  
      'vhdl-forbidden-words  
      'vhdl-forbidden-syntax  
      'vhdl-speedbar  
      'vhdl-speedbar-show-hierarchy  
      'vhdl-speedbar-hierarchy-indent  
      'vhdl-index-menu  
      'vhdl-source-file-menu  
      'vhdl-hideshow-menu  
      'vhdl-hide-all-init  
      'vhdl-print-two-column  
      'vhdl-print-customize-faces  
      'vhdl-intelligent-tab  
      'vhdl-word-completion-case-sensitive  
      'vhdl-word-completion-in-minibuffer  
      'vhdl-underscore-is-part-of-word  
      'vhdl-mode-hook  
      'vhdl-startup-warnings)  
     (function  
      (lambda ()  
        (insert  
         (if vhdl-special-indent-hook  
             (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"  
                     "vhdl-special-indent-hook is set to '"  
                     (format "%s" vhdl-special-indent-hook)  
                     ".\nPerhaps this is your problem?\n"  
                     "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n")  
           "\n"))))  
     nil  
     "Dear VHDL Mode maintainers,")))  
16575    
16576    
16577  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Legend:
Removed from v.1.15  
changed lines
  Added in v.1.15.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26