1;;; vhdl-mode.el --- major mode for editing VHDL code 2 3;; Copyright (C) 1992-2021 Free Software Foundation, Inc. 4 5;; Authors: Reto Zimmermann <reto@gnu.org> 6;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net> 7;; Maintainer: Reto Zimmermann <reto@gnu.org> 8;; Keywords: languages vhdl 9;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html 10 11;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this 12;; file on 18/3/2008, and the maintainer agreed that when a bug is 13;; filed in the Emacs bug reporting system against this file, a copy 14;; of the bug report be sent to the maintainer's email address. 15 16(defconst vhdl-version "3.38.1" 17 "VHDL Mode version number.") 18 19(defconst vhdl-time-stamp "2015-03-12" 20 "VHDL Mode time stamp for last update.") 21 22;; This file is part of GNU Emacs. 23 24;; GNU Emacs is free software: you can redistribute it and/or modify 25;; it under the terms of the GNU General Public License as published by 26;; the Free Software Foundation, either version 3 of the License, or 27;; (at your option) any later version. 28 29;; GNU Emacs is distributed in the hope that it will be useful, 30;; but WITHOUT ANY WARRANTY; without even the implied warranty of 31;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 32;; GNU General Public License for more details. 33 34;; You should have received a copy of the GNU General Public License 35;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 36 37;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 38;;; Commentary: 39;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 40 41;; This package provides an Emacs major mode for editing VHDL code. 42;; It includes the following features: 43 44;; - Syntax highlighting 45;; - Indentation 46;; - Template insertion (electrification) 47;; - Insertion of file headers 48;; - Insertion of user-specified models 49;; - Port translation / testbench generation 50;; - Structural composition 51;; - Configuration generation 52;; - Sensitivity list updating 53;; - File browser 54;; - Design hierarchy browser 55;; - Source file compilation (syntax analysis) 56;; - Makefile generation 57;; - Code hiding 58;; - Word/keyword completion 59;; - Block commenting 60;; - Code fixing/alignment/beautification 61;; - PostScript printing 62;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported 63;; - Comprehensive menu 64;; - Fully customizable 65;; - Works under GNU Emacs (recommended) and XEmacs 66 67;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 68;; Documentation 69 70;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs. 71 72;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 73;; Emacs Versions 74 75;; this updated version was only tested on: GNU Emacs 24.1 76 77;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 78;; Installation 79 80;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. 81 82;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation 83;; or into an arbitrary directory that is added to the load path by the 84;; following line in your Emacs start-up file `.emacs': 85 86;; (push (expand-file-name "<directory-name>") load-path) 87 88;; If you already have the compiled `vhdl-mode.elc' file, put it in the same 89;; directory. Otherwise, byte-compile the source file: 90;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET 91;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el 92 93;; Add the following lines to the `site-start.el' file in the `site-lisp' 94;; directory of your Emacs installation or to your Emacs start-up file `.emacs' 95;; (not required in Emacs 20 and higher): 96 97;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) 98;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) 99 100;; More detailed installation instructions are included in the official 101;; VHDL Mode distribution. 102 103;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 104;; Acknowledgments 105 106;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> 107;; and Steve Grout. 108 109;; Fontification approach suggested by Ken Wood <ken@eda.com.au>. 110;; Ideas about alignment from John Wiegley <johnw@gnu.org>. 111 112;; Many thanks to all the users who sent me bug reports and enhancement 113;; requests. 114;; Thanks to Colin Marquardt for his serious beta testing, his innumerable 115;; enhancement suggestions and the fruitful discussions. 116;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. 117;; Thanks to Ulf Klaperski for the indentation speedup hint. 118 119;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated 120;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for 121;; giving me the opportunity to develop this code. 122;; This work has been funded in part by MICROSWISS, a Microelectronics Program 123;; of the Swiss Government. 124 125;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 126 127;;; Code: 128 129(eval-when-compile 130 (condition-case nil (require 'cl-lib) (file-missing (require 'cl))) 131 (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew))) 132 133;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' 134;; even for relatively simple cases such as used here. We only test <25 135;; because it's easier and sufficient. 136(when (< emacs-major-version 25) 137 (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) 138 139;; Emacs 21+ handling 140(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) 141 "Non-nil if GNU Emacs 21, 22, ... is used.") 142;; Emacs 22+ handling 143(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) 144 "Non-nil if GNU Emacs 22, ... is used.") 145 146(defvar compilation-file-regexp-alist) 147(defvar conf-alist) 148(defvar conf-entry) 149(defvar conf-key) 150(defvar ent-alist) 151(defvar itimer-version) 152(defvar lazy-lock-defer-contextually) 153(defvar lazy-lock-defer-on-scrolling) 154(defvar lazy-lock-defer-on-the-fly) 155(defvar speedbar-attached-frame) 156 157 158;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 159;;; Variables 160;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 161 162;; help function for user options 163(defun vhdl-custom-set (variable value &rest functions) 164 "Set variables as in `custom-set-default' and call FUNCTIONS afterwards." 165 (if (fboundp 'custom-set-default) 166 (custom-set-default variable value) 167 (set-default variable value)) 168 (while functions 169 (when (fboundp (car functions)) (funcall (car functions))) 170 (setq functions (cdr functions)))) 171 172(defun vhdl-widget-directory-validate (widget) 173 "Check that the value of WIDGET is a valid directory entry (i.e. ends with 174'/' or is empty)." 175 (let ((val (widget-value widget))) 176 (unless (string-match "^\\(\\|.*/\\)$" val) 177 (widget-put widget :error "Invalid directory entry: must end with `/'") 178 widget))) 179 180;; help string for user options 181(defconst vhdl-name-doc-string " 182 183FROM REGEXP is a regular expression matching the original name: 184 \".*\" matches the entire string 185 \"\\(...\\)\" matches a substring 186TO STRING specifies the string to be inserted as new name: 187 \"\\&\" means substitute entire matched text 188 \"\\N\" means substitute what matched the Nth \"\\(...\\)\" 189Examples: 190 \".*\" \"\\&\" inserts original string 191 \".*\" \"\\&_i\" attaches \"_i\" to original string 192 \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string 193 \".*\" \"foo\" inserts constant string \"foo\" 194 \".*\" \"\" inserts empty string") 195 196;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 197;; User variables (customization options) 198 199(defgroup vhdl nil 200 "Customizations for VHDL Mode." 201 :prefix "vhdl-" 202 :group 'languages 203; :version "21.2" ; comment out for XEmacs 204 ) 205 206(defgroup vhdl-mode nil 207 "Customizations for modes." 208 :group 'vhdl) 209 210(defcustom vhdl-indent-tabs-mode nil 211 "Non-nil means indentation can insert tabs. 212Overrides local variable `indent-tabs-mode'." 213 :type 'boolean 214 :group 'vhdl-mode) 215 216 217(defgroup vhdl-compile nil 218 "Customizations for compilation." 219 :group 'vhdl) 220 221(defcustom vhdl-compiler-alist 222 '( 223 ;; 60: docal <= false; 224 ;; ^^^^^ 225 ;; [Error] Assignment error: variable is illegal target of signal assignment 226 ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1" 227 nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms" 228 ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("^Compiling file \\(.+\\)" 1) 229 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" 230 "PACK/\\1.vif" "BODY/\\1.vif" upcase)) 231 ;; Aldec 232 ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 233 ("Aldec" "vcom" "-work \\1" "make" "-f \\1" 234 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" 235 ("^.* ERROR [^:]+: \".*\" \"\\([^ \t\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) 236 nil) 237 ;; Cadence Leapfrog: cv -file test.vhd 238 ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared 239 ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" 240 nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" 241 ("^duluth: \\*E,[0-9]+ (\\([^ \t\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) 242 ("\\1/entity" "\\2/\\1" "\\1/configuration" 243 "\\1/package" "\\1/body" downcase)) 244 ;; Cadence Affirma NC vhdl: ncvhdl test.vhd 245 ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier 246 ;; (PLL_400X_TOP) is not declared [10.3]. 247 ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" 248 nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" 249 ("^ncvhdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) 250 ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" 251 "\\1/package/pc.db" "\\1/body/pc.db" downcase)) 252 ;; ghdl vhdl 253 ;; ghdl -a bad_counter.vhdl 254 ;; bad_counter.vhdl:13:14: operator "=" is overloaded 255 ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" 256 nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" 257 ("^ghdl_p: \\*E,\\w+ (\\([^ \t\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) 258 ("\\1/entity" "\\2/\\1" "\\1/configuration" 259 "\\1/package" "\\1/body" downcase)) 260 ;; IBM Compiler 261 ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6 262 ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1" 263 nil "mkdir \\1" "./" "work/" "Makefile" "ibm" 264 ("^[0-9]+ COACHDL.*: File: \\([^ \t\n]+\\), *line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) 265 nil) 266 ;; Ikos Voyager: analyze test.vhd 267 ;; analyze test.vhd 268 ;; E L4/C5: this library unit is inaccessible 269 ("Ikos" "analyze" "-l \\1" "make" "-f \\1" 270 nil "mkdir \\1" "./" "work/" "Makefile" "ikos" 271 ("^E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) 272 ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) 273 nil) 274 ;; ModelSim, Model Technology: vcom test.vhd 275 ;; ERROR: test.vhd(14): Unknown identifier: positiv 276 ;; WARNING[2]: test.vhd(85): Possible infinite loop 277 ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ... 278 ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb 279 ;; ** Error: counter_rtl.vhd(18): Nonresolved signal 'hallo' has multiple sources. 280 ;; Drivers: 281 ;; counter_rtl.vhd(27):Conditional signal assignment line__27 282 ;; counter_rtl.vhd(29):Conditional signal assignment line__29 283 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" 284 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" 285 ("\\(ERROR:\\|WARNING\\[[0-9]+\\]:\\|\\*\\* Error:\\|\\*\\* Warning: \\[[0-9]+\\]\\| +\\) \\([^ ]+\\)(\\([0-9]+\\)):" 2 3 nil) 286 ("" 0) 287 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" 288 "\\1/_primary.dat" "\\1/body.dat" downcase)) 289 ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd 290 ;; test.vhd:34: error message 291 ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" 292 nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" 293 ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) 294 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" 295 "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) 296 ;; Quartus compiler 297 ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used 298 ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text 299 ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal 300 ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library 301 ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ... 302 ("Quartus" "make" "-work \\1" "make" "-f \\1" 303 nil "mkdir \\1" "./" "work/" "Makefile" "quartus" 304 ("^\\(Error\\|Warning\\): .* \\([^ \t\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) 305 nil) 306 ;; QuickHDL, Mentor Graphics: qvhcom test.vhd 307 ;; ERROR: test.vhd(24): near "dnd": expecting: END 308 ;; WARNING[4]: test.vhd(30): A space is required between ... 309 ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" 310 nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" 311 ("^\\(ERROR\\|WARNING\\)[^:]*: \\([^ \t\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) 312 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" 313 "\\1/_primary.dat" "\\1/body.dat" downcase)) 314 ;; Savant: scram -publish-cc test.vhd 315 ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for 316 ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" 317 nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" 318 ("^\\([^ \t\n:]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) 319 ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" 320 "\\1_config.vhdl" "\\1_package.vhdl" 321 "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) 322 ;; Simili: vhdlp -work test.vhd 323 ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix 324 ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" 325 nil "mkdir \\1" "./" "work/" "Makefile" "simili" 326 ("^\\(Error\\|Warning\\): \\w+: \\([^ \t\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) 327 ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" 328 "\\1/prim.var" "\\1/_body.var" downcase)) 329 ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd 330 ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier 331 ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 332 nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" 333 ("^ *ERROR\\[[0-9]+]::File \\([^ \t\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) 334 nil) 335 ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd 336 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. 337 ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" 338 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" 339 ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) 340 ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) 341 ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd 342 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. 343 ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" 344 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" 345 ("^\\*\\*Error: vhdlan,[0-9]+ \\([^ \t\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) 346 ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) 347 ;; Synplify: 348 ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 349 ("Synplify" "n/a" "n/a" "make" "-f \\1" 350 nil "mkdir \\1" "./" "work/" "Makefile" "synplify" 351 ("^@[EWN]:\"\\([^ \t\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) 352 nil) 353 ;; Vantage: analyze -libfile vsslib.ini -src test.vhd 354 ;; Compiling "test.vhd" line 1... 355 ;; **Error: LINE 49 *** No aggregate value is valid in this context. 356 ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 357 nil "mkdir \\1" "./" "work/" "Makefile" "vantage" 358 ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) 359 ("^ *Compiling \"\\(.+\\)\" " 1) 360 nil) 361 ;; VeriBest: vc vhdl test.vhd 362 ;; (no file name printed out!) 363 ;; 32: Z <= A and BitA ; 364 ;; ^^^^ 365 ;; [Error] Name BITA is unknown 366 ("VeriBest" "vc" "vhdl" "make" "-f \\1" 367 nil "mkdir \\1" "./" "work/" "Makefile" "veribest" 368 ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0) 369 nil) 370 ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd 371 ;; Compiling "test.vhd" line 1... 372 ;; **Error: LINE 49 *** No aggregate value is valid in this context. 373 ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 374 nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" 375 ("^\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) 376 ("^ *Compiling \"\\(.+\\)\" " 1) 377 nil) 378 ;; Xilinx XST: 379 ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error 380 ("Xilinx XST" "xflow" "" "make" "-f \\1" 381 nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" 382 ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \t\n]+\\)\" Line \\([0-9]+\\)\\." 1 2 nil) ("" 0) 383 nil) 384 ) 385 "List of available VHDL compilers and their properties. 386Each list entry specifies the following items for a compiler: 387Compiler: 388 Compiler name : name used in option `vhdl-compiler' to choose compiler 389 Compile command : command used for source file compilation 390 Compile options : compile options (\"\\1\" inserts library name) 391 Make command : command used for compilation using a Makefile 392 Make options : make options (\"\\1\" inserts Makefile name) 393 Generate Makefile: use built-in function or command to generate a Makefile 394 (\"\\1\" inserts Makefile name, \"\\2\" inserts library name) 395 Library command : command to create library directory (\"\\1\" inserts 396 library directory, \"\\2\" inserts library name) 397 Compile directory: where compilation is run and the Makefile is placed 398 Library directory: directory of default library 399 Makefile name : name of Makefile (default is \"Makefile\") 400 ID string : compiler identification string (see `vhdl-project-alist') 401Error message: 402 Regexp : regular expression to match error messages (*) 403 File subexp index: index of subexpression that matches the file name 404 Line subexp index: index of subexpression that matches the line number 405 Column subexp idx: index of subexpression that matches the column number 406File message: 407 Regexp : regular expression to match a file name message 408 File subexp index: index of subexpression that matches the file name 409Unit-to-file name mapping: mapping of library unit names to names of files 410 generated by the compiler (used for Makefile generation) 411 To string : string a name is mapped to (\"\\1\" inserts the unit name, 412 \"\\2\" inserts the entity name for architectures, 413 \"\\3\" inserts the library name) 414 Case adjustment : adjust case of inserted unit names 415 416\(*) The regular expression must match the error message starting from the 417 beginning of the line (but not necessarily to the end of the line). 418 419Compile options allows insertion of the library name (see `vhdl-project-alist') 420in order to set the compilers library option (e.g. \"vcom -work my_lib\"). 421 422For Makefile generation, the built-in function can be used (requires 423specification of the unit-to-file name mapping). Alternatively, an 424external command can be specified. Work directory allows specification of 425an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\", 426used for Makefile generation). To use another library name than \"work\", 427customize `vhdl-project-alist'. The library command is inserted in Makefiles 428to automatically create the library directory if not existent. 429 430Compile options, compile directory, library directory, and Makefile name are 431overwritten by the project settings if a project is defined (see 432`vhdl-project-alist'). Directory paths are relative to the source file 433directory. 434 435Some compilers do not include the file name in the error message, but print 436out a file name message in advance. In this case, set \"File Subexp Index\" 437under \"Error Message\" to 0 and fill out the \"File Message\" entries. 438If no file name at all is printed out, set both \"File Message\" entries to 0 439\(a default file name message will be printed out instead, does not work in 440XEmacs). 441 442A compiler is selected for syntax analysis (`\\[vhdl-compile]') by 443assigning its name to option `vhdl-compiler'. 444 445Please send any missing or erroneous compiler properties to the maintainer for 446updating. 447 448NOTE: Activate new error and file message regexps and reflect the new setting 449 in the choice list of option `vhdl-compiler' by restarting Emacs." 450 :type '(repeat 451 (list :tag "Compiler" :indent 2 452 (string :tag "Compiler name ") 453 (string :tag "Compile command ") 454 (string :tag "Compile options " "-work \\1") 455 (string :tag "Make command " "make") 456 (string :tag "Make options " "-f \\1") 457 (choice :tag "Generate Makefile " 458 (const :tag "Built-in function" nil) 459 (string :tag "Command" "vmake \\2 > \\1")) 460 (string :tag "Library command " "mkdir \\1") 461 (directory :tag "Compile directory " 462 :validate vhdl-widget-directory-validate "./") 463 (directory :tag "Library directory " 464 :validate vhdl-widget-directory-validate "work/") 465 (file :tag "Makefile name " "Makefile") 466 (string :tag "ID string ") 467 (list :tag "Error message" :indent 4 468 (regexp :tag "Regexp ") 469 (choice :tag "File subexp " 470 (integer :tag "Index") 471 (const :tag "No file name" nil)) 472 (integer :tag "Line subexp index") 473 (choice :tag "Column subexp " 474 (integer :tag "Index") 475 (const :tag "No column number" nil))) 476 (list :tag "File message" :indent 4 477 (regexp :tag "Regexp ") 478 (integer :tag "File subexp index")) 479 (choice :tag "Unit-to-file name mapping" 480 :format "%t: %[Value Menu%] %v\n" 481 (const :tag "Not defined" nil) 482 (list :tag "To string" :indent 4 483 (string :tag "Entity " "\\1.vhd") 484 (string :tag "Architecture " "\\2_\\1.vhd") 485 (string :tag "Configuration " "\\1.vhd") 486 (string :tag "Package " "\\1.vhd") 487 (string :tag "Package Body " "\\1_body.vhd") 488 (choice :tag "Case adjustment " 489 (const :tag "None" identity) 490 (const :tag "Upcase" upcase) 491 (const :tag "Downcase" downcase)))))) 492 :set (lambda (variable value) 493 (vhdl-custom-set variable value 'vhdl-update-mode-menu)) 494 :version "24.4" 495 :group 'vhdl-compile) 496 497(defcustom vhdl-compiler "GHDL" 498 "Specifies the VHDL compiler to be used for syntax analysis. 499Select a compiler name from the ones defined in option `vhdl-compiler-alist'." 500 :type (let ((alist vhdl-compiler-alist) list) 501 (while alist 502 (push (list 'const (caar alist)) list) 503 (setq alist (cdr alist))) 504 (append '(choice) (nreverse list))) 505 :group 'vhdl-compile) 506 507(defcustom vhdl-compile-use-local-error-regexp nil 508 "Non-nil means use buffer-local `compilation-error-regexp-alist'. 509In this case, only error message regexps for VHDL compilers are active if 510compilation is started from a VHDL buffer. Otherwise, the error message 511regexps are appended to the predefined global regexps, and all regexps are 512active all the time. Note that by doing that, the predefined global regexps 513might result in erroneous parsing of error messages for some VHDL compilers. 514 515NOTE: Activate the new setting by restarting Emacs." 516 :version "25.1" ; t -> nil 517 :type 'boolean 518 :group 'vhdl-compile) 519 520(defcustom vhdl-makefile-default-targets '("all" "clean" "library") 521 "List of default target names in Makefiles. 522Automatically generated Makefiles include three default targets to compile 523the entire design, clean the entire design and to create the design library. 524This option allows you to change the names of these targets to avoid conflicts 525with other user Makefiles." 526 :type '(list (string :tag "Compile entire design") 527 (string :tag "Clean entire design ") 528 (string :tag "Create design library")) 529 :version "24.3" 530 :group 'vhdl-compile) 531 532(defcustom vhdl-makefile-generation-hook nil 533 "Functions to run at the end of Makefile generation. 534Allows you to insert user specific parts into a Makefile. 535 536Example: 537 (lambda nil 538 (re-search-backward \"^# Rule for compiling entire design\") 539 (insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))" 540 :type 'hook 541 :group 'vhdl-compile) 542 543(defcustom vhdl-default-library "work" 544 "Name of default library. 545Is overwritten by project settings if a project is active." 546 :type 'string 547 :group 'vhdl-compile) 548 549 550(defgroup vhdl-project nil 551 "Customizations for projects." 552 :group 'vhdl) 553 554(defcustom vhdl-project-alist 555 '(("Example 1" "Source files in two directories, custom library name, VHDL'87" 556 "~/example1/" ("src/system/" "src/components/") "" 557 (("ModelSim" "-87 \\2" "-f \\1 top_level" nil) 558 ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) 559 "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "") 560 ("Example 2" "Individual source files, multiple compilers in different directories" 561 "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") "" 562 nil "\\1/" "work" "\\1/work/" "Makefile" "") 563 ("Example 3" "Source files in a directory tree, multiple compilers in same directory" 564 "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/" 565 nil "./" "work" "work-\\1/" "Makefile-\\1" "\ 566------------------------------------------------------------------------------- 567-- This is a multi-line project description 568-- that can be used as a project dependent part of the file header. 569")) 570 "List of projects and their properties. 571 Name : name used in option `vhdl-project' to choose project 572 Title : title of project (single-line string) 573 Default directory: default project directory (absolute path) 574 Sources : a) source files : path + \"/\" + file name 575 b) directory : path + \"/\" 576 c) directory tree: \"-r \" + path + \"/\" 577 Exclude regexp : matches file/directory names to be excluded as sources 578 Compile options : project-specific options for each compiler 579 Compiler name : name of compiler for which these options are valid 580 Compile options: project-specific compiler options 581 (\"\\1\" inserts library name, \"\\2\" default options) 582 Make options: project-specific make options 583 (\"\\1\" inserts Makefile name, \"\\2\" default options) 584 Exceptions : file-specific exceptions 585 File name regexp: matches file names for which exceptions are valid 586 - Options : file-specific compiler options string 587 (\"\\1\" inserts library name, \"\\2\" default options, 588 \"\\3\" project-specific options) 589 - Do not compile: do not compile this file (in Makefile) 590 Compile directory: where compilation is run and the Makefile is placed 591 (\"\\1\" inserts compiler ID string) 592 Library name : name of library (default is \"work\") 593 Library directory: path to library (\"\\1\" inserts compiler ID string) 594 Makefile name : name of Makefile 595 (\"\\1\" inserts compiler ID string, \"\\2\" library name) 596 Description : description of project (multi-line string) 597 598Project title and description are used to insert into the file header (see 599option `vhdl-file-header'). 600 601The default directory must have an absolute path (use `M-TAB' for completion). 602All other paths can be absolute or relative to the default directory. All 603paths must end with `/'. 604 605The design units found in the sources (files and directories) are shown in the 606hierarchy browser. Path and file name can contain wildcards `*' and `?' as 607well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute. 608Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are 609specified, the default directory is taken as source directory. Otherwise, 610the default directory is only taken as source directory if there is a sources 611entry with the empty string or \"./\". Exclude regexp allows you to filter 612out specific file and directory names from the list of sources (e.g. CVS 613directories). 614 615Files are compiled in the compile directory. Makefiles are also placed into 616the compile directory. Library directory specifies which directory the 617compiler compiles into (used to generate the Makefile). 618 619Since different compile/library directories and Makefiles may exist for 620different compilers within one project, these paths and names allow the 621insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist'). 622Compile options, compile directory, library directory, and Makefile name 623overwrite the settings of the current compiler. 624 625File-specific compiler options (highest priority) overwrite project-specific 626options which overwrite default options (lowest priority). Lower priority 627options can be inserted in higher priority options. This allows you to reuse 628default options (e.g. \"-file\") in project- or file-specific options (e.g. 629\"-93 -file\"). 630 631NOTE: Reflect the new setting in the choice list of option `vhdl-project' 632 by restarting Emacs." 633 :type `(repeat 634 (list :tag "Project" :indent 2 635 (string :tag "Name ") 636 (string :tag "Title ") 637 (directory :tag "Default directory" 638 :validate vhdl-widget-directory-validate 639 ,(abbreviate-file-name default-directory)) 640 (repeat :tag "Sources " :indent 4 641 (directory :format " %v" "./")) 642 (regexp :tag "Exclude regexp ") 643 (repeat 644 :tag "Compile options " :indent 4 645 (list :tag "Compiler" :indent 6 646 ,(let ((alist vhdl-compiler-alist) list) 647 (while alist 648 (push (list 'const (caar alist)) list) 649 (setq alist (cdr alist))) 650 (append '(choice :tag "Compiler name") 651 (nreverse list))) 652 (string :tag "Compile options" "\\2") 653 (string :tag "Make options " "\\2") 654 (repeat 655 :tag "Exceptions " :indent 8 656 (cons :format "%v" 657 (regexp :tag "File name regexp ") 658 (choice :format "%[Value Menu%] %v" 659 (string :tag "Options" "\\3") 660 (const :tag "Do not compile" nil)))))) 661 (directory :tag "Compile directory" 662 :validate vhdl-widget-directory-validate "./") 663 (string :tag "Library name " "work") 664 (directory :tag "Library directory" 665 :validate vhdl-widget-directory-validate "work/") 666 (file :tag "Makefile name " "Makefile") 667 (string :tag "Description: (type `C-j' for newline)" 668 :format "%t\n%v\n"))) 669 :set (lambda (variable value) 670 (vhdl-custom-set variable value 671 'vhdl-update-mode-menu 672 'vhdl-speedbar-refresh)) 673 :group 'vhdl-project) 674 675(defcustom vhdl-project nil 676 "Specifies the default for the current project. 677Select a project name from the ones defined in option `vhdl-project-alist'. 678Is used to determine the project title and description to be inserted in file 679headers and the source files/directories to be scanned in the hierarchy 680browser. The current project can also be changed temporarily in the menu." 681 :type (let ((alist vhdl-project-alist) list) 682 (while alist 683 (push (list 'const (caar alist)) list) 684 (setq alist (cdr alist))) 685 (append '(choice (const :tag "None" nil) (const :tag "--")) 686 (nreverse list))) 687 :group 'vhdl-project) 688 689(defcustom vhdl-project-file-name '("\\1.prj") 690 "List of file names/paths for importing/exporting project setups. 691\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is 692replaced by the user name (allows you to have user-specific project setups). 693The first entry is used as file name to import/export individual project 694setups. All entries are used to automatically import project setups at 695startup (see option `vhdl-project-autoload'). Projects loaded from the 696first entry are automatically made current. Hint: specify local project 697setups in first entry, global setups in following entries; loading a local 698project setup will make it current, while loading the global setups 699is done without changing the current project. 700Names can also have an absolute path (i.e. project setups can be stored 701in global directories)." 702 :type '(repeat (string :tag "File name" "\\1.prj")) 703 :group 'vhdl-project) 704 705 706(define-obsolete-variable-alias 'vhdl-project-auto-load 707 'vhdl-project-autoload "27.1") 708 709(defcustom vhdl-project-autoload '(startup) 710 "Automatically load project setups from files. 711All project setup files that match the file names specified in option 712`vhdl-project-file-name' are automatically loaded. The project of the 713\(alphabetically) last loaded setup of the first `vhdl-project-file-name' 714entry is activated. 715A project setup file can be obtained by exporting a project (see menu). 716 At startup: project setup file is loaded at Emacs startup" 717 :type '(set (const :tag "At startup" startup)) 718 :group 'vhdl-project) 719 720(defcustom vhdl-project-sort t 721 "Non-nil means projects are displayed in alphabetical order." 722 :type 'boolean 723 :group 'vhdl-project) 724 725 726(defgroup vhdl-style nil 727 "Customizations for coding styles." 728 :group 'vhdl 729 :group 'vhdl-template 730 :group 'vhdl-port 731 :group 'vhdl-compose) 732 733(defcustom vhdl-standard '(93 nil) 734 "VHDL standards used. 735Basic standard: 736 VHDL'87 : IEEE Std 1076-1987 737 VHDL'93/02 : IEEE Std 1076-1993/2002 738 VHDL'08 : IEEE Std 1076-2008 739Additional standards: 740 VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal) 741 Math packages: IEEE Std 1076.2 (`math_real', `math_complex') 742 743NOTE: Activate the new setting in a VHDL buffer by using the menu entry 744 \"Activate Options\"." 745 :type '(list (choice :tag "Basic standard" 746 (const :tag "VHDL'87" 87) 747 (const :tag "VHDL'93/02" 93) 748 (const :tag "VHDL'08" 08)) 749 (set :tag "Additional standards" :indent 2 750 (const :tag "VHDL-AMS" ams) 751 (const :tag "Math packages" math))) 752 :set (lambda (variable value) 753 (vhdl-custom-set variable value 754 'vhdl-template-map-init 755 'vhdl-mode-abbrev-table-init 756 'vhdl-template-construct-alist-init 757 'vhdl-template-package-alist-init 758 'vhdl-update-mode-menu 759 'vhdl-words-init 'vhdl-font-lock-init)) 760 :group 'vhdl-style) 761 762(defcustom vhdl-basic-offset 2 763 "Amount of basic offset used for indentation. 764This value is used by + and - symbols in `vhdl-offsets-alist'." 765 :type 'integer 766 :group 'vhdl-style) 767 768(defcustom vhdl-upper-case-keywords nil 769 "Non-nil means convert keywords to upper case. 770This is done when typed or expanded or by the fix case functions." 771 :type 'boolean 772 :set (lambda (variable value) 773 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 774 :group 'vhdl-style) 775 776(defcustom vhdl-upper-case-types nil 777 "Non-nil means convert standardized types to upper case. 778This is done when expanded or by the fix case functions." 779 :type 'boolean 780 :set (lambda (variable value) 781 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 782 :group 'vhdl-style) 783 784(defcustom vhdl-upper-case-attributes nil 785 "Non-nil means convert standardized attributes to upper case. 786This is done when expanded or by the fix case functions." 787 :type 'boolean 788 :set (lambda (variable value) 789 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 790 :group 'vhdl-style) 791 792(defcustom vhdl-upper-case-enum-values nil 793 "Non-nil means convert standardized enumeration values to upper case. 794This is done when expanded or by the fix case functions." 795 :type 'boolean 796 :set (lambda (variable value) 797 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 798 :group 'vhdl-style) 799 800(defcustom vhdl-upper-case-constants t 801 "Non-nil means convert standardized constants to upper case. 802This is done when expanded." 803 :type 'boolean 804 :set (lambda (variable value) 805 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 806 :group 'vhdl-style) 807 808(defcustom vhdl-use-direct-instantiation 'standard 809 "Non-nil means use VHDL'93 direct component instantiation. 810 Never : never 811 Standard: only in VHDL standards that allow it (VHDL'93 and higher) 812 Always : always" 813 :type '(choice (const :tag "Never" never) 814 (const :tag "Standard" standard) 815 (const :tag "Always" always)) 816 :group 'vhdl-style) 817 818(defcustom vhdl-array-index-record-field-in-sensitivity-list t 819 "Non-nil means include array indices / record fields in sensitivity list. 820If a signal read in a process is a record field or pointed to by an array 821index, the record field or array index is included with the record name in 822the sensitivity list (e.g. \"in1(0)\", \"in2.f0\"). 823Otherwise, only the record name is included (e.g. \"in1\", \"in2\")." 824 :type 'boolean 825 :version "24.3" 826 :group 'vhdl-style) 827 828(defgroup vhdl-naming nil 829 "Customizations for naming conventions." 830 :group 'vhdl) 831 832(defcustom vhdl-entity-file-name '(".*" . "\\&") 833 (concat 834 "Specifies how the entity file name is obtained. 835The entity file name can be obtained by modifying the entity name (e.g. 836attaching or stripping off a substring). The file extension is automatically 837taken from the file name of the current buffer." 838 vhdl-name-doc-string) 839 :type '(cons (regexp :tag "From regexp") 840 (string :tag "To string ")) 841 :group 'vhdl-naming 842 :group 'vhdl-compose) 843 844(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2") 845 (concat 846 "Specifies how the architecture file name is obtained. 847The architecture file name can be obtained by modifying the entity 848and/or architecture name (e.g. attaching or stripping off a substring). The 849file extension is automatically taken from the file name of the current 850buffer. The string that is matched against the regexp is the concatenation 851of the entity and the architecture name separated by a space. This gives 852access to both names (see default setting as example)." 853 vhdl-name-doc-string) 854 :type '(cons (regexp :tag "From regexp") 855 (string :tag "To string ")) 856 :group 'vhdl-naming 857 :group 'vhdl-compose) 858 859(defcustom vhdl-configuration-file-name '(".*" . "\\&") 860 (concat 861 "Specifies how the configuration file name is obtained. 862The configuration file name can be obtained by modifying the configuration 863name (e.g. attaching or stripping off a substring). The file extension is 864automatically taken from the file name of the current buffer." 865 vhdl-name-doc-string) 866 :type '(cons (regexp :tag "From regexp") 867 (string :tag "To string ")) 868 :group 'vhdl-naming 869 :group 'vhdl-compose) 870 871(defcustom vhdl-package-file-name '(".*" . "\\&") 872 (concat 873 "Specifies how the package file name is obtained. 874The package file name can be obtained by modifying the package name (e.g. 875attaching or stripping off a substring). The file extension is automatically 876taken from the file name of the current buffer. Package files can be created 877in a different directory by prepending a relative or absolute path to the 878file name." 879 vhdl-name-doc-string) 880 :type '(cons (regexp :tag "From regexp") 881 (string :tag "To string ")) 882 :group 'vhdl-naming 883 :group 'vhdl-compose) 884 885(defcustom vhdl-file-name-case 'identity 886 "Specifies how to change case for obtaining file names. 887When deriving a file name from a VHDL unit name, case can be changed as 888follows: 889 As Is: case is not changed (taken as is) 890 Lower Case: whole name is changed to lower case 891 Upper Case: whole name is changed to upper case 892 Capitalize: first letter of each word in name is capitalized" 893 :type '(choice (const :tag "As Is" identity) 894 (const :tag "Lower Case" downcase) 895 (const :tag "Upper Case" upcase) 896 (const :tag "Capitalize" capitalize)) 897 :group 'vhdl-naming 898 :group 'vhdl-compose) 899 900 901(defgroup vhdl-template nil 902 "Customizations for electrification." 903 :group 'vhdl) 904 905(defcustom vhdl-electric-keywords '(vhdl user) 906 "Type of keywords for which electrification is enabled. 907 VHDL keywords: invoke built-in templates 908 User keywords: invoke user models (see option `vhdl-model-alist')" 909 :type '(set (const :tag "VHDL keywords" vhdl) 910 (const :tag "User model keywords" user)) 911 :set (lambda (variable value) 912 (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) 913 :group 'vhdl-template) 914 915(defcustom vhdl-optional-labels 'process 916 "Constructs for which labels are to be queried. 917Template generators prompt for optional labels for: 918 None : no constructs 919 Processes only: processes only (also procedurals in VHDL-AMS) 920 All constructs: all constructs with optional labels and keyword END" 921 :type '(choice (const :tag "None" none) 922 (const :tag "Processes only" process) 923 (const :tag "All constructs" all)) 924 :group 'vhdl-template) 925 926(defcustom vhdl-insert-empty-lines 'unit 927 "Specifies whether to insert empty lines in some templates. 928This improves readability of code. Empty lines are inserted in: 929 None : no constructs 930 Design units only: entities, architectures, configurations, packages only 931 All constructs : also all constructs with BEGIN...END parts 932 933Replaces option `vhdl-additional-empty-lines'." 934 :type '(choice (const :tag "None" none) 935 (const :tag "Design units only" unit) 936 (const :tag "All constructs" all)) 937 :group 'vhdl-template 938 :group 'vhdl-port 939 :group 'vhdl-compose) 940 941(defcustom vhdl-argument-list-indent nil 942 "Non-nil means indent argument lists relative to opening parenthesis. 943That is, argument, association, and port lists start on the same line as the 944opening parenthesis and subsequent lines are indented accordingly. 945Otherwise, lists start on a new line and are indented as normal code." 946 :type 'boolean 947 :group 'vhdl-template 948 :group 'vhdl-port 949 :group 'vhdl-compose) 950 951(defcustom vhdl-association-list-with-formals t 952 "Non-nil means write association lists with formal parameters. 953Templates prompt for formal and actual parameters (ports/generics). 954When pasting component instantiations, formals are included. 955If nil, only a list of actual parameters is entered." 956 :type 'boolean 957 :group 'vhdl-template 958 :group 'vhdl-port 959 :group 'vhdl-compose) 960 961(defcustom vhdl-conditions-in-parenthesis nil 962 "Non-nil means place parenthesis around condition expressions." 963 :type 'boolean 964 :group 'vhdl-template) 965 966(defcustom vhdl-sensitivity-list-all t 967 "Non-nil means use `all' keyword in sensitivity list." 968 :version "25.1" 969 :type 'boolean 970 :group 'vhdl-template) 971 972(defcustom vhdl-zero-string "'0'" 973 "String to use for a logic zero." 974 :type 'string 975 :group 'vhdl-template) 976 977(defcustom vhdl-one-string "'1'" 978 "String to use for a logic one." 979 :type 'string 980 :group 'vhdl-template) 981 982 983(defgroup vhdl-header nil 984 "Customizations for file header." 985 :group 'vhdl-template 986 :group 'vhdl-compose) 987 988(defcustom vhdl-file-header "\ 989------------------------------------------------------------------------------- 990-- Title : <title string> 991-- Project : <project> 992------------------------------------------------------------------------------- 993-- File : <filename> 994-- Author : <author> 995-- Company : <company> 996-- Created : <date> 997-- Last update: <date> 998-- Platform : <platform> 999-- Standard : <standard> 1000<projectdesc>------------------------------------------------------------------------------- 1001-- Description: <cursor> 1002<copyright>------------------------------------------------------------------------------- 1003-- Revisions : 1004-- Date Version Author Description 1005-- <date> 1.0 <login>\tCreated 1006------------------------------------------------------------------------------- 1007 1008" 1009 "String or file to insert as file header. 1010If the string specifies an existing file name, the contents of the file is 1011inserted, otherwise the string itself is inserted as file header. 1012Type `C-j' for newlines. 1013If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> 1014if the header needs to be version controlled. 1015 1016The following keywords for template generation are supported: 1017 <filename> : replaced by the name of the buffer 1018 <author> : replaced by the user name and email address 1019 (`user-full-name', `user-mail-address') 1020 <authorfull> : replaced by the user full name (`user-full-name') 1021 <login> : replaced by user login name (`user-login-name') 1022 <company> : replaced by contents of option `vhdl-company-name' 1023 <date> : replaced by the current date 1024 <year> : replaced by the current year 1025 <project> : replaced by title of current project (`vhdl-project') 1026 <projectdesc> : replaced by description of current project (`vhdl-project') 1027 <copyright> : replaced by copyright string (`vhdl-copyright-string') 1028 <platform> : replaced by contents of option `vhdl-platform-spec' 1029 <standard> : replaced by the VHDL language standard(s) used 1030 <... string> : replaced by a queried string (\"...\" is the prompt word) 1031 <title string>: replaced by file title in automatically generated files 1032 <cursor> : final cursor position 1033 1034The (multi-line) project description <projectdesc> can be used as a project 1035dependent part of the file header and can also contain the above keywords." 1036 :type 'string 1037 :group 'vhdl-header) 1038 1039(defcustom vhdl-file-footer "" 1040 "String or file to insert as file footer. 1041If the string specifies an existing file name, the contents of the file is 1042inserted, otherwise the string itself is inserted as file footer (i.e. at 1043the end of the file). 1044Type `C-j' for newlines. 1045The same keywords as in option `vhdl-file-header' can be used." 1046 :type 'string 1047 :group 'vhdl-header) 1048 1049(defcustom vhdl-company-name "" 1050 "Name of company to insert in file header. 1051See option `vhdl-file-header'." 1052 :type 'string 1053 :group 'vhdl-header) 1054 1055(defcustom vhdl-copyright-string "\ 1056------------------------------------------------------------------------------- 1057-- Copyright (c) <year> <company> 1058" 1059 "Copyright string to insert in file header. 1060Can be multi-line string (type `C-j' for newline) and contain other file 1061header keywords (see option `vhdl-file-header')." 1062 :type 'string 1063 :group 'vhdl-header) 1064 1065(defcustom vhdl-platform-spec "" 1066 "Specification of VHDL platform to insert in file header. 1067The platform specification should contain names and versions of the 1068simulation and synthesis tools used. 1069See option `vhdl-file-header'." 1070 :type 'string 1071 :group 'vhdl-header) 1072 1073(defcustom vhdl-date-format "%Y-%m-%d" 1074 "Specifies the date format to use in the header. 1075This string is passed as argument to the command `format-time-string'. 1076For more information on format strings, see the documentation for the 1077`format-time-string' command (C-h f `format-time-string')." 1078 :type 'string 1079 :group 'vhdl-header) 1080 1081(defcustom vhdl-modify-date-prefix-string "-- Last update: " 1082 "Prefix string of modification date in VHDL file header. 1083If actualization of the modification date is called (menu, 1084`\\[vhdl-template-modify]'), this string is searched and the rest 1085of the line replaced by the current date." 1086 :type 'string 1087 :group 'vhdl-header) 1088 1089(defcustom vhdl-modify-date-on-saving t 1090 "Non-nil means update the modification date when the buffer is saved. 1091Calls function `\\[vhdl-template-modify]'). 1092 1093NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1094 \"Activate Options\"." 1095 :type 'boolean 1096 :group 'vhdl-header) 1097 1098 1099(defgroup vhdl-sequential-process nil 1100 "Customizations for sequential processes." 1101 :group 'vhdl-template) 1102 1103(defcustom vhdl-reset-kind 'async 1104 "Specifies which kind of reset to use in sequential processes." 1105 :type '(choice (const :tag "None" none) 1106 (const :tag "Synchronous" sync) 1107 (const :tag "Asynchronous" async) 1108 (const :tag "Query" query)) 1109 :group 'vhdl-sequential-process) 1110 1111(defcustom vhdl-reset-active-high nil 1112 "Non-nil means reset in sequential processes is active high. 1113Otherwise, reset is active low." 1114 :type 'boolean 1115 :group 'vhdl-sequential-process) 1116 1117(defcustom vhdl-clock-rising-edge t 1118 "Non-nil means rising edge of clock triggers sequential processes. 1119Otherwise, falling edge triggers." 1120 :type 'boolean 1121 :group 'vhdl-sequential-process) 1122 1123(defcustom vhdl-clock-edge-condition 'standard 1124 "Syntax of the clock edge condition. 1125 Standard: \"clk\\='event and clk = \\='1\\='\" 1126 Function: \"rising_edge(clk)\"" 1127 :type '(choice (const :tag "Standard" standard) 1128 (const :tag "Function" function)) 1129 :group 'vhdl-sequential-process) 1130 1131(defcustom vhdl-clock-name "" 1132 "Name of clock signal to use in templates." 1133 :type 'string 1134 :group 'vhdl-sequential-process) 1135 1136(defcustom vhdl-reset-name "" 1137 "Name of reset signal to use in templates." 1138 :type 'string 1139 :group 'vhdl-sequential-process) 1140 1141 1142(defgroup vhdl-model nil 1143 "Customizations for user models." 1144 :group 'vhdl) 1145 1146(defcustom vhdl-model-alist 1147 '(("Example Model" 1148 "<label> : process (<clock>, <reset>) 1149begin -- process <label> 1150 if <reset> = '0' then -- asynchronous reset (active low) 1151 <cursor> 1152 elsif <clock>'event and <clock> = '1' then -- rising clock edge 1153 if <enable> = '1' then -- synchronous load 1154 1155 end if; 1156 end if; 1157end process <label>;" 1158 "e" "")) 1159 "List of user models. 1160VHDL models (templates) can be specified by the user in this list. They can be 1161invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword 1162electrification (i.e. overriding existing or creating new keywords, see 1163option `vhdl-electric-keywords'). 1164 Name : name of model (string of words and spaces) 1165 String : string or name of file to be inserted as model (newline: `C-j') 1166 Key Binding: key binding to invoke model, added to prefix `C-c C-m' 1167 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\") 1168 Keyword : keyword to invoke model 1169 1170The models can contain prompts to be queried. A prompt is of the form \"<...>\". 1171A prompt that appears several times is queried once and replaced throughout 1172the model. Special prompts are: 1173 <clock> : name specified in `vhdl-clock-name' (if not empty) 1174 <reset> : name specified in `vhdl-reset-name' (if not empty) 1175 <cursor>: final cursor position 1176File header prompts (see variable `vhdl-file-header') are automatically 1177replaced, so that user models can also be used to insert different types of 1178headers. 1179 1180If the string specifies an existing file name, the contents of the file is 1181inserted, otherwise the string itself is inserted. 1182The code within the models should be correctly indented. 1183Type `C-j' for newlines. 1184 1185NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1186 \"Activate Options\"." 1187 :type '(repeat (list :tag "Model" :indent 2 1188 (string :tag "Name ") 1189 (string :tag "String : (type `C-j' for newline)" 1190 :format "%t\n%v") 1191 (sexp :tag "Key binding" x) 1192 (string :tag "Keyword " :format "%t: %v\n"))) 1193 :set (lambda (variable value) 1194 (vhdl-custom-set variable value 1195 'vhdl-model-map-init 1196 'vhdl-model-defun 1197 'vhdl-mode-abbrev-table-init 1198 'vhdl-update-mode-menu)) 1199 :group 'vhdl-model) 1200 1201 1202(defgroup vhdl-compose nil 1203 "Customizations for structural composition." 1204 :group 'vhdl) 1205 1206(defcustom vhdl-compose-architecture-name '(".*" . "str") 1207 (concat 1208 "Specifies how the component architecture name is obtained. 1209The component architecture name can be obtained by modifying the entity name 1210\(e.g. attaching or stripping off a substring). 1211If TO STRING is empty, the architecture name is queried." 1212 vhdl-name-doc-string) 1213 :type '(cons (regexp :tag "From regexp") 1214 (string :tag "To string ")) 1215 :group 'vhdl-compose) 1216 1217(defcustom vhdl-compose-configuration-name 1218 '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg") 1219 (concat 1220 "Specifies how the configuration name is obtained. 1221The configuration name can be obtained by modifying the entity and/or 1222architecture name (e.g. attaching or stripping off a substring). The string 1223that is matched against the regexp is the concatenation of the entity and the 1224architecture name separated by a space. This gives access to both names (see 1225default setting as example)." 1226 vhdl-name-doc-string) 1227 :type '(cons (regexp :tag "From regexp") 1228 (string :tag "To string ")) 1229 :group 'vhdl-compose) 1230 1231(defcustom vhdl-components-package-name 1232 '((".*" . "\\&_components") . "components") 1233 (concat 1234 "Specifies how the name for the components package is obtained. 1235The components package is a package containing all component declarations for 1236the current design. Its name can be obtained by modifying the project name 1237\(e.g. attaching or stripping off a substring). If no project is defined, the 1238DIRECTORY entry is chosen." 1239 vhdl-name-doc-string) 1240 :type '(cons (cons :tag "Project" :indent 2 1241 (regexp :tag "From regexp") 1242 (string :tag "To string ")) 1243 (string :tag "Directory:\n String ")) 1244 :group 'vhdl-compose) 1245 1246(defcustom vhdl-use-components-package nil 1247 "Non-nil means use a separate components package for component declarations. 1248Otherwise, component declarations are inserted and searched for in the 1249architecture declarative parts." 1250 :type 'boolean 1251 :group 'vhdl-compose) 1252 1253(defcustom vhdl-compose-include-header t 1254 "Non-nil means include a header in automatically generated files." 1255 :type 'boolean 1256 :group 'vhdl-compose) 1257 1258(defcustom vhdl-compose-create-files 'single 1259 "Specifies whether new files should be created for the new component. 1260The component's entity and architecture are inserted: 1261 None : in current buffer 1262 Single file : in new single file 1263 Separate files: in two separate files 1264The file names are obtained from variables `vhdl-entity-file-name' and 1265`vhdl-architecture-file-name'." 1266 :type '(choice (const :tag "None" none) 1267 (const :tag "Single file" single) 1268 (const :tag "Separate files" separate)) 1269 :group 'vhdl-compose) 1270 1271(defcustom vhdl-compose-configuration-create-file nil 1272 "Specifies whether a new file should be created for the configuration. 1273If non-nil, a new file is created for the configuration. 1274The file name is obtained from variable `vhdl-configuration-file-name'." 1275 :type 'boolean 1276 :group 'vhdl-compose) 1277 1278(defcustom vhdl-compose-configuration-hierarchical t 1279 "Specifies whether hierarchical configurations should be created. 1280If non-nil, automatically created configurations are hierarchical and include 1281the whole hierarchy of subcomponents. Otherwise the configuration only 1282includes one level of subcomponents." 1283 :type 'boolean 1284 :group 'vhdl-compose) 1285 1286(defcustom vhdl-compose-configuration-use-subconfiguration t 1287 "Specifies whether subconfigurations should be used inside configurations. 1288If non-nil, automatically created configurations use configurations in binding 1289indications for subcomponents, if such configurations exist. Otherwise, 1290entities are used in binding indications for subcomponents." 1291 :type 'boolean 1292 :group 'vhdl-compose) 1293 1294 1295(defgroup vhdl-port nil 1296 "Customizations for port translation functions." 1297 :group 'vhdl 1298 :group 'vhdl-compose) 1299 1300(defcustom vhdl-include-port-comments nil 1301 "Non-nil means include port comments when a port is pasted." 1302 :type 'boolean 1303 :group 'vhdl-port) 1304 1305(defcustom vhdl-include-direction-comments nil 1306 "Non-nil means include port direction in instantiations as comments." 1307 :type 'boolean 1308 :group 'vhdl-port) 1309 1310(defcustom vhdl-include-type-comments nil 1311 "Non-nil means include generic/port type in instantiations as comments." 1312 :type 'boolean 1313 :group 'vhdl-port) 1314 1315(defcustom vhdl-include-group-comments 'never 1316 "Specifies whether to include group comments and spacings. 1317The comments and empty lines between groups of ports are pasted: 1318 Never : never 1319 Declarations: in entity/component/constant/signal declarations only 1320 Always : also in generic/port maps" 1321 :type '(choice (const :tag "Never" never) 1322 (const :tag "Declarations" decl) 1323 (const :tag "Always" always)) 1324 :group 'vhdl-port) 1325 1326(defcustom vhdl-actual-generic-name '(".*" . "\\&") 1327 (concat 1328 "Specifies how actual generic names are obtained from formal generic names. 1329In a component instantiation, an actual generic name can be 1330obtained by modifying the formal generic name (e.g. attaching or stripping 1331off a substring)." 1332 vhdl-name-doc-string) 1333 :type '(cons (regexp :tag "From regexp") 1334 (string :tag "To string ")) 1335 :group 'vhdl-port 1336 :version "24.4") 1337 1338(defcustom vhdl-actual-port-name '(".*" . "\\&") 1339 (concat 1340 "Specifies how actual port names are obtained from formal port names. 1341In a component instantiation, an actual port name can be obtained by 1342modifying the formal port name (e.g. attaching or stripping off a substring)." 1343 vhdl-name-doc-string) 1344 :type '(cons (regexp :tag "From regexp") 1345 (string :tag "To string ")) 1346 :group 'vhdl-port) 1347 1348(defcustom vhdl-instance-name '(".*" . "\\&_%d") 1349 (concat 1350 "Specifies how an instance name is obtained. 1351The instance name can be obtained by modifying the name of the component to be 1352instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced 1353by a unique number (starting with 1). 1354If TO STRING is empty, the instance name is queried." 1355 vhdl-name-doc-string) 1356 :type '(cons (regexp :tag "From regexp") 1357 (string :tag "To string ")) 1358 :group 'vhdl-port) 1359 1360 1361(defgroup vhdl-testbench nil 1362 "Customizations for testbench generation." 1363 :group 'vhdl-port) 1364 1365(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb") 1366 (concat 1367 "Specifies how the testbench entity name is obtained. 1368The entity name of a testbench can be obtained by modifying the name of 1369the component to be tested (e.g. attaching or stripping off a substring)." 1370 vhdl-name-doc-string) 1371 :type '(cons (regexp :tag "From regexp") 1372 (string :tag "To string ")) 1373 :group 'vhdl-testbench) 1374 1375(defcustom vhdl-testbench-architecture-name '(".*" . "") 1376 (concat 1377 "Specifies how the testbench architecture name is obtained. 1378The testbench architecture name can be obtained by modifying the name of 1379the component to be tested (e.g. attaching or stripping off a substring). 1380If TO STRING is empty, the architecture name is queried." 1381 vhdl-name-doc-string) 1382 :type '(cons (regexp :tag "From regexp") 1383 (string :tag "To string ")) 1384 :group 'vhdl-testbench) 1385 1386(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name 1387 (concat 1388 "Specifies how the testbench configuration name is obtained. 1389The configuration name of a testbench can be obtained by modifying the entity 1390and/or architecture name (e.g. attaching or stripping off a substring). The 1391string that is matched against the regexp is the concatenation of the entity 1392and the architecture name separated by a space. This gives access to both 1393names (see default setting as example)." 1394 vhdl-name-doc-string) 1395 :type '(cons (regexp :tag "From regexp") 1396 (string :tag "To string ")) 1397 :group 'vhdl-testbench) 1398 1399(defcustom vhdl-testbench-dut-name '(".*" . "DUT") 1400 (concat 1401 "Specifies how a DUT instance name is obtained. 1402The design-under-test instance name (i.e. the component instantiated in the 1403testbench) can be obtained by modifying the component name (e.g. attaching 1404or stripping off a substring)." 1405 vhdl-name-doc-string) 1406 :type '(cons (regexp :tag "From regexp") 1407 (string :tag "To string ")) 1408 :group 'vhdl-testbench) 1409 1410(defcustom vhdl-testbench-include-header t 1411 "Non-nil means include a header in automatically generated files." 1412 :type 'boolean 1413 :group 'vhdl-testbench) 1414 1415(defcustom vhdl-testbench-declarations "\ 1416 -- clock 1417 signal Clk : std_logic := '1'; 1418" 1419 "String or file to be inserted in the testbench declarative part. 1420If the string specifies an existing file name, the contents of the file is 1421inserted, otherwise the string itself is inserted in the testbench 1422architecture before the BEGIN keyword. 1423Type `C-j' for newlines." 1424 :type 'string 1425 :group 'vhdl-testbench) 1426 1427(defcustom vhdl-testbench-statements "\ 1428 -- clock generation 1429 Clk <= not Clk after 10 ns; 1430 1431 -- waveform generation 1432 WaveGen_Proc: process 1433 begin 1434 -- insert signal assignments here 1435 1436 wait until Clk = '1'; 1437 end process WaveGen_Proc; 1438" 1439 "String or file to be inserted in the testbench statement part. 1440If the string specifies an existing file name, the contents of the file is 1441inserted, otherwise the string itself is inserted in the testbench 1442architecture before the END keyword. 1443Type `C-j' for newlines." 1444 :type 'string 1445 :group 'vhdl-testbench) 1446 1447(defcustom vhdl-testbench-initialize-signals nil 1448 "Non-nil means initialize signals with `0' when declared in testbench." 1449 :type 'boolean 1450 :group 'vhdl-testbench) 1451 1452(defcustom vhdl-testbench-include-library t 1453 "Non-nil means a library/use clause for std_logic_1164 is included." 1454 :type 'boolean 1455 :group 'vhdl-testbench) 1456 1457(defcustom vhdl-testbench-include-configuration t 1458 "Non-nil means a testbench configuration is attached at the end." 1459 :type 'boolean 1460 :group 'vhdl-testbench) 1461 1462(defcustom vhdl-testbench-create-files 'single 1463 "Specifies whether new files should be created for the testbench. 1464testbench entity and architecture are inserted: 1465 None : in current buffer 1466 Single file : in new single file 1467 Separate files: in two separate files 1468The file names are obtained from variables `vhdl-testbench-entity-file-name' 1469and `vhdl-testbench-architecture-file-name'." 1470 :type '(choice (const :tag "None" none) 1471 (const :tag "Single file" single) 1472 (const :tag "Separate files" separate)) 1473 :group 'vhdl-testbench) 1474 1475(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name 1476 (concat 1477 "Specifies how the testbench entity file name is obtained. 1478The entity file name can be obtained by modifying the testbench entity name 1479\(e.g. attaching or stripping off a substring). The file extension is 1480automatically taken from the file name of the current buffer. Testbench 1481files can be created in a different directory by prepending a relative or 1482absolute path to the file name." 1483 vhdl-name-doc-string) 1484 :type '(cons (regexp :tag "From regexp") 1485 (string :tag "To string ")) 1486 :group 'vhdl-testbench) 1487 1488(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name 1489 (concat 1490 "Specifies how the testbench architecture file name is obtained. 1491The architecture file name can be obtained by modifying the testbench entity 1492and/or architecture name (e.g. attaching or stripping off a substring). The 1493string that is matched against the regexp is the concatenation of the entity 1494and the architecture name separated by a space. This gives access to both 1495names (see default setting as example). Testbench files can be created in 1496a different directory by prepending a relative or absolute path to the file 1497name." 1498 vhdl-name-doc-string) 1499 :type '(cons (regexp :tag "From regexp") 1500 (string :tag "To string ")) 1501 :group 'vhdl-testbench) 1502 1503 1504(defgroup vhdl-comment nil 1505 "Customizations for comments." 1506 :group 'vhdl) 1507 1508(defcustom vhdl-self-insert-comments t 1509 "Non-nil means various templates automatically insert help comments." 1510 :type 'boolean 1511 :group 'vhdl-comment) 1512 1513(defcustom vhdl-prompt-for-comments t 1514 "Non-nil means various templates prompt for user definable comments." 1515 :type 'boolean 1516 :group 'vhdl-comment) 1517 1518(defcustom vhdl-inline-comment-column 40 1519 "Column to indent and align inline comments to. 1520Overrides local option `comment-column'. 1521 1522NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1523 \"Activate Options\"." 1524 :type 'integer 1525 :group 'vhdl-comment) 1526 1527(defcustom vhdl-end-comment-column 79 1528 "End of comment column. 1529Comments that exceed this column number are wrapped. 1530 1531NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1532 \"Activate Options\"." 1533 :type 'integer 1534 :group 'vhdl-comment) 1535 1536(defvar end-comment-column) 1537 1538 1539(defgroup vhdl-beautify nil 1540 "Customizations for beautification." 1541 :group 'vhdl) 1542 1543(defcustom vhdl-auto-align t 1544 "Non-nil means align some templates automatically after generation." 1545 :type 'boolean 1546 :group 'vhdl-beautify) 1547 1548(defcustom vhdl-align-groups t 1549 "Non-nil means align groups of code lines separately. 1550A group of code lines is a region of consecutive lines between two lines that 1551match the regexp in option `vhdl-align-group-separate'." 1552 :type 'boolean 1553 :group 'vhdl-beautify) 1554 1555(defcustom vhdl-align-group-separate "^\\s-*$" 1556 "Regexp for matching a line that separates groups of lines for alignment. 1557Examples: 1558 \"^\\s-*$\": matches an empty line 1559 \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" 1560 :type 'regexp 1561 :group 'vhdl-beautify) 1562 1563(defcustom vhdl-align-same-indent t 1564 "Non-nil means align blocks with same indent separately. 1565When a region or the entire buffer is aligned, the code is divided into 1566blocks of same indent which are aligned separately (except for argument/port 1567lists). This gives nicer alignment in most cases. 1568Option `vhdl-align-groups' still applies within these blocks." 1569 :type 'boolean 1570 :group 'vhdl-beautify) 1571 1572(defcustom vhdl-beautify-options '(t t t t t) 1573 "List of options for beautifying code. 1574Allows you to disable individual features of code beautification." 1575 :type '(list (boolean :tag "Whitespace cleanup ") 1576 (boolean :tag "Single statement per line") 1577 (boolean :tag "Indentation ") 1578 (boolean :tag "Alignment ") 1579 (boolean :tag "Case fixing ")) 1580 :group 'vhdl-beautify 1581 :version "24.4") 1582 1583 1584(defgroup vhdl-highlight nil 1585 "Customizations for highlighting." 1586 :group 'vhdl) 1587 1588(defcustom vhdl-highlight-keywords t 1589 "Non-nil means highlight VHDL keywords and other standardized words. 1590The following faces are used: 1591 `font-lock-keyword-face' : keywords 1592 `font-lock-type-face' : standardized types 1593 `vhdl-font-lock-attribute-face': standardized attributes 1594 `vhdl-font-lock-enumvalue-face': standardized enumeration values 1595 `vhdl-font-lock-function-face' : standardized function and package names 1596 1597NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1598 entry \"Fontify Buffer\")." 1599 :type 'boolean 1600 :set (lambda (variable value) 1601 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1602 :group 'vhdl-highlight) 1603 1604(defcustom vhdl-highlight-names t 1605 "Non-nil means highlight declaration names and construct labels. 1606The following faces are used: 1607 `font-lock-function-name-face' : names in declarations of units, 1608 subprograms, components, as well as labels of VHDL constructs 1609 `font-lock-type-face' : names in type/nature declarations 1610 `vhdl-font-lock-attribute-face': names in attribute declarations 1611 `font-lock-variable-name-face' : names in declarations of signals, 1612 variables, constants, subprogram parameters, generics, and ports 1613 1614NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1615 entry \"Fontify Buffer\")." 1616 :type 'boolean 1617 :set (lambda (variable value) 1618 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1619 :group 'vhdl-highlight) 1620 1621(defcustom vhdl-highlight-special-words nil 1622 "Non-nil means highlight words with special syntax. 1623The words with syntax and color specified in option `vhdl-special-syntax-alist' 1624are highlighted accordingly. 1625Can be used for visual support of naming conventions. 1626 1627NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1628 entry \"Fontify Buffer\")." 1629 :type 'boolean 1630 :set (lambda (variable value) 1631 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1632 :group 'vhdl-highlight) 1633 1634(defcustom vhdl-highlight-forbidden-words nil 1635 "Non-nil means highlight forbidden words. 1636The reserved words specified in option `vhdl-forbidden-words' or having the 1637syntax specified in option `vhdl-forbidden-syntax' are highlighted in a 1638warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to 1639use them. 1640 1641NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1642 entry \"Fontify Buffer\")." 1643 :type 'boolean 1644 :set (lambda (variable value) 1645 (vhdl-custom-set variable value 1646 'vhdl-words-init 'vhdl-font-lock-init)) 1647 :group 'vhdl-highlight) 1648 1649(defcustom vhdl-highlight-verilog-keywords nil 1650 "Non-nil means highlight Verilog keywords as reserved words. 1651Verilog keywords are highlighted in a warning color (face 1652`vhdl-font-lock-reserved-words-face') to indicate not to use them. 1653 1654NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1655 entry \"Fontify Buffer\")." 1656 :type 'boolean 1657 :set (lambda (variable value) 1658 (vhdl-custom-set variable value 1659 'vhdl-words-init 'vhdl-font-lock-init)) 1660 :group 'vhdl-highlight) 1661 1662(defcustom vhdl-highlight-translate-off nil 1663 "Non-nil means background-highlight code excluded from translation. 1664That is, all code between \"-- pragma translate_off\" and 1665\"-- pragma translate_on\" is highlighted using a different background color 1666\(face `vhdl-font-lock-translate-off-face'). 1667Note: this might slow down on-the-fly fontification (and thus editing). 1668 1669NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1670 entry \"Fontify Buffer\")." 1671 :type 'boolean 1672 :set (lambda (variable value) 1673 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1674 :group 'vhdl-highlight) 1675 1676(defcustom vhdl-highlight-case-sensitive nil 1677 "Non-nil means consider case for highlighting. 1678Possible trade-off: 1679 non-nil also upper-case VHDL words are highlighted, but case of words with 1680 special syntax is not considered 1681 nil only lower-case VHDL words are highlighted, but case of words with 1682 special syntax is considered 1683Overrides local option `font-lock-keywords-case-fold-search'. 1684 1685NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1686 entry \"Fontify Buffer\")." 1687 :type 'boolean 1688 :group 'vhdl-highlight) 1689 1690(defcustom vhdl-special-syntax-alist 1691 '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil) 1692 ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil) 1693 ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil)) 1694 "List of special syntax to be highlighted. 1695If option `vhdl-highlight-special-words' is non-nil, words with the specified 1696syntax (as regular expression) are highlighted in the corresponding color. 1697 1698 Name : string of words and spaces 1699 Regexp : regular expression describing word syntax 1700 (e.g., `\\=\\<\\w+_c\\>' matches word with suffix `_c') 1701 expression must start with `\\=\\<' and end with `\\>' 1702 if only whole words should be matched (no substrings) 1703 Color (light): foreground color for light background 1704 (matching color examples: Gold3, Grey50, LimeGreen, Tomato, 1705 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed) 1706 Color (dark) : foreground color for dark background 1707 (matching color examples: BurlyWood1, Grey80, Green, Coral, 1708 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1) 1709 In comments : If non-nil, words are also highlighted inside comments 1710 1711Can be used for visual support of naming conventions, such as highlighting 1712different kinds of signals (e.g. `Clk50', `Rst_n') or objects (e.g. 1713`Signal_s', `Variable_v', `Constant_c') by distinguishing them using 1714common substrings or name suffices. 1715For each entry, a new face is generated with the specified colors and name 1716`vhdl-font-lock-' + name + `-face'. 1717 1718NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu 1719 entry `Fontify Buffer'). All other changes require restarting Emacs." 1720 :type '(repeat (list :tag "Face" :indent 2 1721 (string :tag "Name ") 1722 (regexp :tag "Regexp " "\\w+_") 1723 (string :tag "Color (light)") 1724 (string :tag "Color (dark) ") 1725 (boolean :tag "In comments "))) 1726 :set (lambda (variable value) 1727 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1728 :group 'vhdl-highlight) 1729 1730(defcustom vhdl-forbidden-words '() 1731 "List of forbidden words to be highlighted. 1732If option `vhdl-highlight-forbidden-words' is non-nil, these reserved 1733words are highlighted in a warning color to indicate not to use them. 1734 1735NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1736 entry \"Fontify Buffer\")." 1737 :type '(repeat (string :format "%v")) 1738 :set (lambda (variable value) 1739 (vhdl-custom-set variable value 1740 'vhdl-words-init 'vhdl-font-lock-init)) 1741 :group 'vhdl-highlight) 1742 1743(defcustom vhdl-forbidden-syntax "" 1744 "Syntax of forbidden words to be highlighted. 1745If option `vhdl-highlight-forbidden-words' is non-nil, words with this 1746syntax are highlighted in a warning color to indicate not to use them. 1747Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\" 1748highlights identifiers with 10 or more characters). 1749 1750NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1751 entry \"Fontify Buffer\")." 1752 :type 'regexp 1753 :set (lambda (variable value) 1754 (vhdl-custom-set variable value 1755 'vhdl-words-init 'vhdl-font-lock-init)) 1756 :group 'vhdl-highlight) 1757 1758(defcustom vhdl-directive-keywords '("psl" "pragma" "synopsys") 1759 "List of compiler directive keywords recognized for highlighting. 1760 1761NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1762 entry \"Fontify Buffer\")." 1763 :type '(repeat (string :format "%v")) 1764 :set (lambda (variable value) 1765 (vhdl-custom-set variable value 1766 'vhdl-words-init 'vhdl-font-lock-init)) 1767 :group 'vhdl-highlight) 1768 1769 1770(defgroup vhdl-speedbar nil 1771 "Customizations for speedbar." 1772 :group 'vhdl) 1773 1774(defcustom vhdl-speedbar-auto-open nil 1775 "Non-nil means automatically open speedbar at startup. 1776Alternatively, the speedbar can be opened from the VHDL menu." 1777 :type 'boolean 1778 :group 'vhdl-speedbar) 1779 1780(defcustom vhdl-speedbar-display-mode 'files 1781 "Specifies the default displaying mode when opening speedbar. 1782Alternatively, the displaying mode can be selected from the speedbar menu or 1783by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)." 1784 :type '(choice (const :tag "Files" files) 1785 (const :tag "Directory hierarchy" directory) 1786 (const :tag "Project hierarchy" project)) 1787 :group 'vhdl-speedbar) 1788 1789(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50)) 1790 "Limits scanning of large files and netlists. 1791Design units: maximum file size to scan for design units 1792Hierarchy (instances of subcomponents): 1793 File size: maximum file size to scan for instances (in bytes) 1794 Instances per arch: maximum number of instances to scan per architecture 1795 1796\"None\" always means that there is no limit. 1797In case of files not or incompletely scanned, a warning message and the file 1798names are printed out. 1799Background: scanning for instances is considerably slower than scanning for 1800design units, especially when there are many instances. These limits should 1801prevent the scanning of large netlists." 1802 :type '(list (choice :tag "Design units" 1803 :format "%t : %[Value Menu%] %v" 1804 (const :tag "None" nil) 1805 (integer :tag "File size")) 1806 (list :tag "Hierarchy" :indent 2 1807 (choice :tag "File size" 1808 :format "%t : %[Value Menu%] %v" 1809 (const :tag "None" nil) 1810 (integer :tag "Size ")) 1811 (choice :tag "Instances per arch" 1812 (const :tag "None" nil) 1813 (integer :tag "Number ")))) 1814 :group 'vhdl-speedbar) 1815 1816(defcustom vhdl-speedbar-jump-to-unit t 1817 "Non-nil means jump to the design unit code when opened in a buffer. 1818The buffer cursor position is left unchanged otherwise." 1819 :type 'boolean 1820 :group 'vhdl-speedbar) 1821 1822(defcustom vhdl-speedbar-update-on-saving t 1823 "Automatically update design hierarchy when buffer is saved." 1824 :type 'boolean 1825 :group 'vhdl-speedbar) 1826 1827(defcustom vhdl-speedbar-save-cache '(hierarchy display) 1828 "Automatically save modified hierarchy caches when exiting Emacs. 1829 Hierarchy: design hierarchy information 1830 Display: displaying information (which design units to expand)" 1831 :type '(set (const :tag "Hierarchy" hierarchy) 1832 (const :tag "Display" display)) 1833 :group 'vhdl-speedbar) 1834 1835(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2" 1836 "Name of file for saving hierarchy cache. 1837\"\\1\" is replaced by the project name if a project is specified, 1838\"directory\" otherwise. \"\\2\" is replaced by the user name (allows for 1839different users to have cache files in the same directory). Can also have 1840an absolute path (i.e. all caches can be stored in one global directory)." 1841 :type 'string 1842 :group 'vhdl-speedbar) 1843 1844 1845(defgroup vhdl-menu nil 1846 "Customizations for menus." 1847 :group 'vhdl) 1848 1849(defcustom vhdl-index-menu nil 1850 "Non-nil means add an index menu for a source file when loading. 1851Alternatively, the speedbar can be used. Note that the index menu scans a file 1852when it is opened, while speedbar only scans the file upon request." 1853 :type 'boolean 1854 :group 'vhdl-menu) 1855 1856(defcustom vhdl-source-file-menu nil 1857 "Non-nil means add a menu of all source files in current directory. 1858Alternatively, the speedbar can be used." 1859 :type 'boolean 1860 :group 'vhdl-menu) 1861 1862(defcustom vhdl-hideshow-menu nil 1863 "Non-nil means add hideshow menu and functionality at startup. 1864Hideshow can also be enabled from the VHDL Mode menu. 1865Hideshow allows hiding code of various VHDL constructs. 1866 1867NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1868 \"Activate Options\"." 1869 :type 'boolean 1870 :group 'vhdl-menu) 1871 1872(defcustom vhdl-hide-all-init nil 1873 "Non-nil means hide all design units initially after a file is loaded." 1874 :type 'boolean 1875 :group 'vhdl-menu) 1876 1877 1878(defgroup vhdl-print nil 1879 "Customizations for printing." 1880 :group 'vhdl) 1881 1882(defcustom vhdl-print-two-column t 1883 "Non-nil means print code in two columns and landscape format. 1884Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print') 1885prints VHDL files in a nice two-column landscape style. 1886 1887NOTE: Activate the new setting by restarting Emacs. 1888 Overrides `ps-print' settings locally." 1889 :type 'boolean 1890 :group 'vhdl-print) 1891 1892(defcustom vhdl-print-customize-faces t 1893 "Non-nil means use an optimized set of faces for PostScript printing. 1894 1895NOTE: Activate the new setting by restarting Emacs. 1896 Overrides `ps-print' settings locally." 1897 :type 'boolean 1898 :group 'vhdl-print) 1899 1900 1901(defgroup vhdl-misc nil 1902 "Miscellaneous customizations." 1903 :group 'vhdl) 1904 1905(defcustom vhdl-intelligent-tab t 1906 "Non-nil means `TAB' does indentation, word completion and tab insertion. 1907That is, if preceding character is part of a word then complete word, 1908else if not at beginning of line then insert tab, 1909else if last command was a `TAB' or `RET' then dedent one step, 1910else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab'). 1911If nil, TAB always indents current line (i.e. `TAB' is bound to 1912`indent-according-to-mode'). 1913 1914NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1915 \"Activate Options\"." 1916 :type 'boolean 1917 :group 'vhdl-misc) 1918 1919(defcustom vhdl-indent-syntax-based t 1920 "Non-nil means indent lines of code based on their syntactic context. 1921Otherwise, a line is indented like the previous nonblank line. This can be 1922useful in large files where syntax-based indentation gets very slow." 1923 :type 'boolean 1924 :group 'vhdl-misc) 1925 1926(defcustom vhdl-indent-comment-like-next-code-line t 1927 "Non-nil means comment lines are indented like the following code line. 1928Otherwise, comment lines are indented like the preceding code line. 1929Indenting comment lines like the following code line gives nicer indentation 1930when comments precede the code that they refer to." 1931 :type 'boolean 1932 :version "24.3" 1933 :group 'vhdl-misc) 1934 1935(defcustom vhdl-word-completion-case-sensitive nil 1936 "Non-nil means word completion using `TAB' is case sensitive. 1937That is, `TAB' completes words that start with the same letters and case. 1938Otherwise, case is ignored." 1939 :type 'boolean 1940 :group 'vhdl-misc) 1941 1942(defcustom vhdl-word-completion-in-minibuffer t 1943 "Non-nil enables word completion in minibuffer (for template prompts). 1944 1945NOTE: Activate the new setting by restarting Emacs." 1946 :type 'boolean 1947 :group 'vhdl-misc) 1948 1949(defcustom vhdl-underscore-is-part-of-word nil 1950 "Non-nil means consider the underscore character `_' as part of word. 1951An identifier containing underscores is then treated as a single word in 1952select and move operations. All parts of an identifier separated by underscore 1953are treated as single words otherwise." 1954 :type 'boolean 1955 :group 'vhdl-misc) 1956(make-obsolete-variable 'vhdl-underscore-is-part-of-word 1957 'superword-mode "24.4") 1958 1959 1960(defgroup vhdl-related nil 1961 "Related general customizations." 1962 :group 'vhdl) 1963 1964;; add related general customizations 1965(custom-add-to-group 'vhdl-related 'hideshow 'custom-group) 1966(if (featurep 'xemacs) 1967 (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) 1968 (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) 1969(custom-add-to-group 'vhdl-related 'ps-print 'custom-group) 1970(custom-add-to-group 'vhdl-related 'speedbar 'custom-group) 1971(custom-add-to-group 'vhdl-related 'comment-style 'custom-variable) 1972(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) 1973(unless (featurep 'xemacs) 1974 (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) 1975(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) 1976(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable) 1977 1978;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1979;; Hidden user variables 1980 1981(defvar vhdl-compile-absolute-path nil 1982 "If non-nil, use absolute instead of relative path for compiled files.") 1983 1984(defvar vhdl-comment-display-line-char ?- 1985 "Character to use in comment display line.") 1986 1987;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1988;; Internal variables 1989 1990(defvar vhdl-menu-max-size 20 1991 "Specifies the maximum size of a menu before splitting it into submenus.") 1992 1993(defvar vhdl-progress-interval 1 1994 "Interval used to update progress status during long operations. 1995If a number, percentage complete gets updated after each interval of 1996that many seconds. To inhibit all messages, set this option to nil.") 1997 1998(defvar vhdl-inhibit-startup-warnings-p nil 1999 "If non-nil, inhibits start up compatibility warnings.") 2000 2001(defvar vhdl-strict-syntax-p nil 2002 "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. 2003If the syntactic symbol for a particular line does not match a symbol 2004in the offsets alist, an error is generated, otherwise no error is 2005reported and the syntactic symbol is ignored.") 2006 2007(defvar vhdl-echo-syntactic-information-p nil 2008 "If non-nil, syntactic info is echoed when the line is indented.") 2009 2010(defconst vhdl-offsets-alist-default 2011 '((string . -1000) 2012 (cpp-macro . -1000) 2013 (block-open . 0) 2014 (block-close . 0) 2015 (statement . 0) 2016 (statement-cont . vhdl-lineup-statement-cont) 2017 (statement-block-intro . +) 2018 (statement-case-intro . +) 2019 (case-alternative . +) 2020 (comment . vhdl-lineup-comment) 2021 (arglist-intro . +) 2022 (arglist-cont . 0) 2023 (arglist-cont-nonempty . vhdl-lineup-arglist) 2024 (arglist-close . vhdl-lineup-arglist) 2025 (entity . 0) 2026 (configuration . 0) 2027 (package . 0) 2028 (architecture . 0) 2029 (package-body . 0) 2030 (context . 0) 2031 (directive . 0) 2032 ) 2033 "Default settings for offsets of syntactic elements. 2034Do not change this constant! See the variable `vhdl-offsets-alist' for 2035more information.") 2036 2037(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) 2038 "Association list of syntactic element symbols and indentation offsets. 2039As described below, each cons cell in this list has the form: 2040 2041 (SYNTACTIC-SYMBOL . OFFSET) 2042 2043When a line is indented, `vhdl-mode' first determines the syntactic 2044context of the line by generating a list of symbols called syntactic 2045elements. This list can contain more than one syntactic element and 2046the global variable `vhdl-syntactic-context' contains the context list 2047for the line being indented. Each element in this list is actually a 2048cons cell of the syntactic symbol and a buffer position. This buffer 2049position is call the relative indent point for the line. Some 2050syntactic symbols may not have a relative indent point associated with 2051them. 2052 2053After the syntactic context list for a line is generated, `vhdl-mode' 2054calculates the absolute indentation for the line by looking at each 2055syntactic element in the list. First, it compares the syntactic 2056element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it 2057finds a match, it adds the OFFSET to the column of the relative indent 2058point. The sum of this calculation for each element in the syntactic 2059list is the absolute offset for line being indented. 2060 2061If the syntactic element does not match any in the `vhdl-offsets-alist', 2062an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise 2063the element is ignored. 2064 2065Actually, OFFSET can be an integer, a function, a variable, or one of 2066the following symbols: `+', `-', `++', or `--'. These latter 2067designate positive or negative multiples of `vhdl-basic-offset', 2068respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is 2069called with a single argument containing the cons of the syntactic 2070element symbol and the relative indent point. The function should 2071return an integer offset. 2072 2073Here is the current list of valid syntactic element symbols: 2074 2075 string -- inside multi-line string 2076 block-open -- statement block open 2077 block-close -- statement block close 2078 statement -- a VHDL statement 2079 statement-cont -- a continuation of a VHDL statement 2080 statement-block-intro -- the first line in a new statement block 2081 statement-case-intro -- the first line in a case alternative block 2082 case-alternative -- a case statement alternative clause 2083 comment -- a line containing only a comment 2084 arglist-intro -- the first line in an argument list 2085 arglist-cont -- subsequent argument list lines when no 2086 arguments follow on the same line as 2087 the arglist opening paren 2088 arglist-cont-nonempty -- subsequent argument list lines when at 2089 least one argument follows on the same 2090 line as the arglist opening paren 2091 arglist-close -- the solo close paren of an argument list 2092 entity -- inside an entity declaration 2093 configuration -- inside a configuration declaration 2094 package -- inside a package declaration 2095 architecture -- inside an architecture body 2096 package-body -- inside a package body 2097 context -- inside a context declaration") 2098 2099(defvar vhdl-comment-only-line-offset 0 2100 "Extra offset for line which contains only the start of a comment. 2101Can contain an integer or a cons cell of the form: 2102 2103 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) 2104 2105Where NON-ANCHORED-OFFSET is the amount of offset given to 2106non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is 2107the amount of offset to give column-zero anchored comment-only lines. 2108Just an integer as value is equivalent to (<val> . 0)") 2109 2110(defvar vhdl-special-indent-hook nil 2111 "Hook for user defined special indentation adjustments. 2112This hook gets called after a line is indented by the mode.") 2113 2114(defvar vhdl-style-alist 2115 '(("IEEE" 2116 (vhdl-basic-offset . 4) 2117 (vhdl-offsets-alist . ()))) 2118 "Styles of Indentation. 2119Elements of this alist are of the form: 2120 2121 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) 2122 2123where STYLE-STRING is a short descriptive string used to select a 2124style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended 2125value for that variable when using the selected style. 2126 2127There is one special case when VARIABLE is `vhdl-offsets-alist'. In this 2128case, the VALUE is a list containing elements of the form: 2129 2130 (SYNTACTIC-SYMBOL . VALUE) 2131 2132as described in `vhdl-offsets-alist'. These are passed directly to 2133`vhdl-set-offset' so there is no need to set every syntactic symbol in 2134your style, only those that are different from the default.") 2135 2136;; dynamically append the default value of most variables 2137(or (assoc "Default" vhdl-style-alist) 2138 (let* ((varlist '(vhdl-inhibit-startup-warnings-p 2139 vhdl-strict-syntax-p 2140 vhdl-echo-syntactic-information-p 2141 vhdl-basic-offset 2142 vhdl-offsets-alist 2143 vhdl-comment-only-line-offset)) 2144 (default (cons "Default" 2145 (mapcar 2146 (function 2147 (lambda (var) 2148 (cons var (symbol-value var)))) 2149 varlist)))) 2150 (push default vhdl-style-alist))) 2151 2152(defvar vhdl-mode-hook nil 2153 "Hook called by `vhdl-mode'.") 2154 2155 2156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2157;;; Required packages 2158;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2159 2160;; mandatory 2161(require 'compile) ; XEmacs 2162(require 'easymenu) 2163(require 'hippie-exp) 2164 2165;; optional (minimize warning messages during compile) 2166(unless (featurep 'xemacs) 2167(eval-when-compile 2168 (require 'font-lock) 2169 (require 'ps-print) 2170 (require 'speedbar))) ; for speedbar-with-writable 2171 2172(defun vhdl-aput (alist-symbol key &optional value) 2173 "Insert a key-value pair into an alist. 2174The alist is referenced by ALIST-SYMBOL. The key-value pair is made 2175from KEY and VALUE. If the key-value pair referenced by KEY can be 2176found in the alist, the value of KEY will be set to VALUE. If the 2177key-value pair cannot be found in the alist, it will be inserted into 2178the head of the alist." 2179 (let* ((alist (symbol-value alist-symbol)) 2180 (elem (assoc key alist))) 2181 (if elem 2182 (setcdr elem value) 2183 (set alist-symbol (cons (cons key value) alist))))) 2184 2185(defun vhdl-adelete (alist-symbol key) 2186 "Delete a key-value pair from the alist. 2187Alist is referenced by ALIST-SYMBOL and the key-value pair to remove 2188is pair matching KEY." 2189 (let ((alist (symbol-value alist-symbol)) alist-cdr) 2190 (while (equal key (caar alist)) 2191 (setq alist (cdr alist)) 2192 (set alist-symbol alist)) 2193 (while (setq alist-cdr (cdr alist)) 2194 (if (equal key (caar alist-cdr)) 2195 (setcdr alist (cdr alist-cdr)) 2196 (setq alist alist-cdr))))) 2197 2198(defun vhdl-aget (alist key) 2199 "Return the value in ALIST that is associated with KEY. If KEY is 2200not found, then nil is returned." 2201 (cdr (assoc key alist))) 2202 2203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2204;;; Compatibility 2205;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2206 2207;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2208;; XEmacs compatibility 2209 2210;; active regions 2211(defun vhdl-keep-region-active () 2212 "Do whatever is necessary to keep the region active in XEmacs. 2213Ignore byte-compiler warnings you might see." 2214 (and (featurep 'xemacs) 2215 (setq zmacs-region-stays t))) 2216 2217;; `wildcard-to-regexp' is included only in XEmacs 21 2218(unless (fboundp 'wildcard-to-regexp) 2219 (defun wildcard-to-regexp (wildcard) 2220 "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'." 2221 (let* ((i (string-match "[*?]" wildcard)) 2222 (result (substring wildcard 0 i)) 2223 (len (length wildcard))) 2224 (when i 2225 (while (< i len) 2226 (let ((ch (aref wildcard i))) 2227 (setq result (concat result 2228 (cond ((eq ch ?*) "[^\000]*") 2229 ((eq ch ??) "[^\000]") 2230 (t (char-to-string ch))))) 2231 (setq i (1+ i))))) 2232 (concat "\\`" result "\\'")))) 2233 2234;; `regexp-opt' undefined (`xemacs-devel' not installed) 2235;; `regexp-opt' accelerates fontification by 10-20% 2236(unless (fboundp 'regexp-opt) 2237; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") 2238 (defun regexp-opt (strings &optional paren) 2239 (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) 2240 (concat open (mapconcat 'regexp-quote strings "\\|") close)))) 2241 2242;; `match-string-no-properties' undefined (XEmacs, what else?) 2243(unless (fboundp 'match-string-no-properties) 2244 (defalias 'match-string-no-properties 'match-string)) 2245 2246;; `subst-char-in-string' undefined (XEmacs) 2247(unless (fboundp 'subst-char-in-string) 2248 (defun subst-char-in-string (fromchar tochar string &optional inplace) 2249 (let ((i (length string)) 2250 (newstr (if inplace string (copy-sequence string)))) 2251 (while (> i 0) 2252 (setq i (1- i)) 2253 (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) 2254 newstr))) 2255 2256;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) 2257(when (and (featurep 'xemacs) (string< itimer-version "1.09") 2258 (not noninteractive)) 2259 (load "itimer") 2260 (when (string< itimer-version "1.09") 2261 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") 2262 (beep) (sit-for 5))) 2263 2264;; `file-expand-wildcards' undefined (XEmacs) 2265(unless (fboundp 'file-expand-wildcards) 2266 (defun file-expand-wildcards (pattern &optional full) 2267 "Taken from Emacs's `files.el'." 2268 (let* ((nondir (file-name-nondirectory pattern)) 2269 (dirpart (file-name-directory pattern)) 2270 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 2271 (mapcar 'file-name-as-directory 2272 (file-expand-wildcards (directory-file-name dirpart))) 2273 (list dirpart))) 2274 contents) 2275 (while dirs 2276 (when (or (null (car dirs)) ; Possible if DIRPART is not wild. 2277 (file-directory-p (directory-file-name (car dirs)))) 2278 (let ((this-dir-contents 2279 (delq nil 2280 (mapcar #'(lambda (name) 2281 (unless (string-match "\\`\\.\\.?\\'" 2282 (file-name-nondirectory name)) 2283 name)) 2284 (directory-files (or (car dirs) ".") full 2285 (wildcard-to-regexp nondir)))))) 2286 (setq contents 2287 (nconc 2288 (if (and (car dirs) (not full)) 2289 (mapcar (function (lambda (name) (concat (car dirs) name))) 2290 this-dir-contents) 2291 this-dir-contents) 2292 contents)))) 2293 (setq dirs (cdr dirs))) 2294 contents))) 2295 2296;; `member-ignore-case' undefined (XEmacs) 2297(unless (fboundp 'member-ignore-case) 2298 (defalias 'member-ignore-case 'member)) 2299 2300;; `last-input-char' obsolete in Emacs 24, `last-input-event' different 2301;; behavior in XEmacs 2302(defvar vhdl-last-input-event) 2303(if (featurep 'xemacs) 2304 (defvaralias 'vhdl-last-input-event 'last-input-char) 2305 (defvaralias 'vhdl-last-input-event 'last-input-event)) 2306 2307;; `help-print-return-message' changed to `print-help-return-message' in Emacs 2308;;;(unless (fboundp 'help-print-return-message) 2309;;; (defalias 'help-print-return-message 'print-help-return-message)) 2310 2311;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2312;; Compatibility with older VHDL Mode versions 2313 2314(defvar vhdl-warnings nil 2315 "Warnings to tell the user during start up.") 2316 2317(defun vhdl-run-when-idle (secs repeat function) 2318 "Wait until idle, then run FUNCTION." 2319 (if (fboundp 'start-itimer) 2320 (start-itimer "vhdl-mode" function secs repeat t) 2321 ;; explicitly activate timer (necessary when Emacs is already idle) 2322 (aset (run-with-idle-timer secs repeat function) 0 nil))) 2323 2324(defun vhdl-warning-when-idle (&rest args) 2325 "Wait until idle, then print out warning STRING and beep." 2326 (let ((message (apply #'format-message args))) 2327 (if noninteractive 2328 (vhdl-warning message t) 2329 (unless vhdl-warnings 2330 (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) 2331 (push message vhdl-warnings)))) 2332 2333(defun vhdl-warning (string &optional nobeep) 2334 "Print out warning STRING and beep." 2335 (message "WARNING: %s" string) 2336 (unless (or nobeep noninteractive) (beep))) 2337 2338(defun vhdl-print-warnings () 2339 "Print out messages in variable `vhdl-warnings'." 2340 (let ((no-warnings (length vhdl-warnings))) 2341 (setq vhdl-warnings (nreverse vhdl-warnings)) 2342 (while vhdl-warnings 2343 (message "WARNING: %s" (car vhdl-warnings)) 2344 (setq vhdl-warnings (cdr vhdl-warnings))) 2345 (beep) 2346 (when (> no-warnings 1) 2347 (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) 2348 2349;; Backward compatibility checks and fixes 2350;; option `vhdl-compiler' changed format 2351(unless (stringp vhdl-compiler) 2352 (setq vhdl-compiler "ModelSim") 2353 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) 2354 2355;; option `vhdl-standard' changed format 2356(unless (listp vhdl-standard) 2357 (setq vhdl-standard '(87 nil)) 2358 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) 2359 2360;; option `vhdl-model-alist' changed format 2361(when (= (length (car vhdl-model-alist)) 3) 2362 (let ((old-alist vhdl-model-alist) 2363 new-alist) 2364 (while old-alist 2365 (push (append (car old-alist) '("")) new-alist) 2366 (setq old-alist (cdr old-alist))) 2367 (setq vhdl-model-alist (nreverse new-alist))) 2368 (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) 2369 2370;; option `vhdl-project-alist' changed format 2371(when (= (length (car vhdl-project-alist)) 3) 2372 (let ((old-alist vhdl-project-alist) 2373 new-alist) 2374 (while old-alist 2375 (push (append (car old-alist) '("")) new-alist) 2376 (setq old-alist (cdr old-alist))) 2377 (setq vhdl-project-alist (nreverse new-alist))) 2378 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2379 2380;; option `vhdl-project-alist' changed format (3.31.1) 2381(when (= (length (car vhdl-project-alist)) 4) 2382 (let ((old-alist vhdl-project-alist) 2383 new-alist elem) 2384 (while old-alist 2385 (setq elem (car old-alist)) 2386 (setq new-alist 2387 (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) 2388 nil "./" "work" "work/" "Makefile" (nth 3 elem)) 2389 new-alist)) 2390 (setq old-alist (cdr old-alist))) 2391 (setq vhdl-project-alist (nreverse new-alist))) 2392 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) 2393 2394;; option `vhdl-project-alist' changed format (3.31.12) 2395(when (= (length (car vhdl-project-alist)) 10) 2396 (let ((tmp-alist vhdl-project-alist)) 2397 (while tmp-alist 2398 (setcdr (nthcdr 3 (car tmp-alist)) 2399 (cons "" (nthcdr 4 (car tmp-alist)))) 2400 (setq tmp-alist (cdr tmp-alist)))) 2401 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2402 2403;; option `vhdl-compiler-alist' changed format (3.31.1) 2404(when (= (length (car vhdl-compiler-alist)) 7) 2405 (let ((old-alist vhdl-compiler-alist) 2406 new-alist elem) 2407 (while old-alist 2408 (setq elem (car old-alist)) 2409 (setq new-alist 2410 (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" 2411 (if (equal (nth 3 elem) "") nil (nth 3 elem)) 2412 (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) 2413 (nth 5 elem) (nth 6 elem) nil) 2414 new-alist)) 2415 (setq old-alist (cdr old-alist))) 2416 (setq vhdl-compiler-alist (nreverse new-alist))) 2417 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) 2418 2419;; option `vhdl-compiler-alist' changed format (3.31.10) 2420(when (= (length (car vhdl-compiler-alist)) 12) 2421 (let ((tmp-alist vhdl-compiler-alist)) 2422 (while tmp-alist 2423 (setcdr (nthcdr 4 (car tmp-alist)) 2424 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) 2425 (setq tmp-alist (cdr tmp-alist)))) 2426 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2427 2428;; option `vhdl-compiler-alist' changed format (3.31.11) 2429(when (= (length (car vhdl-compiler-alist)) 13) 2430 (let ((tmp-alist vhdl-compiler-alist)) 2431 (while tmp-alist 2432 (setcdr (nthcdr 3 (car tmp-alist)) 2433 (cons "" (nthcdr 4 (car tmp-alist)))) 2434 (setq tmp-alist (cdr tmp-alist)))) 2435 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2436 2437;; option `vhdl-compiler-alist' changed format (3.32.7) 2438(when (= (length (nth 11 (car vhdl-compiler-alist))) 3) 2439 (let ((tmp-alist vhdl-compiler-alist)) 2440 (while tmp-alist 2441 (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) 2442 '(0 . nil)) 2443 (setq tmp-alist (cdr tmp-alist)))) 2444 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2445 2446;; option `vhdl-project': empty value changed from "" to nil (3.31.1) 2447(when (equal vhdl-project "") 2448 (setq vhdl-project nil) 2449 (customize-save-variable 'vhdl-project vhdl-project)) 2450 2451;; option `vhdl-project-file-name': changed format (3.31.17 beta) 2452(when (stringp vhdl-project-file-name) 2453 (setq vhdl-project-file-name (list vhdl-project-file-name)) 2454 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) 2455 2456;; option `speedbar-indentation-width': introduced in speedbar 0.10 2457(if (not (boundp 'speedbar-indentation-width)) 2458 (defvar speedbar-indentation-width 2) 2459 ;; set default to 2 if not already customized 2460 (unless (get 'speedbar-indentation-width 'saved-value) 2461 (setq speedbar-indentation-width 2))) 2462 2463;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2464;;; Help functions / inline substitutions / macros 2465;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2466 2467(defun vhdl-standard-p (standard) 2468 "Check if STANDARD is specified as used standard." 2469 (or (eq standard (car vhdl-standard)) 2470 (memq standard (cadr vhdl-standard)))) 2471 2472(defun vhdl-project-p (&optional warning) 2473 "Return non-nil if a project is displayed, i.e. directories or files are 2474specified." 2475 (if (assoc vhdl-project vhdl-project-alist) 2476 vhdl-project 2477 (when (and vhdl-project warning) 2478 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) 2479 nil)) 2480 2481(defun vhdl-resolve-env-variable (string) 2482 "Resolve environment variables in STRING." 2483 (while (string-match "\\(.*\\)\\${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) 2484 (setq string (concat (match-string 1 string) 2485 (getenv (match-string 2 string)) 2486 (match-string 4 string)))) 2487 string) 2488 2489(defun vhdl-default-directory () 2490 "Return the default directory of the current project or the directory of the 2491current buffer if no project is defined." 2492 (if (vhdl-project-p) 2493 (expand-file-name (vhdl-resolve-env-variable 2494 (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) 2495 default-directory)) 2496 2497(defmacro vhdl-prepare-search-1 (&rest body) 2498 "Enable case insensitive search and switch to syntax table that includes `_', 2499then execute BODY, and finally restore the old environment. Used for 2500consistent searching." 2501 `(let ((case-fold-search t)) ; case insensitive search 2502 ;; use extended syntax table 2503 (with-syntax-table vhdl-mode-ext-syntax-table 2504 ,@body))) 2505 2506(defmacro vhdl-prepare-search-2 (&rest body) 2507 "Enable case insensitive search, switch to syntax table that includes `_', 2508arrange to ignore `intangible' overlays, then execute BODY, and finally restore 2509the old environment. Used for consistent searching." 2510 `(let ((case-fold-search t) ; case insensitive search 2511 (current-syntax-table (syntax-table)) 2512 (inhibit-point-motion-hooks t)) 2513 ;; use extended syntax table 2514 (set-syntax-table vhdl-mode-ext-syntax-table) 2515 ;; execute BODY safely 2516 (unwind-protect 2517 (progn ,@body) 2518 ;; restore syntax table 2519 (set-syntax-table current-syntax-table)))) 2520 2521(defmacro vhdl-visit-file (file-name issue-error &rest body) 2522 "Visit file FILE-NAME and execute BODY." 2523 `(if (null ,file-name) 2524 (progn ,@body) 2525 (unless (file-directory-p ,file-name) 2526 (let ((source-buffer (current-buffer)) 2527 (visiting-buffer (find-buffer-visiting ,file-name)) 2528 file-opened) 2529 (when (or (and visiting-buffer (set-buffer visiting-buffer)) 2530 (condition-case () 2531 (progn (set-buffer (create-file-buffer ,file-name)) 2532 (setq file-opened t) 2533 (vhdl-insert-file-contents ,file-name) 2534 ;; FIXME: This modifies a global syntax-table! 2535 (modify-syntax-entry ?\- ". 12" (syntax-table)) 2536 (modify-syntax-entry ?\n ">" (syntax-table)) 2537 (modify-syntax-entry ?\^M ">" (syntax-table)) 2538 (modify-syntax-entry ?_ "w" (syntax-table)) 2539 t) 2540 (error 2541 (if ,issue-error 2542 (progn 2543 (when file-opened (kill-buffer (current-buffer))) 2544 (set-buffer source-buffer) 2545 (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) 2546 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) 2547 nil)))) 2548 (condition-case info 2549 (progn ,@body) 2550 (error 2551 (if ,issue-error 2552 (progn 2553 (when file-opened (kill-buffer (current-buffer))) 2554 (set-buffer source-buffer) 2555 (error (cadr info))) 2556 (vhdl-warning (cadr info)))))) 2557 (when file-opened (kill-buffer (current-buffer))) 2558 (set-buffer source-buffer))))) 2559 2560(defun vhdl-insert-file-contents (filename) 2561 "Nicked from `insert-file-contents-literally', but allow coding system 2562conversion." 2563 (let ((format-alist nil) 2564 (after-insert-file-functions nil) 2565 (jka-compr-compression-info-list nil)) 2566 (insert-file-contents filename t))) 2567 2568(defun vhdl-sort-alist (alist) 2569 "Sort ALIST." 2570 (sort alist (function (lambda (a b) (string< (car a) (car b)))))) 2571 2572(defun vhdl-get-subdirs (directory) 2573 "Recursively get subdirectories of DIRECTORY." 2574 (let ((dir-list (list (file-name-as-directory directory))) 2575 file-list) 2576 (setq file-list (vhdl-directory-files directory t "\\w.*")) 2577 (while file-list 2578 (when (file-directory-p (car file-list)) 2579 (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) 2580 (setq file-list (cdr file-list))) 2581 dir-list)) 2582 2583(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) 2584 "As `aput', but delete key-value pair if VALUE is nil." 2585 (if value 2586 (vhdl-aput alist-symbol key value) 2587 (vhdl-adelete alist-symbol key))) 2588 2589(defun vhdl-delete (elt list) 2590 "Delete by side effect the first occurrence of ELT as a member of LIST." 2591 (push nil list) 2592 (let ((list1 list)) 2593 (while (and (cdr list1) (not (equal elt (cadr list1)))) 2594 (setq list1 (cdr list1))) 2595 (when list 2596 (setcdr list1 (cddr list1)))) 2597 (cdr list)) 2598 2599(declare-function speedbar-refresh "speedbar" (&optional arg)) 2600(declare-function speedbar-do-function-pointer "speedbar" ()) 2601 2602(defun vhdl-speedbar-refresh (&optional key) 2603 "Refresh directory or project with name KEY." 2604 (when (and (boundp 'speedbar-frame) 2605 (frame-live-p speedbar-frame)) 2606 (let ((pos (point)) 2607 (last-frame (selected-frame))) 2608 (if (null key) 2609 (speedbar-refresh) 2610 (select-frame speedbar-frame) 2611 (when (save-excursion 2612 (goto-char (point-min)) 2613 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) 2614 (goto-char (match-end 1)) 2615 (speedbar-do-function-pointer) 2616 (backward-char 2) 2617 (speedbar-do-function-pointer) 2618 (message "Refreshing speedbar...done")) 2619 (select-frame last-frame))))) 2620 2621(defun vhdl-show-messages () 2622 "Get *Messages* buffer to show recent messages." 2623 (interactive) 2624 (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) 2625 2626(defun vhdl-use-direct-instantiation () 2627 "Return whether direct instantiation is used." 2628 (or (eq vhdl-use-direct-instantiation 'always) 2629 (and (eq vhdl-use-direct-instantiation 'standard) 2630 (not (vhdl-standard-p '87))))) 2631 2632(defun vhdl-max-marker (marker1 marker2) 2633 "Return larger marker." 2634 (if (> marker1 marker2) marker1 marker2)) 2635 2636(defun vhdl-goto-marker (marker) 2637 "Goto marker in appropriate buffer." 2638 (when (markerp marker) 2639 (set-buffer (marker-buffer marker))) 2640 (goto-char marker)) 2641 2642(defun vhdl-menu-split (list title) 2643 "Split menu LIST into several submenus, if number of 2644elements > `vhdl-menu-max-size'." 2645 (if (> (length list) vhdl-menu-max-size) 2646 (let ((remain list) 2647 (result '()) 2648 (sublist '()) 2649 (menuno 1) 2650 (i 0)) 2651 (while remain 2652 (push (car remain) sublist) 2653 (setq remain (cdr remain)) 2654 (setq i (+ i 1)) 2655 (if (= i vhdl-menu-max-size) 2656 (progn 2657 (push (cons (format "%s %s" title menuno) 2658 (nreverse sublist)) result) 2659 (setq i 0) 2660 (setq menuno (+ menuno 1)) 2661 (setq sublist '())))) 2662 (and sublist 2663 (push (cons (format "%s %s" title menuno) 2664 (nreverse sublist)) result)) 2665 (nreverse result)) 2666 list)) 2667 2668 2669;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2670;;; Bindings 2671;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2672 2673;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2674;; Key bindings 2675 2676(defvar vhdl-template-map nil 2677 "Keymap for VHDL templates.") 2678 2679(defun vhdl-template-map-init () 2680 "Initialize `vhdl-template-map'." 2681 (setq vhdl-template-map (make-sparse-keymap)) 2682 ;; key bindings for VHDL templates 2683 (define-key vhdl-template-map "al" 'vhdl-template-alias) 2684 (define-key vhdl-template-map "ar" 'vhdl-template-architecture) 2685 (define-key vhdl-template-map "at" 'vhdl-template-assert) 2686 (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) 2687 (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) 2688 (define-key vhdl-template-map "bl" 'vhdl-template-block) 2689 (define-key vhdl-template-map "ca" 'vhdl-template-case-is) 2690 (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) 2691 (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) 2692 (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) 2693 (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) 2694 (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) 2695 (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) 2696 (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) 2697 (define-key vhdl-template-map "co" 'vhdl-template-constant) 2698 (define-key vhdl-template-map "ct" 'vhdl-template-context) 2699 (define-key vhdl-template-map "di" 'vhdl-template-disconnect) 2700 (define-key vhdl-template-map "el" 'vhdl-template-else) 2701 (define-key vhdl-template-map "ei" 'vhdl-template-elsif) 2702 (define-key vhdl-template-map "en" 'vhdl-template-entity) 2703 (define-key vhdl-template-map "ex" 'vhdl-template-exit) 2704 (define-key vhdl-template-map "fi" 'vhdl-template-file) 2705 (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) 2706 (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) 2707 (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) 2708 (define-key vhdl-template-map "fb" 'vhdl-template-function-body) 2709 (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) 2710 (define-key vhdl-template-map "ge" 'vhdl-template-generic) 2711 (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) 2712 (define-key vhdl-template-map "gt" 'vhdl-template-group-template) 2713 (define-key vhdl-template-map "\C-h" 'vhdl-template-header) 2714 (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) 2715 (define-key vhdl-template-map "it" 'vhdl-template-if-then) 2716 (define-key vhdl-template-map "li" 'vhdl-template-library) 2717 (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) 2718 (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) 2719 (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) 2720 (define-key vhdl-template-map "ma" 'vhdl-template-map) 2721 (define-key vhdl-template-map "ne" 'vhdl-template-next) 2722 (define-key vhdl-template-map "ot" 'vhdl-template-others) 2723 (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) 2724 (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) 2725 (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) 2726 (define-key vhdl-template-map "po" 'vhdl-template-port) 2727 (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) 2728 (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) 2729 (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) 2730 (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) 2731 (define-key vhdl-template-map "rp" 'vhdl-template-report) 2732 (define-key vhdl-template-map "rt" 'vhdl-template-return) 2733 (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) 2734 (define-key vhdl-template-map "si" 'vhdl-template-signal) 2735 (define-key vhdl-template-map "su" 'vhdl-template-subtype) 2736 (define-key vhdl-template-map "ty" 'vhdl-template-type) 2737 (define-key vhdl-template-map "us" 'vhdl-template-use) 2738 (define-key vhdl-template-map "va" 'vhdl-template-variable) 2739 (define-key vhdl-template-map "wa" 'vhdl-template-wait) 2740 (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) 2741 (define-key vhdl-template-map "wi" 'vhdl-template-with) 2742 (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) 2743 (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) 2744 (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) 2745 (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) 2746 (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) 2747 (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) 2748 (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) 2749 (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) 2750 (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) 2751 (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) 2752 (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) 2753 (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) 2754 (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) 2755 (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) 2756 (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) 2757 (when (vhdl-standard-p 'ams) 2758 (define-key vhdl-template-map "br" 'vhdl-template-break) 2759 (define-key vhdl-template-map "cu" 'vhdl-template-case-use) 2760 (define-key vhdl-template-map "iu" 'vhdl-template-if-use) 2761 (define-key vhdl-template-map "lm" 'vhdl-template-limit) 2762 (define-key vhdl-template-map "na" 'vhdl-template-nature) 2763 (define-key vhdl-template-map "pa" 'vhdl-template-procedural) 2764 (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) 2765 (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) 2766 (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) 2767 (define-key vhdl-template-map "sn" 'vhdl-template-subnature) 2768 (define-key vhdl-template-map "te" 'vhdl-template-terminal) 2769 ) 2770 (when (vhdl-standard-p 'math) 2771 (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) 2772 (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) 2773 )) 2774 2775;; initialize template map for VHDL Mode 2776(vhdl-template-map-init) 2777 2778(defun vhdl-function-name (prefix string &optional postfix) 2779 "Generate a Lisp function name. 2780PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in 2781STRING are replaced by `-' and substrings are converted to lower case." 2782 (let ((name prefix)) 2783 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) 2784 (setq name 2785 (concat name "-" (downcase (substring string 0 (match-end 1))))) 2786 (setq string (substring string (match-beginning 2)))) 2787 (when postfix (setq name (concat name "-" postfix))) 2788 (intern name))) 2789 2790(defvar vhdl-model-map nil 2791 "Keymap for VHDL models.") 2792 2793(defun vhdl-model-map-init () 2794 "Initialize `vhdl-model-map'." 2795 (setq vhdl-model-map (make-sparse-keymap)) 2796 ;; key bindings for VHDL models 2797 (let ((model-alist vhdl-model-alist) model) 2798 (while model-alist 2799 (setq model (car model-alist)) 2800 (define-key vhdl-model-map (nth 2 model) 2801 (vhdl-function-name "vhdl-model" (nth 0 model))) 2802 (setq model-alist (cdr model-alist))))) 2803 2804;; initialize user model map for VHDL Mode 2805(vhdl-model-map-init) 2806 2807(defvar vhdl-mode-map nil 2808 "Keymap for VHDL Mode.") 2809 2810(defun vhdl-mode-map-init () 2811 "Initialize `vhdl-mode-map'." 2812 (setq vhdl-mode-map (make-sparse-keymap)) 2813 ;; template key bindings 2814 (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) 2815 ;; model key bindings 2816 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) 2817 ;; standard key bindings 2818 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) 2819 (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) 2820 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) 2821 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) 2822 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) 2823 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) 2824 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) 2825 (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs 2826 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) 2827 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) 2828 (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) 2829 ;; mode specific key bindings 2830 (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) 2831 (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) 2832 (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) 2833 (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) 2834 (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) 2835 (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) 2836 (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) 2837 (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) 2838 (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) 2839 (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) 2840 (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) 2841 (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) 2842 (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) 2843 (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) 2844 (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) 2845 (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) 2846 (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) 2847 (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs 2848 (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) 2849 (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) 2850 (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) 2851 (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) 2852 (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) 2853 (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) 2854 (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) 2855 (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) 2856 (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) 2857 (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) 2858 (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) 2859 (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) 2860 (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) 2861 (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) 2862 (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) 2863 (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) 2864 (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) 2865 (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) 2866 (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) 2867 (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) 2868 (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) 2869 (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) 2870 (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) 2871 (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) 2872 (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) 2873 (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) 2874 (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) 2875 (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) 2876 (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) 2877 (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) 2878 (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) 2879 (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) 2880 (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) 2881 (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) 2882 (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) 2883 (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) 2884 (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) 2885 (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) 2886 (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) 2887 (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) 2888 (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) 2889 (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) 2890 (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) 2891 (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) 2892 (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) 2893 (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) 2894 (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) 2895 (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) 2896 (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) 2897 (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) 2898 (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) 2899 (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) 2900 (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) 2901 (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) 2902 (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) 2903 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) 2904 (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) 2905 (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) 2906 (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) 2907 (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) 2908 (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) 2909 (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) 2910 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) 2911 (define-key vhdl-mode-map "\M-\t" 'insert-tab) 2912 ;; insert commands bindings 2913 (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) 2914 (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) 2915 (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) 2916 (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) 2917 ;; electric key bindings 2918 (define-key vhdl-mode-map " " 'vhdl-electric-space) 2919 (when vhdl-intelligent-tab 2920 (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) 2921 (define-key vhdl-mode-map "\r" 'vhdl-electric-return) 2922 (define-key vhdl-mode-map "-" 'vhdl-electric-dash) 2923 (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) 2924 (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) 2925 (define-key vhdl-mode-map "'" 'vhdl-electric-quote) 2926 (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) 2927 (define-key vhdl-mode-map "," 'vhdl-electric-comma) 2928 (define-key vhdl-mode-map "." 'vhdl-electric-period) 2929 (when (vhdl-standard-p 'ams) 2930 (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) 2931 2932;; initialize mode map for VHDL Mode 2933(vhdl-mode-map-init) 2934 2935;; define special minibuffer keymap for enabling word completion in minibuffer 2936;; (useful in template generator prompts) 2937(defvar vhdl-minibuffer-local-map 2938 (let ((map (make-sparse-keymap))) 2939 (set-keymap-parent map minibuffer-local-map) 2940 (when vhdl-word-completion-in-minibuffer 2941 (define-key map "\t" 'vhdl-minibuffer-tab)) 2942 map) 2943 "Keymap for minibuffer used in VHDL Mode.") 2944 2945;; set up electric character functions to work with 2946;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) 2947(mapc 2948 (function 2949 (lambda (sym) 2950 (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) 2951 (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs) 2952 '(vhdl-electric-space 2953 vhdl-electric-tab 2954 vhdl-electric-return 2955 vhdl-electric-dash 2956 vhdl-electric-open-bracket 2957 vhdl-electric-close-bracket 2958 vhdl-electric-quote 2959 vhdl-electric-semicolon 2960 vhdl-electric-comma 2961 vhdl-electric-period 2962 vhdl-electric-equal)) 2963 2964;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2965;; Syntax table 2966 2967(defvar vhdl-mode-syntax-table 2968 (let ((st (make-syntax-table))) 2969 ;; define punctuation 2970 (modify-syntax-entry ?\# "." st) 2971 (modify-syntax-entry ?\$ "." st) 2972 (modify-syntax-entry ?\% "." st) 2973 (modify-syntax-entry ?\& "." st) 2974 (modify-syntax-entry ?\' "." st) 2975 (modify-syntax-entry ?\* "." st) 2976 (modify-syntax-entry ?\+ "." st) 2977 (modify-syntax-entry ?\. "." st) 2978;;; (modify-syntax-entry ?\/ "." st) 2979 (modify-syntax-entry ?\: "." st) 2980 (modify-syntax-entry ?\; "." st) 2981 (modify-syntax-entry ?\< "." st) 2982 (modify-syntax-entry ?\= "." st) 2983 (modify-syntax-entry ?\> "." st) 2984 (modify-syntax-entry ?\\ "." st) 2985 (modify-syntax-entry ?\| "." st) 2986 ;; define string 2987 (modify-syntax-entry ?\" "\"" st) 2988 ;; define underscore 2989 (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st) 2990 ;; single-line comments 2991 (modify-syntax-entry ?\- ". 12b" st) 2992 ;; multi-line comments 2993 (modify-syntax-entry ?\/ ". 14b" st) 2994 (modify-syntax-entry ?* ". 23" st) 2995 (modify-syntax-entry ?\n "> b" st) 2996 (modify-syntax-entry ?\^M "> b" st) 2997 ;; define parentheses to match 2998 (modify-syntax-entry ?\( "()" st) 2999 (modify-syntax-entry ?\) ")(" st) 3000 (modify-syntax-entry ?\[ "(]" st) 3001 (modify-syntax-entry ?\] ")[" st) 3002 (modify-syntax-entry ?\{ "(}" st) 3003 (modify-syntax-entry ?\} "){" st) 3004 st) 3005 "Syntax table used in `vhdl-mode' buffers.") 3006 3007(defvar vhdl-mode-ext-syntax-table 3008 ;; Extended syntax table including '_' (for simpler search regexps). 3009 (let ((st (copy-syntax-table vhdl-mode-syntax-table))) 3010 (modify-syntax-entry ?_ "w" st) 3011 st) 3012 "Syntax table extended by `_' used in `vhdl-mode' buffers.") 3013 3014(defvar vhdl-syntactic-context nil 3015 "Buffer local variable containing syntactic analysis list.") 3016(make-variable-buffer-local 'vhdl-syntactic-context) 3017 3018;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3019;; Abbrev hook bindings 3020 3021(defvar vhdl-mode-abbrev-table nil 3022 "Abbrev table to use in `vhdl-mode' buffers.") 3023 3024(defun vhdl-mode-abbrev-table-init () 3025 "Initialize `vhdl-mode-abbrev-table'." 3026 (define-abbrev-table 'vhdl-mode-abbrev-table 3027 (append 3028 (when (memq 'vhdl vhdl-electric-keywords) 3029 ;; VHDL'02 keywords 3030 (mapcar (if (featurep 'xemacs) 3031 (lambda (x) (list (car x) "" (cdr x) 0)) 3032 (lambda (x) (list (car x) "" (cdr x) 0 'system))) 3033 '( 3034 ("--" . vhdl-template-display-comment-hook) 3035 ("abs" . vhdl-template-default-hook) 3036 ("access" . vhdl-template-default-hook) 3037 ("after" . vhdl-template-default-hook) 3038 ("alias" . vhdl-template-alias-hook) 3039 ("all" . vhdl-template-default-hook) 3040 ("and" . vhdl-template-default-hook) 3041 ("arch" . vhdl-template-architecture-hook) 3042 ("architecture" . vhdl-template-architecture-hook) 3043 ("array" . vhdl-template-default-hook) 3044 ("assert" . vhdl-template-assert-hook) 3045 ("attr" . vhdl-template-attribute-hook) 3046 ("attribute" . vhdl-template-attribute-hook) 3047 ("begin" . vhdl-template-default-indent-hook) 3048 ("block" . vhdl-template-block-hook) 3049 ("body" . vhdl-template-default-hook) 3050 ("buffer" . vhdl-template-default-hook) 3051 ("bus" . vhdl-template-default-hook) 3052 ("case" . vhdl-template-case-hook) 3053 ("comp" . vhdl-template-component-hook) 3054 ("component" . vhdl-template-component-hook) 3055 ("cond" . vhdl-template-conditional-signal-asst-hook) 3056 ("conditional" . vhdl-template-conditional-signal-asst-hook) 3057 ("conf" . vhdl-template-configuration-hook) 3058 ("configuration" . vhdl-template-configuration-hook) 3059 ("cons" . vhdl-template-constant-hook) 3060 ("constant" . vhdl-template-constant-hook) 3061 ("context" . vhdl-template-context-hook) 3062 ("disconnect" . vhdl-template-disconnect-hook) 3063 ("downto" . vhdl-template-default-hook) 3064 ("else" . vhdl-template-else-hook) 3065 ("elseif" . vhdl-template-elsif-hook) 3066 ("elsif" . vhdl-template-elsif-hook) 3067 ("end" . vhdl-template-default-indent-hook) 3068 ("entity" . vhdl-template-entity-hook) 3069 ("exit" . vhdl-template-exit-hook) 3070 ("file" . vhdl-template-file-hook) 3071 ("for" . vhdl-template-for-hook) 3072 ("func" . vhdl-template-function-hook) 3073 ("function" . vhdl-template-function-hook) 3074 ("generic" . vhdl-template-generic-hook) 3075 ("group" . vhdl-template-group-hook) 3076 ("guarded" . vhdl-template-default-hook) 3077 ("if" . vhdl-template-if-hook) 3078 ("impure" . vhdl-template-default-hook) 3079 ("in" . vhdl-template-default-hook) 3080 ("inertial" . vhdl-template-default-hook) 3081 ("inout" . vhdl-template-default-hook) 3082 ("inst" . vhdl-template-instance-hook) 3083 ("instance" . vhdl-template-instance-hook) 3084 ("is" . vhdl-template-default-hook) 3085 ("label" . vhdl-template-default-hook) 3086 ("library" . vhdl-template-library-hook) 3087 ("linkage" . vhdl-template-default-hook) 3088 ("literal" . vhdl-template-default-hook) 3089 ("loop" . vhdl-template-bare-loop-hook) 3090 ("map" . vhdl-template-map-hook) 3091 ("mod" . vhdl-template-default-hook) 3092 ("nand" . vhdl-template-default-hook) 3093 ("new" . vhdl-template-default-hook) 3094 ("next" . vhdl-template-next-hook) 3095 ("nor" . vhdl-template-default-hook) 3096 ("not" . vhdl-template-default-hook) 3097 ("null" . vhdl-template-default-hook) 3098 ("of" . vhdl-template-default-hook) 3099 ("on" . vhdl-template-default-hook) 3100 ("open" . vhdl-template-default-hook) 3101 ("or" . vhdl-template-default-hook) 3102 ("others" . vhdl-template-others-hook) 3103 ("out" . vhdl-template-default-hook) 3104 ("pack" . vhdl-template-package-hook) 3105 ("package" . vhdl-template-package-hook) 3106 ("port" . vhdl-template-port-hook) 3107 ("postponed" . vhdl-template-default-hook) 3108 ("procedure" . vhdl-template-procedure-hook) 3109 ("process" . vhdl-template-process-hook) 3110 ("pure" . vhdl-template-default-hook) 3111 ("range" . vhdl-template-default-hook) 3112 ("record" . vhdl-template-default-hook) 3113 ("register" . vhdl-template-default-hook) 3114 ("reject" . vhdl-template-default-hook) 3115 ("rem" . vhdl-template-default-hook) 3116 ("report" . vhdl-template-report-hook) 3117 ("return" . vhdl-template-return-hook) 3118 ("rol" . vhdl-template-default-hook) 3119 ("ror" . vhdl-template-default-hook) 3120 ("select" . vhdl-template-selected-signal-asst-hook) 3121 ("severity" . vhdl-template-default-hook) 3122 ("shared" . vhdl-template-default-hook) 3123 ("sig" . vhdl-template-signal-hook) 3124 ("signal" . vhdl-template-signal-hook) 3125 ("sla" . vhdl-template-default-hook) 3126 ("sll" . vhdl-template-default-hook) 3127 ("sra" . vhdl-template-default-hook) 3128 ("srl" . vhdl-template-default-hook) 3129 ("subtype" . vhdl-template-subtype-hook) 3130 ("then" . vhdl-template-default-hook) 3131 ("to" . vhdl-template-default-hook) 3132 ("transport" . vhdl-template-default-hook) 3133 ("type" . vhdl-template-type-hook) 3134 ("unaffected" . vhdl-template-default-hook) 3135 ("units" . vhdl-template-default-hook) 3136 ("until" . vhdl-template-default-hook) 3137 ("use" . vhdl-template-use-hook) 3138 ("var" . vhdl-template-variable-hook) 3139 ("variable" . vhdl-template-variable-hook) 3140 ("wait" . vhdl-template-wait-hook) 3141 ("when" . vhdl-template-when-hook) 3142 ("while" . vhdl-template-while-loop-hook) 3143 ("with" . vhdl-template-with-hook) 3144 ("xnor" . vhdl-template-default-hook) 3145 ("xor" . vhdl-template-default-hook) 3146 ))) 3147 ;; VHDL-AMS keywords 3148 (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) 3149 (mapcar (if (featurep 'xemacs) 3150 (lambda (x) (list (car x) "" (cdr x) 0)) 3151 (lambda (x) (list (car x) "" (cdr x) 0 'system))) 3152 '( 3153 ("across" . vhdl-template-default-hook) 3154 ("break" . vhdl-template-break-hook) 3155 ("limit" . vhdl-template-limit-hook) 3156 ("nature" . vhdl-template-nature-hook) 3157 ("noise" . vhdl-template-default-hook) 3158 ("procedural" . vhdl-template-procedural-hook) 3159 ("quantity" . vhdl-template-quantity-hook) 3160 ("reference" . vhdl-template-default-hook) 3161 ("spectrum" . vhdl-template-default-hook) 3162 ("subnature" . vhdl-template-subnature-hook) 3163 ("terminal" . vhdl-template-terminal-hook) 3164 ("through" . vhdl-template-default-hook) 3165 ("tolerance" . vhdl-template-default-hook) 3166 ))) 3167 ;; user model keywords 3168 (when (memq 'user vhdl-electric-keywords) 3169 (let (abbrev-list keyword) 3170 (dolist (elem vhdl-model-alist) 3171 (setq keyword (nth 3 elem)) 3172 (unless (equal keyword "") 3173 (push (list keyword "" 3174 (vhdl-function-name 3175 "vhdl-model" (nth 0 elem) "hook") 0 'system) 3176 abbrev-list))) 3177 abbrev-list))))) 3178 3179;; initialize abbrev table for VHDL Mode 3180(vhdl-mode-abbrev-table-init) 3181 3182;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3183;; Template completion lists 3184 3185(defvar vhdl-template-construct-alist nil 3186 "List of built-in construct templates.") 3187 3188(defun vhdl-template-construct-alist-init () 3189 "Initialize `vhdl-template-construct-alist'." 3190 (setq 3191 vhdl-template-construct-alist 3192 (append 3193 '( 3194 ("alias declaration" vhdl-template-alias) 3195 ("architecture body" vhdl-template-architecture) 3196 ("assertion" vhdl-template-assert) 3197 ("attribute declaration" vhdl-template-attribute-decl) 3198 ("attribute specification" vhdl-template-attribute-spec) 3199 ("block configuration" vhdl-template-block-configuration) 3200 ("block statement" vhdl-template-block) 3201 ("case statement" vhdl-template-case-is) 3202 ("component configuration" vhdl-template-component-conf) 3203 ("component declaration" vhdl-template-component-decl) 3204 ("component instantiation statement" vhdl-template-component-inst) 3205 ("conditional signal assignment" vhdl-template-conditional-signal-asst) 3206 ("configuration declaration" vhdl-template-configuration-decl) 3207 ("configuration specification" vhdl-template-configuration-spec) 3208 ("constant declaration" vhdl-template-constant) 3209 ("context declaration" vhdl-template-context) 3210 ("disconnection specification" vhdl-template-disconnect) 3211 ("entity declaration" vhdl-template-entity) 3212 ("exit statement" vhdl-template-exit) 3213 ("file declaration" vhdl-template-file) 3214 ("generate statement" vhdl-template-generate) 3215 ("generic clause" vhdl-template-generic) 3216 ("group declaration" vhdl-template-group-decl) 3217 ("group template declaration" vhdl-template-group-template) 3218 ("if statement" vhdl-template-if-then) 3219 ("library clause" vhdl-template-library) 3220 ("loop statement" vhdl-template-loop) 3221 ("next statement" vhdl-template-next) 3222 ("package declaration" vhdl-template-package-decl) 3223 ("package body" vhdl-template-package-body) 3224 ("port clause" vhdl-template-port) 3225 ("process statement" vhdl-template-process) 3226 ("report statement" vhdl-template-report) 3227 ("return statement" vhdl-template-return) 3228 ("selected signal assignment" vhdl-template-selected-signal-asst) 3229 ("signal declaration" vhdl-template-signal) 3230 ("subprogram declaration" vhdl-template-subprogram-decl) 3231 ("subprogram body" vhdl-template-subprogram-body) 3232 ("subtype declaration" vhdl-template-subtype) 3233 ("type declaration" vhdl-template-type) 3234 ("use clause" vhdl-template-use) 3235 ("variable declaration" vhdl-template-variable) 3236 ("wait statement" vhdl-template-wait) 3237 ) 3238 (when (vhdl-standard-p 'ams) 3239 '( 3240 ("break statement" vhdl-template-break) 3241 ("nature declaration" vhdl-template-nature) 3242 ("quantity declaration" vhdl-template-quantity) 3243 ("simultaneous case statement" vhdl-template-case-use) 3244 ("simultaneous if statement" vhdl-template-if-use) 3245 ("simultaneous procedural statement" vhdl-template-procedural) 3246 ("step limit specification" vhdl-template-limit) 3247 ("subnature declaration" vhdl-template-subnature) 3248 ("terminal declaration" vhdl-template-terminal) 3249 ))))) 3250 3251;; initialize for VHDL Mode 3252(vhdl-template-construct-alist-init) 3253 3254(defvar vhdl-template-package-alist nil 3255 "List of built-in package templates.") 3256 3257(defun vhdl-template-package-alist-init () 3258 "Initialize `vhdl-template-package-alist'." 3259 (setq 3260 vhdl-template-package-alist 3261 (append 3262 '( 3263 ("numeric_bit" vhdl-template-package-numeric-bit) 3264 ("numeric_std" vhdl-template-package-numeric-std) 3265 ("std_logic_1164" vhdl-template-package-std-logic-1164) 3266 ("std_logic_arith" vhdl-template-package-std-logic-arith) 3267 ("std_logic_misc" vhdl-template-package-std-logic-misc) 3268 ("std_logic_signed" vhdl-template-package-std-logic-signed) 3269 ("std_logic_textio" vhdl-template-package-std-logic-textio) 3270 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) 3271 ("textio" vhdl-template-package-textio) 3272 ) 3273 (when (vhdl-standard-p 'math) 3274 '( 3275 ("math_complex" vhdl-template-package-math-complex) 3276 ("math_real" vhdl-template-package-math-real) 3277 ))))) 3278 3279;; initialize for VHDL Mode 3280(vhdl-template-package-alist-init) 3281 3282(defvar vhdl-template-directive-alist 3283 '( 3284 ("translate_on" vhdl-template-directive-translate-on) 3285 ("translate_off" vhdl-template-directive-translate-off) 3286 ("synthesis_on" vhdl-template-directive-synthesis-on) 3287 ("synthesis_off" vhdl-template-directive-synthesis-off) 3288 ) 3289 "List of built-in directive templates.") 3290 3291 3292;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3293;;; Menus 3294;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3295 3296;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3297;; VHDL menu (using `easy-menu.el') 3298 3299(defun vhdl-customize () 3300 "Call the customize function with `vhdl' as argument." 3301 (interactive) 3302 (customize-browse 'vhdl)) 3303 3304(defun vhdl-create-mode-menu () 3305 "Create VHDL Mode menu." 3306 `("VHDL" 3307 ,(append 3308 '("Project" 3309 ["None" (vhdl-set-project "") 3310 :style radio :selected (null vhdl-project)] 3311 "--") 3312 ;; add menu entries for defined projects 3313 (let ((project-alist vhdl-project-alist) menu-list name) 3314 (while project-alist 3315 (setq name (caar project-alist)) 3316 (setq menu-list 3317 (cons `[,name (vhdl-set-project ,name) 3318 :style radio :selected (equal ,name vhdl-project)] 3319 menu-list)) 3320 (setq project-alist (cdr project-alist))) 3321 (setq menu-list 3322 (if vhdl-project-sort 3323 (sort menu-list 3324 (function (lambda (a b) (string< (elt a 0) (elt b 0))))) 3325 (nreverse menu-list))) 3326 (vhdl-menu-split menu-list "Project")) 3327 '("--" "--" 3328 ["Select Project..." vhdl-set-project t] 3329 ["Set As Default Project" vhdl-set-default-project t] 3330 "--" 3331 ["Duplicate Project" vhdl-duplicate-project vhdl-project] 3332 ["Import Project..." vhdl-import-project 3333 :keys "C-c C-p C-m" :active t] 3334 ["Export Project" vhdl-export-project vhdl-project] 3335 "--" 3336 ["Customize Project..." (customize-option 'vhdl-project-alist) t])) 3337 "--" 3338 ("Compile" 3339 ["Compile Buffer" vhdl-compile t] 3340 ["Stop Compilation" kill-compilation t] 3341 "--" 3342 ["Make" vhdl-make t] 3343 ["Generate Makefile" vhdl-generate-makefile t] 3344 "--" 3345 ["Next Error" next-error t] 3346 ["Previous Error" previous-error t] 3347 ["First Error" first-error t] 3348 "--" 3349 ,(append 3350 '("Compiler") 3351 ;; add menu entries for defined compilers 3352 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3353 (while comp-alist 3354 (setq name (caar comp-alist)) 3355 (setq menu-list 3356 (cons `[,name (setq vhdl-compiler ,name) 3357 :style radio :selected (equal ,name vhdl-compiler)] 3358 menu-list)) 3359 (setq comp-alist (cdr comp-alist))) 3360 (setq menu-list (nreverse menu-list)) 3361 (vhdl-menu-split menu-list "Compiler")) 3362 '("--" "--" 3363 ["Select Compiler..." vhdl-set-compiler t] 3364 "--" 3365 ["Customize Compiler..." 3366 (customize-option 'vhdl-compiler-alist) t]))) 3367 "--" 3368 ,(append 3369 '("Template" 3370 ("VHDL Construct 1" 3371 ["Alias" vhdl-template-alias t] 3372 ["Architecture" vhdl-template-architecture t] 3373 ["Assert" vhdl-template-assert t] 3374 ["Attribute (Decl)" vhdl-template-attribute-decl t] 3375 ["Attribute (Spec)" vhdl-template-attribute-spec t] 3376 ["Block" vhdl-template-block t] 3377 ["Case" vhdl-template-case-is t] 3378 ["Component (Decl)" vhdl-template-component-decl t] 3379 ["(Component) Instance" vhdl-template-component-inst t] 3380 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] 3381 ["Configuration (Block)" vhdl-template-block-configuration t] 3382 ["Configuration (Comp)" vhdl-template-component-conf t] 3383 ["Configuration (Decl)" vhdl-template-configuration-decl t] 3384 ["Configuration (Spec)" vhdl-template-configuration-spec t] 3385 ["Constant" vhdl-template-constant t] 3386 ["Context" vhdl-template-context t] 3387 ["Disconnect" vhdl-template-disconnect t] 3388 ["Else" vhdl-template-else t] 3389 ["Elsif" vhdl-template-elsif t] 3390 ["Entity" vhdl-template-entity t] 3391 ["Exit" vhdl-template-exit t] 3392 ["File" vhdl-template-file t] 3393 ["For (Generate)" vhdl-template-for-generate t] 3394 ["For (Loop)" vhdl-template-for-loop t] 3395 ["Function (Body)" vhdl-template-function-body t] 3396 ["Function (Decl)" vhdl-template-function-decl t] 3397 ["Generic" vhdl-template-generic t] 3398 ["Group (Decl)" vhdl-template-group-decl t] 3399 ["Group (Template)" vhdl-template-group-template t]) 3400 ("VHDL Construct 2" 3401 ["If (Generate)" vhdl-template-if-generate t] 3402 ["If (Then)" vhdl-template-if-then t] 3403 ["Library" vhdl-template-library t] 3404 ["Loop" vhdl-template-bare-loop t] 3405 ["Map" vhdl-template-map t] 3406 ["Next" vhdl-template-next t] 3407 ["Others (Aggregate)" vhdl-template-others t] 3408 ["Package (Decl)" vhdl-template-package-decl t] 3409 ["Package (Body)" vhdl-template-package-body t] 3410 ["Port" vhdl-template-port t] 3411 ["Procedure (Body)" vhdl-template-procedure-body t] 3412 ["Procedure (Decl)" vhdl-template-procedure-decl t] 3413 ["Process (Comb)" vhdl-template-process-comb t] 3414 ["Process (Seq)" vhdl-template-process-seq t] 3415 ["Report" vhdl-template-report t] 3416 ["Return" vhdl-template-return t] 3417 ["Select" vhdl-template-selected-signal-asst t] 3418 ["Signal" vhdl-template-signal t] 3419 ["Subtype" vhdl-template-subtype t] 3420 ["Type" vhdl-template-type t] 3421 ["Use" vhdl-template-use t] 3422 ["Variable" vhdl-template-variable t] 3423 ["Wait" vhdl-template-wait t] 3424 ["(Clocked Wait)" vhdl-template-clocked-wait t] 3425 ["When" vhdl-template-when t] 3426 ["While (Loop)" vhdl-template-while-loop t] 3427 ["With" vhdl-template-with t])) 3428 (when (vhdl-standard-p 'ams) 3429 '(("VHDL-AMS Construct" 3430 ["Break" vhdl-template-break t] 3431 ["Case (Use)" vhdl-template-case-use t] 3432 ["If (Use)" vhdl-template-if-use t] 3433 ["Limit" vhdl-template-limit t] 3434 ["Nature" vhdl-template-nature t] 3435 ["Procedural" vhdl-template-procedural t] 3436 ["Quantity (Free)" vhdl-template-quantity-free t] 3437 ["Quantity (Branch)" vhdl-template-quantity-branch t] 3438 ["Quantity (Source)" vhdl-template-quantity-source t] 3439 ["Subnature" vhdl-template-subnature t] 3440 ["Terminal" vhdl-template-terminal t]))) 3441 '(["Insert Construct..." vhdl-template-insert-construct 3442 :keys "C-c C-i C-t"] 3443 "--") 3444 (list 3445 (append 3446 '("Package") 3447 '(["numeric_bit" vhdl-template-package-numeric-bit t] 3448 ["numeric_std" vhdl-template-package-numeric-std t] 3449 ["std_logic_1164" vhdl-template-package-std-logic-1164 t] 3450 ["textio" vhdl-template-package-textio t] 3451 "--" 3452 ["std_logic_arith" vhdl-template-package-std-logic-arith t] 3453 ["std_logic_signed" vhdl-template-package-std-logic-signed t] 3454 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] 3455 ["std_logic_misc" vhdl-template-package-std-logic-misc t] 3456 ["std_logic_textio" vhdl-template-package-std-logic-textio t] 3457 "--") 3458 (when (vhdl-standard-p 'ams) 3459 '(["fundamental_constants" vhdl-template-package-fundamental-constants t] 3460 ["material_constants" vhdl-template-package-material-constants t] 3461 ["energy_systems" vhdl-template-package-energy-systems t] 3462 ["electrical_systems" vhdl-template-package-electrical-systems t] 3463 ["mechanical_systems" vhdl-template-package-mechanical-systems t] 3464 ["radiant_systems" vhdl-template-package-radiant-systems t] 3465 ["thermal_systems" vhdl-template-package-thermal-systems t] 3466 ["fluidic_systems" vhdl-template-package-fluidic-systems t] 3467 "--")) 3468 (when (vhdl-standard-p 'math) 3469 '(["math_complex" vhdl-template-package-math-complex t] 3470 ["math_real" vhdl-template-package-math-real t] 3471 "--")) 3472 '(["Insert Package..." vhdl-template-insert-package 3473 :keys "C-c C-i C-p"]))) 3474 '(("Directive" 3475 ["translate_on" vhdl-template-directive-translate-on t] 3476 ["translate_off" vhdl-template-directive-translate-off t] 3477 ["synthesis_on" vhdl-template-directive-synthesis-on t] 3478 ["synthesis_off" vhdl-template-directive-synthesis-off t] 3479 "--" 3480 ["Insert Directive..." vhdl-template-insert-directive 3481 :keys "C-c C-i C-d"]) 3482 "--" 3483 ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] 3484 ["Insert Footer" vhdl-template-footer t] 3485 ["Insert Date" vhdl-template-insert-date t] 3486 ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] 3487 "--" 3488 ["Query Next Prompt" vhdl-template-search-prompt t])) 3489 ,(append 3490 '("Model") 3491 ;; add menu entries for defined models 3492 (let ((model-alist vhdl-model-alist) menu-list model) 3493 (while model-alist 3494 (setq model (car model-alist)) 3495 (setq menu-list 3496 (cons 3497 (vector 3498 (nth 0 model) 3499 (vhdl-function-name "vhdl-model" (nth 0 model)) 3500 :keys (concat "C-c C-m " (key-description (nth 2 model)))) 3501 menu-list)) 3502 (setq model-alist (cdr model-alist))) 3503 (setq menu-list (nreverse menu-list)) 3504 (vhdl-menu-split menu-list "Model")) 3505 '("--" "--" 3506 ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] 3507 ["Customize Model..." (customize-option 'vhdl-model-alist) t])) 3508 ("Port" 3509 ["Copy" vhdl-port-copy t] 3510 "--" 3511 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] 3512 ["Paste As Component" vhdl-port-paste-component vhdl-port-list] 3513 ["Paste As Instance" vhdl-port-paste-instance 3514 :keys "C-c C-p C-i" :active vhdl-port-list] 3515 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] 3516 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] 3517 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] 3518 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] 3519 "--" 3520 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] 3521 "--" 3522 ["Flatten" vhdl-port-flatten 3523 :style toggle :selected vhdl-port-flattened :active vhdl-port-list] 3524 ["Reverse Direction" vhdl-port-reverse-direction 3525 :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) 3526 ("Compose" 3527 ["New Component" vhdl-compose-new-component t] 3528 ["Copy Component" vhdl-port-copy t] 3529 ["Place Component" vhdl-compose-place-component vhdl-port-list] 3530 ["Wire Components" vhdl-compose-wire-components t] 3531 "--" 3532 ["Generate Configuration" vhdl-compose-configuration t] 3533 ["Generate Components Package" vhdl-compose-components-package t]) 3534 ("Subprogram" 3535 ["Copy" vhdl-subprog-copy t] 3536 "--" 3537 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] 3538 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] 3539 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] 3540 "--" 3541 ["Flatten" vhdl-subprog-flatten 3542 :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) 3543 "--" 3544 ("Comment" 3545 ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] 3546 "--" 3547 ["Insert Inline Comment" vhdl-comment-append-inline t] 3548 ["Insert Horizontal Line" vhdl-comment-display-line t] 3549 ["Insert Display Comment" vhdl-comment-display t] 3550 "--" 3551 ["Fill Comment" fill-paragraph t] 3552 ["Fill Comment Region" fill-region (mark)] 3553 ["Kill Comment Region" vhdl-comment-kill-region (mark)] 3554 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) 3555 ("Line" 3556 ["Kill" vhdl-line-kill t] 3557 ["Copy" vhdl-line-copy t] 3558 ["Yank" vhdl-line-yank t] 3559 ["Expand" vhdl-line-expand t] 3560 "--" 3561 ["Transpose Next" vhdl-line-transpose-next t] 3562 ["Transpose Prev" vhdl-line-transpose-previous t] 3563 ["Open" vhdl-line-open t] 3564 ["Join" vhdl-delete-indentation t] 3565 "--" 3566 ["Goto" goto-line t] 3567 ["(Un)Comment Out" vhdl-comment-uncomment-line t]) 3568 ("Move" 3569 ["Forward Statement" vhdl-end-of-statement t] 3570 ["Backward Statement" vhdl-beginning-of-statement t] 3571 ["Forward Expression" vhdl-forward-sexp t] 3572 ["Backward Expression" vhdl-backward-sexp t] 3573 ["Forward Same Indent" vhdl-forward-same-indent t] 3574 ["Backward Same Indent" vhdl-backward-same-indent t] 3575 ["Forward Function" vhdl-end-of-defun t] 3576 ["Backward Function" vhdl-beginning-of-defun t] 3577 ["Mark Function" vhdl-mark-defun t]) 3578 "--" 3579 ("Indent" 3580 ["Line" indent-according-to-mode :keys "C-c C-i C-l"] 3581 ["Group" vhdl-indent-group :keys "C-c C-i C-g"] 3582 ["Region" vhdl-indent-region (mark)] 3583 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) 3584 ("Align" 3585 ["Group" vhdl-align-group t] 3586 ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] 3587 ["List" vhdl-align-list t] 3588 ["Declarations" vhdl-align-declarations t] 3589 ["Region" vhdl-align-region (mark)] 3590 ["Buffer" vhdl-align-buffer t] 3591 "--" 3592 ["Inline Comment Group" vhdl-align-inline-comment-group t] 3593 ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] 3594 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) 3595 ("Fill" 3596 ["List" vhdl-fill-list t] 3597 ["Group" vhdl-fill-group t] 3598 ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] 3599 ["Region" vhdl-fill-region (mark)]) 3600 ("Beautify" 3601 ["Region" vhdl-beautify-region (mark)] 3602 ["Buffer" vhdl-beautify-buffer t]) 3603 ("Fix" 3604 ["Generic/Port Clause" vhdl-fix-clause t] 3605 ["Generic/Port Clause Buffer" vhdl-fix-clause t] 3606 "--" 3607 ["Case Region" vhdl-fix-case-region (mark)] 3608 ["Case Buffer" vhdl-fix-case-buffer t] 3609 "--" 3610 ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] 3611 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] 3612 "--" 3613 ["Statement Region" vhdl-fix-statement-region (mark)] 3614 ["Statement Buffer" vhdl-fix-statement-buffer t] 3615 "--" 3616 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) 3617 ("Update" 3618 ["Sensitivity List" vhdl-update-sensitivity-list-process t] 3619 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) 3620 "--" 3621 ["Fontify Buffer" vhdl-fontify-buffer t] 3622 ["Statistics Buffer" vhdl-statistics-buffer t] 3623 ["Show Messages" vhdl-show-messages t] 3624 ["Syntactic Info" vhdl-show-syntactic-information t] 3625 "--" 3626 ["Speedbar" vhdl-speedbar t] 3627 ["Hide/Show" vhdl-hs-minor-mode t] 3628 "--" 3629 ("Documentation" 3630 ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] 3631 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] 3632 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] 3633 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) 3634 ["Version" vhdl-version t] 3635 ["Bug Report..." vhdl-submit-bug-report t] 3636 "--" 3637 ("Options" 3638 ("Mode" 3639 ["Electric Mode" 3640 (progn (customize-set-variable 'vhdl-electric-mode 3641 (not vhdl-electric-mode)) 3642 (vhdl-mode-line-update)) 3643 :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] 3644 ["Stutter Mode" 3645 (progn (customize-set-variable 'vhdl-stutter-mode 3646 (not vhdl-stutter-mode)) 3647 (vhdl-mode-line-update)) 3648 :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] 3649 ["Indent Tabs Mode" 3650 (progn (customize-set-variable 'vhdl-indent-tabs-mode 3651 (not vhdl-indent-tabs-mode)) 3652 (setq indent-tabs-mode vhdl-indent-tabs-mode)) 3653 :style toggle :selected vhdl-indent-tabs-mode] 3654 "--" 3655 ["Customize Group..." (customize-group 'vhdl-mode) t]) 3656 ("Project" 3657 ["Project Setup..." (customize-option 'vhdl-project-alist) t] 3658 ,(append 3659 '("Selected Project at Startup" 3660 ["None" (progn (customize-set-variable 'vhdl-project nil) 3661 (vhdl-set-project "")) 3662 :style radio :selected (null vhdl-project)] 3663 "--") 3664 ;; add menu entries for defined projects 3665 (let ((project-alist vhdl-project-alist) menu-list name) 3666 (while project-alist 3667 (setq name (caar project-alist)) 3668 (setq menu-list 3669 (cons `[,name (progn (customize-set-variable 3670 'vhdl-project ,name) 3671 (vhdl-set-project ,name)) 3672 :style radio :selected (equal ,name vhdl-project)] 3673 menu-list)) 3674 (setq project-alist (cdr project-alist))) 3675 (setq menu-list (nreverse menu-list)) 3676 (vhdl-menu-split menu-list "Project"))) 3677 ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] 3678 ("Auto Load Setup File" 3679 ["At Startup" 3680 (customize-set-variable 'vhdl-project-autoload 3681 (if (memq 'startup vhdl-project-autoload) 3682 (delq 'startup vhdl-project-autoload) 3683 (cons 'startup vhdl-project-autoload))) 3684 :style toggle :selected (memq 'startup vhdl-project-autoload)]) 3685 ["Sort Projects" 3686 (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) 3687 :style toggle :selected vhdl-project-sort] 3688 "--" 3689 ["Customize Group..." (customize-group 'vhdl-project) t]) 3690 ("Compiler" 3691 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] 3692 ,(append 3693 '("Selected Compiler at Startup") 3694 ;; add menu entries for defined compilers 3695 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3696 (while comp-alist 3697 (setq name (caar comp-alist)) 3698 (setq menu-list 3699 (cons `[,name (customize-set-variable 'vhdl-compiler ,name) 3700 :style radio :selected (equal ,name vhdl-compiler)] 3701 menu-list)) 3702 (setq comp-alist (cdr comp-alist))) 3703 (setq menu-list (nreverse menu-list)) 3704 (vhdl-menu-split menu-list "Compiler"))) 3705 ["Use Local Error Regexp" 3706 (customize-set-variable 'vhdl-compile-use-local-error-regexp 3707 (not vhdl-compile-use-local-error-regexp)) 3708 :style toggle :selected vhdl-compile-use-local-error-regexp] 3709 ["Makefile Default Targets..." 3710 (customize-option 'vhdl-makefile-default-targets) t] 3711 ["Makefile Generation Hook..." 3712 (customize-option 'vhdl-makefile-generation-hook) t] 3713 ["Default Library Name" (customize-option 'vhdl-default-library) t] 3714 "--" 3715 ["Customize Group..." (customize-group 'vhdl-compiler) t]) 3716 ("Style" 3717 ("VHDL Standard" 3718 ["VHDL'87" 3719 (progn (customize-set-variable 'vhdl-standard 3720 (list '87 (cadr vhdl-standard))) 3721 (vhdl-activate-customizations)) 3722 :style radio :selected (eq '87 (car vhdl-standard))] 3723 ["VHDL'93/02" 3724 (progn (customize-set-variable 'vhdl-standard 3725 (list '93 (cadr vhdl-standard))) 3726 (vhdl-activate-customizations)) 3727 :style radio :selected (eq '93 (car vhdl-standard))] 3728 ["VHDL'08" 3729 (progn (customize-set-variable 'vhdl-standard 3730 (list '08 (cadr vhdl-standard))) 3731 (vhdl-activate-customizations)) 3732 :style radio :selected (eq '08 (car vhdl-standard))] 3733 "--" 3734 ["VHDL-AMS" 3735 (progn (customize-set-variable 3736 'vhdl-standard (list (car vhdl-standard) 3737 (if (memq 'ams (cadr vhdl-standard)) 3738 (delq 'ams (cadr vhdl-standard)) 3739 (cons 'ams (cadr vhdl-standard))))) 3740 (vhdl-activate-customizations)) 3741 :style toggle :selected (memq 'ams (cadr vhdl-standard))] 3742 ["Math Packages" 3743 (progn (customize-set-variable 3744 'vhdl-standard (list (car vhdl-standard) 3745 (if (memq 'math (cadr vhdl-standard)) 3746 (delq 'math (cadr vhdl-standard)) 3747 (cons 'math (cadr vhdl-standard))))) 3748 (vhdl-activate-customizations)) 3749 :style toggle :selected (memq 'math (cadr vhdl-standard))]) 3750 ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] 3751 ["Upper Case Keywords" 3752 (customize-set-variable 'vhdl-upper-case-keywords 3753 (not vhdl-upper-case-keywords)) 3754 :style toggle :selected vhdl-upper-case-keywords] 3755 ["Upper Case Types" 3756 (customize-set-variable 'vhdl-upper-case-types 3757 (not vhdl-upper-case-types)) 3758 :style toggle :selected vhdl-upper-case-types] 3759 ["Upper Case Attributes" 3760 (customize-set-variable 'vhdl-upper-case-attributes 3761 (not vhdl-upper-case-attributes)) 3762 :style toggle :selected vhdl-upper-case-attributes] 3763 ["Upper Case Enumeration Values" 3764 (customize-set-variable 'vhdl-upper-case-enum-values 3765 (not vhdl-upper-case-enum-values)) 3766 :style toggle :selected vhdl-upper-case-enum-values] 3767 ["Upper Case Constants" 3768 (customize-set-variable 'vhdl-upper-case-constants 3769 (not vhdl-upper-case-constants)) 3770 :style toggle :selected vhdl-upper-case-constants] 3771 ("Use Direct Instantiation" 3772 ["Never" 3773 (customize-set-variable 'vhdl-use-direct-instantiation 'never) 3774 :style radio :selected (eq 'never vhdl-use-direct-instantiation)] 3775 ["Standard" 3776 (customize-set-variable 'vhdl-use-direct-instantiation 'standard) 3777 :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] 3778 ["Always" 3779 (customize-set-variable 'vhdl-use-direct-instantiation 'always) 3780 :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) 3781 ["Include Array Index and Record Field in Sensitivity List" 3782 (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list 3783 (not vhdl-array-index-record-field-in-sensitivity-list)) 3784 :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list] 3785 "--" 3786 ["Customize Group..." (customize-group 'vhdl-style) t]) 3787 ("Naming" 3788 ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] 3789 ["Architecture File Name..." 3790 (customize-option 'vhdl-architecture-file-name) t] 3791 ["Configuration File Name..." 3792 (customize-option 'vhdl-configuration-file-name) t] 3793 ["Package File Name..." (customize-option 'vhdl-package-file-name) t] 3794 ("File Name Case" 3795 ["As Is" 3796 (customize-set-variable 'vhdl-file-name-case 'identity) 3797 :style radio :selected (eq 'identity vhdl-file-name-case)] 3798 ["Lower Case" 3799 (customize-set-variable 'vhdl-file-name-case 'downcase) 3800 :style radio :selected (eq 'downcase vhdl-file-name-case)] 3801 ["Upper Case" 3802 (customize-set-variable 'vhdl-file-name-case 'upcase) 3803 :style radio :selected (eq 'upcase vhdl-file-name-case)] 3804 ["Capitalize" 3805 (customize-set-variable 'vhdl-file-name-case 'capitalize) 3806 :style radio :selected (eq 'capitalize vhdl-file-name-case)]) 3807 "--" 3808 ["Customize Group..." (customize-group 'vhdl-naming) t]) 3809 ("Template" 3810 ("Electric Keywords" 3811 ["VHDL Keywords" 3812 (customize-set-variable 'vhdl-electric-keywords 3813 (if (memq 'vhdl vhdl-electric-keywords) 3814 (delq 'vhdl vhdl-electric-keywords) 3815 (cons 'vhdl vhdl-electric-keywords))) 3816 :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] 3817 ["User Model Keywords" 3818 (customize-set-variable 'vhdl-electric-keywords 3819 (if (memq 'user vhdl-electric-keywords) 3820 (delq 'user vhdl-electric-keywords) 3821 (cons 'user vhdl-electric-keywords))) 3822 :style toggle :selected (memq 'user vhdl-electric-keywords)]) 3823 ("Insert Optional Labels" 3824 ["None" 3825 (customize-set-variable 'vhdl-optional-labels 'none) 3826 :style radio :selected (eq 'none vhdl-optional-labels)] 3827 ["Processes Only" 3828 (customize-set-variable 'vhdl-optional-labels 'process) 3829 :style radio :selected (eq 'process vhdl-optional-labels)] 3830 ["All Constructs" 3831 (customize-set-variable 'vhdl-optional-labels 'all) 3832 :style radio :selected (eq 'all vhdl-optional-labels)]) 3833 ("Insert Empty Lines" 3834 ["None" 3835 (customize-set-variable 'vhdl-insert-empty-lines 'none) 3836 :style radio :selected (eq 'none vhdl-insert-empty-lines)] 3837 ["Design Units Only" 3838 (customize-set-variable 'vhdl-insert-empty-lines 'unit) 3839 :style radio :selected (eq 'unit vhdl-insert-empty-lines)] 3840 ["All Constructs" 3841 (customize-set-variable 'vhdl-insert-empty-lines 'all) 3842 :style radio :selected (eq 'all vhdl-insert-empty-lines)]) 3843 ["Argument List Indent" 3844 (customize-set-variable 'vhdl-argument-list-indent 3845 (not vhdl-argument-list-indent)) 3846 :style toggle :selected vhdl-argument-list-indent] 3847 ["Association List with Formals" 3848 (customize-set-variable 'vhdl-association-list-with-formals 3849 (not vhdl-association-list-with-formals)) 3850 :style toggle :selected vhdl-association-list-with-formals] 3851 ["Conditions in Parenthesis" 3852 (customize-set-variable 'vhdl-conditions-in-parenthesis 3853 (not vhdl-conditions-in-parenthesis)) 3854 :style toggle :selected vhdl-conditions-in-parenthesis] 3855 ["Sensitivity List uses 'all'" 3856 (customize-set-variable 'vhdl-sensitivity-list-all 3857 (not vhdl-sensitivity-list-all)) 3858 :style toggle :selected vhdl-sensitivity-list-all] 3859 ["Zero String..." (customize-option 'vhdl-zero-string) t] 3860 ["One String..." (customize-option 'vhdl-one-string) t] 3861 ("File Header" 3862 ["Header String..." (customize-option 'vhdl-file-header) t] 3863 ["Footer String..." (customize-option 'vhdl-file-footer) t] 3864 ["Company Name..." (customize-option 'vhdl-company-name) t] 3865 ["Copyright String..." (customize-option 'vhdl-copyright-string) t] 3866 ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] 3867 ["Date Format..." (customize-option 'vhdl-date-format) t] 3868 ["Modify Date Prefix String..." 3869 (customize-option 'vhdl-modify-date-prefix-string) t] 3870 ["Modify Date on Saving" 3871 (progn (customize-set-variable 'vhdl-modify-date-on-saving 3872 (not vhdl-modify-date-on-saving)) 3873 (vhdl-activate-customizations)) 3874 :style toggle :selected vhdl-modify-date-on-saving]) 3875 ("Sequential Process" 3876 ("Kind of Reset" 3877 ["None" 3878 (customize-set-variable 'vhdl-reset-kind 'none) 3879 :style radio :selected (eq 'none vhdl-reset-kind)] 3880 ["Synchronous" 3881 (customize-set-variable 'vhdl-reset-kind 'sync) 3882 :style radio :selected (eq 'sync vhdl-reset-kind)] 3883 ["Asynchronous" 3884 (customize-set-variable 'vhdl-reset-kind 'async) 3885 :style radio :selected (eq 'async vhdl-reset-kind)] 3886 ["Query" 3887 (customize-set-variable 'vhdl-reset-kind 'query) 3888 :style radio :selected (eq 'query vhdl-reset-kind)]) 3889 ["Reset is Active High" 3890 (customize-set-variable 'vhdl-reset-active-high 3891 (not vhdl-reset-active-high)) 3892 :style toggle :selected vhdl-reset-active-high] 3893 ["Use Rising Clock Edge" 3894 (customize-set-variable 'vhdl-clock-rising-edge 3895 (not vhdl-clock-rising-edge)) 3896 :style toggle :selected vhdl-clock-rising-edge] 3897 ("Clock Edge Condition" 3898 ["Standard" 3899 (customize-set-variable 'vhdl-clock-edge-condition 'standard) 3900 :style radio :selected (eq 'standard vhdl-clock-edge-condition)] 3901 ["Function \"rising_edge\"" 3902 (customize-set-variable 'vhdl-clock-edge-condition 'function) 3903 :style radio :selected (eq 'function vhdl-clock-edge-condition)]) 3904 ["Clock Name..." (customize-option 'vhdl-clock-name) t] 3905 ["Reset Name..." (customize-option 'vhdl-reset-name) t]) 3906 "--" 3907 ["Customize Group..." (customize-group 'vhdl-template) t]) 3908 ("Model" 3909 ["Model Definition..." (customize-option 'vhdl-model-alist) t]) 3910 ("Port" 3911 ["Include Port Comments" 3912 (customize-set-variable 'vhdl-include-port-comments 3913 (not vhdl-include-port-comments)) 3914 :style toggle :selected vhdl-include-port-comments] 3915 ["Include Direction Comments" 3916 (customize-set-variable 'vhdl-include-direction-comments 3917 (not vhdl-include-direction-comments)) 3918 :style toggle :selected vhdl-include-direction-comments] 3919 ["Include Type Comments" 3920 (customize-set-variable 'vhdl-include-type-comments 3921 (not vhdl-include-type-comments)) 3922 :style toggle :selected vhdl-include-type-comments] 3923 ("Include Group Comments" 3924 ["Never" 3925 (customize-set-variable 'vhdl-include-group-comments 'never) 3926 :style radio :selected (eq 'never vhdl-include-group-comments)] 3927 ["Declarations" 3928 (customize-set-variable 'vhdl-include-group-comments 'decl) 3929 :style radio :selected (eq 'decl vhdl-include-group-comments)] 3930 ["Always" 3931 (customize-set-variable 'vhdl-include-group-comments 'always) 3932 :style radio :selected (eq 'always vhdl-include-group-comments)]) 3933 ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] 3934 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] 3935 ["Instance Name..." (customize-option 'vhdl-instance-name) t] 3936 ("Testbench" 3937 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] 3938 ["Architecture Name..." 3939 (customize-option 'vhdl-testbench-architecture-name) t] 3940 ["Configuration Name..." 3941 (customize-option 'vhdl-testbench-configuration-name) t] 3942 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] 3943 ["Include Header" 3944 (customize-set-variable 'vhdl-testbench-include-header 3945 (not vhdl-testbench-include-header)) 3946 :style toggle :selected vhdl-testbench-include-header] 3947 ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] 3948 ["Statements..." (customize-option 'vhdl-testbench-statements) t] 3949 ["Initialize Signals" 3950 (customize-set-variable 'vhdl-testbench-initialize-signals 3951 (not vhdl-testbench-initialize-signals)) 3952 :style toggle :selected vhdl-testbench-initialize-signals] 3953 ["Include Library Clause" 3954 (customize-set-variable 'vhdl-testbench-include-library 3955 (not vhdl-testbench-include-library)) 3956 :style toggle :selected vhdl-testbench-include-library] 3957 ["Include Configuration" 3958 (customize-set-variable 'vhdl-testbench-include-configuration 3959 (not vhdl-testbench-include-configuration)) 3960 :style toggle :selected vhdl-testbench-include-configuration] 3961 ("Create Files" 3962 ["None" 3963 (customize-set-variable 'vhdl-testbench-create-files 'none) 3964 :style radio :selected (eq 'none vhdl-testbench-create-files)] 3965 ["Single" 3966 (customize-set-variable 'vhdl-testbench-create-files 'single) 3967 :style radio :selected (eq 'single vhdl-testbench-create-files)] 3968 ["Separate" 3969 (customize-set-variable 'vhdl-testbench-create-files 'separate) 3970 :style radio :selected (eq 'separate vhdl-testbench-create-files)]) 3971 ["Testbench Entity File Name..." 3972 (customize-option 'vhdl-testbench-entity-file-name) t] 3973 ["Testbench Architecture File Name..." 3974 (customize-option 'vhdl-testbench-architecture-file-name) t]) 3975 "--" 3976 ["Customize Group..." (customize-group 'vhdl-port) t]) 3977 ("Compose" 3978 ["Architecture Name..." 3979 (customize-option 'vhdl-compose-architecture-name) t] 3980 ["Configuration Name..." 3981 (customize-option 'vhdl-compose-configuration-name) t] 3982 ["Components Package Name..." 3983 (customize-option 'vhdl-components-package-name) t] 3984 ["Use Components Package" 3985 (customize-set-variable 'vhdl-use-components-package 3986 (not vhdl-use-components-package)) 3987 :style toggle :selected vhdl-use-components-package] 3988 ["Include Header" 3989 (customize-set-variable 'vhdl-compose-include-header 3990 (not vhdl-compose-include-header)) 3991 :style toggle :selected vhdl-compose-include-header] 3992 ("Create Entity/Architecture Files" 3993 ["None" 3994 (customize-set-variable 'vhdl-compose-create-files 'none) 3995 :style radio :selected (eq 'none vhdl-compose-create-files)] 3996 ["Single" 3997 (customize-set-variable 'vhdl-compose-create-files 'single) 3998 :style radio :selected (eq 'single vhdl-compose-create-files)] 3999 ["Separate" 4000 (customize-set-variable 'vhdl-compose-create-files 'separate) 4001 :style radio :selected (eq 'separate vhdl-compose-create-files)]) 4002 ["Create Configuration File" 4003 (customize-set-variable 'vhdl-compose-configuration-create-file 4004 (not vhdl-compose-configuration-create-file)) 4005 :style toggle :selected vhdl-compose-configuration-create-file] 4006 ["Hierarchical Configuration" 4007 (customize-set-variable 'vhdl-compose-configuration-hierarchical 4008 (not vhdl-compose-configuration-hierarchical)) 4009 :style toggle :selected vhdl-compose-configuration-hierarchical] 4010 ["Use Subconfiguration" 4011 (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration 4012 (not vhdl-compose-configuration-use-subconfiguration)) 4013 :style toggle :selected vhdl-compose-configuration-use-subconfiguration] 4014 "--" 4015 ["Customize Group..." (customize-group 'vhdl-compose) t]) 4016 ("Comment" 4017 ["Self Insert Comments" 4018 (customize-set-variable 'vhdl-self-insert-comments 4019 (not vhdl-self-insert-comments)) 4020 :style toggle :selected vhdl-self-insert-comments] 4021 ["Prompt for Comments" 4022 (customize-set-variable 'vhdl-prompt-for-comments 4023 (not vhdl-prompt-for-comments)) 4024 :style toggle :selected vhdl-prompt-for-comments] 4025 ["Inline Comment Column..." 4026 (customize-option 'vhdl-inline-comment-column) t] 4027 ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] 4028 "--" 4029 ["Customize Group..." (customize-group 'vhdl-comment) t]) 4030 ("Beautify" 4031 ["Auto Align Templates" 4032 (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) 4033 :style toggle :selected vhdl-auto-align] 4034 ["Align Line Groups" 4035 (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) 4036 :style toggle :selected vhdl-align-groups] 4037 ["Group Separation String..." 4038 (customize-option 'vhdl-align-group-separate) t] 4039 ["Align Lines with Same Indent" 4040 (customize-set-variable 'vhdl-align-same-indent 4041 (not vhdl-align-same-indent)) 4042 :style toggle :selected vhdl-align-same-indent] 4043 ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] 4044 "--" 4045 ["Customize Group..." (customize-group 'vhdl-beautify) t]) 4046 ("Highlight" 4047 ["Highlighting On/Off..." 4048 (customize-option 4049 (if (fboundp 'global-font-lock-mode) 4050 'global-font-lock-mode 'font-lock-auto-fontify)) t] 4051 ["Highlight Keywords" 4052 (progn (customize-set-variable 'vhdl-highlight-keywords 4053 (not vhdl-highlight-keywords)) 4054 (vhdl-fontify-buffer)) 4055 :style toggle :selected vhdl-highlight-keywords] 4056 ["Highlight Names" 4057 (progn (customize-set-variable 'vhdl-highlight-names 4058 (not vhdl-highlight-names)) 4059 (vhdl-fontify-buffer)) 4060 :style toggle :selected vhdl-highlight-names] 4061 ["Highlight Special Words" 4062 (progn (customize-set-variable 'vhdl-highlight-special-words 4063 (not vhdl-highlight-special-words)) 4064 (vhdl-fontify-buffer)) 4065 :style toggle :selected vhdl-highlight-special-words] 4066 ["Highlight Forbidden Words" 4067 (progn (customize-set-variable 'vhdl-highlight-forbidden-words 4068 (not vhdl-highlight-forbidden-words)) 4069 (vhdl-fontify-buffer)) 4070 :style toggle :selected vhdl-highlight-forbidden-words] 4071 ["Highlight Verilog Keywords" 4072 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords 4073 (not vhdl-highlight-verilog-keywords)) 4074 (vhdl-fontify-buffer)) 4075 :style toggle :selected vhdl-highlight-verilog-keywords] 4076 ["Highlight \"translate_off\"" 4077 (progn (customize-set-variable 'vhdl-highlight-translate-off 4078 (not vhdl-highlight-translate-off)) 4079 (vhdl-fontify-buffer)) 4080 :style toggle :selected vhdl-highlight-translate-off] 4081 ["Case Sensitive Highlighting" 4082 (progn (customize-set-variable 'vhdl-highlight-case-sensitive 4083 (not vhdl-highlight-case-sensitive)) 4084 (vhdl-fontify-buffer)) 4085 :style toggle :selected vhdl-highlight-case-sensitive] 4086 ["Special Syntax Definition..." 4087 (customize-option 'vhdl-special-syntax-alist) t] 4088 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] 4089 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] 4090 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] 4091 ["Colors..." (customize-group 'vhdl-highlight-faces) t] 4092 "--" 4093 ["Customize Group..." (customize-group 'vhdl-highlight) t]) 4094 ("Speedbar" 4095 ["Auto Open at Startup" 4096 (customize-set-variable 'vhdl-speedbar-auto-open 4097 (not vhdl-speedbar-auto-open)) 4098 :style toggle :selected vhdl-speedbar-auto-open] 4099 ("Default Displaying Mode" 4100 ["Files" 4101 (customize-set-variable 'vhdl-speedbar-display-mode 'files) 4102 :style radio :selected (eq 'files vhdl-speedbar-display-mode)] 4103 ["Directory Hierarchy" 4104 (customize-set-variable 'vhdl-speedbar-display-mode 'directory) 4105 :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] 4106 ["Project Hierarchy" 4107 (customize-set-variable 'vhdl-speedbar-display-mode 'project) 4108 :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) 4109 ["Indentation Offset..." 4110 (customize-option 'speedbar-indentation-width) t] 4111 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] 4112 ["Jump to Unit when Opening" 4113 (customize-set-variable 'vhdl-speedbar-jump-to-unit 4114 (not vhdl-speedbar-jump-to-unit)) 4115 :style toggle :selected vhdl-speedbar-jump-to-unit] 4116 ["Update Hierarchy on File Saving" 4117 (customize-set-variable 'vhdl-speedbar-update-on-saving 4118 (not vhdl-speedbar-update-on-saving)) 4119 :style toggle :selected vhdl-speedbar-update-on-saving] 4120 ("Save in Cache File" 4121 ["Hierarchy Information" 4122 (customize-set-variable 'vhdl-speedbar-save-cache 4123 (if (memq 'hierarchy vhdl-speedbar-save-cache) 4124 (delq 'hierarchy vhdl-speedbar-save-cache) 4125 (cons 'hierarchy vhdl-speedbar-save-cache))) 4126 :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] 4127 ["Displaying Status" 4128 (customize-set-variable 'vhdl-speedbar-save-cache 4129 (if (memq 'display vhdl-speedbar-save-cache) 4130 (delq 'display vhdl-speedbar-save-cache) 4131 (cons 'display vhdl-speedbar-save-cache))) 4132 :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) 4133 ["Cache File Name..." 4134 (customize-option 'vhdl-speedbar-cache-file-name) t] 4135 "--" 4136 ["Customize Group..." (customize-group 'vhdl-speedbar) t]) 4137 ("Menu" 4138 ["Add Index Menu when Loading File" 4139 (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) 4140 (vhdl-index-menu-init)) 4141 :style toggle :selected vhdl-index-menu] 4142 ["Add Source File Menu when Loading File" 4143 (progn (customize-set-variable 'vhdl-source-file-menu 4144 (not vhdl-source-file-menu)) 4145 (vhdl-add-source-files-menu)) 4146 :style toggle :selected vhdl-source-file-menu] 4147 ["Add Hideshow Menu at Startup" 4148 (progn (customize-set-variable 'vhdl-hideshow-menu 4149 (not vhdl-hideshow-menu)) 4150 (vhdl-activate-customizations)) 4151 :style toggle :selected vhdl-hideshow-menu] 4152 ["Hide Everything Initially" 4153 (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) 4154 :style toggle :selected vhdl-hide-all-init] 4155 "--" 4156 ["Customize Group..." (customize-group 'vhdl-menu) t]) 4157 ("Print" 4158 ["In Two Column Format" 4159 (progn (customize-set-variable 'vhdl-print-two-column 4160 (not vhdl-print-two-column)) 4161 (message "Activate new setting by saving options and restarting Emacs")) 4162 :style toggle :selected vhdl-print-two-column] 4163 ["Use Customized Faces" 4164 (progn (customize-set-variable 'vhdl-print-customize-faces 4165 (not vhdl-print-customize-faces)) 4166 (message "Activate new setting by saving options and restarting Emacs")) 4167 :style toggle :selected vhdl-print-customize-faces] 4168 "--" 4169 ["Customize Group..." (customize-group 'vhdl-print) t]) 4170 ("Miscellaneous" 4171 ["Use Intelligent Tab" 4172 (progn (customize-set-variable 'vhdl-intelligent-tab 4173 (not vhdl-intelligent-tab)) 4174 (vhdl-activate-customizations)) 4175 :style toggle :selected vhdl-intelligent-tab] 4176 ["Indent Syntax-Based" 4177 (customize-set-variable 'vhdl-indent-syntax-based 4178 (not vhdl-indent-syntax-based)) 4179 :style toggle :selected vhdl-indent-syntax-based] 4180 ["Indent Comments Like Next Code Line" 4181 (customize-set-variable 'vhdl-indent-comment-like-next-code-line 4182 (not vhdl-indent-comment-like-next-code-line)) 4183 :style toggle :selected vhdl-indent-comment-like-next-code-line] 4184 ["Word Completion is Case Sensitive" 4185 (customize-set-variable 'vhdl-word-completion-case-sensitive 4186 (not vhdl-word-completion-case-sensitive)) 4187 :style toggle :selected vhdl-word-completion-case-sensitive] 4188 ["Word Completion in Minibuffer" 4189 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer 4190 (not vhdl-word-completion-in-minibuffer)) 4191 (message "Activate new setting by saving options and restarting Emacs")) 4192 :style toggle :selected vhdl-word-completion-in-minibuffer] 4193 ["Underscore is Part of Word" 4194 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word 4195 (not vhdl-underscore-is-part-of-word)) 4196 (vhdl-activate-customizations)) 4197 :style toggle :selected vhdl-underscore-is-part-of-word] 4198 "--" 4199 ["Customize Group..." (customize-group 'vhdl-misc) t]) 4200 ["Related..." (customize-browse 'vhdl-related) t] 4201 "--" 4202 ["Save Options" customize-save-customized t] 4203 ["Activate Options" vhdl-activate-customizations t] 4204 ["Browse Options..." vhdl-customize t]))) 4205 4206(defvar vhdl-mode-menu-list (vhdl-create-mode-menu) 4207 "VHDL Mode menu.") 4208 4209(defun vhdl-update-mode-menu () 4210 "Update VHDL Mode menu." 4211 (interactive) 4212 (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs 4213 (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) 4214 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs 4215 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4216 "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) 4217 4218;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4219;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') 4220 4221(defconst vhdl-imenu-generic-expression 4222 '( 4223 ("Subprogram" 4224 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" 4225 4) 4226 ("Instance" 4227 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" 4228 1) 4229 ("Component" 4230 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4231 2) 4232 ("Procedural" 4233 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" 4234 1) 4235 ("Process" 4236 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" 4237 1) 4238 ("Block" 4239 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" 4240 1) 4241 ("Package" 4242 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4243 3) 4244 ("Configuration" 4245 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4246 2) 4247 ("Architecture" 4248 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4249 2) 4250 ("Entity" 4251 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4252 2) 4253 ("Context" 4254 "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4255 2) 4256 ) 4257 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") 4258 4259(defun vhdl-index-menu-init () 4260 "Initialize index menu." 4261 (set (make-local-variable 'imenu-case-fold-search) t) 4262 (set (make-local-variable 'imenu-generic-expression) 4263 vhdl-imenu-generic-expression) 4264 (when (and vhdl-index-menu (fboundp 'imenu)) 4265 (imenu-add-to-menubar "Index"))) 4266 4267;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4268;; Source file menu (using `easy-menu.el') 4269 4270(defvar vhdl-sources-menu nil) 4271 4272(defun vhdl-directory-files (directory &optional full match) 4273 "Call `directory-files' if DIRECTORY exists, otherwise generate error 4274message." 4275 (if (not (file-directory-p directory)) 4276 (vhdl-warning-when-idle "No such directory: \"%s\"" directory) 4277 (let ((dir (directory-files directory full match))) 4278 (setq dir (delete "." dir)) 4279 (setq dir (delete ".." dir)) 4280 dir))) 4281 4282(defun vhdl-get-source-files (&optional full directory) 4283 "Get list of VHDL source files in DIRECTORY or current directory." 4284 (let ((mode-alist auto-mode-alist) 4285 filename-regexp) 4286 ;; create regular expressions for matching file names 4287 (setq filename-regexp "\\`[^.].*\\(") 4288 (while mode-alist 4289 (when (eq (cdar mode-alist) 'vhdl-mode) 4290 (setq filename-regexp 4291 (concat filename-regexp (caar mode-alist) "\\|"))) 4292 (setq mode-alist (cdr mode-alist))) 4293 (setq filename-regexp 4294 (concat (substring filename-regexp 0 4295 (string-match "\\\\|$" filename-regexp)) "\\)")) 4296 ;; find files 4297 (vhdl-directory-files 4298 (or directory default-directory) full filename-regexp))) 4299 4300(defun vhdl-add-source-files-menu () 4301 "Scan directory for all VHDL source files and generate menu. 4302The directory of the current source file is scanned." 4303 (interactive) 4304 (message "Scanning directory for source files ...") 4305 (let ((newmap (current-local-map)) 4306 (file-list (vhdl-get-source-files)) 4307 menu-list found) 4308 ;; Create list for menu 4309 (setq found nil) 4310 (while file-list 4311 (setq found t) 4312 (push (vector (car file-list) (list 'find-file (car file-list)) t) 4313 menu-list) 4314 (setq file-list (cdr file-list))) 4315 (setq menu-list (vhdl-menu-split menu-list "Sources")) 4316 (when found (push "--" menu-list)) 4317 (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) 4318 (push "Sources" menu-list) 4319 ;; Create menu 4320 (easy-menu-add menu-list) 4321 (easy-menu-define vhdl-sources-menu newmap 4322 "VHDL source files menu" menu-list)) 4323 (message "")) 4324 4325 4326;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4327;;; Mode definition 4328;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4329;; performs all buffer local initializations 4330 4331;;;###autoload 4332(define-derived-mode vhdl-mode prog-mode 4333 '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) 4334 (vhdl-electric-mode "e") 4335 (vhdl-stutter-mode "s")) 4336 "Major mode for editing VHDL code. 4337 4338Usage: 4339------ 4340 4341 TEMPLATE INSERTION (electrification): 4342 After typing a VHDL keyword and entering `SPC', you are prompted for 4343 arguments while a template is generated for that VHDL construct. Typing 4344 `RET' or `C-g' at the first (mandatory) prompt aborts the current 4345 template generation. Optional arguments are indicated by square 4346 brackets and removed if the queried string is left empty. Prompts for 4347 mandatory arguments remain in the code if the queried string is left 4348 empty. They can be queried again by `C-c C-t C-q'. Enabled 4349 electrification is indicated by `/e' in the mode line. 4350 4351 Typing `M-SPC' after a keyword inserts a space without calling the 4352 template generator. Automatic template generation (i.e. 4353 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by 4354 setting option `vhdl-electric-mode' (see OPTIONS). 4355 4356 Template generators can be invoked from the VHDL menu, by key 4357 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing 4358 the keyword (i.e. first word of menu entry not in parenthesis) and 4359 `SPC'. The following abbreviations can also be used: arch, attr, cond, 4360 conf, comp, cons, func, inst, pack, sig, var. 4361 4362 Template styles can be customized in customization group 4363 `vhdl-template' (see OPTIONS). 4364 4365 4366 HEADER INSERTION: 4367 A file header can be inserted by `C-c C-t C-h'. A file footer 4368 (template at the end of the file) can be inserted by `C-c C-t C-f'. 4369 See customization group `vhdl-header'. 4370 4371 4372 STUTTERING: 4373 Double striking of some keys inserts cumbersome VHDL syntax elements. 4374 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by 4375 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in 4376 the mode line. The stuttering keys and their effects are: 4377 4378 ;; --> \" : \" [ --> ( -- --> comment 4379 ;;; --> \" := \" [[ --> [ --CR --> comment-out code 4380 .. --> \" => \" ] --> ) --- --> horizontal line 4381 ,, --> \" <= \" ]] --> ] ---- --> display comment 4382 == --> \" == \" \\='\\=' --> \\\" 4383 4384 4385 WORD COMPLETION: 4386 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a 4387 word in the buffer that starts alike, inserts it and adjusts case. 4388 Re-typing `TAB' toggles through alternative word completions. This also 4389 works in the minibuffer (i.e. in template generator prompts). 4390 4391 Typing `TAB' after `(' looks for and inserts complete parenthesized 4392 expressions (e.g. for array index ranges). All keywords as well as 4393 standard types and subprograms of VHDL have predefined abbreviations 4394 (e.g., type \"std\" and `TAB' will toggle through all standard types 4395 beginning with \"std\"). 4396 4397 Typing `TAB' after a non-word character indents the line if at the 4398 beginning of a line (i.e. no preceding non-blank characters), and 4399 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator 4400 stop. 4401 4402 4403 COMMENTS: 4404 `--' puts a single comment. 4405 `---' draws a horizontal line for separating code segments. 4406 `----' inserts a display comment, i.e. two horizontal lines 4407 with a comment in between. 4408 `--CR' comments out code on that line. Re-hitting CR comments 4409 out following lines. 4410 `C-c C-c' comments out a region if not commented out, 4411 uncomments a region if already commented out. Option 4412 `comment-style' defines where the comment characters 4413 should be placed (beginning of line, indent, etc.). 4414 4415 You are prompted for comments after object definitions (i.e. signals, 4416 variables, constants, ports) and after subprogram and process 4417 specifications if option `vhdl-prompt-for-comments' is non-nil. 4418 Comments are automatically inserted as additional labels (e.g. after 4419 begin statements) and as help comments if `vhdl-self-insert-comments' is 4420 non-nil. 4421 4422 Inline comments (i.e. comments after a piece of code on the same line) 4423 are indented at least to `vhdl-inline-comment-column'. Comments go at 4424 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment 4425 will open a new comment line. Typing beyond `vhdl-end-comment-column' 4426 in a comment automatically opens a new comment line. `M-q' re-fills 4427 multi-line comments. 4428 4429 4430 INDENTATION: 4431 `TAB' indents a line if at the beginning of the line. The amount of 4432 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' 4433 always indents the current line (is bound to `TAB' if option 4434 `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents 4435 the entire region. 4436 4437 Indentation can be done for a group of lines (`C-c C-i C-g'), a region 4438 (`M-C-\\') or the entire buffer (menu). Argument and port lists are 4439 indented normally (nil) or relative to the opening parenthesis (non-nil) 4440 according to option `vhdl-argument-list-indent'. 4441 4442 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of 4443 tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to 4444 tabs and vice versa. 4445 4446 Syntax-based indentation can be very slow in large files. Option 4447 `vhdl-indent-syntax-based' allows you to use faster but simpler indentation. 4448 4449 Option `vhdl-indent-comment-like-next-code-line' controls whether 4450 comment lines are indented like the preceding or like the following code 4451 line. 4452 4453 4454 ALIGNMENT: 4455 The alignment functions align operators, keywords, and inline comments 4456 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines 4457 separated by blank lines, `C-c C-a C-i' a block of lines with same 4458 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by 4459 a pair of parentheses (e.g. port clause/map, argument list), and `C-c 4460 C-a C-d' all lines within the declarative part of a design unit. `C-c 4461 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments 4462 for a group of lines, and `C-c C-a M-c' for a region. 4463 4464 If option `vhdl-align-groups' is non-nil, groups of code lines 4465 separated by special lines (see option `vhdl-align-group-separate') are 4466 aligned individually. If option `vhdl-align-same-indent' is non-nil, 4467 blocks of lines with same indent are aligned separately. Some templates 4468 are automatically aligned after generation if option `vhdl-auto-align' 4469 is non-nil. 4470 4471 Alignment tries to align inline comments at 4472 `vhdl-inline-comment-column' and tries inline comment not to exceed 4473 `vhdl-end-comment-column'. 4474 4475 `C-c C-x M-w' fixes up whitespace in a region. That is, operator 4476 symbols are surrounded by one space, and multiple spaces are eliminated. 4477 4478 4479 CODE FILLING: 4480 Code filling allows you to condense code (e.g. sensitivity lists or port 4481 maps) by removing comments and newlines and re-wrapping so that all 4482 lines are maximally filled (block filling). `C-c C-f C-f' fills a list 4483 enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by 4484 blank lines, `C-c C-f C-i' a block of lines with same indent, and 4485 `C-c C-f M-f' an entire region. 4486 4487 4488 CODE BEAUTIFICATION: 4489 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire 4490 buffer respectively. This includes indentation, alignment, and case 4491 fixing. Code beautification can also be run non-interactively using the 4492 command: 4493 4494 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer 4495 4496 4497 PORT TRANSLATION: 4498 Generic and port clauses from entity or component declarations can be 4499 copied (`C-c C-p C-w') and pasted as entity and component declarations, 4500 as component instantiations and corresponding internal constants and 4501 signals, as a generic map with constants as actual generics, and as 4502 internal signal initializations (menu). 4503 4504 To include formals in component instantiations, see option 4505 `vhdl-association-list-with-formals'. To include comments in pasting, 4506 see options `vhdl-include-...-comments'. 4507 4508 A clause with several generic/port names on the same line can be 4509 flattened (`C-c C-p C-f') so that only one name per line exists. The 4510 direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become 4511 outputs and vice versa, which can be useful in testbenches. (This 4512 reversion is done on the internal data structure and is only reflected 4513 in subsequent paste operations.) 4514 4515 Names for actual ports, instances, testbenches, and 4516 design-under-test instances can be derived from existing names according 4517 to options `vhdl-...-name'. See customization group `vhdl-port'. 4518 4519 4520 SUBPROGRAM TRANSLATION: 4521 Similar functionality exists for copying/pasting the interface of 4522 subprograms (function/procedure). A subprogram interface can be copied 4523 and then pasted as a subprogram declaration, body or call (uses 4524 association list with formals). 4525 4526 4527 TESTBENCH GENERATION: 4528 A copied port can also be pasted as a testbench. The generated 4529 testbench includes an entity, an architecture, and an optional 4530 configuration. The architecture contains the component declaration and 4531 instantiation of the DUT as well as internal constant and signal 4532 declarations. Additional user-defined templates can be inserted. The 4533 names used for entity/architecture/configuration/DUT as well as the file 4534 structure to be generated can be customized. See customization group 4535 `vhdl-testbench'. 4536 4537 4538 KEY BINDINGS: 4539 Key bindings (`C-c ...') exist for most commands (see in menu). 4540 4541 4542 VHDL MENU: 4543 All commands can be found in the VHDL menu including their key bindings. 4544 4545 4546 FILE BROWSER: 4547 The speedbar allows browsing of directories and file contents. It can 4548 be accessed from the VHDL menu and is automatically opened if option 4549 `vhdl-speedbar-auto-open' is non-nil. 4550 4551 In speedbar, open files and directories with `mouse-2' on the name and 4552 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. 4553 4554 4555 DESIGN HIERARCHY BROWSER: 4556 The speedbar can also be used for browsing the hierarchy of design units 4557 contained in the source files of the current directory or the specified 4558 projects (see option `vhdl-project-alist'). 4559 4560 The speedbar can be switched between file, directory hierarchy and 4561 project hierarchy browsing mode in the speedbar menu or by typing `f', 4562 `h' or `H' in speedbar. 4563 4564 In speedbar, open design units with `mouse-2' on the name and browse 4565 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied 4566 from entities and components (in packages). Individual design units and 4567 complete designs can directly be compiled (\"Make\" menu entry). 4568 4569 The hierarchy is automatically updated upon saving a modified source 4570 file when option `vhdl-speedbar-update-on-saving' is non-nil. The 4571 hierarchy is only updated for projects that have been opened once in the 4572 speedbar. The hierarchy is cached between Emacs sessions in a file (see 4573 options in group `vhdl-speedbar'). 4574 4575 Simple design consistency checks are done during scanning, such as 4576 multiple declarations of the same unit or missing primary units that are 4577 required by secondary units. 4578 4579 4580 STRUCTURAL COMPOSITION: 4581 Enables simple structural composition. `C-c C-m C-n' creates a skeleton 4582 for a new component. Subcomponents (i.e. component declaration and 4583 instantiation) can be automatically placed from a previously read port 4584 (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally, 4585 all subcomponents can be automatically connected using internal signals 4586 and ports (`C-c C-m C-w') following these rules: 4587 - subcomponent actual ports with same name are considered to be 4588 connected by a signal (internal signal or port) 4589 - signals that are only inputs to subcomponents are considered as 4590 inputs to this component -> input port created 4591 - signals that are only outputs from subcomponents are considered as 4592 outputs from this component -> output port created 4593 - signals that are inputs to AND outputs from subcomponents are 4594 considered as internal connections -> internal signal created 4595 4596 Purpose: With appropriate naming conventions it is possible to 4597 create higher design levels with only a few mouse clicks or key 4598 strokes. A new design level can be created by simply generating a new 4599 component, placing the required subcomponents from the hierarchy 4600 browser, and wiring everything automatically. 4601 4602 Note: Automatic wiring only works reliably on templates of new 4603 components and component instantiations that were created by VHDL mode. 4604 4605 Component declarations can be placed in a components package (option 4606 `vhdl-use-components-package') which can be automatically generated for 4607 an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct 4608 component instantiation is also supported (option 4609 `vhdl-use-direct-instantiation'). 4610 4611 Configuration declarations can automatically be generated either from 4612 the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from 4613 the speedbar menu (for the architecture under the cursor). The 4614 configurations can optionally be hierarchical (i.e. include all 4615 component levels of a hierarchical design, option 4616 `vhdl-compose-configuration-hierarchical') or include subconfigurations 4617 (option `vhdl-compose-configuration-use-subconfiguration'). For 4618 subcomponents in hierarchical configurations, the most-recently-analyzed 4619 (mra) architecture is selected. If another architecture is desired, it 4620 can be marked as most-recently-analyzed (speedbar menu) before 4621 generating the configuration. 4622 4623 Note: Configurations of subcomponents (i.e. hierarchical configuration 4624 declarations) are currently not considered when displaying 4625 configurations in speedbar. 4626 4627 See the options group `vhdl-compose' for all relevant user options. 4628 4629 4630 SOURCE FILE COMPILATION: 4631 The syntax of the current buffer can be analyzed by calling a VHDL 4632 compiler (menu, `C-c C-k'). The compiler to be used is specified by 4633 option `vhdl-compiler'. The available compilers are listed in option 4634 `vhdl-compiler-alist' including all required compilation command, 4635 command options, compilation directory, and error message syntax 4636 information. New compilers can be added. 4637 4638 All the source files of an entire design can be compiled by the `make' 4639 command (menu, `C-c M-C-k') if an appropriate Makefile exists. 4640 4641 4642 MAKEFILE GENERATION: 4643 Makefiles can be generated automatically by an internal generation 4644 routine (`C-c M-k'). The library unit dependency information is 4645 obtained from the hierarchy browser. Makefile generation can be 4646 customized for each compiler in option `vhdl-compiler-alist'. 4647 4648 Makefile generation can also be run non-interactively using the 4649 command: 4650 4651 emacs -batch -l ~/.emacs -l vhdl-mode 4652 [-compiler compilername] [-project projectname] 4653 -f vhdl-generate-makefile 4654 4655 The Makefile's default target \"all\" compiles the entire design, the 4656 target \"clean\" removes it and the target \"library\" creates the 4657 library directory if not existent. These target names can be customized 4658 by option `vhdl-makefile-default-targets'. The Makefile also includes a 4659 target for each primary library unit which allows selective compilation 4660 of this unit, its secondary units and its subhierarchy (example: 4661 compilation of a design specified by a configuration). User specific 4662 parts can be inserted into a Makefile with option 4663 `vhdl-makefile-generation-hook'. 4664 4665 Limitations: 4666 - Only library units and dependencies within the current library are 4667 considered. Makefiles for designs that span multiple libraries are 4668 not (yet) supported. 4669 - Only one-level configurations are supported (also hierarchical), 4670 but configurations that go down several levels are not. 4671 - The \"others\" keyword in configurations is not supported. 4672 4673 4674 PROJECTS: 4675 Projects can be defined in option `vhdl-project-alist' and a current 4676 project be selected using option `vhdl-project' (permanently) or from 4677 the menu or speedbar (temporarily). For each project, title and 4678 description strings (for the file headers), source files/directories 4679 (for the hierarchy browser and Makefile generation), library name, and 4680 compiler-dependent options, exceptions and compilation directory can be 4681 specified. Compilation settings overwrite the settings of option 4682 `vhdl-compiler-alist'. 4683 4684 Project setups can be exported (i.e. written to a file) and imported. 4685 Imported setups are not automatically saved in `vhdl-project-alist' but 4686 can be saved afterwards in its customization buffer. When starting 4687 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l 4688 vhdl-mode\") in a directory with an existing project setup file, it is 4689 automatically loaded and its project activated if option 4690 `vhdl-project-autoload' is non-nil. Names/paths of the project setup 4691 files can be specified in option `vhdl-project-file-name'. Multiple 4692 project setups can be automatically loaded from global directories. 4693 This is an alternative to specifying project setups with option 4694 `vhdl-project-alist'. 4695 4696 4697 SPECIAL MENUES: 4698 As an alternative to the speedbar, an index menu can be added (set 4699 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu 4700 (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up 4701 file) for browsing the file contents (is not populated if buffer is 4702 larger than 256000). Also, a source file menu can be 4703 added (set option `vhdl-source-file-menu' to non-nil) for browsing the 4704 current directory for VHDL source files. 4705 4706 4707 VHDL STANDARDS: 4708 The VHDL standards to be used are specified in option `vhdl-standard'. 4709 Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages. 4710 4711 4712 KEYWORD CASE: 4713 Lower and upper case for keywords and standardized types, attributes, 4714 and enumeration values is supported. If the option 4715 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in 4716 lower case and are converted into upper case automatically (not for 4717 types, attributes, and enumeration values). The case of keywords, 4718 types, attributes,and enumeration values can be fixed for an entire 4719 region (menu) or buffer (`C-c C-x C-c') according to the options 4720 `vhdl-upper-case-{keywords,types,attributes,enum-values}'. 4721 4722 4723 HIGHLIGHTING (fontification): 4724 Keywords and standardized types, attributes, enumeration values, and 4725 function names (controlled by option `vhdl-highlight-keywords'), as well 4726 as comments, strings, and template prompts are highlighted using 4727 different colors. Unit, subprogram, signal, variable, constant, 4728 parameter and generic/port names in declarations as well as labels are 4729 highlighted if option `vhdl-highlight-names' is non-nil. 4730 4731 Additional reserved words or words with a forbidden syntax (e.g. words 4732 that should be avoided) can be specified in option 4733 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in 4734 a warning color (option `vhdl-highlight-forbidden-words'). Verilog 4735 keywords are highlighted as forbidden words if option 4736 `vhdl-highlight-verilog-keywords' is non-nil. 4737 4738 Words with special syntax can be highlighted by specifying their 4739 syntax and color in option `vhdl-special-syntax-alist' and by setting 4740 option `vhdl-highlight-special-words' to non-nil. This allows you to 4741 establish some naming conventions (e.g. to distinguish different kinds 4742 of signals or other objects by using name suffices) and to support them 4743 visually. 4744 4745 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order 4746 to support case-sensitive highlighting. However, keywords are then only 4747 highlighted if written in lower case. 4748 4749 Code between \"translate_off\" and \"translate_on\" pragmas is 4750 highlighted using a different background color if option 4751 `vhdl-highlight-translate-off' is non-nil. 4752 4753 For documentation and customization of the used colors see 4754 customization group `vhdl-highlight-faces' (`\\[customize-group]'). For 4755 highlighting of matching parenthesis, see customization group 4756 `paren-showing'. Automatic buffer highlighting is turned on/off by 4757 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). 4758 4759 4760 USER MODELS: 4761 VHDL models (templates) can be specified by the user and made accessible 4762 in the menu, through key bindings (`C-c C-m ...'), or by keyword 4763 electrification. See option `vhdl-model-alist'. 4764 4765 4766 HIDE/SHOW: 4767 The code of blocks, processes, subprograms, component declarations and 4768 instantiations, generic/port clauses, and configuration declarations can 4769 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within 4770 the code (see customization group `vhdl-menu'). XEmacs: limited 4771 functionality due to old `hideshow.el' package. 4772 4773 4774 CODE UPDATING: 4775 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the 4776 current process, `C-c C-u M-s' of all processes in the current buffer. 4777 Limitations: 4778 - Only declared local signals (ports, signals declared in 4779 architecture and blocks) are automatically inserted. 4780 - Global signals declared in packages are not automatically inserted. 4781 Insert them once manually (will be kept afterwards). 4782 - Out parameters of procedures are considered to be read. 4783 Use option `vhdl-entity-file-name' to specify the entity file name 4784 (used to obtain the port names). 4785 Use option `vhdl-array-index-record-field-in-sensitivity-list' to 4786 specify whether to include array indices and record fields in 4787 sensitivity lists. 4788 4789 4790 CODE FIXING: 4791 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause 4792 (e.g., if the closing parenthesis is on the wrong line or is missing). 4793 4794 4795 PRINTING: 4796 PostScript printing with different faces (an optimized set of faces is 4797 used if `vhdl-print-customize-faces' is non-nil) or colors (if 4798 `ps-print-color-p' is non-nil) is possible using the standard Emacs 4799 PostScript printing commands. Option `vhdl-print-two-column' defines 4800 appropriate default settings for nice landscape two-column printing. 4801 The paper format can be set by option `ps-paper-type'. Do not forget to 4802 switch `ps-print-color-p' to nil for printing on black-and-white 4803 printers. 4804 4805 4806 OPTIONS: 4807 User options allow customization of VHDL Mode. All options are 4808 accessible from the \"Options\" menu entry. Simple options (switches 4809 and choices) can directly be changed, while for complex options a 4810 customization buffer is opened. Changed options can be saved for future 4811 sessions using the \"Save Options\" menu entry. 4812 4813 Options and their detailed descriptions can also be accessed by using 4814 the \"Customize\" menu entry or the command `\\[customize-option]' 4815 (`\\[customize-group]' for groups). Some customizations only take effect 4816 after some action (read the NOTE in the option documentation). 4817 Customization can also be done globally (i.e. site-wide, read the 4818 INSTALL file). 4819 4820 Not all options are described in this documentation, so go and see 4821 what other useful user options there are (`\\[vhdl-customize]' or menu)! 4822 4823 4824 FILE EXTENSIONS: 4825 As default, files with extensions \".vhd\" and \".vhdl\" are 4826 automatically recognized as VHDL source files. To add an extension 4827 \".xxx\", add the following line to your Emacs start-up file (`.emacs'): 4828 4829 (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist) 4830 4831 4832 HINTS: 4833 - To start Emacs with open VHDL hierarchy browser without having to load 4834 a VHDL file first, use the command: 4835 4836 emacs -l vhdl-mode -f speedbar-frame-mode 4837 4838 - Type `C-g C-g' to interrupt long operations or if Emacs hangs. 4839 4840 - Some features only work on properly indented code. 4841 4842 4843 RELEASE NOTES: 4844 See also the release notes (menu) for added features in new releases. 4845 4846 4847Maintenance: 4848------------ 4849 4850To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. 4851Add a description of the problem and include a reproducible test case. 4852 4853Questions and enhancement requests can be sent to <reto@gnu.org>. 4854 4855The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. 4856The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta 4857releases. You are kindly invited to participate in beta testing. Subscribe 4858to above mailing lists by sending an email to <reto@gnu.org>. 4859 4860VHDL Mode is officially distributed at 4861https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html 4862where the latest version can be found. 4863 4864 4865Known problems: 4866--------------- 4867 4868- XEmacs: Incorrect start-up when automatically opening speedbar. 4869- XEmacs: Indentation in XEmacs 21.4 (and higher). 4870- Indentation incorrect for new `postponed' VHDL keyword. 4871- Indentation incorrect for `protected body' construct. 4872 4873 4874 The VHDL Mode Authors 4875 Reto Zimmermann and Rod Whitby 4876 4877Key bindings: 4878------------- 4879 4880\\{vhdl-mode-map}" 4881 :abbrev-table vhdl-mode-abbrev-table 4882 4883 ;; set local variables 4884 (set (make-local-variable 'paragraph-start) 4885 "\\s-*\\(--+\\s-*$\\|$\\)") 4886 (set (make-local-variable 'paragraph-separate) paragraph-start) 4887 (set (make-local-variable 'paragraph-ignore-fill-prefix) t) 4888 (set (make-local-variable 'parse-sexp-ignore-comments) t) 4889 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) 4890 (set (make-local-variable 'comment-start) "--") 4891 (set (make-local-variable 'comment-end) "") 4892 (set (make-local-variable 'comment-column) vhdl-inline-comment-column) 4893 (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) 4894 (set (make-local-variable 'comment-start-skip) "--+\\s-*") 4895 (set (make-local-variable 'comment-multi-line) nil) 4896 (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) 4897 (set (make-local-variable 'hippie-expand-verbose) nil) 4898 4899 ;; setup the comment indent variable in an Emacs version portable way 4900 ;; ignore any byte compiler warnings you might get here 4901 (when (boundp 'comment-indent-function) 4902 (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) 4903 4904 ;; initialize font locking 4905 (set (make-local-variable 'font-lock-defaults) 4906 (list 4907 '(nil vhdl-font-lock-keywords) nil 4908 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) 4909 (if (eval-when-compile (fboundp 'syntax-propertize-rules)) 4910 (set (make-local-variable 'syntax-propertize-function) 4911 (syntax-propertize-rules 4912 ;; Mark single quotes as having string quote syntax in 4913 ;; 'c' instances. 4914 ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) 4915 (set (make-local-variable 'font-lock-syntactic-keywords) 4916 vhdl-font-lock-syntactic-keywords)) 4917 (unless vhdl-emacs-21 4918 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) 4919 (set (make-local-variable 'lazy-lock-defer-contextually) nil) 4920 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) 4921 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) 4922 4923 ;; variables for source file compilation 4924 (when vhdl-compile-use-local-error-regexp 4925 (set (make-local-variable 'compilation-error-regexp-alist) nil) 4926 (set (make-local-variable 'compilation-file-regexp-alist) nil)) 4927 4928 ;; add index menu 4929 (vhdl-index-menu-init) 4930 ;; add source file menu 4931 (if vhdl-source-file-menu (vhdl-add-source-files-menu)) 4932 ;; add VHDL menu 4933 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs 4934 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4935 "Menu keymap for VHDL Mode." vhdl-mode-menu-list) 4936 ;; initialize hideshow and add menu 4937 (vhdl-hideshow-init) 4938 (run-hooks 'menu-bar-update-hook) 4939 4940 ;; miscellaneous 4941 (vhdl-ps-print-init) 4942 (vhdl-write-file-hooks-init) 4943 (message "VHDL Mode %s.%s" vhdl-version 4944 (if noninteractive "" " See menu for documentation and release notes."))) 4945 4946(defun vhdl-activate-customizations () 4947 "Activate all customizations on local variables." 4948 (interactive) 4949 (vhdl-mode-map-init) 4950 (use-local-map vhdl-mode-map) 4951 (set-syntax-table vhdl-mode-syntax-table) 4952 (setq comment-column vhdl-inline-comment-column) 4953 (setq end-comment-column vhdl-end-comment-column) 4954 (vhdl-write-file-hooks-init) 4955 (vhdl-update-mode-menu) 4956 (vhdl-hideshow-init) 4957 (run-hooks 'menu-bar-update-hook)) 4958 4959(defun vhdl-write-file-hooks-init () 4960 "Add/remove hooks when buffer is saved." 4961 (if vhdl-modify-date-on-saving 4962 (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) 4963 (remove-hook 'write-file-functions 'vhdl-template-modify-noerror t)) 4964 (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) 4965 (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) 4966 4967(defun vhdl-process-command-line-option (option) 4968 "Process command line options for VHDL Mode." 4969 (cond 4970 ;; set compiler 4971 ((equal option "-compiler") 4972 (vhdl-set-compiler (car command-line-args-left)) 4973 (setq command-line-args-left (cdr command-line-args-left))) 4974 ;; set project 4975 ((equal option "-project") 4976 (vhdl-set-project (car command-line-args-left)) 4977 (setq command-line-args-left (cdr command-line-args-left))))) 4978 4979;; make Emacs process VHDL Mode options 4980(setq command-switch-alist 4981 (append command-switch-alist 4982 '(("-compiler" . vhdl-process-command-line-option) 4983 ("-project" . vhdl-process-command-line-option)))) 4984 4985 4986;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4987;;; Keywords and standardized words 4988;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4989 4990(defconst vhdl-02-keywords 4991 '( 4992 "abs" "access" "after" "alias" "all" "and" "architecture" "array" 4993 "assert" "attribute" 4994 "begin" "block" "body" "buffer" "bus" 4995 "case" "component" "configuration" "constant" 4996 "disconnect" "downto" 4997 "else" "elsif" "end" "entity" "exit" 4998 "file" "for" "function" 4999 "generate" "generic" "group" "guarded" 5000 "if" "impure" "in" "inertial" "inout" "is" 5001 "label" "library" "linkage" "literal" "loop" 5002 "map" "mod" 5003 "nand" "new" "next" "nor" "not" "null" 5004 "of" "on" "open" "or" "others" "out" 5005 "package" "port" "postponed" "procedure" "process" "protected" "pure" 5006 "range" "record" "register" "reject" "rem" "report" "return" 5007 "rol" "ror" 5008 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" 5009 "then" "to" "transport" "type" 5010 "unaffected" "units" "until" "use" 5011 "variable" 5012 "wait" "when" "while" "with" 5013 "xnor" "xor" 5014 ) 5015 "List of VHDL'02 keywords.") 5016 5017(defconst vhdl-08-keywords 5018 '( 5019 "context" "force" "property" "release" "sequence" 5020 ) 5021 "List of VHDL'08 keywords.") 5022 5023(defconst vhdl-ams-keywords 5024 '( 5025 "across" "break" "limit" "nature" "noise" "procedural" "quantity" 5026 "reference" "spectrum" "subnature" "terminal" "through" 5027 "tolerance" 5028 ) 5029 "List of VHDL-AMS keywords.") 5030 5031(defconst vhdl-verilog-keywords 5032 '( 5033 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" 5034 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" 5035 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" 5036 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" 5037 "endprimitive" "endspecify" "endtable" "endtask" "event" 5038 "for" "force" "forever" "fork" "function" 5039 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" 5040 "macromodule" "makefile" "medium" "module" 5041 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" 5042 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" 5043 "pullup" 5044 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" 5045 "rtranif0" "rtranif1" 5046 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" 5047 "strong1" "supply" "supply0" "supply1" 5048 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" 5049 "triand" "trior" "trireg" 5050 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" 5051 ) 5052 "List of Verilog keywords as candidate for additional reserved words.") 5053 5054(defconst vhdl-02-types 5055 '( 5056 "boolean" "bit" "bit_vector" "character" "severity_level" "integer" 5057 "real" "time" "natural" "positive" "string" "line" "text" "side" 5058 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" 5059 "std_logic" "std_logic_vector" 5060 "std_ulogic" "std_ulogic_vector" 5061 ) 5062 "List of VHDL'02 standardized types.") 5063 5064(defconst vhdl-08-types 5065 '( 5066 "boolean_vector" "integer_vector" "real_vector" "time_vector" 5067 ) 5068 "List of VHDL'08 standardized types.") 5069 5070(defconst vhdl-ams-types 5071 ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004 5072 '( 5073 ;; package `standard' 5074 "domain_type" "real_vector" 5075 ;; package `energy_systems' 5076 "energy" "power" "periodicity" "real_across" "real_through" "unspecified" 5077 "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector" 5078 "real_across_vector" "real_through_vector" 5079 ;; package `electrical_systems' 5080 "voltage" "current" "charge" "resistance" "conductance" "capacitance" 5081 "mmf" "electric_flux" "electric_flux_density" "electric_field_strength" 5082 "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength" 5083 "inductance" "reluctance" "electrical" "electrical_vector" "magnetic" 5084 "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector" 5085 "magnetic_flux_vector" "charge_vector" "resistance_vector" 5086 "conductance_vector" "capacitance_vector" "electric_flux_vector" 5087 "electric_flux_density_vector" "electric_field_strength_vector" 5088 "magnetic_flux_density_vector" "magnetic_field_strength_vector" 5089 "inductance_vector" "reluctance_vector" "ground" 5090 ;; package `mechanical_systems' 5091 "displacement" "force" "velocity" "acceleration" "mass" "stiffness" 5092 "damping" "momentum" "angle" "torque" "angular_velocity" 5093 "angular_acceleration" "moment_inertia" "angular_momentum" 5094 "angular_stiffness" "angular_damping" "translational" 5095 "translational_vector" "translational_velocity" 5096 "translational_velocity_vector" "rotational" "rotational_vector" 5097 "rotational_velocity" "rotational_velocity_vector" "displacement_vector" 5098 "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector" 5099 "torque_vector" "angular_velocity_vector" "torque_velocity_vector" 5100 "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector" 5101 "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector" 5102 "angular_momentum_vector" "angular_stiffness_vector" 5103 "angular_damping_vector" "anchor" "translational_v_ref" 5104 "rotational_v_ref" "translational_v" "rotational_v" 5105 ;; package `radiant_systems' 5106 "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant" 5107 "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector" 5108 "illuminance_vector" "irradiance_vector" 5109 ;; package `thermal_systems' 5110 "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance" 5111 "thermal_conductance" "thermal" "thermal_vector" "temperature_vector" 5112 "heat_flow_vector" "thermal_capacitance_vector" 5113 "thermal_resistance_vector" "thermal_conductance_vector" 5114 ;; package `fluidic_systems' 5115 "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity" 5116 "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance" 5117 "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector" 5118 "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector" 5119 "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector" 5120 "density_vector" "viscosity_vector" "fresistance_vector" 5121 "fconductance_vector" "fcapacitance_vector" "inertance_vector" 5122 "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector" 5123 "cfinertance_vector" 5124 ) 5125 "List of VHDL-AMS standardized types.") 5126 5127(defconst vhdl-math-types 5128 '( 5129 "complex" "complex_polar" "positive_real" "principal_value" 5130 ) 5131 "List of Math Packages standardized types.") 5132 5133(defconst vhdl-02-attributes 5134 '( 5135 "base" "left" "right" "high" "low" "pos" "val" "succ" 5136 "pred" "leftof" "rightof" "range" "reverse_range" 5137 "length" "delayed" "stable" "quiet" "transaction" 5138 "event" "active" "last_event" "last_active" "last_value" 5139 "driving" "driving_value" "ascending" "value" "image" 5140 "simple_name" "instance_name" "path_name" 5141 "foreign" 5142 ) 5143 "List of VHDL'02 standardized attributes.") 5144 5145(defconst vhdl-08-attributes 5146 '( 5147 "instance_name" "path_name" 5148 ) 5149 "List of VHDL'08 standardized attributes.") 5150 5151(defconst vhdl-ams-attributes 5152 '( 5153 "across" "through" 5154 "reference" "contribution" "tolerance" 5155 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" 5156 "ramp" "slew" 5157 ) 5158 "List of VHDL-AMS standardized attributes.") 5159 5160(defconst vhdl-02-enum-values 5161 '( 5162 "true" "false" 5163 "note" "warning" "error" "failure" 5164 "read_mode" "write_mode" "append_mode" 5165 "open_ok" "status_error" "name_error" "mode_error" 5166 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" 5167 "right" "left" 5168 ) 5169 "List of VHDL'02 standardized enumeration values.") 5170 5171(defconst vhdl-ams-enum-values 5172 '( 5173 "quiescent_domain" "time_domain" "frequency_domain" 5174 ;; from `nature_pkg' package 5175 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" 5176 ) 5177 "List of VHDL-AMS standardized enumeration values.") 5178 5179(defconst vhdl-ams-constants 5180 ;; standard: IEEE Std 1076.1.1-2004 5181 '( 5182 ;; package `fundamental_constants' 5183 "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok" 5184 "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto" 5185 "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega" 5186 "giga" "tera" "peta" "exa" "zetta" "yotta" "deca" 5187 ;; package `material_constants' 5188 "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly" 5189 "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2" 5190 "ambient_temperature" "ambient_pressure" "ambient_illuminance" 5191 ) 5192 "List of VHDL-AMS standardized constants.") 5193 5194(defconst vhdl-math-constants 5195 ;; standard: IEEE Std 1076.2-1996 5196 '( 5197 "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi" 5198 "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero" 5199 "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e" 5200 "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2" 5201 "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2" 5202 "math_sqrt_pi" 5203 ) 5204 "List of Math Packages standardized constants.") 5205 5206(defconst vhdl-02-functions 5207 '( 5208 "now" "resolved" "rising_edge" "falling_edge" 5209 "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite" 5210 "endfile" 5211 "resize" "is_X" "std_match" 5212 "shift_left" "shift_right" "rotate_left" "rotate_right" 5213 "to_unsigned" "to_signed" "to_integer" 5214 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" 5215 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" 5216 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" 5217 "shl" "shr" "ext" "sxt" 5218 "deallocate" 5219 ) 5220 "List of VHDL'02 standardized functions.") 5221 5222(defconst vhdl-08-functions 5223 '( 5224 "finish" "flush" "justify" "maximum" "minimum" 5225 "resolution_limit" "rising_edge" "stop" "swrite" 5226 "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring" 5227 "to_octalstring" "to_ostring" "to_string" 5228 ) 5229 "List of VHDL'08 standardized functions.") 5230 5231(defconst vhdl-ams-functions 5232 '( 5233 ;; package `standard' 5234 "frequency" 5235 ) 5236 "List of VHDL-AMS standardized functions.") 5237 5238(defconst vhdl-math-functions 5239 ;; standard: IEEE Std 1076.2-1996 5240 '( 5241 "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg" 5242 "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp" 5243 "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex" 5244 "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt" 5245 "tan" "tanh" "trunc" "uniform" 5246 ) 5247 "List of Math Packages standardized functions.") 5248 5249(defconst vhdl-02-packages 5250 '( 5251 "std_logic_1164" "numeric_std" "numeric_bit" 5252 "standard" "textio" 5253 "std_logic_arith" "std_logic_signed" "std_logic_unsigned" 5254 "std_logic_misc" "std_logic_textio" 5255 "ieee" "std" "work" 5256 ) 5257 "List of VHDL'02 standardized packages and libraries.") 5258 5259(defconst vhdl-08-packages 5260 '( 5261 "env" "numeric_std_signed" "numeric_std_unsigned" 5262 "ieee_bit_context" "ieee_std_context" ;; contexts 5263 ) 5264 "List of VHDL'08 standardized packages and libraries.") 5265 5266(defconst vhdl-ams-packages 5267 '( 5268 "fundamental_constants" "material_constants" "energy_systems" 5269 "electrical_systems" "mechanical_systems" "radiant_systems" 5270 "thermal_systems" "fluidic_systems" 5271 ) 5272 "List of VHDL-AMS standardized packages and libraries.") 5273 5274(defconst vhdl-math-packages 5275 '( 5276 "math_real" "math_complex" 5277 ) 5278 "List of Math Packages standardized packages and libraries.") 5279 5280(defconst vhdl-08-directives 5281 '( 5282 "author" "author_info" "begin" "begin_protected" "comment" 5283 "data_block" "data_keyname" "data_keyowner" "data_method" 5284 "decrypt_license" "digest_block" "digest_key_method" "digest_keyname" 5285 "digest_keyowner" "digest_method" 5286 "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected" 5287 "key_block" "key_keyname" "key_keyowner" "key_method" 5288 "runtime_license" "viewport" 5289 ) 5290 "List of VHDL'08 standardized tool directives.") 5291 5292(defvar vhdl-keywords nil 5293 "List of VHDL keywords.") 5294 5295(defvar vhdl-types nil 5296 "List of VHDL standardized types.") 5297 5298(defvar vhdl-attributes nil 5299 "List of VHDL standardized attributes.") 5300 5301(defvar vhdl-enum-values nil 5302 "List of VHDL standardized enumeration values.") 5303 5304(defvar vhdl-constants nil 5305 "List of VHDL standardized constants.") 5306 5307(defvar vhdl-functions nil 5308 "List of VHDL standardized functions.") 5309 5310(defvar vhdl-packages nil 5311 "List of VHDL standardized packages and libraries.") 5312 5313(defvar vhdl-directives nil 5314 "List of VHDL standardized packages and libraries.") 5315 5316(defvar vhdl-reserved-words nil 5317 "List of additional reserved words.") 5318 5319(defvar vhdl-keywords-regexp nil 5320 "Regexp for VHDL keywords.") 5321 5322(defvar vhdl-types-regexp nil 5323 "Regexp for VHDL standardized types.") 5324 5325(defvar vhdl-attributes-regexp nil 5326 "Regexp for VHDL standardized attributes.") 5327 5328(defvar vhdl-enum-values-regexp nil 5329 "Regexp for VHDL standardized enumeration values.") 5330 5331(defvar vhdl-constants-regexp nil 5332 "Regexp for VHDL standardized constants.") 5333 5334(defvar vhdl-functions-regexp nil 5335 "Regexp for VHDL standardized functions.") 5336 5337(defvar vhdl-packages-regexp nil 5338 "Regexp for VHDL standardized packages and libraries.") 5339 5340(defvar vhdl-reserved-words-regexp nil 5341 "Regexp for additional reserved words.") 5342 5343(defvar vhdl-directive-keywords-regexp nil 5344 "Regexp for compiler directive keywords.") 5345 5346(defun vhdl-upcase-list (condition list) 5347 "Upcase all elements in LIST based on CONDITION." 5348 (when condition 5349 (let ((tmp-list list)) 5350 (while tmp-list 5351 (setcar tmp-list (upcase (car tmp-list))) 5352 (setq tmp-list (cdr tmp-list))))) 5353 list) 5354 5355(defun vhdl-words-init () 5356 "Initialize reserved words." 5357 (setq vhdl-keywords 5358 (vhdl-upcase-list 5359 (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords) 5360 (append vhdl-02-keywords 5361 (when (vhdl-standard-p '08) vhdl-08-keywords) 5362 (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))) 5363 (setq vhdl-types 5364 (vhdl-upcase-list 5365 (and vhdl-highlight-case-sensitive vhdl-upper-case-types) 5366 (append vhdl-02-types 5367 (when (vhdl-standard-p '08) vhdl-08-types) 5368 (when (vhdl-standard-p 'ams) vhdl-ams-types) 5369 (when (vhdl-standard-p 'math) vhdl-math-types)))) 5370 (setq vhdl-attributes 5371 (vhdl-upcase-list 5372 (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes) 5373 (append vhdl-02-attributes 5374 (when (vhdl-standard-p '08) vhdl-08-attributes) 5375 (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))) 5376 (setq vhdl-enum-values 5377 (vhdl-upcase-list 5378 (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values) 5379 (append vhdl-02-enum-values 5380 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))) 5381 (setq vhdl-constants 5382 (vhdl-upcase-list 5383 (and vhdl-highlight-case-sensitive vhdl-upper-case-constants) 5384 (append (when (vhdl-standard-p 'ams) vhdl-ams-constants) 5385 (when (vhdl-standard-p 'math) vhdl-math-constants) 5386 '("")))) 5387 (setq vhdl-functions 5388 (append vhdl-02-functions 5389 (when (vhdl-standard-p '08) vhdl-08-functions) 5390 (when (vhdl-standard-p 'ams) vhdl-ams-functions) 5391 (when (vhdl-standard-p 'math) vhdl-math-functions))) 5392 (setq vhdl-packages 5393 (append vhdl-02-packages 5394 (when (vhdl-standard-p '08) vhdl-08-packages) 5395 (when (vhdl-standard-p 'ams) vhdl-ams-packages) 5396 (when (vhdl-standard-p 'math) vhdl-math-packages))) 5397 (setq vhdl-directives 5398 (append (when (vhdl-standard-p '08) vhdl-08-directives))) 5399 (setq vhdl-reserved-words 5400 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) 5401 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) 5402 '(""))) 5403 (setq vhdl-keywords-regexp 5404 (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) 5405 (setq vhdl-types-regexp 5406 (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) 5407 (setq vhdl-attributes-regexp 5408 (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) 5409 (setq vhdl-enum-values-regexp 5410 (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) 5411 (setq vhdl-constants-regexp 5412 (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>")) 5413 (setq vhdl-functions-regexp 5414 (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) 5415 (setq vhdl-packages-regexp 5416 (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) 5417 (setq vhdl-reserved-words-regexp 5418 (concat "\\<\\(" 5419 (unless (equal vhdl-forbidden-syntax "") 5420 (concat vhdl-forbidden-syntax "\\|")) 5421 (regexp-opt vhdl-reserved-words) 5422 "\\)\\>")) 5423 (setq vhdl-directive-keywords-regexp 5424 (concat "\\<\\(" (mapconcat 'regexp-quote 5425 vhdl-directive-keywords "\\|") "\\)\\>")) 5426 (vhdl-abbrev-list-init)) 5427 5428;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5429;; Words to expand 5430 5431(defvar vhdl-abbrev-list nil 5432 "Predefined abbreviations for VHDL.") 5433 5434(defun vhdl-abbrev-list-init () 5435 (setq vhdl-abbrev-list 5436 (append 5437 (list vhdl-upper-case-keywords) vhdl-keywords 5438 (list vhdl-upper-case-types) vhdl-types 5439 (list vhdl-upper-case-attributes) vhdl-attributes 5440 (list vhdl-upper-case-enum-values) vhdl-enum-values 5441 (list vhdl-upper-case-constants) vhdl-constants 5442 (list nil) vhdl-functions 5443 (list nil) vhdl-packages 5444 (list nil) vhdl-directives))) 5445 5446;; initialize reserved words for VHDL Mode 5447(vhdl-words-init) 5448 5449 5450;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5451;;; Indentation 5452;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5453 5454;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5455;; Syntax analysis 5456 5457;; constant regular expressions for looking at various constructs 5458 5459(defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" 5460 "Regexp describing a VHDL symbol. 5461We cannot use just `word' syntax class since `_' cannot be in word 5462class. Putting underscore in word class breaks forward word movement 5463behavior that users are familiar with.") 5464 5465(defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is" 5466 "Regexp describing a case statement header key.") 5467 5468(defconst vhdl-label-key 5469 (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") 5470 "Regexp describing a VHDL label.") 5471 5472;; Macro definitions: 5473 5474(defmacro vhdl-point (position) 5475 "Return the value of point at certain commonly referenced POSITIONs. 5476POSITION can be one of the following symbols: 5477 5478bol -- beginning of line 5479eol -- end of line 5480bod -- beginning of defun 5481boi -- back to indentation 5482eoi -- last whitespace on line 5483ionl -- indentation of next line 5484iopl -- indentation of previous line 5485bonl -- beginning of next line 5486bopl -- beginning of previous line 5487 5488This function does not modify point or mark." 5489 (or (and (eq 'quote (car-safe position)) 5490 (null (cddr position))) 5491 (error "ERROR: Bad buffer position requested: %s" position)) 5492 (setq position (nth 1 position)) 5493 `(let ((here (point))) 5494 ,@(cond 5495 ((eq position 'bol) '((beginning-of-line))) 5496 ((eq position 'eol) '((end-of-line))) 5497 ((eq position 'bod) '((save-match-data 5498 (vhdl-beginning-of-defun)))) 5499 ((eq position 'boi) '((back-to-indentation))) 5500 ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t"))) 5501 ((eq position 'bonl) '((forward-line 1))) 5502 ((eq position 'bopl) '((forward-line -1))) 5503 ((eq position 'iopl) 5504 '((forward-line -1) 5505 (back-to-indentation))) 5506 ((eq position 'ionl) 5507 '((forward-line 1) 5508 (back-to-indentation))) 5509 (t (error "ERROR: Unknown buffer position requested: %s" position)) 5510 ) 5511 (prog1 5512 (point) 5513 (goto-char here)) 5514 ;; workaround for an Emacs18 bug -- blech! Well, at least it 5515 ;; doesn't hurt for v19 5516 ,@nil 5517 )) 5518 5519(defmacro vhdl-safe (&rest body) 5520 "Safely execute BODY, return nil if an error occurred." 5521 `(condition-case nil 5522 (progn ,@body) 5523 (error nil))) 5524 5525(defmacro vhdl-add-syntax (symbol &optional relpos) 5526 "A simple macro to append the syntax in SYMBOL to the syntax list. 5527Try to increase performance by using this macro." 5528 `(setq vhdl-syntactic-context 5529 (cons (cons ,symbol ,relpos) vhdl-syntactic-context))) 5530 5531(defmacro vhdl-has-syntax (symbol) 5532 "A simple macro to return check the syntax list. 5533Try to increase performance by using this macro." 5534 `(assoc ,symbol vhdl-syntactic-context)) 5535 5536;; Syntactic element offset manipulation: 5537 5538(defun vhdl-read-offset (langelem) 5539 "Read new offset value for LANGELEM from minibuffer. 5540Return a valid value only." 5541 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) 5542 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") 5543 (prompt "Offset: ") 5544 offset input interned) 5545 (while (not offset) 5546 (setq input (read-string prompt oldoff) 5547 offset (cond ((string-equal "+" input) '+) 5548 ((string-equal "-" input) '-) 5549 ((string-equal "++" input) '++) 5550 ((string-equal "--" input) '--) 5551 ((string-match "^-?[0-9]+$" input) 5552 (string-to-number input)) 5553 ((fboundp (setq interned (intern input))) 5554 interned) 5555 ((boundp interned) interned) 5556 ;; error, but don't signal one, keep trying 5557 ;; to read an input value 5558 (t (ding) 5559 (setq prompt errmsg) 5560 nil)))) 5561 offset)) 5562 5563(defun vhdl-set-offset (symbol offset &optional add-p) 5564 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. 5565SYMBOL is the syntactic element symbol to change and OFFSET is the new 5566offset for that syntactic element. Optional ADD-P says to add SYMBOL to 5567`vhdl-offsets-alist' if it doesn't already appear there." 5568 (interactive 5569 (let* ((langelem 5570 (intern (completing-read 5571 (concat "Syntactic symbol to change" 5572 (if current-prefix-arg " or add" "") 5573 ": ") 5574 (mapcar 5575 (function 5576 (lambda (langelem) 5577 (cons (format "%s" (car langelem)) nil))) 5578 vhdl-offsets-alist) 5579 nil (not current-prefix-arg) 5580 ;; initial contents tries to be the last element 5581 ;; on the syntactic analysis list for the current 5582 ;; line 5583 (let* ((syntax (vhdl-get-syntactic-context)) 5584 (len (length syntax)) 5585 (ic (format "%s" (car (nth (1- len) syntax))))) 5586 ic) 5587 ))) 5588 (offset (vhdl-read-offset langelem))) 5589 (list langelem offset current-prefix-arg))) 5590 ;; sanity check offset 5591 (or (eq offset '+) 5592 (eq offset '-) 5593 (eq offset '++) 5594 (eq offset '--) 5595 (integerp offset) 5596 (fboundp offset) 5597 (boundp offset) 5598 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" 5599 offset)) 5600 (let ((entry (assq symbol vhdl-offsets-alist))) 5601 (if entry 5602 (setcdr entry offset) 5603 (if add-p 5604 (setq vhdl-offsets-alist 5605 (cons (cons symbol offset) vhdl-offsets-alist)) 5606 (error "ERROR: %s is not a valid syntactic symbol" symbol)))) 5607 (vhdl-keep-region-active)) 5608 5609(defun vhdl-set-style (style &optional local) 5610 "Set `vhdl-mode' variables to use one of several different indentation styles. 5611STYLE is a string representing the desired style and optional LOCAL is 5612a flag which, if non-nil, means to make the style variables being 5613changed buffer local, instead of the default, which is to set the 5614global variables. Interactively, the flag comes from the prefix 5615argument. The styles are chosen from the `vhdl-style-alist' variable." 5616 (interactive (list (completing-read "Use which VHDL indentation style? " 5617 vhdl-style-alist nil t) 5618 current-prefix-arg)) 5619 (let ((vars (cdr (assoc style vhdl-style-alist)))) 5620 (or vars 5621 (error "ERROR: Invalid VHDL indentation style `%s'" style)) 5622 ;; set all the variables 5623 (mapc 5624 (function 5625 (lambda (varentry) 5626 (let ((var (car varentry)) 5627 (val (cdr varentry))) 5628 ;; special case for vhdl-offsets-alist 5629 (if (not (eq var 'vhdl-offsets-alist)) 5630 (set (if local (make-local-variable var) var) val) 5631 ;; reset vhdl-offsets-alist to the default value first 5632 (set (if local (make-local-variable var) var) 5633 (copy-alist vhdl-offsets-alist-default)) 5634 ;; now set the langelems that are different 5635 (mapcar 5636 (function 5637 (lambda (langentry) 5638 (let ((langelem (car langentry)) 5639 (offset (cdr langentry))) 5640 (vhdl-set-offset langelem offset) 5641 ))) 5642 val)) 5643 ))) 5644 vars)) 5645 (vhdl-keep-region-active)) 5646 5647(defun vhdl-get-offset (langelem) 5648 "Get offset from LANGELEM which is a cons cell of the form: 5649\(SYMBOL . RELPOS). The symbol is matched against 5650vhdl-offsets-alist and the offset found there is either returned, 5651or added to the indentation at RELPOS. If RELPOS is nil, then 5652the offset is simply returned." 5653 (let* ((symbol (car langelem)) 5654 (relpos (cdr langelem)) 5655 (match (assq symbol vhdl-offsets-alist)) 5656 (offset (cdr-safe match))) 5657 ;; offset can be a number, a function, a variable, or one of the 5658 ;; symbols + or - 5659 (cond 5660 ((not match) 5661 (if vhdl-strict-syntax-p 5662 (error "ERROR: Don't know how to indent a %s" symbol) 5663 (setq offset 0 5664 relpos 0))) 5665 ((eq offset '+) (setq offset vhdl-basic-offset)) 5666 ((eq offset '-) (setq offset (- vhdl-basic-offset))) 5667 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) 5668 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) 5669 ((and (not (numberp offset)) 5670 (fboundp offset)) 5671 (setq offset (funcall offset langelem))) 5672 ((not (numberp offset)) 5673 (setq offset (eval offset))) 5674 ) 5675 (+ (if (and relpos 5676 (< relpos (vhdl-point 'bol))) 5677 (save-excursion 5678 (goto-char relpos) 5679 (current-column)) 5680 0) 5681 offset))) 5682 5683;; Syntactic support functions: 5684 5685(defun vhdl-in-comment-p (&optional pos) 5686 "Check if point is in a comment (include multi-line comments)." 5687 (let ((parse (lambda (p) 5688 (let ((c (char-after p))) 5689 (or (and c (eq (char-syntax c) ?<)) 5690 (nth 4 (parse-partial-sexp 5691 (save-excursion 5692 (beginning-of-defun) 5693 (point)) p))))))) 5694 (save-excursion 5695 (goto-char (or pos (point))) 5696 (or (funcall parse (point)) 5697 ;; `parse-partial-sexp's notion of comments doesn't span lines 5698 (progn 5699 (back-to-indentation) 5700 (unless (eolp) 5701 (forward-char) 5702 (funcall parse (point)))))))) 5703 5704(defun vhdl-in-string-p () 5705 "Check if point is in a string." 5706 (eq (vhdl-in-literal) 'string)) 5707 5708(defun vhdl-in-quote-p () 5709 "Check if point is in a quote ('x')." 5710 (or (and (> (point) (point-min)) 5711 (< (1+ (point)) (point-max)) 5712 (= (char-before (point)) ?\') 5713 (= (char-after (1+ (point))) ?\')) 5714 (and (> (1- (point)) (point-min)) 5715 (< (point) (point-max)) 5716 (= (char-before (1- (point))) ?\') 5717 (= (char-after (point)) ?\')))) 5718 5719(defun vhdl-in-literal () 5720 "Determine if point is in a VHDL literal." 5721 (save-excursion 5722 (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) 5723 (cond 5724 ((nth 3 state) 'string) 5725 ((nth 4 state) 'comment) 5726 ((vhdl-beginning-of-macro) 'pound) 5727 ((vhdl-beginning-of-directive) 'directive) 5728 ;; for multi-line comments 5729 ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment) 5730 (t nil))))) 5731 5732(defun vhdl-in-extended-identifier-p () 5733 "Determine if point is inside extended identifier (delimited by `\\')." 5734 (save-match-data 5735 (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t)) 5736 (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t))))) 5737 5738(defun vhdl-forward-comment (&optional direction) 5739 "Skip all comments (including whitespace). Skip backwards if DIRECTION is 5740negative, skip forward otherwise." 5741 (interactive "p") 5742 (if (and direction (< direction 0)) 5743 ;; skip backwards 5744 (progn 5745 (skip-chars-backward " \t\n\r\f") 5746 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) 5747 (goto-char (match-beginning 3)) 5748 (skip-chars-backward " \t\n\r\f"))) 5749 ;; skip forwards 5750 (skip-chars-forward " \t\n\r\f") 5751 (while (looking-at "--.*") 5752 (goto-char (match-end 0)) 5753 (skip-chars-forward " \t\n\r\f")))) 5754 5755;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ 5756(unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) 5757 (defalias 'vhdl-forward-comment 'forward-comment)) 5758 5759(defun vhdl-back-to-indentation () 5760 "Move point to the first non-whitespace character on this line." 5761 (interactive) 5762 (beginning-of-line 1) 5763 (skip-syntax-forward " " (vhdl-point 'eol))) 5764 5765;; XEmacs hack: work around old `back-to-indentation' in XEmacs 5766(when (featurep 'xemacs) 5767 (defalias 'back-to-indentation 'vhdl-back-to-indentation)) 5768 5769;; This is the best we can do in Win-Emacs. 5770(defun vhdl-win-il (&optional lim) 5771 "Determine if point is in a VHDL literal." 5772 (save-excursion 5773 (let* ((here (point)) 5774 (state nil) 5775 (match nil) 5776 (lim (or lim (vhdl-point 'bod)))) 5777 (goto-char lim ) 5778 (while (< (point) here) 5779 (setq match 5780 (and (re-search-forward "--\\|[\"']\\|`" 5781 here 'move) 5782 (buffer-substring (match-beginning 0) (match-end 0)))) 5783 (setq state 5784 (cond 5785 ;; no match 5786 ((null match) nil) 5787 ;; looking at the opening of a VHDL style comment 5788 ((string= "--" match) 5789 (if (<= here (progn (end-of-line) (point))) 'comment)) 5790 ;; looking at a directive 5791 ((string= "`" match) 5792 (if (<= here (progn (end-of-line) (point))) 'directive)) 5793 ;; looking at the opening of a double quote string 5794 ((string= "\"" match) 5795 (if (not (save-restriction 5796 ;; this seems to be necessary since the 5797 ;; re-search-forward will not work without it 5798 (narrow-to-region (point) here) 5799 (re-search-forward 5800 ;; this regexp matches a double quote 5801 ;; which is preceded by an even number 5802 ;; of backslashes, including zero 5803 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) 5804 'string)) 5805 ;; looking at the opening of a single quote string 5806 ((string= "'" match) 5807 (if (not (save-restriction 5808 ;; see comments from above 5809 (narrow-to-region (point) here) 5810 (re-search-forward 5811 ;; this matches a single quote which is 5812 ;; preceded by zero or two backslashes. 5813 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" 5814 here 'move))) 5815 'string)) 5816 (t nil))) 5817 ) ; end-while 5818 state))) 5819 5820(and (string-match "Win-Emacs" emacs-version) 5821 (fset 'vhdl-in-literal 'vhdl-win-il)) 5822 5823;; Skipping of "syntactic whitespace". Syntactic whitespace is 5824;; defined as lexical whitespace or comments. Search no farther back 5825;; or forward than optional LIM. If LIM is omitted, (point-min) is 5826;; used for backward skipping, (point-max) is used for forward 5827;; skipping. 5828 5829(defun vhdl-forward-syntactic-ws (&optional lim) 5830 "Forward skip of syntactic whitespace." 5831 (let* ((here (point-max)) 5832 (hugenum (point-max))) 5833 (while (/= here (point)) 5834 (setq here (point)) 5835 (vhdl-forward-comment hugenum) 5836 ;; skip preprocessor directives 5837 (when (and (or (eq (char-after) ?#) (eq (char-after) ?`)) 5838 (= (vhdl-point 'boi) (point))) 5839 (while (and (eq (char-before (vhdl-point 'eol)) ?\\) 5840 (= (forward-line 1) 0))) 5841 (end-of-line))) 5842 (if lim (goto-char (min (point) lim))))) 5843 5844 5845;; This is the best we can do in Win-Emacs. 5846(defun vhdl-win-fsws (&optional lim) 5847 "Forward skip syntactic whitespace for Win-Emacs." 5848 (let ((lim (or lim (point-max))) 5849 stop) 5850 (while (not stop) 5851 (skip-chars-forward " \t\n\r\f" lim) 5852 (cond 5853 ;; vhdl comment 5854 ((looking-at "--") (end-of-line)) 5855 ;; none of the above 5856 (t (setq stop t)))))) 5857 5858(and (string-match "Win-Emacs" emacs-version) 5859 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) 5860 5861(defun vhdl-beginning-of-macro (&optional lim) 5862 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." 5863 (let ((here (point))) 5864 (beginning-of-line) 5865 (while (eq (char-before (1- (point))) ?\\) 5866 (forward-line -1)) 5867 (back-to-indentation) 5868 (if (and (<= (point) here) 5869 (eq (char-after) ?#)) 5870 t 5871 (goto-char here) 5872 nil))) 5873 5874(defun vhdl-beginning-of-directive (&optional lim) 5875 "Go to the beginning of a directive (nicked from `cc-engine')." 5876 (let ((here (point))) 5877 (beginning-of-line) 5878 (while (eq (char-before (1- (point))) ?\\) 5879 (forward-line -1)) 5880 (back-to-indentation) 5881 (if (and (<= (point) here) 5882 (eq (char-after) ?`)) 5883 t 5884 (goto-char here) 5885 nil))) 5886 5887(defun vhdl-backward-syntactic-ws (&optional lim) 5888 "Backward skip over syntactic whitespace." 5889 (let* ((here (point-min)) 5890 (hugenum (- (point-max)))) 5891 (while (/= here (point)) 5892 (setq here (point)) 5893 (vhdl-forward-comment hugenum) 5894 (vhdl-beginning-of-macro)) 5895 (if lim (goto-char (max (point) lim))))) 5896 5897;; This is the best we can do in Win-Emacs. 5898(defun vhdl-win-bsws (&optional lim) 5899 "Backward skip syntactic whitespace for Win-Emacs." 5900 (let ((lim (or lim (vhdl-point 'bod))) 5901 stop) 5902 (while (not stop) 5903 (skip-chars-backward " \t\n\r\f" lim) 5904 (cond 5905 ;; vhdl comment 5906 ((eq (vhdl-in-literal) 'comment) 5907 (skip-chars-backward "^-" lim) 5908 (skip-chars-backward "-" lim) 5909 (while (not (or (and (= (following-char) ?-) 5910 (= (char-after (1+ (point))) ?-)) 5911 (<= (point) lim))) 5912 (skip-chars-backward "^-" lim) 5913 (skip-chars-backward "-" lim))) 5914 ;; none of the above 5915 (t (setq stop t)))))) 5916 5917(and (string-match "Win-Emacs" emacs-version) 5918 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) 5919 5920;; Functions to help finding the correct indentation column: 5921 5922(defun vhdl-first-word (point) 5923 "If the keyword at POINT is at boi, then return (current-column) at 5924that point, else nil." 5925 (save-excursion 5926 (and (goto-char point) 5927 (eq (point) (vhdl-point 'boi)) 5928 (current-column)))) 5929 5930(defun vhdl-last-word (point) 5931 "If the keyword at POINT is at eoi, then return (current-column) at 5932that point, else nil." 5933 (save-excursion 5934 (and (goto-char point) 5935 (save-excursion (or (eq (progn (forward-sexp) (point)) 5936 (vhdl-point 'eoi)) 5937 (looking-at "\\s-*\\(--\\)?"))) 5938 (current-column)))) 5939 5940;; Core syntactic evaluation functions: 5941 5942(defconst vhdl-libunit-re 5943 "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]") 5944 5945(defun vhdl-libunit-p () 5946 (and 5947 (save-excursion 5948 (forward-sexp) 5949 (skip-chars-forward " \t\n\r\f") 5950 (not (looking-at "is\\b[^_]"))) 5951 (save-excursion 5952 (backward-sexp) 5953 (and (not (looking-at "use\\b[^_]")) 5954 (progn 5955 (forward-sexp) 5956 (vhdl-forward-syntactic-ws) 5957 (/= (following-char) ?:)))) 5958 )) 5959 5960(defconst vhdl-defun-re 5961 "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") 5962 5963(defun vhdl-defun-p () 5964 (save-excursion 5965 (if (looking-at "block\\|process\\|procedural") 5966 ;; "block", "process", "procedural": 5967 (save-excursion 5968 (backward-sexp) 5969 (not (looking-at "end\\s-+\\w"))) 5970 ;; "architecture", "configuration", "context", "entity", 5971 ;; "package", "procedure", "function": 5972 t))) 5973 5974(defun vhdl-corresponding-defun () 5975 "If the word at the current position corresponds to a \"defun\" 5976keyword, then return a string that can be used to find the 5977corresponding \"begin\" keyword, else return nil." 5978 (save-excursion 5979 (and (looking-at vhdl-defun-re) 5980 (vhdl-defun-p) 5981 (if (looking-at "block\\|process\\|procedural") 5982 ;; "block", "process". "procedural: 5983 (buffer-substring (match-beginning 0) (match-end 0)) 5984 ;; "architecture", "configuration", "context", "entity", "package", 5985 ;; "procedure", "function": 5986 "is")))) 5987 5988(defconst vhdl-begin-fwd-re 5989 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)" 5990 "A regular expression for searching forward that matches all known 5991\"begin\" keywords.") 5992 5993(defconst vhdl-begin-bwd-re 5994 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]" 5995 "A regular expression for searching backward that matches all known 5996\"begin\" keywords.") 5997 5998(defun vhdl-begin-p (&optional lim) 5999 "Return t if we are looking at a real \"begin\" keyword. 6000Assumes that the caller will make sure that we are looking at 6001vhdl-begin-fwd-re, and are not inside a literal, and that we are not in 6002the middle of an identifier that just happens to contain a \"begin\" 6003keyword." 6004 (cond 6005 ;; "[architecture|case|configuration|context|entity|package| 6006 ;; procedure|function] ... is": 6007 ((and (looking-at "i") 6008 (save-excursion 6009 ;; Skip backward over first sexp (needed to skip over a 6010 ;; procedure interface list, and is harmless in other 6011 ;; situations). Note that we need "return" in the 6012 ;; following search list so that we don't run into 6013 ;; semicolons in the function interface list. 6014 (backward-sexp) 6015 (skip-chars-forward "(") 6016 (let (foundp) 6017 (while (and (not foundp) 6018 (re-search-backward 6019 ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" 6020 lim 'move)) 6021 (if (or (= (preceding-char) ?_) 6022 (vhdl-in-literal)) 6023 (backward-char) 6024 (setq foundp t)))) 6025 (and (/= (following-char) ?\;) 6026 (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) 6027 t) 6028 ;; "begin", "then", "use": 6029 ((looking-at "be\\|t\\|use") 6030 t) 6031 ;; "else": 6032 ((and (looking-at "e") 6033 ;; make sure that the "else" isn't inside a 6034 ;; conditional signal assignment. 6035 (save-excursion 6036 (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 6037 (or (eq (following-char) ?\;) 6038 (eq (point) lim)))) 6039 t) 6040 ;; "block", "generate", "loop", "process", "procedural", 6041 ;; "units", "record", "protected body": 6042 ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record") 6043 (save-excursion 6044 (backward-sexp) 6045 (not (looking-at "end\\s-+\\w")))) 6046 t) 6047 ;; "component": 6048 ((and (looking-at "c") 6049 (save-excursion 6050 (backward-sexp) 6051 (not (looking-at "end\\s-+\\w"))) 6052 ;; look out for the dreaded entity class in an attribute 6053 (save-excursion 6054 (vhdl-backward-syntactic-ws lim) 6055 (/= (preceding-char) ?:))) 6056 t) 6057 ;; "for" (inside configuration declaration): 6058 ((and (looking-at "f") 6059 (save-excursion 6060 (backward-sexp) 6061 (not (looking-at "end\\s-+\\w"))) 6062 (vhdl-has-syntax 'configuration)) 6063 t) 6064 )) 6065 6066(defun vhdl-corresponding-mid (&optional lim) 6067 (cond 6068 ((looking-at "is\\|block\\|generate\\|process\\|procedural") 6069 "begin") 6070 ((looking-at "then\\|use") 6071 "<else>") 6072 (t 6073 "end"))) 6074 6075(defun vhdl-corresponding-end (&optional lim) 6076 "If the word at the current position corresponds to a \"begin\" 6077keyword, then return a vector containing enough information to find 6078the corresponding \"end\" keyword, else return nil. The keyword to 6079search forward for is aref 0. The column in which the keyword must 6080appear is aref 1 or nil if any column is suitable. 6081Assumes that the caller will make sure that we are not in the middle 6082of an identifier that just happens to contain a \"begin\" keyword." 6083 (save-excursion 6084 (and (looking-at vhdl-begin-fwd-re) 6085 (or (not (looking-at "\\<use\\>")) 6086 (save-excursion (back-to-indentation) 6087 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6088 (/= (preceding-char) ?_) 6089 (not (vhdl-in-literal)) 6090 (vhdl-begin-p lim) 6091 (cond 6092 ;; "is", "generate", "loop": 6093 ((looking-at "[igl]") 6094 (vector "end" 6095 (and (vhdl-last-word (point)) 6096 (or (vhdl-first-word (point)) 6097 (save-excursion 6098 (vhdl-beginning-of-statement-1 lim) 6099 (vhdl-backward-skip-label lim) 6100 (vhdl-first-word (point))))))) 6101 ;; "begin", "else", "for": 6102 ((looking-at "be\\|[ef]") 6103 (vector "end" 6104 (and (vhdl-last-word (point)) 6105 (or (vhdl-first-word (point)) 6106 (save-excursion 6107 (vhdl-beginning-of-statement-1 lim) 6108 (vhdl-backward-skip-label lim) 6109 (vhdl-first-word (point))))))) 6110 ;; "component", "units", "record", "protected body": 6111 ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record") 6112 ;; The first end found will close the block 6113 (vector "end" nil)) 6114 ;; "block", "process", "procedural": 6115 ((looking-at "bl\\|p") 6116 (vector "end" 6117 (or (vhdl-first-word (point)) 6118 (save-excursion 6119 (vhdl-beginning-of-statement-1 lim) 6120 (vhdl-backward-skip-label lim) 6121 (vhdl-first-word (point)))))) 6122 ;; "then": 6123 ((looking-at "t\\|use") 6124 (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)" 6125 (and (vhdl-last-word (point)) 6126 (or (vhdl-first-word (point)) 6127 (save-excursion 6128 (vhdl-beginning-of-statement-1 lim) 6129 (vhdl-backward-skip-label lim) 6130 (vhdl-first-word (point))))))) 6131 )))) 6132 6133(defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") 6134 6135(defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") 6136 6137(defun vhdl-end-p (&optional lim) 6138 "Return t if we are looking at a real \"end\" keyword. 6139Assumes that the caller will make sure that we are looking at 6140vhdl-end-fwd-re, and are not inside a literal, and that we are not in 6141the middle of an identifier that just happens to contain an \"end\" 6142keyword." 6143 (or (not (looking-at "else")) 6144 ;; make sure that the "else" isn't inside a conditional signal 6145 ;; assignment. 6146 (save-excursion 6147 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 6148 (or (eq (following-char) ?\;) 6149 (eq (point) lim) 6150 (vhdl-in-literal))))) 6151 6152(defun vhdl-corresponding-begin (&optional lim) 6153 "If the word at the current position corresponds to an \"end\" 6154keyword, then return a vector containing enough information to find 6155the corresponding \"begin\" keyword, else return nil. The keyword to 6156search backward for is aref 0. The column in which the keyword must 6157appear is aref 1 or nil if any column is suitable. The supplementary 6158keyword to search forward for is aref 2 or nil if this is not 6159required. If aref 3 is t, then the \"begin\" keyword may be found in 6160the middle of a statement. 6161Assumes that the caller will make sure that we are not in the middle 6162of an identifier that just happens to contain an \"end\" keyword." 6163 (save-excursion 6164 (let (pos) 6165 (if (and (looking-at vhdl-end-fwd-re) 6166 (not (vhdl-in-literal)) 6167 (vhdl-end-p lim)) 6168 (if (looking-at "el") 6169 ;; "else", "elsif": 6170 (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil) 6171 ;; "end ...": 6172 (setq pos (point)) 6173 (forward-sexp) 6174 (skip-chars-forward " \t\n\r\f") 6175 (cond 6176 ;; "end if": 6177 ((looking-at "if\\b[^_]") 6178 (vector "else\\|elsif\\|if" 6179 (vhdl-first-word pos) 6180 "else\\|then\\|use" nil)) 6181 ;; "end component": 6182 ((looking-at "component\\b[^_]") 6183 (vector (buffer-substring (match-beginning 1) 6184 (match-end 1)) 6185 (vhdl-first-word pos) 6186 nil nil)) 6187 ;; "end units", "end record", "end protected": 6188 ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]") 6189 (vector (buffer-substring (match-beginning 1) 6190 (match-end 1)) 6191 (vhdl-first-word pos) 6192 nil t)) 6193 ;; "end block", "end process", "end procedural": 6194 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") 6195 (vector "begin" (vhdl-first-word pos) nil nil)) 6196 ;; "end case": 6197 ((looking-at "case\\b[^_]") 6198 (vector "case" (vhdl-first-word pos) "is" nil)) 6199 ;; "end generate": 6200 ((looking-at "generate\\b[^_]") 6201 (vector "generate\\|for\\|if" 6202 (vhdl-first-word pos) 6203 "generate" nil)) 6204 ;; "end loop": 6205 ((looking-at "loop\\b[^_]") 6206 (vector "loop\\|while\\|for" 6207 (vhdl-first-word pos) 6208 "loop" nil)) 6209 ;; "end for" (inside configuration declaration): 6210 ((looking-at "for\\b[^_]") 6211 (vector "for" (vhdl-first-word pos) nil nil)) 6212 ;; "end [id]": 6213 (t 6214 (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function" 6215 (vhdl-first-word pos) 6216 ;; return an alist of (statement . keyword) mappings 6217 '( 6218 ;; "begin ... end [id]": 6219 ("begin" . nil) 6220 ;; "architecture ... is ... begin ... end [id]": 6221 ("architecture" . "is") 6222 ;; "configuration ... is ... end [id]": 6223 ("configuration" . "is") 6224 ;; "context ... is ... end [id]": 6225 ("context" . "is") 6226 ;; "entity ... is ... end [id]": 6227 ("entity" . "is") 6228 ;; "package ... is ... end [id]": 6229 ("package" . "is") 6230 ;; "procedure ... is ... begin ... end [id]": 6231 ("procedure" . "is") 6232 ;; "function ... is ... begin ... end [id]": 6233 ("function" . "is") 6234 ) 6235 nil)) 6236 ))) ; "end ..." 6237 ))) 6238 6239(defconst vhdl-leader-re 6240 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") 6241 6242(defun vhdl-end-of-leader () 6243 (save-excursion 6244 (cond ((looking-at "block\\|process\\|procedural") 6245 (if (save-excursion 6246 (forward-sexp) 6247 (skip-chars-forward " \t\n\r\f") 6248 (= (following-char) ?\()) 6249 (forward-sexp 2) 6250 (forward-sexp)) 6251 (when (looking-at "[ \t\n\r\f]*is") 6252 (goto-char (match-end 0))) 6253 (point)) 6254 ((looking-at "component") 6255 (forward-sexp 2) 6256 (when (looking-at "[ \t\n\r\f]*is") 6257 (goto-char (match-end 0))) 6258 (point)) 6259 ((looking-at "for") 6260 (forward-sexp 2) 6261 (skip-chars-forward " \t\n\r\f") 6262 (while (looking-at "[,:(]") 6263 (forward-sexp) 6264 (skip-chars-forward " \t\n\r\f")) 6265 (point)) 6266 (t nil) 6267 ))) 6268 6269(defconst vhdl-trailer-re 6270 "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]") 6271 6272(defconst vhdl-statement-fwd-re 6273 "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)" 6274 "A regular expression for searching forward that matches all known 6275\"statement\" keywords.") 6276 6277(defconst vhdl-statement-bwd-re 6278 "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]" 6279 "A regular expression for searching backward that matches all known 6280\"statement\" keywords.") 6281 6282(defun vhdl-statement-p (&optional lim) 6283 "Return t if we are looking at a real \"statement\" keyword. 6284Assumes that the caller will make sure that we are looking at 6285vhdl-statement-fwd-re, and are not inside a literal, and that we are not 6286in the middle of an identifier that just happens to contain a 6287\"statement\" keyword." 6288 (cond 6289 ;; "for" ... "generate": 6290 ((and (looking-at "f") 6291 ;; Make sure it's the start of a parameter specification. 6292 (save-excursion 6293 (forward-sexp 2) 6294 (skip-chars-forward " \t\n\r\f") 6295 (looking-at "in\\b[^_]")) 6296 ;; Make sure it's not an "end for". 6297 (save-excursion 6298 (backward-sexp) 6299 (not (looking-at "end\\s-+\\w")))) 6300 t) 6301 ;; "if" ... "then", "if" ... "generate", "if" ... "loop": 6302 ((and (looking-at "i") 6303 ;; Make sure it's not an "end if". 6304 (save-excursion 6305 (backward-sexp) 6306 (not (looking-at "end\\s-+\\w")))) 6307 t) 6308 ;; "while" ... "loop": 6309 ((looking-at "w") 6310 t) 6311 )) 6312 6313(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>" 6314 "Regexp describing a case statement alternative key.") 6315 6316(defun vhdl-case-alternative-p (&optional lim) 6317 "Return t if we are looking at a real case alternative. 6318Assumes that the caller will make sure that we are looking at 6319vhdl-case-alternative-re, and are not inside a literal, and that 6320we are not in the middle of an identifier that just happens to 6321contain a \"when\" keyword." 6322 (save-excursion 6323 (let (foundp) 6324 (while (and (not foundp) 6325 (re-search-backward ";\\|<=" lim 'move)) 6326 (if (or (= (preceding-char) ?_) 6327 (vhdl-in-literal)) 6328 (backward-char) 6329 (setq foundp t))) 6330 (or (eq (following-char) ?\;) 6331 (eq (point) lim))) 6332 )) 6333 6334;; Core syntactic movement functions: 6335 6336(defconst vhdl-b-t-b-re 6337 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) 6338 6339(defun vhdl-backward-to-block (&optional lim) 6340 "Move backward to the previous \"begin\" or \"end\" keyword." 6341 (let (foundp) 6342 (while (and (not foundp) 6343 (re-search-backward vhdl-b-t-b-re lim 'move)) 6344 (if (or (= (preceding-char) ?_) 6345 (vhdl-in-literal)) 6346 (backward-char) 6347 (cond 6348 ;; "begin" keyword: 6349 ((and (looking-at vhdl-begin-fwd-re) 6350 (or (not (looking-at "\\<use\\>")) 6351 (save-excursion (back-to-indentation) 6352 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6353 (/= (preceding-char) ?_) 6354 (vhdl-begin-p lim)) 6355 (setq foundp 'begin)) 6356 ;; "end" keyword: 6357 ((and (looking-at vhdl-end-fwd-re) 6358 (/= (preceding-char) ?_) 6359 (vhdl-end-p lim)) 6360 (setq foundp 'end)) 6361 )) 6362 ) 6363 foundp 6364 )) 6365 6366(defun vhdl-forward-sexp (&optional count lim) 6367 "Move forward across one balanced expression (sexp). 6368With COUNT, do it that many times." 6369 (interactive "p") 6370 (let ((count (or count 1)) 6371 (case-fold-search t) 6372 end-vec target) 6373 (save-excursion 6374 (while (> count 0) 6375 ;; skip whitespace 6376 (skip-chars-forward " \t\n\r\f") 6377 ;; Check for an unbalanced "end" keyword 6378 (if (and (looking-at vhdl-end-fwd-re) 6379 (/= (preceding-char) ?_) 6380 (not (vhdl-in-literal)) 6381 (vhdl-end-p lim) 6382 (not (looking-at "else"))) 6383 (error 6384 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) 6385 ;; If the current keyword is a "begin" keyword, then find the 6386 ;; corresponding "end" keyword. 6387 (if (setq end-vec (vhdl-corresponding-end lim)) 6388 (let ( 6389 ;; end-re is the statement keyword to search for 6390 (end-re 6391 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) 6392 ;; column is either the statement keyword target column 6393 ;; or nil 6394 (column (aref end-vec 1)) 6395 (eol (vhdl-point 'eol)) 6396 foundp literal placeholder) 6397 ;; Look for the statement keyword. 6398 (while (and (not foundp) 6399 (re-search-forward end-re nil t) 6400 (setq placeholder (match-end 1)) 6401 (goto-char (match-beginning 0))) 6402 ;; If we are in a literal, or not in the right target 6403 ;; column and not on the same line as the begin, then 6404 ;; try again. 6405 (if (or (and column 6406 (/= (current-indentation) column) 6407 (> (point) eol)) 6408 (= (preceding-char) ?_) 6409 (setq literal (vhdl-in-literal))) 6410 (if (eq literal 'comment) 6411 (end-of-line) 6412 (forward-char)) 6413 ;; An "else" keyword corresponds to both the opening brace 6414 ;; of the following sexp and the closing brace of the 6415 ;; previous sexp. 6416 (if (not (looking-at "else")) 6417 (goto-char placeholder)) 6418 (setq foundp t)) 6419 ) 6420 (if (not foundp) 6421 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) 6422 ) 6423 ;; If the current keyword is not a "begin" keyword, then just 6424 ;; perform the normal forward-sexp. 6425 (forward-sexp) 6426 ) 6427 (setq count (1- count)) 6428 ) 6429 (setq target (point))) 6430 (goto-char target) 6431 nil)) 6432 6433(defun vhdl-backward-sexp (&optional count lim) 6434 "Move backward across one balanced expression (sexp). 6435With COUNT, do it that many times. LIM bounds any required backward 6436searches." 6437 (interactive "p") 6438 (let ((count (or count 1)) 6439 (case-fold-search t) 6440 begin-vec target) 6441 (save-excursion 6442 (while (> count 0) 6443 ;; Perform the normal backward-sexp, unless we are looking at 6444 ;; "else" - an "else" keyword corresponds to both the opening brace 6445 ;; of the following sexp and the closing brace of the previous sexp. 6446 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") 6447 (/= (preceding-char) ?_) 6448 (not (vhdl-in-literal))) 6449 nil 6450 (backward-sexp) 6451 (if (and (looking-at vhdl-begin-fwd-re) 6452 (or (not (looking-at "\\<use\\>")) 6453 (save-excursion 6454 (back-to-indentation) 6455 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6456 (/= (preceding-char) ?_) 6457 (not (vhdl-in-literal)) 6458 (vhdl-begin-p lim)) 6459 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) 6460 ;; If the current keyword is an "end" keyword, then find the 6461 ;; corresponding "begin" keyword. 6462 (if (and (setq begin-vec (vhdl-corresponding-begin lim)) 6463 (/= (preceding-char) ?_)) 6464 (let ( 6465 ;; begin-re is the statement keyword to search for 6466 (begin-re 6467 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) 6468 ;; column is either the statement keyword target column 6469 ;; or nil 6470 (column (aref begin-vec 1)) 6471 ;; internal-p controls where the statement keyword can 6472 ;; be found. 6473 (internal-p (aref begin-vec 3)) 6474 (last-backward (point)) last-forward 6475 foundp literal keyword) 6476 ;; Look for the statement keyword. 6477 (while (and (not foundp) 6478 (re-search-backward begin-re lim t) 6479 (setq keyword 6480 (buffer-substring (match-beginning 1) 6481 (match-end 1)))) 6482 ;; If we are in a literal or in the wrong column, 6483 ;; then try again. 6484 (if (or (and column 6485 (and (/= (current-indentation) column) 6486 ;; possibly accept current-column as 6487 ;; well as current-indentation. 6488 (or (not internal-p) 6489 (/= (current-column) column)))) 6490 (= (preceding-char) ?_) 6491 (vhdl-in-literal)) 6492 (backward-char) 6493 ;; If there is a supplementary keyword, then 6494 ;; search forward for it. 6495 (if (and (setq begin-re (aref begin-vec 2)) 6496 (or (not (listp begin-re)) 6497 ;; If begin-re is an alist, then find the 6498 ;; element corresponding to the actual 6499 ;; keyword that we found. 6500 (progn 6501 (setq begin-re 6502 (assoc keyword begin-re)) 6503 (and begin-re 6504 (setq begin-re (cdr begin-re)))))) 6505 (and 6506 (setq begin-re 6507 (concat "\\b\\(" begin-re "\\)\\b[^_]")) 6508 (save-excursion 6509 (setq last-forward (point)) 6510 ;; Look for the supplementary keyword 6511 ;; (bounded by the backward search start 6512 ;; point). 6513 (while (and (not foundp) 6514 (re-search-forward begin-re 6515 last-backward t) 6516 (goto-char (match-beginning 1))) 6517 ;; If we are in a literal, then try again. 6518 (if (or (= (preceding-char) ?_) 6519 (setq literal 6520 (vhdl-in-literal))) 6521 (if (eq literal 'comment) 6522 (goto-char 6523 (min (vhdl-point 'eol) last-backward)) 6524 (forward-char)) 6525 ;; We have found the supplementary keyword. 6526 ;; Save the position of the keyword in foundp. 6527 (setq foundp (point))) 6528 ) 6529 foundp) 6530 ;; If the supplementary keyword was found, then 6531 ;; move point to the supplementary keyword. 6532 (goto-char foundp)) 6533 ;; If there was no supplementary keyword, then 6534 ;; point is already at the statement keyword. 6535 (setq foundp t))) 6536 ) ; end of the search for the statement keyword 6537 (if (not foundp) 6538 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) 6539 )) 6540 (setq count (1- count)) 6541 ) 6542 (setq target (point))) 6543 (goto-char target) 6544 nil)) 6545 6546(defun vhdl-backward-up-list (&optional count limit) 6547 "Move backward out of one level of blocks. 6548With argument, do this that many times." 6549 (interactive "p") 6550 (let ((count (or count 1)) 6551 target) 6552 (save-excursion 6553 (while (> count 0) 6554 (if (looking-at vhdl-defun-re) 6555 (error "ERROR: Unbalanced blocks")) 6556 (vhdl-backward-to-block limit) 6557 (setq count (1- count))) 6558 (setq target (point))) 6559 (goto-char target))) 6560 6561(defun vhdl-end-of-defun (&optional count) 6562 "Move forward to the end of a VHDL defun." 6563 (interactive) 6564 (let ((case-fold-search t)) 6565 (vhdl-beginning-of-defun) 6566 (if (not (looking-at "block\\|process\\|procedural")) 6567 (re-search-forward "\\bis\\b")) 6568 (vhdl-forward-sexp))) 6569 6570(defun vhdl-mark-defun () 6571 "Put mark at end of this \"defun\", point at beginning." 6572 (interactive) 6573 (let ((case-fold-search t)) 6574 (push-mark) 6575 (vhdl-beginning-of-defun) 6576 (push-mark) 6577 (if (not (looking-at "block\\|process\\|procedural")) 6578 (re-search-forward "\\bis\\b")) 6579 (vhdl-forward-sexp) 6580 (exchange-point-and-mark))) 6581 6582(defun vhdl-beginning-of-libunit () 6583 "Move backward to the beginning of a VHDL library unit. 6584Returns the location of the corresponding begin keyword, unless search 6585stops due to beginning or end of buffer. 6586Note that if point is between the \"libunit\" keyword and the 6587corresponding \"begin\" keyword, then that libunit will not be 6588recognized, and the search will continue backwards. If point is 6589at the \"begin\" keyword, then the defun will be recognized. The 6590returned point is at the first character of the \"libunit\" keyword." 6591 (let ((last-forward (point)) 6592 (last-backward 6593 ;; Just in case we are actually sitting on the "begin" 6594 ;; keyword, allow for the keyword and an extra character, 6595 ;; as this will be used when looking forward for the 6596 ;; "begin" keyword. 6597 (save-excursion (forward-word-strictly 1) (1+ (point)))) 6598 foundp literal placeholder) 6599 ;; Find the "libunit" keyword. 6600 (while (and (not foundp) 6601 (re-search-backward vhdl-libunit-re nil 'move)) 6602 ;; If we are in a literal, or not at a real libunit, then try again. 6603 (if (or (= (preceding-char) ?_) 6604 (vhdl-in-literal) 6605 (not (vhdl-libunit-p))) 6606 (backward-char) 6607 ;; Find the corresponding "begin" keyword. 6608 (setq last-forward (point)) 6609 (while (and (not foundp) 6610 (re-search-forward "\\bis\\b[^_]" last-backward t) 6611 (setq placeholder (match-beginning 0))) 6612 (if (or (= (preceding-char) ?_) 6613 (setq literal (vhdl-in-literal))) 6614 ;; It wasn't a real keyword, so keep searching. 6615 (if (eq literal 'comment) 6616 (goto-char 6617 (min (vhdl-point 'eol) last-backward)) 6618 (forward-char)) 6619 ;; We have found the begin keyword, loop will exit. 6620 (setq foundp placeholder))) 6621 ;; Go back to the libunit keyword 6622 (goto-char last-forward))) 6623 foundp)) 6624 6625(defun vhdl-beginning-of-defun (&optional count) 6626 "Move backward to the beginning of a VHDL defun. 6627With argument, do it that many times. 6628Returns the location of the corresponding begin keyword, unless search 6629stops due to beginning or end of buffer." 6630 ;; Note that if point is between the "defun" keyword and the 6631 ;; corresponding "begin" keyword, then that defun will not be 6632 ;; recognized, and the search will continue backwards. If point is 6633 ;; at the "begin" keyword, then the defun will be recognized. The 6634 ;; returned point is at the first character of the "defun" keyword. 6635 (interactive "p") 6636 (let ((count (or count 1)) 6637 (case-fold-search t) 6638 (last-forward (point)) 6639 foundp) 6640 (while (> count 0) 6641 (setq foundp nil) 6642 (goto-char last-forward) 6643 (let ((last-backward 6644 ;; Just in case we are actually sitting on the "begin" 6645 ;; keyword, allow for the keyword and an extra character, 6646 ;; as this will be used when looking forward for the 6647 ;; "begin" keyword. 6648 (save-excursion (forward-word-strictly 1) (1+ (point)))) 6649 begin-string literal) 6650 (while (and (not foundp) 6651 (re-search-backward vhdl-defun-re nil 'move)) 6652 ;; If we are in a literal, then try again. 6653 (if (or (= (preceding-char) ?_) 6654 (vhdl-in-literal)) 6655 (backward-char) 6656 (if (setq begin-string (vhdl-corresponding-defun)) 6657 ;; This is a real defun keyword. 6658 ;; Find the corresponding "begin" keyword. 6659 ;; Look for the begin keyword. 6660 (progn 6661 ;; Save the search start point. 6662 (setq last-forward (point)) 6663 (while (and (not foundp) 6664 (search-forward begin-string last-backward t)) 6665 (if (or (= (preceding-char) ?_) 6666 (save-match-data 6667 (setq literal (vhdl-in-literal)))) 6668 ;; It wasn't a real keyword, so keep searching. 6669 (if (eq literal 'comment) 6670 (goto-char 6671 (min (vhdl-point 'eol) last-backward)) 6672 (forward-char)) 6673 ;; We have found the begin keyword, loop will exit. 6674 (setq foundp (match-beginning 0))) 6675 ) 6676 ;; Go back to the defun keyword 6677 (goto-char last-forward)) ; end search for begin keyword 6678 )) 6679 ) ; end of the search for the defun keyword 6680 ) 6681 (setq count (1- count)) 6682 ) 6683 (vhdl-keep-region-active) 6684 foundp)) 6685 6686(defun vhdl-beginning-of-statement (&optional count lim interactive) 6687 "Go to the beginning of the innermost VHDL statement. 6688With prefix arg, go back N - 1 statements. If already at the 6689beginning of a statement then go to the beginning of the preceding 6690one. If within a string or comment, or next to a comment (only 6691whitespace between), move by sentences instead of statements. 6692 6693When called from a program, this function takes 3 optional args: the 6694prefix arg, a buffer position limit which is the farthest back to 6695search, and an argument indicating an interactive call." 6696 (interactive "p\np") 6697 (let ((count (or count 1)) 6698 (case-fold-search t) 6699 (lim (or lim (point-min))) 6700 (here (point)) 6701 state) 6702 (save-excursion 6703 (goto-char lim) 6704 (setq state (parse-partial-sexp (point) here nil nil))) 6705 (if (and interactive 6706 (or (nth 3 state) 6707 (nth 4 state) 6708 (looking-at (concat "[ \t]*\\(?:" comment-start-skip "\\)")))) 6709 (forward-sentence (- count)) 6710 (while (> count 0) 6711 (vhdl-beginning-of-statement-1 lim) 6712 (setq count (1- count)))) 6713 ;; its possible we've been left up-buf of lim 6714 (goto-char (max (point) lim)) 6715 ) 6716 (vhdl-keep-region-active)) 6717 6718(defconst vhdl-e-o-s-re 6719 (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) 6720 6721(defun vhdl-end-of-statement () 6722 "Very simple implementation." 6723 (interactive) 6724 (re-search-forward vhdl-e-o-s-re)) 6725 6726(defconst vhdl-b-o-s-re 6727 (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|" 6728 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) 6729 6730(defun vhdl-beginning-of-statement-1 (&optional lim) 6731 "Move to the start of the current statement, or the previous 6732statement if already at the beginning of one." 6733 (let ((lim (or lim (point-min))) 6734 (here (point)) 6735 (pos (point)) 6736 donep) 6737 ;; go backwards one balanced expression, but be careful of 6738 ;; unbalanced paren being reached 6739 (if (not (vhdl-safe (progn (backward-sexp) t))) 6740 (progn 6741 (backward-up-list 1) 6742 (forward-char) 6743 (vhdl-forward-syntactic-ws here) 6744 (setq donep t))) 6745 (while (and (not donep) 6746 (not (bobp)) 6747 ;; look backwards for a statement boundary 6748 (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move))) 6749 (if (or (= (preceding-char) ?_) 6750 (vhdl-in-literal)) 6751 (backward-char) 6752 (cond 6753 ;; If we are looking at an open paren, then stop after it 6754 ((eq (following-char) ?\() 6755 (forward-char) 6756 (vhdl-forward-syntactic-ws here) 6757 (setq donep t)) 6758 ;; If we are looking at a close paren, then skip it 6759 ((eq (following-char) ?\)) 6760 (forward-char) 6761 (setq pos (point)) 6762 (backward-sexp) 6763 (if (< (point) lim) 6764 (progn (goto-char pos) 6765 (vhdl-forward-syntactic-ws here) 6766 (setq donep t)))) 6767 ;; If we are looking at a semicolon, then stop 6768 ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p))) 6769 (progn 6770 (forward-char) 6771 (vhdl-forward-syntactic-ws here) 6772 (setq donep t))) 6773 ;; If we are looking at a "begin", then stop 6774 ((and (looking-at vhdl-begin-fwd-re) 6775 (or (not (looking-at "\\<use\\>")) 6776 (save-excursion 6777 (back-to-indentation) 6778 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6779 (/= (preceding-char) ?_) 6780 (vhdl-begin-p nil)) 6781 ;; If it's a leader "begin", then find the 6782 ;; right place 6783 (if (looking-at vhdl-leader-re) 6784 (save-excursion 6785 ;; set a default stop point at the begin 6786 (setq pos (point)) 6787 ;; is the start point inside the leader area ? 6788 (goto-char (vhdl-end-of-leader)) 6789 (vhdl-forward-syntactic-ws here) 6790 (if (< (point) here) 6791 ;; start point was not inside leader area 6792 ;; set stop point at word after leader 6793 (setq pos (point)))) 6794 (unless (looking-at "\\<else\\s-+generate\\>") 6795 (forward-word-strictly 1)) 6796 (vhdl-forward-syntactic-ws here) 6797 (setq pos (point))) 6798 (goto-char pos) 6799 (setq donep t)) 6800 ;; If we are looking at a "statement", then stop 6801 ((and (looking-at vhdl-statement-fwd-re) 6802 (/= (preceding-char) ?_) 6803 (vhdl-statement-p nil)) 6804 (setq donep t)) 6805 ;; If we are looking at a case alternative key, then stop 6806 ((and (looking-at vhdl-case-alternative-re) 6807 (vhdl-case-alternative-p lim)) 6808 (save-excursion 6809 ;; set a default stop point at the when 6810 (setq pos (point)) 6811 ;; is the start point inside the case alternative key ? 6812 (looking-at vhdl-case-alternative-re) 6813 (goto-char (match-end 0)) 6814 (vhdl-forward-syntactic-ws here) 6815 (if (< (point) here) 6816 ;; start point was not inside the case alternative key 6817 ;; set stop point at word after case alternative keyleader 6818 (setq pos (point)))) 6819 (goto-char pos) 6820 (setq donep t)) 6821 ;; Bogus find, continue 6822 (t 6823 (backward-char))))) 6824 )) 6825 6826;; Defuns for calculating the current syntactic state: 6827 6828(defun vhdl-get-library-unit (bod placeholder) 6829 "If there is an enclosing library unit at BOD, with its \"begin\" 6830keyword at PLACEHOLDER, then return the library unit type." 6831 (let ((here (vhdl-point 'bol))) 6832 (if (save-excursion 6833 (goto-char placeholder) 6834 (vhdl-safe (vhdl-forward-sexp 1 bod)) 6835 (<= here (point))) 6836 (save-excursion 6837 (goto-char bod) 6838 (cond 6839 ((looking-at "e") 'entity) 6840 ((looking-at "a") 'architecture) 6841 ((looking-at "conf") 'configuration) 6842 ((looking-at "cont") 'context) 6843 ((looking-at "p") 6844 (save-excursion 6845 (goto-char bod) 6846 (forward-sexp) 6847 (vhdl-forward-syntactic-ws here) 6848 (if (looking-at "body\\b[^_]") 6849 'package-body 'package)))))) 6850 )) 6851 6852(defun vhdl-get-block-state (&optional lim) 6853 "Finds and records all the closest opens. 6854LIM is the furthest back we need to search (it should be the 6855previous libunit keyword)." 6856 (let ((here (point)) 6857 (lim (or lim (point-min))) 6858 keyword sexp-start sexp-mid sexp-end 6859 preceding-sexp containing-sexp 6860 containing-begin containing-mid containing-paren) 6861 (save-excursion 6862 ;; Find the containing-paren, and use that as the limit 6863 (if (setq containing-paren 6864 (save-restriction 6865 (narrow-to-region lim (point)) 6866 (vhdl-safe (scan-lists (point) -1 1)))) 6867 (setq lim containing-paren)) 6868 ;; Look backwards for "begin" and "end" keywords. 6869 (while (and (> (point) lim) 6870 (not containing-sexp)) 6871 (setq keyword (vhdl-backward-to-block lim)) 6872 (cond 6873 ((eq keyword 'begin) 6874 ;; Found a "begin" keyword 6875 (setq sexp-start (point)) 6876 (setq sexp-mid (vhdl-corresponding-mid lim)) 6877 (setq sexp-end (vhdl-safe 6878 (save-excursion 6879 (vhdl-forward-sexp 1 lim) (point)))) 6880 (if (and sexp-end (<= sexp-end here)) 6881 ;; we want to record this sexp, but we only want to 6882 ;; record the last-most of any of them before here 6883 (or preceding-sexp 6884 (setq preceding-sexp sexp-start)) 6885 ;; we're contained in this sexp so put sexp-start on 6886 ;; front of list 6887 (setq containing-sexp sexp-start) 6888 (setq containing-mid sexp-mid) 6889 (setq containing-begin t))) 6890 ((eq keyword 'end) 6891 ;; Found an "end" keyword 6892 (forward-sexp) 6893 (setq sexp-end (point)) 6894 (setq sexp-mid nil) 6895 (setq sexp-start 6896 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) 6897 (progn (backward-sexp) (point)))) 6898 ;; we want to record this sexp, but we only want to 6899 ;; record the last-most of any of them before here 6900 (or preceding-sexp 6901 (setq preceding-sexp sexp-start))) 6902 ))) 6903 ;; Check if the containing-paren should be the containing-sexp 6904 (if (and containing-paren 6905 (or (null containing-sexp) 6906 (< containing-sexp containing-paren))) 6907 (setq containing-sexp containing-paren 6908 preceding-sexp nil 6909 containing-begin nil 6910 containing-mid nil)) 6911 (vector containing-sexp preceding-sexp containing-begin containing-mid) 6912 )) 6913 6914 6915(defconst vhdl-s-c-a-re 6916 (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) 6917 6918(defun vhdl-skip-case-alternative (&optional lim) 6919 "Skip forward over case/when bodies, with optional maximal 6920limit. If no next case alternative is found, nil is returned and 6921point is not moved." 6922 (let ((lim (or lim (point-max))) 6923 (here (point)) 6924 donep foundp) 6925 (while (and (< (point) lim) 6926 (not donep)) 6927 (if (and (re-search-forward vhdl-s-c-a-re lim 'move) 6928 (save-match-data 6929 (not (vhdl-in-literal))) 6930 (/= (match-beginning 0) here)) 6931 (progn 6932 (goto-char (match-beginning 0)) 6933 (cond 6934 ((and (looking-at "case") 6935 (re-search-forward "\\bis[^_]" lim t)) 6936 (backward-sexp) 6937 (vhdl-forward-sexp)) 6938 (t 6939 (setq donep t 6940 foundp t)))))) 6941 (if (not foundp) 6942 (goto-char here)) 6943 foundp)) 6944 6945(defun vhdl-backward-skip-label (&optional lim) 6946 "Skip backward over a label, with optional maximal 6947limit. If label is not found, nil is returned and point 6948is not moved." 6949 (let ((lim (or lim (point-min))) 6950 placeholder) 6951 (if (save-excursion 6952 (vhdl-backward-syntactic-ws lim) 6953 (and (eq (preceding-char) ?:) 6954 (progn 6955 (backward-sexp) 6956 (setq placeholder (point)) 6957 (looking-at vhdl-label-key)))) 6958 (goto-char placeholder)) 6959 )) 6960 6961(defun vhdl-forward-skip-label (&optional lim) 6962 "Skip forward over a label, with optional maximal 6963limit. If label is not found, nil is returned and point 6964is not moved." 6965 (let ((lim (or lim (point-max)))) 6966 (if (looking-at vhdl-label-key) 6967 (progn 6968 (goto-char (match-end 0)) 6969 (vhdl-forward-syntactic-ws lim))) 6970 )) 6971 6972(defun vhdl-get-syntactic-context () 6973 "Guess the syntactic description of the current line of VHDL code." 6974 (save-excursion 6975 (save-restriction 6976 (beginning-of-line) 6977 (let* ((indent-point (point)) 6978 (case-fold-search t) 6979 vec literal containing-sexp preceding-sexp 6980 containing-begin containing-mid containing-leader 6981 char-before-ip char-after-ip begin-after-ip end-after-ip 6982 placeholder lim library-unit 6983 ) 6984 6985 ;; Reset the syntactic context 6986 (setq vhdl-syntactic-context nil) 6987 6988 (save-excursion 6989 ;; Move to the start of the previous library unit, and 6990 ;; record the position of the "begin" keyword. 6991 (setq placeholder (vhdl-beginning-of-libunit)) 6992 ;; The position of the "libunit" keyword gives us a gross 6993 ;; limit point. 6994 (setq lim (point)) 6995 ) 6996 6997 ;; If there is a previous library unit, and we are enclosed by 6998 ;; it, then set the syntax accordingly. 6999 (and placeholder 7000 (setq library-unit (vhdl-get-library-unit lim placeholder)) 7001 (vhdl-add-syntax library-unit lim)) 7002 7003 ;; Find the surrounding state. 7004 (if (setq vec (vhdl-get-block-state lim)) 7005 (progn 7006 (setq containing-sexp (aref vec 0)) 7007 (setq preceding-sexp (aref vec 1)) 7008 (setq containing-begin (aref vec 2)) 7009 (setq containing-mid (aref vec 3)) 7010 )) 7011 7012 ;; set the limit on the farthest back we need to search 7013 (setq lim (if containing-sexp 7014 (save-excursion 7015 (goto-char containing-sexp) 7016 ;; set containing-leader if required 7017 (if (looking-at vhdl-leader-re) 7018 (setq containing-leader (vhdl-end-of-leader))) 7019 (vhdl-point 'bol)) 7020 (point-min))) 7021 7022 ;; cache char before and after indent point, and move point to 7023 ;; the most likely position to perform the majority of tests 7024 (goto-char indent-point) 7025 (skip-chars-forward " \t") 7026 (setq literal (vhdl-in-literal)) 7027 (setq char-after-ip (following-char)) 7028 (setq begin-after-ip (and 7029 (not literal) 7030 (looking-at vhdl-begin-fwd-re) 7031 (or (not (looking-at "\\<use\\>")) 7032 (save-excursion 7033 (back-to-indentation) 7034 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 7035 (vhdl-begin-p))) 7036 (setq end-after-ip (and 7037 (not literal) 7038 (looking-at vhdl-end-fwd-re) 7039 (vhdl-end-p))) 7040 (vhdl-backward-syntactic-ws lim) 7041 (setq char-before-ip (preceding-char)) 7042 (goto-char indent-point) 7043 (skip-chars-forward " \t") 7044 7045 ;; now figure out syntactic qualities of the current line 7046 (cond 7047 ;; CASE 1: in a string or comment. 7048 ((memq literal '(string comment)) 7049 (vhdl-add-syntax literal (vhdl-point 'bopl))) 7050 ;; CASE 2: Line is at top level. 7051 ((null containing-sexp) 7052 ;; Find the point to which indentation will be relative 7053 (save-excursion 7054 (if (null preceding-sexp) 7055 ;; CASE 2X.1 7056 ;; no preceding-sexp -> use the preceding statement 7057 (vhdl-beginning-of-statement-1 lim) 7058 ;; CASE 2X.2 7059 ;; if there is a preceding-sexp then indent relative to it 7060 (goto-char preceding-sexp) 7061 ;; if not at boi, then the block-opening keyword is 7062 ;; probably following a label, so we need a different 7063 ;; relpos 7064 (if (/= (point) (vhdl-point 'boi)) 7065 ;; CASE 2X.3 7066 (vhdl-beginning-of-statement-1 lim))) 7067 ;; v-b-o-s could have left us at point-min 7068 (and (bobp) 7069 ;; CASE 2X.4 7070 (vhdl-forward-syntactic-ws indent-point)) 7071 (setq placeholder (point))) 7072 (cond 7073 ;; CASE 2A : we are looking at a block-open 7074 (begin-after-ip 7075 (vhdl-add-syntax 'block-open placeholder)) 7076 ;; CASE 2B: we are looking at a block-close 7077 (end-after-ip 7078 (vhdl-add-syntax 'block-close placeholder)) 7079 ;; CASE 2C: we are looking at a top-level statement 7080 ((progn 7081 (vhdl-backward-syntactic-ws lim) 7082 (or (bobp) 7083 (and (= (preceding-char) ?\;) 7084 (not (vhdl-in-quote-p))))) 7085 (vhdl-add-syntax 'statement placeholder)) 7086 ;; CASE 2D: we are looking at a top-level statement-cont 7087 (t 7088 (vhdl-beginning-of-statement-1 lim) 7089 ;; v-b-o-s could have left us at point-min 7090 (and (bobp) 7091 ;; CASE 2D.1 7092 (vhdl-forward-syntactic-ws indent-point)) 7093 (vhdl-add-syntax 'statement-cont (point))) 7094 )) ; end CASE 2 7095 ;; CASE 3: line is inside parentheses. Most likely we are 7096 ;; either in a subprogram argument (interface) list, or a 7097 ;; continued expression containing parentheses. 7098 ((null containing-begin) 7099 (vhdl-backward-syntactic-ws containing-sexp) 7100 (cond 7101 ;; CASE 3A: we are looking at the arglist closing paren 7102 ((eq char-after-ip ?\)) 7103 (goto-char containing-sexp) 7104 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) 7105 ;; CASE 3B: we are looking at the first argument in an empty 7106 ;; argument list. 7107 ((eq char-before-ip ?\() 7108 (goto-char containing-sexp) 7109 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) 7110 ;; CASE 3C: we are looking at an arglist continuation line, 7111 ;; but the preceding argument is on the same line as the 7112 ;; opening paren. This case includes multi-line 7113 ;; expression paren groupings. 7114 ((and (save-excursion 7115 (goto-char (1+ containing-sexp)) 7116 (skip-chars-forward " \t") 7117 (not (eolp)) 7118 (not (looking-at "--\\|`"))) 7119 (save-excursion 7120 (vhdl-beginning-of-statement-1 containing-sexp) 7121 (skip-chars-backward " \t(") 7122 (while (and (= (preceding-char) ?\;) 7123 (not (vhdl-in-quote-p))) 7124 (vhdl-beginning-of-statement-1 containing-sexp) 7125 (skip-chars-backward " \t(")) 7126 (<= (point) containing-sexp))) 7127 (goto-char containing-sexp) 7128 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) 7129 ;; CASE 3D: we are looking at just a normal arglist 7130 ;; continuation line 7131 (t (vhdl-beginning-of-statement-1 containing-sexp) 7132 (vhdl-forward-syntactic-ws indent-point) 7133 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) 7134 )) 7135 ;; CASE 4: A block mid open 7136 ((and begin-after-ip 7137 (looking-at containing-mid)) 7138 (goto-char containing-sexp) 7139 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7140 (if (looking-at vhdl-trailer-re) 7141 ;; CASE 4.1 7142 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7143 (vhdl-backward-skip-label (vhdl-point 'boi)) 7144 (vhdl-add-syntax 'block-open (point))) 7145 ;; CASE 5: block close brace 7146 (end-after-ip 7147 (goto-char containing-sexp) 7148 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7149 (if (looking-at vhdl-trailer-re) 7150 ;; CASE 5.1 7151 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7152 (vhdl-backward-skip-label (vhdl-point 'boi)) 7153 (vhdl-add-syntax 'block-close (point))) 7154 ;; CASE 6: A continued statement 7155 ((and (/= char-before-ip ?\;) 7156 ;; check it's not a trailer begin keyword, or a begin 7157 ;; keyword immediately following a label. 7158 (not (and begin-after-ip 7159 (or (looking-at vhdl-trailer-re) 7160 (save-excursion 7161 (vhdl-backward-skip-label containing-sexp))))) 7162 ;; check it's not a statement keyword 7163 (not (and (looking-at vhdl-statement-fwd-re) 7164 (vhdl-statement-p))) 7165 ;; see if the b-o-s is before the indent point 7166 (> indent-point 7167 (save-excursion 7168 (vhdl-beginning-of-statement-1 containing-sexp) 7169 ;; If we ended up after a leader, then this will 7170 ;; move us forward to the start of the first 7171 ;; statement. Note that a containing sexp here is 7172 ;; always a keyword, not a paren, so this will 7173 ;; have no effect if we hit the containing-sexp. 7174 (vhdl-forward-syntactic-ws indent-point) 7175 (setq placeholder (point)))) 7176 ;; check it's not a block-intro 7177 (/= placeholder containing-sexp) 7178 ;; check it's not a case block-intro 7179 (save-excursion 7180 (goto-char placeholder) 7181 (or (not (looking-at vhdl-case-alternative-re)) 7182 (> (match-end 0) indent-point)))) 7183 ;; Make placeholder skip a label, but only if it puts us 7184 ;; before the indent point at the start of a line. 7185 (let ((new placeholder)) 7186 (if (and (> indent-point 7187 (save-excursion 7188 (goto-char placeholder) 7189 (vhdl-forward-skip-label indent-point) 7190 (setq new (point)))) 7191 (save-excursion 7192 (goto-char new) 7193 (eq new (progn (back-to-indentation) (point))))) 7194 (setq placeholder new))) 7195 (vhdl-add-syntax 'statement-cont placeholder) 7196 (if begin-after-ip 7197 (vhdl-add-syntax 'block-open))) 7198 ;; Statement. But what kind? 7199 ;; CASE 7: A case alternative key 7200 ((and (looking-at vhdl-case-alternative-re) 7201 (vhdl-case-alternative-p containing-sexp)) 7202 ;; for a case alternative key, we set relpos to the first 7203 ;; non-whitespace char on the line containing the "case" 7204 ;; keyword. 7205 (goto-char containing-sexp) 7206 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7207 (if (looking-at vhdl-trailer-re) 7208 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7209 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) 7210 ;; CASE 8: statement catchall 7211 (t 7212 ;; we know its a statement, but we need to find out if it is 7213 ;; the first statement in a block 7214 (if containing-leader 7215 (goto-char containing-leader) 7216 (goto-char containing-sexp) 7217 ;; Note that a containing sexp here is always a keyword, 7218 ;; not a paren, so skip over the keyword. 7219 (forward-sexp)) 7220 ;; move to the start of the first statement 7221 (vhdl-forward-syntactic-ws indent-point) 7222 (setq placeholder (point)) 7223 ;; we want to ignore case alternatives keys when skipping forward 7224 (let (incase-p) 7225 (while (looking-at vhdl-case-alternative-re) 7226 (setq incase-p (point)) 7227 ;; we also want to skip over the body of the 7228 ;; case/when statement if that doesn't put us at 7229 ;; after the indent-point 7230 (while (vhdl-skip-case-alternative indent-point)) 7231 ;; set up the match end 7232 (looking-at vhdl-case-alternative-re) 7233 (goto-char (match-end 0)) 7234 ;; move to the start of the first case alternative statement 7235 (vhdl-forward-syntactic-ws indent-point) 7236 (setq placeholder (point))) 7237 (cond 7238 ;; CASE 8A: we saw a case/when statement so we must be 7239 ;; in a switch statement. find out if we are at the 7240 ;; statement just after a case alternative key 7241 ((and incase-p 7242 (= (point) indent-point)) 7243 ;; relpos is the "when" keyword 7244 (vhdl-add-syntax 'statement-case-intro incase-p)) 7245 ;; CASE 8B: any old statement 7246 ((< (point) indent-point) 7247 ;; relpos is the first statement of the block 7248 (vhdl-add-syntax 'statement placeholder) 7249 (if begin-after-ip 7250 (vhdl-add-syntax 'block-open))) 7251 ;; CASE 8C: first statement in a block 7252 (t 7253 (goto-char containing-sexp) 7254 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7255 (if (looking-at vhdl-trailer-re) 7256 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7257 (vhdl-backward-skip-label (vhdl-point 'boi)) 7258 (vhdl-add-syntax 'statement-block-intro (point)) 7259 (if begin-after-ip 7260 (vhdl-add-syntax 'block-open))) 7261 ))) 7262 ) 7263 7264 ;; now we need to look at any modifiers 7265 (goto-char indent-point) 7266 (skip-chars-forward " \t") 7267 (if (or (looking-at "--") (looking-at "/\\*")) 7268 (vhdl-add-syntax 'comment)) 7269 (if (looking-at "`") 7270 (vhdl-add-syntax 'directive)) 7271 (if (eq literal 'pound) 7272 (vhdl-add-syntax 'cpp-macro)) 7273 ;; return the syntax 7274 vhdl-syntactic-context)))) 7275 7276;; Standard indentation line-ups: 7277 7278(defun vhdl-lineup-arglist (langelem) 7279 "Lineup the current arglist line with the arglist appearing just 7280after the containing paren which starts the arglist." 7281 (save-excursion 7282 (let* ((containing-sexp 7283 (save-excursion 7284 ;; arglist-cont-nonempty gives relpos == 7285 ;; to boi of containing-sexp paren. This 7286 ;; is good when offset is +, but bad 7287 ;; when it is vhdl-lineup-arglist, so we 7288 ;; have to special case a kludge here. 7289 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) 7290 (progn 7291 (beginning-of-line) 7292 (backward-up-list 1) 7293 (skip-chars-forward " \t" (vhdl-point 'eol))) 7294 (goto-char (cdr langelem))) 7295 (point))) 7296 (cs-curcol (save-excursion 7297 (goto-char (cdr langelem)) 7298 (current-column)))) 7299 (if (save-excursion 7300 (beginning-of-line) 7301 (looking-at "[ \t]*)")) 7302 (progn (goto-char (match-end 0)) 7303 (backward-sexp) 7304 (forward-char) 7305 (vhdl-forward-syntactic-ws) 7306 (- (current-column) cs-curcol)) 7307 (goto-char containing-sexp) 7308 (or (eolp) 7309 (let ((eol (vhdl-point 'eol)) 7310 (here (progn 7311 (forward-char) 7312 (skip-chars-forward " \t") 7313 (point)))) 7314 (vhdl-forward-syntactic-ws) 7315 (if (< (point) eol) 7316 (goto-char here)))) 7317 (- (current-column) cs-curcol) 7318 )))) 7319 7320(defun vhdl-lineup-arglist-intro (langelem) 7321 "Lineup an arglist-intro line to just after the open paren." 7322 (save-excursion 7323 (let ((cs-curcol (save-excursion 7324 (goto-char (cdr langelem)) 7325 (current-column))) 7326 (ce-curcol (save-excursion 7327 (beginning-of-line) 7328 (backward-up-list 1) 7329 (skip-chars-forward " \t" (vhdl-point 'eol)) 7330 (current-column)))) 7331 (- ce-curcol cs-curcol -1)))) 7332 7333(defun vhdl-lineup-comment (langelem) 7334 "Support old behavior for comment indentation. We look at 7335vhdl-comment-only-line-offset to decide how to indent comment 7336only-lines." 7337 (save-excursion 7338 (back-to-indentation) 7339 ;; at or to the right of comment-column 7340 (if (>= (current-column) comment-column) 7341 (vhdl-comment-indent) 7342 ;; otherwise, indent as specified by vhdl-comment-only-line-offset 7343 (if (not (bolp)) 7344 ;; inside multi-line comment 7345 (if (looking-at "\\*") 7346 1 7347 ;; otherwise 7348 (or (car-safe vhdl-comment-only-line-offset) 7349 vhdl-comment-only-line-offset)) 7350 (or (cdr-safe vhdl-comment-only-line-offset) 7351 (car-safe vhdl-comment-only-line-offset) 7352 -1000 ;jam it against the left side 7353 ))))) 7354 7355(defun vhdl-lineup-statement-cont (langelem) 7356 "Line up statement-cont after the assignment operator." 7357 (save-excursion 7358 (let* ((relpos (cdr langelem)) 7359 (assignp (save-excursion 7360 (goto-char (vhdl-point 'boi)) 7361 (and (re-search-forward "\\(<\\|:\\|=\\)=" 7362 (vhdl-point 'eol) t) 7363 (- (point) (vhdl-point 'boi))))) 7364 (curcol (progn 7365 (goto-char relpos) 7366 (current-column))) 7367 foundp) 7368 (while (and (not foundp) 7369 (< (point) (vhdl-point 'eol))) 7370 (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move) 7371 (if (vhdl-in-literal) 7372 (forward-char) 7373 (if (= (preceding-char) ?\() 7374 ;; skip over any parenthesized expressions 7375 (goto-char (min (vhdl-point 'eol) 7376 (scan-lists (point) 1 1))) 7377 ;; found an assignment operator (not at eol) 7378 (setq foundp (not (looking-at "\\s-*$")))))) 7379 (if (not foundp) 7380 ;; there's no assignment operator on the line 7381 vhdl-basic-offset 7382 ;; calculate indentation column after assign and ws, unless 7383 ;; our line contains an assignment operator 7384 (if (not assignp) 7385 (progn 7386 (forward-char) 7387 (skip-chars-forward " \t") 7388 (setq assignp 0))) 7389 (- (current-column) assignp curcol)) 7390 ))) 7391 7392;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7393;; Progress reporting 7394 7395(defvar vhdl-progress-info nil 7396 "Array variable for progress information: 0 begin, 1 end, 2 time.") 7397 7398(defun vhdl-update-progress-info (string pos) 7399 "Update progress information." 7400 (when (and vhdl-progress-info (not noninteractive) 7401 (time-less-p vhdl-progress-interval 7402 (time-since (aref vhdl-progress-info 2)))) 7403 (let ((delta (- (aref vhdl-progress-info 1) 7404 (aref vhdl-progress-info 0)))) 7405 (message "%s... (%2d%%)" string 7406 (if (= 0 delta) 7407 100 7408 (floor (* 100.0 (- pos (aref vhdl-progress-info 0))) 7409 delta)))) 7410 (aset vhdl-progress-info 2 (time-convert nil 'integer)))) 7411 7412;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7413;; Indentation commands 7414 7415(defun vhdl-electric-tab (&optional prefix-arg) 7416 "If preceding character is part of a word or a paren then hippie-expand, 7417else if right of non whitespace on line then insert tab, 7418else if last command was a tab or return then dedent one step or if a comment 7419toggle between normal indent and inline comment indent, 7420else indent `correctly'." 7421 (interactive "*P") 7422 (vhdl-prepare-search-2 7423 (cond 7424 ;; indent region if region is active 7425 ((and (not (featurep 'xemacs)) (use-region-p)) 7426 (vhdl-indent-region (region-beginning) (region-end) nil)) 7427 ;; expand word 7428 ((= (char-syntax (preceding-char)) ?w) 7429 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7430 (case-replace nil) 7431 (hippie-expand-only-buffers 7432 (or (and (boundp 'hippie-expand-only-buffers) 7433 hippie-expand-only-buffers) 7434 '(vhdl-mode)))) 7435 (vhdl-expand-abbrev prefix-arg))) 7436 ;; expand parenthesis 7437 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 7438 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7439 (case-replace nil)) 7440 (vhdl-expand-paren prefix-arg))) 7441 ;; insert tab 7442 ((> (current-column) (current-indentation)) 7443 (insert-tab)) 7444 ;; toggle comment indent 7445 ((and (looking-at "--") 7446 (or (eq last-command 'vhdl-electric-tab) 7447 (eq last-command 'vhdl-electric-return))) 7448 (cond ((= (current-indentation) 0) ; no indent 7449 (indent-to 1) 7450 (indent-according-to-mode)) 7451 ((< (current-indentation) comment-column) ; normal indent 7452 (indent-to comment-column) 7453 (indent-according-to-mode)) 7454 (t ; inline comment indent 7455 (delete-region (line-beginning-position) (point))))) 7456 ;; dedent 7457 ((and (>= (current-indentation) vhdl-basic-offset) 7458 (or (eq last-command 'vhdl-electric-tab) 7459 (eq last-command 'vhdl-electric-return))) 7460 (backward-delete-char-untabify vhdl-basic-offset nil)) 7461 ;; indent line 7462 (t (indent-according-to-mode))) 7463 (setq this-command 'vhdl-electric-tab))) 7464 7465(defun vhdl-electric-return () 7466 "newline-and-indent or indent-new-comment-line if in comment and preceding 7467character is a space." 7468 (interactive) 7469 (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) 7470 (indent-new-comment-line) 7471 (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z) 7472 (not (vhdl-in-comment-p))) 7473 (vhdl-fix-case-word -1)) 7474 (newline-and-indent))) 7475 7476(defun vhdl-indent-line () 7477 "Indent the current line as VHDL code. Returns the amount of 7478indentation change." 7479 (interactive) 7480 (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) 7481 (pos (- (point-max) (point))) 7482 (is-comment nil) 7483 (indent 7484 (if syntax 7485 ;; indent syntax-based 7486 (if (and (eq (caar syntax) 'comment) 7487 (>= (vhdl-get-offset (car syntax)) comment-column)) 7488 ;; special case: comments at or right of comment-column 7489 (vhdl-get-offset (car syntax)) 7490 ;; align comments like following code line 7491 (when vhdl-indent-comment-like-next-code-line 7492 (save-excursion 7493 (while (eq (caar syntax) 'comment) 7494 (setq is-comment t) 7495 (beginning-of-line 2) 7496 (setq syntax (vhdl-get-syntactic-context))))) 7497 (when is-comment 7498 (push (cons 'comment nil) syntax)) 7499 (apply '+ (mapcar 'vhdl-get-offset syntax))) 7500 ;; indent like previous nonblank line 7501 (save-excursion (beginning-of-line) 7502 (re-search-backward "^[^\n]" nil t) 7503 (current-indentation)))) 7504 (shift-amt (- indent (current-indentation)))) 7505 (and vhdl-echo-syntactic-information-p 7506 (message "syntax: %s, indent= %d" syntax indent)) 7507 (let ((has-formfeed 7508 (save-excursion (beginning-of-line) (looking-at "\\s-*\f")))) 7509 (when (or (not (zerop shift-amt)) has-formfeed) 7510 (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) 7511 (beginning-of-line) 7512 (when has-formfeed (insert "\f")) 7513 (indent-to indent))) 7514 (if (< (point) (vhdl-point 'boi)) 7515 (back-to-indentation) 7516 ;; If initial point was within line's indentation, position after 7517 ;; the indentation. Else stay at same point in text. 7518 (when (> (- (point-max) pos) (point)) 7519 (goto-char (- (point-max) pos)))) 7520 (run-hooks 'vhdl-special-indent-hook) 7521 (vhdl-update-progress-info "Indenting" (vhdl-current-line)) 7522 shift-amt)) 7523 7524(defun vhdl-indent-region (beg end &optional column) 7525 "Indent region as VHDL code. 7526Adds progress reporting to `indent-region'." 7527 (interactive "r\nP") 7528 (when vhdl-progress-interval 7529 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7530 (count-lines (point-min) end) 0))) 7531 (indent-region beg end column) 7532 (when vhdl-progress-interval (message "Indenting...done")) 7533 (setq vhdl-progress-info nil)) 7534 7535(defun vhdl-indent-buffer () 7536 "Indent whole buffer as VHDL code. 7537Calls `indent-region' for whole buffer and adds progress reporting." 7538 (interactive) 7539 (vhdl-indent-region (point-min) (point-max))) 7540 7541(defun vhdl-indent-group () 7542 "Indent group of lines between empty lines." 7543 (interactive) 7544 (let ((beg (save-excursion 7545 (if (re-search-backward vhdl-align-group-separate nil t) 7546 (point-marker) 7547 (point-min-marker)))) 7548 (end (save-excursion 7549 (if (re-search-forward vhdl-align-group-separate nil t) 7550 (point-marker) 7551 (point-max-marker))))) 7552 (vhdl-indent-region beg end))) 7553 7554(defun vhdl-indent-sexp (&optional endpos) 7555 "Indent each line of the list starting just after point. 7556If optional arg ENDPOS is given, indent each line, stopping when 7557ENDPOS is encountered." 7558 (interactive) 7559 (save-excursion 7560 (let ((beg (point)) 7561 (end (progn (vhdl-forward-sexp nil endpos) (point)))) 7562 (indent-region beg end nil)))) 7563 7564;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7565;; Miscellaneous commands 7566 7567(defun vhdl-show-syntactic-information () 7568 "Show syntactic information for current line." 7569 (interactive) 7570 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) 7571 (vhdl-keep-region-active)) 7572 7573;; Verification and regression functions: 7574 7575(defun vhdl-regress-line (&optional arg) 7576 "Check syntactic information for current line." 7577 (interactive "P") 7578 (let ((expected (save-excursion 7579 (end-of-line) 7580 (when (search-backward " -- ((" (vhdl-point 'bol) t) 7581 (forward-char 4) 7582 (read (current-buffer))))) 7583 (actual (vhdl-get-syntactic-context)) 7584 (expurgated)) 7585 ;; remove the library unit symbols 7586 (mapc 7587 (function 7588 (lambda (elt) 7589 (if (memq (car elt) '(entity configuration context package 7590 package-body architecture)) 7591 nil 7592 (setq expurgated (append expurgated (list elt)))))) 7593 actual) 7594 (if (and (not arg) expected (listp expected)) 7595 (if (not (equal expected expurgated)) 7596 (error "ERROR: Should be: %s, is: %s" expected expurgated)) 7597 (save-excursion 7598 (beginning-of-line) 7599 (when (not (looking-at "^\\s-*\\(--.*\\)?$")) 7600 (end-of-line) 7601 (if (search-backward " -- ((" (vhdl-point 'bol) t) 7602 (delete-region (point) (line-end-position))) 7603 (insert " -- ") 7604 (insert (format "%s" expurgated)))))) 7605 (vhdl-keep-region-active)) 7606 7607 7608;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7609;;; Alignment, beautifying 7610;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7611 7612(defconst vhdl-align-alist 7613 '( 7614 ;; after some keywords 7615 (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]" 7616 "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2) 7617 ;; before ':' 7618 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") 7619 ;; after direction specifications 7620 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" 7621 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) 7622 ;; before "==", ":=", "=>", and "<=" 7623 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur 7624 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7625 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur 7626 ;; before some keywords 7627 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) 7628 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) 7629 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) 7630 (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1) 7631 (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1) 7632 ;; before "=>" since "when/else ... =>" can occur 7633 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7634 ) 7635 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). 7636It is searched in order. If REGEXP is found anywhere in the first 7637line of a region to be aligned, ALIGN-PATTERN will be used for that 7638region. ALIGN-PATTERN must include the whitespace to be expanded or 7639contracted. It may also provide regexps for the text surrounding the 7640whitespace. SUBEXP specifies which sub-expression of 7641ALIGN-PATTERN matches the white space to be expanded/contracted.") 7642 7643;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7644;; Align code 7645 7646(defvar vhdl-align-try-all-clauses t 7647 "If REGEXP is not found on the first line of the region that clause 7648is ignored. If this variable is non-nil, then the clause is tried anyway.") 7649 7650(defun vhdl-do-group (function &optional spacing) 7651 "Apply FUNCTION on group of lines between empty lines." 7652 (let 7653 ;; search for group beginning 7654 ((beg (save-excursion 7655 (if (re-search-backward vhdl-align-group-separate nil t) 7656 (progn (beginning-of-line 2) (back-to-indentation) (point)) 7657 (point-min)))) 7658 ;; search for group end 7659 (end (save-excursion 7660 (if (re-search-forward vhdl-align-group-separate nil t) 7661 (progn (beginning-of-line) (point)) 7662 (point-max))))) 7663 ;; run FUNCTION 7664 (funcall function beg end spacing))) 7665 7666(defun vhdl-do-list (function &optional spacing) 7667 "Apply FUNCTION to the lines of a list surrounded by a balanced group of 7668parentheses." 7669 (let (beg end) 7670 (save-excursion 7671 ;; search for beginning of balanced group of parentheses 7672 (setq beg (vhdl-re-search-backward "[()]" nil t)) 7673 (while (looking-at ")") 7674 (forward-char) (backward-sexp) 7675 (setq beg (vhdl-re-search-backward "[()]" nil t))) 7676 ;; search for end of balanced group of parentheses 7677 (when beg 7678 (forward-list) 7679 (setq end (point)) 7680 (goto-char (1+ beg)) 7681 (skip-chars-forward " \t\n\r\f") 7682 (setq beg (point)))) 7683 ;; run FUNCTION 7684 (if beg 7685 (funcall function beg end spacing) 7686 (error "ERROR: Not within a list enclosed by a pair of parentheses")))) 7687 7688(defun vhdl-do-same-indent (function &optional spacing) 7689 "Apply FUNCTION to block of lines with same indent." 7690 (let ((indent (current-indentation)) 7691 beg end) 7692 ;; search for first line with same indent 7693 (save-excursion 7694 (while (and (not (bobp)) 7695 (or (looking-at "^\\s-*\\(--.*\\)?$") 7696 (= (current-indentation) indent))) 7697 (unless (looking-at "^\\s-*$") 7698 (back-to-indentation) (setq beg (point))) 7699 (beginning-of-line -0))) 7700 ;; search for last line with same indent 7701 (save-excursion 7702 (while (and (not (eobp)) 7703 (or (looking-at "^\\s-*\\(--.*\\)?$") 7704 (= (current-indentation) indent))) 7705 (if (looking-at "^\\s-*$") 7706 (beginning-of-line 2) 7707 (beginning-of-line 2) 7708 (setq end (point))))) 7709 ;; run FUNCTION 7710 (funcall function beg end spacing))) 7711 7712(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) 7713 "Attempt to align a range of lines based on the content of the 7714lines. The definition of `alignment-list' determines the matching 7715order and the manner in which the lines are aligned. If ALIGNMENT-LIST 7716is not specified `vhdl-align-alist' is used. If INDENT is non-nil, 7717indentation is done before aligning." 7718 (interactive "r\np") 7719 (setq alignment-list (or alignment-list vhdl-align-alist)) 7720 (setq spacing (or spacing 1)) 7721 (save-excursion 7722 (let (bol indent) 7723 (goto-char end) 7724 (setq end (point-marker)) 7725 (goto-char begin) 7726 (setq bol (setq begin (progn (beginning-of-line) (point)))) 7727 (when indent 7728 (indent-region bol end nil)))) 7729 (let ((copy (copy-alist alignment-list))) 7730 (vhdl-prepare-search-2 7731 (while copy 7732 (save-excursion 7733 (goto-char begin) 7734 (let (element 7735 (eol (point-at-eol))) 7736 (setq element (nth 0 copy)) 7737 (when (and (or (and (listp (car element)) 7738 (memq major-mode (car element))) 7739 (eq major-mode (car element))) 7740 (or vhdl-align-try-all-clauses 7741 (re-search-forward (car (cdr element)) eol t))) 7742 (vhdl-align-region-2 begin end (car (cdr (cdr element))) 7743 (car (cdr (cdr (cdr element)))) spacing)) 7744 (setq copy (cdr copy)))))))) 7745 7746(defun vhdl-align-region-2 (begin end match &optional substr spacing) 7747 "Align a range of lines from BEGIN to END. The regular expression 7748MATCH must match exactly one field: the whitespace to be 7749contracted/expanded. The alignment column will equal the 7750rightmost column of the widest whitespace block. SPACING is 7751the amount of extra spaces to add to the calculated maximum required. 7752SPACING defaults to 1 so that at least one space is inserted after 7753the token in MATCH." 7754 (setq spacing (or spacing 1)) 7755 (setq substr (or substr 1)) 7756 (save-excursion 7757 (let (distance (max 0) (lines 0) bol eol width) 7758 ;; Determine the greatest whitespace distance to the alignment 7759 ;; character 7760 (goto-char begin) 7761 (setq eol (point-at-eol) 7762 bol (setq begin (progn (beginning-of-line) (point)))) 7763 (while (< bol end) 7764 (save-excursion 7765 (when (and (vhdl-re-search-forward match eol t) 7766 (save-excursion 7767 (goto-char (match-beginning 0)) 7768 (forward-char) 7769 (and (not (vhdl-in-literal)) 7770 (not (vhdl-in-quote-p)) 7771 (not (vhdl-in-extended-identifier-p)))) 7772 (not (looking-at "\\s-*$"))) 7773 (setq distance (- (match-beginning substr) bol)) 7774 (when (> distance max) 7775 (setq max distance)))) 7776 (forward-line) 7777 (setq bol (point) 7778 eol (point-at-eol)) 7779 (setq lines (1+ lines))) 7780 ;; Now insert enough maxs to push each assignment operator to 7781 ;; the same column. We need to use 'lines' as a counter, since 7782 ;; the location of the mark may change 7783 (goto-char (setq bol begin)) 7784 (setq eol (point-at-eol)) 7785 (while (> lines 0) 7786 (when (and (vhdl-re-search-forward match eol t) 7787 (save-excursion 7788 (goto-char (match-beginning 0)) 7789 (forward-char) 7790 (and (not (vhdl-in-literal)) 7791 (not (vhdl-in-quote-p)) 7792 (not (vhdl-in-extended-identifier-p)))) 7793 (not (looking-at "\\s-*$")) 7794 (> (match-beginning 0) ; not if at boi 7795 (save-excursion (back-to-indentation) (point)))) 7796 (setq width (- (match-end substr) (match-beginning substr))) 7797 (setq distance (- (match-beginning substr) bol)) 7798 (goto-char (match-beginning substr)) 7799 (delete-char width) 7800 (insert-char ? (+ (- max distance) spacing))) 7801 (beginning-of-line) 7802 (forward-line) 7803 (setq bol (point) 7804 eol (point-at-eol)) 7805 (setq lines (1- lines)))))) 7806 7807(defun vhdl-align-region-groups (beg end &optional spacing 7808 no-message no-comments) 7809 "Align region, treat groups of lines separately." 7810 (interactive "r\nP") 7811 (save-excursion 7812 (let (orig pos) 7813 (goto-char beg) 7814 (beginning-of-line) 7815 (setq orig (point-marker)) 7816 (setq beg (point)) 7817 (goto-char end) 7818 (setq end (point-marker)) 7819 (untabify beg end) 7820 (unless no-message 7821 (when vhdl-progress-interval 7822 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7823 (count-lines (point-min) end) 0)))) 7824 (when (nth 0 vhdl-beautify-options) 7825 (vhdl-fixup-whitespace-region beg end t)) 7826 (goto-char beg) 7827 (if (not vhdl-align-groups) 7828 ;; align entire region 7829 (progn (vhdl-align-region-1 beg end spacing) 7830 (unless no-comments 7831 (vhdl-align-inline-comment-region-1 beg end))) 7832 ;; align groups 7833 (while (and (< beg end) 7834 (re-search-forward vhdl-align-group-separate end t)) 7835 (setq pos (point-marker)) 7836 (vhdl-align-region-1 beg pos spacing) 7837 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) 7838 (vhdl-update-progress-info "Aligning" (vhdl-current-line)) 7839 (setq beg (1+ pos)) 7840 (goto-char beg)) 7841 ;; align last group 7842 (when (< beg end) 7843 (vhdl-align-region-1 beg end spacing) 7844 (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) 7845 (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) 7846 (when vhdl-indent-tabs-mode 7847 (tabify orig end)) 7848 (unless no-message 7849 (when vhdl-progress-interval (message "Aligning...done")) 7850 (setq vhdl-progress-info nil))))) 7851 7852(defun vhdl-align-region (beg end &optional spacing) 7853 "Align region, treat blocks with same indent and argument lists separately." 7854 (interactive "r\nP") 7855 (if (not vhdl-align-same-indent) 7856 ;; align entire region 7857 (vhdl-align-region-groups beg end spacing) 7858 ;; align blocks with same indent and argument lists 7859 (save-excursion 7860 (let ((cur-beg beg) 7861 indent cur-end) 7862 (when vhdl-progress-interval 7863 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7864 (count-lines (point-min) end) 0))) 7865 (goto-char end) 7866 (setq end (point-marker)) 7867 (goto-char cur-beg) 7868 (while (< (point) end) 7869 ;; is argument list opening? 7870 (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp 7871 (point) (vhdl-point 'eol))))) 7872 ;; determine region for argument list 7873 (progn (goto-char cur-beg) 7874 (forward-sexp) 7875 (setq cur-end (point)) 7876 (beginning-of-line 2)) 7877 ;; determine region with same indent 7878 (setq indent (current-indentation)) 7879 (setq cur-beg (point)) 7880 (setq cur-end (vhdl-point 'bonl)) 7881 (beginning-of-line 2) 7882 (while (and (< (point) end) 7883 (or (looking-at "^\\s-*\\(--.*\\)?$") 7884 (= (current-indentation) indent)) 7885 (<= (save-excursion 7886 (nth 0 (parse-partial-sexp 7887 (point) (vhdl-point 'eol)))) 0)) 7888 (unless (looking-at "^\\s-*$") 7889 (setq cur-end (vhdl-point 'bonl))) 7890 (beginning-of-line 2))) 7891 ;; align region 7892 (vhdl-align-region-groups cur-beg cur-end spacing t t)) 7893 (vhdl-align-inline-comment-region beg end spacing noninteractive) 7894 (when vhdl-progress-interval (message "Aligning...done")) 7895 (setq vhdl-progress-info nil))))) 7896 7897(defun vhdl-align-group (&optional spacing) 7898 "Align group of lines between empty lines." 7899 (interactive) 7900 (vhdl-do-group 'vhdl-align-region spacing)) 7901 7902(defun vhdl-align-list (&optional spacing) 7903 "Align the lines of a list surrounded by a balanced group of parentheses." 7904 (interactive) 7905 (vhdl-do-list 'vhdl-align-region-groups spacing)) 7906 7907(defun vhdl-align-same-indent (&optional spacing) 7908 "Align block of lines with same indent." 7909 (interactive) 7910 (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) 7911 7912(defun vhdl-align-declarations (&optional spacing) 7913 "Align the lines within the declarative part of a design unit." 7914 (interactive) 7915 (let (beg end) 7916 (vhdl-prepare-search-2 7917 (save-excursion 7918 ;; search for declarative part 7919 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t) 7920 (not (member (upcase (match-string 1)) '("BEGIN" "END")))) 7921 (setq beg (point)) 7922 (re-search-forward "^\\(begin\\|end\\)\\>" nil t) 7923 (setq end (point))))) 7924 (if beg 7925 (vhdl-align-region-groups beg end spacing) 7926 (error "ERROR: Not within the declarative part of a design unit")))) 7927 7928(defun vhdl-align-buffer () 7929 "Align buffer." 7930 (interactive) 7931 (vhdl-align-region (point-min) (point-max))) 7932 7933;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7934;; Align inline comments 7935 7936(defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) 7937 "Align inline comments in region." 7938 (save-excursion 7939 (let ((start-max comment-column) 7940 (length-max 0) 7941 comment-list start-list tmp-list start length 7942 cur-start prev-start no-code) 7943 (setq spacing (or spacing 2)) 7944 (vhdl-prepare-search-2 7945 (goto-char beg) 7946 ;; search for comment start positions and lengths 7947 (while (< (point) end) 7948 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7949 (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") 7950 (not (save-excursion (goto-char (match-beginning 2)) 7951 (vhdl-in-literal)))) 7952 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7953 (setq length (- (match-end 2) (match-beginning 2))) 7954 (setq start-max (max start start-max)) 7955 (setq length-max (max length length-max)) 7956 (push (cons start length) comment-list)) 7957 (beginning-of-line 2)) 7958 (setq comment-list 7959 (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) 7960 ;; reduce start positions 7961 (setq start-list (list (caar comment-list))) 7962 (setq comment-list (cdr comment-list)) 7963 (while comment-list 7964 (unless (or (= (caar comment-list) (car start-list)) 7965 (<= (+ (car start-list) (cdar comment-list)) 7966 end-comment-column)) 7967 (push (caar comment-list) start-list)) 7968 (setq comment-list (cdr comment-list))) 7969 ;; align lines as nicely as possible 7970 (goto-char beg) 7971 (while (< (point) end) 7972 (setq cur-start nil) 7973 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7974 (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") 7975 (not (save-excursion 7976 (goto-char (match-beginning 3)) 7977 (vhdl-in-literal)))) 7978 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") 7979 (>= (- (match-end 2) (match-beginning 2)) 7980 comment-column)))) 7981 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7982 (setq length (- (match-end 3) (match-beginning 3))) 7983 (setq no-code (= (match-beginning 1) (match-end 1))) 7984 ;; insert minimum whitespace 7985 (goto-char (match-end 2)) 7986 (delete-region (match-beginning 2) (match-end 2)) 7987 (insert-char ?\ spacing) 7988 (setq tmp-list start-list) 7989 ;; insert additional whitespace to align 7990 (setq cur-start 7991 (cond 7992 ;; align comment-only line to inline comment of previous line 7993 ((and no-code prev-start 7994 (<= length (- end-comment-column prev-start))) 7995 prev-start) 7996 ;; align all comments at `start-max' if this is possible 7997 ((<= (+ start-max length-max) end-comment-column) 7998 start-max) 7999 ;; align at `comment-column' if possible 8000 ((and (<= start comment-column) 8001 (<= length (- end-comment-column comment-column))) 8002 comment-column) 8003 ;; align at left-most possible start position otherwise 8004 (t 8005 (while (and tmp-list (< (car tmp-list) start)) 8006 (setq tmp-list (cdr tmp-list))) 8007 (car tmp-list)))) 8008 (indent-to cur-start)) 8009 (setq prev-start cur-start) 8010 (beginning-of-line 2)))))) 8011 8012(defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) 8013 "Align inline comments within a region. Groups of code lines separated by 8014empty lines are aligned individually, if `vhdl-align-groups' is non-nil." 8015 (interactive "r\nP") 8016 (save-excursion 8017 (let (orig pos) 8018 (goto-char beg) 8019 (beginning-of-line) 8020 (setq orig (point-marker)) 8021 (setq beg (point)) 8022 (goto-char end) 8023 (setq end (point-marker)) 8024 (untabify beg end) 8025 (unless no-message (message "Aligning inline comments...")) 8026 (goto-char beg) 8027 (if (not vhdl-align-groups) 8028 ;; align entire region 8029 (vhdl-align-inline-comment-region-1 beg end spacing) 8030 ;; align groups 8031 (while (and (< beg end) 8032 (re-search-forward vhdl-align-group-separate end t)) 8033 (setq pos (point-marker)) 8034 (vhdl-align-inline-comment-region-1 beg pos spacing) 8035 (setq beg (1+ pos)) 8036 (goto-char beg)) 8037 ;; align last group 8038 (when (< beg end) 8039 (vhdl-align-inline-comment-region-1 beg end spacing))) 8040 (when vhdl-indent-tabs-mode 8041 (tabify orig end)) 8042 (unless no-message (message "Aligning inline comments...done"))))) 8043 8044(defun vhdl-align-inline-comment-group (&optional spacing) 8045 "Align inline comments within a group of lines between empty lines." 8046 (interactive) 8047 (save-excursion 8048 (let ((start (point)) 8049 beg end) 8050 (setq end (if (re-search-forward vhdl-align-group-separate nil t) 8051 (point-marker) (point-max))) 8052 (goto-char start) 8053 (setq beg (if (re-search-backward vhdl-align-group-separate nil t) 8054 (point) (point-min))) 8055 (untabify beg end) 8056 (message "Aligning inline comments...") 8057 (vhdl-align-inline-comment-region-1 beg end) 8058 (when vhdl-indent-tabs-mode 8059 (tabify beg end)) 8060 (message "Aligning inline comments...done")))) 8061 8062(defun vhdl-align-inline-comment-buffer () 8063 "Align inline comments within buffer. Groups of code lines separated by 8064empty lines are aligned individually, if `vhdl-align-groups' is non-nil." 8065 (interactive) 8066 (vhdl-align-inline-comment-region (point-min) (point-max))) 8067 8068;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8069;; Fixup whitespace 8070 8071(defun vhdl-fixup-whitespace-region (beg end &optional no-message) 8072 "Fixup whitespace in region. Surround operator symbols by one space, 8073eliminate multiple spaces (except at beginning of line), eliminate spaces at 8074end of line, do nothing in comments and strings." 8075 (interactive "r") 8076 (unless no-message (message "Fixing up whitespace...")) 8077 (save-excursion 8078 (goto-char end) 8079 (setq end (point-marker)) 8080 ;; have no space before and one space after `,' and ';' 8081 (goto-char beg) 8082 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) 8083 (if (match-string 1) 8084 (goto-char (match-end 1)) 8085 (replace-match "\\3 " nil nil nil 2))) 8086 ;; have no space after `(' 8087 (goto-char beg) 8088 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t) 8089 (if (match-string 1) 8090 (goto-char (match-end 1)) 8091 (replace-match "\\2"))) 8092 ;; have no space before `)' 8093 (goto-char beg) 8094 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) 8095 (if (match-string 1) 8096 (goto-char (match-end 1)) 8097 (replace-match "\\2"))) 8098 ;; surround operator symbols by one space 8099 (goto-char beg) 8100 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) 8101 (if (or (match-string 1) 8102 (<= (match-beginning 0) ; not if at boi 8103 (save-excursion (back-to-indentation) (point)))) 8104 (goto-char (match-end 0)) 8105 (replace-match "\\3 \\4 \\5") 8106 (goto-char (match-end 2)))) 8107 ;; eliminate multiple spaces and spaces at end of line 8108 (goto-char beg) 8109 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) 8110 (and (looking-at "--.*") (re-search-forward "--.*" end t)) 8111 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) 8112 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) 8113 (progn (replace-match "" nil nil) t)) 8114 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) 8115 (progn (replace-match ";" nil nil) t)) 8116 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) 8117 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) 8118 (progn (replace-match " " nil nil) t)) 8119 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) 8120 (progn (replace-match " " nil nil) t)) 8121 (and (looking-at "-") (re-search-forward "-" end t)) 8122 (re-search-forward "[^ \t\"-]+" end t)))) 8123 (unless no-message (message "Fixing up whitespace...done"))) 8124 8125(defun vhdl-fixup-whitespace-buffer () 8126 "Fixup whitespace in buffer. Surround operator symbols by one space, 8127eliminate multiple spaces (except at beginning of line), eliminate spaces at 8128end of line, do nothing in comments." 8129 (interactive) 8130 (vhdl-fixup-whitespace-region (point-min) (point-max))) 8131 8132;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8133;; Case fixing 8134 8135(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) 8136 "Convert all words matching WORD-REGEXP in region to lower or upper case, 8137depending on parameter UPPER-CASE." 8138 (let ((case-replace nil) 8139 (last-update 0)) 8140 (vhdl-prepare-search-2 8141 (save-excursion 8142 (goto-char end) 8143 (setq end (point-marker)) 8144 (goto-char beg) 8145 (while (re-search-forward word-regexp end t) 8146 (or (vhdl-in-literal) 8147 (if upper-case 8148 (upcase-word -1) 8149 (downcase-word -1))) 8150 (when (and count vhdl-progress-interval (not noninteractive) 8151 (time-less-p vhdl-progress-interval 8152 (time-since last-update))) 8153 (message "Fixing case... (%2d%s)" 8154 (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) 8155 "%") 8156 (setq last-update (time-convert nil 'integer)))) 8157 (goto-char end))))) 8158 8159(defun vhdl-fix-case-region (beg end &optional arg) 8160 "Convert all VHDL words in region to lower or upper case, depending on 8161options vhdl-upper-case-{keywords,types,attributes,enum-values}." 8162 (interactive "r\nP") 8163 (vhdl-fix-case-region-1 8164 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) 8165 (vhdl-fix-case-region-1 8166 beg end vhdl-upper-case-types vhdl-types-regexp 1) 8167 (vhdl-fix-case-region-1 8168 beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) 8169 (vhdl-fix-case-region-1 8170 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) 8171 (vhdl-fix-case-region-1 8172 beg end vhdl-upper-case-constants vhdl-constants-regexp 4) 8173 (when vhdl-progress-interval (message "Fixing case...done"))) 8174 8175(defun vhdl-fix-case-buffer () 8176 "Convert all VHDL words in buffer to lower or upper case, depending on 8177options vhdl-upper-case-{keywords,types,attributes,enum-values}." 8178 (interactive) 8179 (vhdl-fix-case-region (point-min) (point-max))) 8180 8181(defun vhdl-fix-case-word (&optional arg) 8182 "Convert word after cursor to upper case if necessary." 8183 (interactive "p") 8184 (save-excursion 8185 (when arg (backward-word 1)) 8186 (vhdl-prepare-search-1 8187 (when (and vhdl-upper-case-keywords 8188 (looking-at vhdl-keywords-regexp)) 8189 (upcase-word 1)) 8190 (when (and vhdl-upper-case-types 8191 (looking-at vhdl-types-regexp)) 8192 (upcase-word 1)) 8193 (when (and vhdl-upper-case-attributes 8194 (looking-at vhdl-attributes-regexp)) 8195 (upcase-word 1)) 8196 (when (and vhdl-upper-case-enum-values 8197 (looking-at vhdl-enum-values-regexp)) 8198 (upcase-word 1)) 8199 (when (and vhdl-upper-case-constants 8200 (looking-at vhdl-constants-regexp)) 8201 (upcase-word 1))))) 8202 8203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8204;; Fix statements 8205;; - force each statement to be on a separate line except when on same line 8206;; with 'end' keyword 8207 8208(defun vhdl-fix-statement-region (beg end &optional arg) 8209 "Force statements in region on separate line except when on same line 8210with `end' keyword (necessary for correct indentation). 8211Currently supported keywords: `begin', `if'." 8212 (interactive "r\nP") 8213 (vhdl-prepare-search-2 8214 (let (point) 8215 (save-excursion 8216 (goto-char end) 8217 (setq end (point-marker)) 8218 (goto-char beg) 8219 ;; `begin' keyword 8220 (while (re-search-forward 8221 "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t) 8222 (goto-char (match-end 0)) 8223 (setq point (point-marker)) 8224 (when (and (match-string 1) 8225 (or (not (match-string 2)) 8226 (save-excursion (goto-char (match-end 2)) 8227 (vhdl-in-literal))) 8228 (not (save-excursion (goto-char (match-beginning 1)) 8229 (vhdl-in-literal)))) 8230 (goto-char (match-beginning 1)) 8231 (insert "\n") 8232 (indent-according-to-mode)) 8233 (goto-char point)) 8234 (goto-char beg) 8235 ;; `for', `if' keywords 8236 (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) 8237 (goto-char (match-end 1)) 8238 (setq point (point-marker)) 8239 ;; exception: in literal or preceded by `end', `wait' or label 8240 (when (and (not (save-excursion (goto-char (match-beginning 1)) 8241 (vhdl-in-literal))) 8242 (save-excursion 8243 (beginning-of-line 1) 8244 (save-match-data 8245 (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" 8246 (match-beginning 1) t) 8247 (not (string-match 8248 "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$" 8249 (match-string 1))))))) 8250 (goto-char (match-beginning 1)) 8251 (insert "\n") 8252 (indent-according-to-mode)) 8253 (goto-char point)))))) 8254 8255(defun vhdl-fix-statement-buffer () 8256 "Force statements in buffer on separate line except when on same line 8257with `end' keyword (necessary for correct indentation)." 8258 (interactive) 8259 (vhdl-fix-statement-region (point-min) (point-max))) 8260 8261;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8262;; Trailing spaces 8263 8264(defun vhdl-remove-trailing-spaces-region (beg end &optional arg) 8265 "Remove trailing spaces in region." 8266 (interactive "r\nP") 8267 (save-excursion 8268 (goto-char end) 8269 (setq end (point-marker)) 8270 (goto-char beg) 8271 (while (re-search-forward "[ \t]+$" end t) 8272 (unless (vhdl-in-literal) 8273 (replace-match "" nil nil))))) 8274 8275(defun vhdl-remove-trailing-spaces () 8276 "Remove trailing spaces in buffer." 8277 (interactive) 8278 (vhdl-remove-trailing-spaces-region (point-min) (point-max))) 8279 8280;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8281;; Beautify 8282 8283(defun vhdl-beautify-region (beg end) 8284 "Beautify region by applying indentation, whitespace fixup, alignment, and 8285case fixing to a region. Calls functions `vhdl-indent-buffer', 8286`vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and 8287`vhdl-fix-case-buffer'." 8288 (interactive "r") 8289 (setq end (save-excursion (goto-char end) (point-marker))) 8290 (save-excursion ; remove DOS EOL characters in UNIX file 8291 (goto-char beg) 8292 (while (search-forward "\r" nil t) 8293 (replace-match "" nil t))) 8294 (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) 8295 (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) 8296 (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) 8297 (when (nth 3 vhdl-beautify-options) 8298 (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) 8299 (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) 8300 (when (nth 0 vhdl-beautify-options) 8301 (vhdl-remove-trailing-spaces-region beg end) 8302 (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end)))) 8303 8304(defun vhdl-beautify-buffer () 8305 "Beautify buffer by applying indentation, whitespace fixup, alignment, and 8306case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire 8307buffer." 8308 (interactive) 8309 (vhdl-beautify-region (point-min) (point-max)) 8310 (when noninteractive (save-buffer))) 8311 8312;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8313;; Code filling 8314 8315(defun vhdl-fill-region (beg end &optional arg) 8316 "Fill lines for a region of code." 8317 (interactive "r\np") 8318 (save-excursion 8319 (goto-char beg) 8320 (let ((margin (if arg (current-indentation) (current-column)))) 8321 (goto-char end) 8322 (setq end (point-marker)) 8323 ;; remove inline comments, newlines and whitespace 8324 (vhdl-comment-kill-region beg end) 8325 (vhdl-comment-kill-inline-region beg end) 8326 (subst-char-in-region beg (1- end) ?\n ?\ ) 8327 (vhdl-fixup-whitespace-region beg end) 8328 ;; wrap and end-comment-column 8329 (goto-char beg) 8330 (while (re-search-forward "\\s-" end t) 8331 (when(> (current-column) vhdl-end-comment-column) 8332 (backward-char) 8333 (when (re-search-backward "\\s-" beg t) 8334 (replace-match "\n") 8335 (indent-to margin))))))) 8336 8337(defun vhdl-fill-group () 8338 "Fill group of lines between empty lines." 8339 (interactive) 8340 (vhdl-do-group 'vhdl-fill-region)) 8341 8342(defun vhdl-fill-list () 8343 "Fill the lines of a list surrounded by a balanced group of parentheses." 8344 (interactive) 8345 (vhdl-do-list 'vhdl-fill-region)) 8346 8347(defun vhdl-fill-same-indent () 8348 "Fill the lines of block of lines with same indent." 8349 (interactive) 8350 (vhdl-do-same-indent 'vhdl-fill-region)) 8351 8352 8353;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8354;;; Code updating/fixing 8355;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8356 8357;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8358;; Sensitivity list update 8359 8360;; Strategy: 8361;; - no sensitivity list is generated for processes with wait statements 8362;; - otherwise, do the following: 8363;; 1. scan for all local signals (ports, signals declared in arch./blocks) 8364;; 2. scan for all signals already in the sensitivity list (in order to catch 8365;; manually entered global signals) 8366;; 3. signals from 1. and 2. form the list of visible signals 8367;; 4. search for if/elsif conditions containing an event (sequential code) 8368;; 5. scan for strings that are within syntactical regions where signals are 8369;; read but not within sequential code, and that correspond to visible 8370;; signals 8371;; 6. replace sensitivity list by list of signals from 5. 8372 8373(defun vhdl-update-sensitivity-list-process () 8374 "Update sensitivity list of current process." 8375 (interactive) 8376 (save-excursion 8377 (vhdl-prepare-search-2 8378 (end-of-line) 8379 ;; look whether in process 8380 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) 8381 (equal (upcase (match-string 2)) "PROCESS") 8382 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) 8383 (error "ERROR: Not within a process") 8384 (message "Updating sensitivity list...") 8385 (vhdl-update-sensitivity-list) 8386 (message "Updating sensitivity list...done"))))) 8387 8388(defun vhdl-update-sensitivity-list-buffer () 8389 "Update sensitivity list of all processes in current buffer." 8390 (interactive) 8391 (save-excursion 8392 (vhdl-prepare-search-2 8393 (goto-char (point-min)) 8394 (message "Updating sensitivity lists...") 8395 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) 8396 (goto-char (match-beginning 0)) 8397 (condition-case nil (vhdl-update-sensitivity-list) (error ""))) 8398 (message "Updating sensitivity lists...done"))) 8399 (when noninteractive (save-buffer))) 8400 8401(defun vhdl-update-sensitivity-list () 8402 "Update sensitivity list." 8403 (let ((proc-beg (point)) 8404 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 8405 (proc-mid (vhdl-re-search-backward 8406 "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t)) 8407 seq-region-list) 8408 (cond 8409 ;; error if 'begin' keyword missing 8410 ((not (match-string 2)) 8411 (error "ERROR: No 'begin' keyword found")) 8412 ;; search for wait statement (no sensitivity list allowed) 8413 ((progn (goto-char proc-mid) 8414 (vhdl-re-search-forward "\\<wait\\>" proc-end t)) 8415 (error "ERROR: Process with wait statement, sensitivity list not generated")) 8416 ;; combinational process (update sensitivity list) 8417 (t 8418 (let 8419 ;; scan for visible signals 8420 ((visible-list (vhdl-get-visible-signals)) 8421 ;; define syntactic regions where signals are read 8422 (scan-regions-list 8423 '(;; right-hand side of signal/variable assignment 8424 ;; (special case: "<=" is relational operator in a condition) 8425 ((vhdl-re-search-forward "[<:]=" proc-end t) 8426 (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) 8427 ;; if condition 8428 ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) 8429 (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8430 ;; elsif condition 8431 ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) 8432 (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8433 ;; while loop condition 8434 ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) 8435 (vhdl-re-search-forward "\\<loop\\>" proc-end t)) 8436 ;; exit/next condition 8437 ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) 8438 (vhdl-re-search-forward ";" proc-end t)) 8439 ;; assert condition 8440 ((vhdl-re-search-forward "\\<assert\\>" proc-end t) 8441 (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) 8442 ;; case expression 8443 ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) 8444 (vhdl-re-search-forward "\\<is\\>" proc-end t)) 8445 ;; parameter list of procedure call, array index 8446 ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) 8447 (1- (point))) 8448 (progn (backward-char) (forward-sexp) 8449 (while (looking-at "(") (forward-sexp)) (point))))) 8450 name field read-list sens-list signal-list tmp-list 8451 sens-beg sens-end beg end margin) 8452 ;; scan for signals in old sensitivity list 8453 (goto-char proc-beg) 8454 (vhdl-re-search-forward "\\<process\\>" proc-mid t) 8455 (if (not (looking-at "[ \t\n\r\f]*(")) 8456 (setq sens-beg (point)) 8457 (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) 8458 (goto-char (match-end 1)) 8459 (forward-sexp) 8460 (setq sens-end (1- (point))) 8461 (goto-char sens-beg) 8462 (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) 8463 (setq sens-list 8464 (cons (downcase (match-string 0)) sens-list)) 8465 (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) 8466 (setq signal-list (append visible-list sens-list)) 8467 ;; search for sequential parts 8468 (goto-char proc-mid) 8469 (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) 8470 (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8471 (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) 8472 (goto-char end) 8473 (backward-word-strictly 1) 8474 (vhdl-forward-sexp) 8475 (push (cons end (point)) seq-region-list) 8476 (beginning-of-line))) 8477 ;; scan for signals read in process 8478 (while scan-regions-list 8479 (goto-char proc-mid) 8480 (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) 8481 (setq end (eval (nth 1 (car scan-regions-list))))) 8482 (goto-char beg) 8483 (unless (or (vhdl-in-literal) 8484 (and seq-region-list 8485 (let ((tmp-list seq-region-list)) 8486 (while (and tmp-list 8487 (< (point) (caar tmp-list))) 8488 (setq tmp-list (cdr tmp-list))) 8489 (and tmp-list (< (point) (cdar tmp-list)))))) 8490 (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) 8491 (setq name (match-string 1)) 8492 ;; get array index range 8493 (when vhdl-array-index-record-field-in-sensitivity-list 8494 (setq field (match-string 2)) 8495 ;; not use if it includes a variable name 8496 (save-match-data 8497 (setq tmp-list visible-list) 8498 (while (and field tmp-list) 8499 (when (string-match 8500 (concat "\\<" (car tmp-list) "\\>") field) 8501 (setq field nil)) 8502 (setq tmp-list (cdr tmp-list))))) 8503 (when (and (not (match-string 6)) ; not when formal parameter 8504 (not (and (match-string 5) ; not event attribute 8505 (not (member (downcase (match-string 5)) 8506 '("event" "last_event" "transaction"))))) 8507 (member (downcase name) signal-list)) 8508 ;; not add if name or name+field already exists 8509 (unless 8510 (or (member-ignore-case name read-list) 8511 (member-ignore-case (concat name field) read-list)) 8512 (push (concat name field) read-list)) 8513 (setq tmp-list read-list) 8514 ;; remove existing name+field if name is added 8515 (save-match-data 8516 (while tmp-list 8517 (when (string-match (concat "^" name field "[(.]") 8518 (car tmp-list)) 8519 (setq read-list (delete (car tmp-list) read-list))) 8520 (setq tmp-list (cdr tmp-list))))) 8521 (goto-char (match-end 1))))) 8522 (setq scan-regions-list (cdr scan-regions-list))) 8523 ;; update sensitivity list 8524 (goto-char sens-beg) 8525 (if sens-end 8526 (delete-region sens-beg sens-end) 8527 (when read-list 8528 (insert " ()") (backward-char))) 8529 (setq read-list (sort read-list 'string<)) 8530 (when read-list 8531 (setq margin (current-column)) 8532 (insert (car read-list)) 8533 (setq read-list (cdr read-list)) 8534 (while read-list 8535 (insert ",") 8536 (if (<= (+ (current-column) (length (car read-list)) 2) 8537 end-comment-column) 8538 (insert " ") 8539 (insert "\n") (indent-to margin)) 8540 (insert (car read-list)) 8541 (setq read-list (cdr read-list))))))))) 8542 8543(defun vhdl-get-visible-signals () 8544 "Get all signals visible in the current block." 8545 (let (beg end signal-list entity-name file-name) 8546 (vhdl-prepare-search-2 8547 ;; get entity name 8548 (save-excursion 8549 (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 8550 (not (equal "END" (upcase (match-string 1)))) 8551 (setq entity-name (match-string 2))) 8552 (error "ERROR: Not within an architecture"))) 8553 ;; search for signals declared in entity port clause 8554 (save-excursion 8555 (goto-char (point-min)) 8556 (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) 8557 (setq file-name 8558 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) 8559 "." (file-name-extension (buffer-file-name))))) 8560 (vhdl-visit-file 8561 file-name t 8562 (vhdl-prepare-search-2 8563 (goto-char (point-min)) 8564 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) 8565 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) 8566 (when (setq beg (vhdl-re-search-forward 8567 "\\<port[ \t\n\r\f]*(" 8568 (save-excursion 8569 (re-search-forward "^end\\>" nil t)) t)) 8570 (setq end (save-excursion 8571 (backward-char) (forward-sexp) (point))) 8572 (vhdl-forward-syntactic-ws) 8573 (while (< (point) end) 8574 (when (looking-at "signal[ \t\n\r\f]+") 8575 (goto-char (match-end 0))) 8576 (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") 8577 (setq signal-list 8578 (cons (downcase (match-string 1)) signal-list)) 8579 (goto-char (match-end 0)) 8580 (vhdl-forward-syntactic-ws)) 8581 (re-search-forward ";" end 1) 8582 (vhdl-forward-syntactic-ws))))))) 8583 ;; search for signals declared in architecture declarative part 8584 (save-excursion 8585 (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) 8586 (not (equal "END" (upcase (match-string 1)))) 8587 (setq end (re-search-forward "^begin\\>" nil t)))) 8588 (error "ERROR: No architecture declarative part found") 8589 ;; scan for all declared signal and alias names 8590 (goto-char beg) 8591 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 8592 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 8593 (if (match-string 2) 8594 ;; scan signal name 8595 (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") 8596 (setq signal-list 8597 (cons (downcase (match-string 1)) signal-list)) 8598 (goto-char (match-end 0))) 8599 ;; scan alias name, check is alias of (declared) signal 8600 (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)") 8601 (member (downcase (match-string 2)) signal-list)) 8602 (setq signal-list 8603 (cons (downcase (match-string 1)) signal-list)) 8604 (goto-char (match-end 0)))) 8605 (setq beg (point)))))) 8606 ;; search for signals declared in surrounding block declarative parts 8607 (save-excursion 8608 (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t)) 8609 (match-string 4)) 8610 (goto-char (match-end 4)) 8611 (vhdl-backward-sexp) 8612 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t)) 8613 beg) 8614 (setq end (re-search-forward "^\\s-*begin\\>" nil t))) 8615 ;; scan for all declared signal names 8616 (goto-char beg) 8617 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 8618 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 8619 (if (match-string 2) 8620 ;; scan signal name 8621 (while (looking-at "[ \t\n,]+\\(\\w+\\)") 8622 (setq signal-list 8623 (cons (downcase (match-string 1)) signal-list)) 8624 (goto-char (match-end 0))) 8625 ;; scan alias name, check is alias of (declared) signal 8626 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") 8627 (member (downcase (match-string 2)) signal-list)) 8628 (setq signal-list 8629 (cons (downcase (match-string 1)) signal-list)) 8630 (goto-char (match-end 0)))))) 8631 (goto-char beg))) 8632 signal-list))) 8633 8634;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8635;; Generic/port clause fixing 8636 8637(defun vhdl-fix-clause-buffer () 8638 "Fix all generic/port clauses in current buffer." 8639 (interactive) 8640 (save-excursion 8641 (vhdl-prepare-search-2 8642 (goto-char (point-min)) 8643 (message "Fixing generic/port clauses...") 8644 (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t) 8645 (goto-char (match-end 0)) 8646 (condition-case nil (vhdl-fix-clause) (error ""))) 8647 (message "Fixing generic/port clauses...done")))) 8648 8649(defun vhdl-fix-clause () 8650 "Fix closing parenthesis within generic/port clause." 8651 (interactive) 8652 (save-excursion 8653 (vhdl-prepare-search-2 8654 (let ((pos (point)) 8655 beg end) 8656 (end-of-line) 8657 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)) 8658 (error "ERROR: Not within a generic/port clause") 8659 ;; search for end of clause 8660 (goto-char (match-end 0)) 8661 (setq beg (1- (point))) 8662 (vhdl-forward-syntactic-ws) 8663 (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;") 8664 (goto-char (1- (match-end 0))) 8665 (setq end (point-marker)) 8666 (forward-char) 8667 (vhdl-forward-syntactic-ws)) 8668 (goto-char end) 8669 (when (> pos (point-at-eol)) 8670 (error "ERROR: Not within a generic/port clause")) 8671 ;; delete closing parenthesis on separate line (not supported style) 8672 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) 8673 (vhdl-line-kill) 8674 (vhdl-backward-syntactic-ws) 8675 (setq end (point-marker)) 8676 (insert ";")) 8677 ;; delete superfluous parentheses 8678 (while (progn (goto-char beg) 8679 (condition-case () (forward-sexp) 8680 (error (goto-char (point-max)))) 8681 (< (point) end)) 8682 (delete-char -1)) 8683 ;; add closing parenthesis 8684 (when (> (point) end) 8685 (goto-char end) 8686 (insert ")"))))))) 8687 8688 8689;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8690;;; Electrification 8691;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8692 8693(defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" 8694 "Syntax of prompt inserted by template generators.") 8695 8696(defvar vhdl-template-invoked-by-hook nil 8697 "Indicates whether a template has been invoked by a hook or by key or menu. 8698Used for undoing after template abortion.") 8699 8700;; correct different behavior of function `unread-command-events' in XEmacs 8701(defun vhdl-character-to-event (arg)) 8702(defalias 'vhdl-character-to-event 8703 (if (fboundp 'character-to-event) 'character-to-event 'identity)) 8704 8705(defun vhdl-work-library () 8706 "Return the working library name of the current project or \"work\" if no 8707project is defined." 8708 (vhdl-resolve-env-variable 8709 (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) 8710 vhdl-default-library))) 8711 8712;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8713;; Enabling/disabling 8714 8715(define-minor-mode vhdl-electric-mode 8716 "Toggle VHDL electric mode." 8717 :global t :group 'vhdl-mode) 8718 8719(define-minor-mode vhdl-stutter-mode 8720 "Toggle VHDL stuttering mode." 8721 :global t :group 'vhdl-mode) 8722 8723;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8724;; Stuttering 8725 8726(defun vhdl-electric-dash (count) 8727 "-- starts a comment, --- draws a horizontal line, 8728---- starts a display comment." 8729 (interactive "p") 8730 (if (and vhdl-stutter-mode (not (vhdl-in-literal))) 8731 (cond 8732 ((and abbrev-start-location (= abbrev-start-location (point))) 8733 (setq abbrev-start-location nil) 8734 (goto-char last-abbrev-location) 8735 (beginning-of-line nil) 8736 (vhdl-comment-display)) 8737 ((/= (preceding-char) ?-) ; standard dash (minus) 8738 (self-insert-command count)) 8739 (t (self-insert-command count) 8740 (message "Enter `-' for horiz. line, RET for commenting-out code, else enter comment") 8741 (let ((next-input (read-char))) 8742 (if (= next-input ?-) ; triple dash 8743 (progn 8744 (vhdl-comment-display-line) 8745 (message 8746 "Enter `-' for display comment, else continue coding") 8747 (let ((next-input (read-char))) 8748 (if (= next-input ?-) ; four dashes 8749 (vhdl-comment-display t) 8750 (push (vhdl-character-to-event next-input) 8751 ; pushback the char 8752 unread-command-events)))) 8753 (push (vhdl-character-to-event next-input) ; pushback the char 8754 unread-command-events) 8755 (vhdl-comment-insert))))) 8756 (self-insert-command count))) 8757 8758(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['" 8759 (interactive "p") 8760 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8761 (if (= (preceding-char) ?\() 8762 (progn (delete-char -1) (insert-char ?\[ 1)) 8763 (insert-char ?\( 1)) 8764 (self-insert-command count))) 8765 8766(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'" 8767 (interactive "p") 8768 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8769 (progn 8770 (if (= (preceding-char) ?\)) 8771 (progn (delete-char -1) (insert-char ?\] 1)) 8772 (insert-char ?\) 1)) 8773 (blink-matching-open)) 8774 (self-insert-command count))) 8775 8776(defun vhdl-electric-quote (count) "\\='\\=' --> \"" 8777 (interactive "p") 8778 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8779 (if (= (preceding-char) vhdl-last-input-event) 8780 (progn (delete-char -1) (insert-char ?\" 1)) 8781 (insert-char ?\' 1)) 8782 (self-insert-command count))) 8783 8784(defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '" 8785 (interactive "p") 8786 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8787 (cond ((= (preceding-char) vhdl-last-input-event) 8788 (progn (delete-char -1) 8789 (unless (eq (preceding-char) ? ) (insert " ")) 8790 (insert ": ") 8791 (setq this-command 'vhdl-electric-colon))) 8792 ((and 8793 (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) 8794 (progn (delete-char -1) (insert "= "))) 8795 (t (insert-char ?\; 1))) 8796 (self-insert-command count))) 8797 8798(defun vhdl-electric-comma (count) "`,,' --> ` <= '" 8799 (interactive "p") 8800 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8801 (cond ((= (preceding-char) vhdl-last-input-event) 8802 (progn (delete-char -1) 8803 (unless (eq (preceding-char) ? ) (insert " ")) 8804 (insert "<= "))) 8805 (t (insert-char ?\, 1))) 8806 (self-insert-command count))) 8807 8808(defun vhdl-electric-period (count) "`..' --> ` => '" 8809 (interactive "p") 8810 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8811 (cond ((= (preceding-char) vhdl-last-input-event) 8812 (progn (delete-char -1) 8813 (unless (eq (preceding-char) ? ) (insert " ")) 8814 (insert "=> "))) 8815 (t (insert-char ?\. 1))) 8816 (self-insert-command count))) 8817 8818(defun vhdl-electric-equal (count) "`==' --> ` == '" 8819 (interactive "p") 8820 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8821 (cond ((= (preceding-char) vhdl-last-input-event) 8822 (progn (delete-char -1) 8823 (unless (eq (preceding-char) ? ) (insert " ")) 8824 (insert "== "))) 8825 (t (insert-char ?\= 1))) 8826 (self-insert-command count))) 8827 8828;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8829;; VHDL templates 8830 8831(defun vhdl-template-paired-parens () 8832 "Insert a pair of round parentheses, placing point between them." 8833 (interactive) 8834 (insert "()") 8835 (backward-char)) 8836 8837(defun vhdl-template-alias () 8838 "Insert alias declaration." 8839 (interactive) 8840 (let ((start (point))) 8841 (vhdl-insert-keyword "ALIAS ") 8842 (when (vhdl-template-field "name" nil t start (point)) 8843 (insert " : ") 8844 (unless (vhdl-template-field 8845 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") 8846 nil t) 8847 (delete-char -3)) 8848 (vhdl-insert-keyword " IS ") 8849 (vhdl-template-field "name" ";") 8850 (vhdl-comment-insert-inline)))) 8851 8852(defun vhdl-template-architecture () 8853 "Insert architecture." 8854 (interactive) 8855 (let ((margin (current-indentation)) 8856 (start (point)) 8857 arch-name) 8858 (vhdl-insert-keyword "ARCHITECTURE ") 8859 (when (setq arch-name 8860 (vhdl-template-field "name" nil t start (point))) 8861 (vhdl-insert-keyword " OF ") 8862 (if (save-excursion 8863 (vhdl-prepare-search-1 8864 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) 8865 (insert (match-string 1)) 8866 (vhdl-template-field "entity name")) 8867 (vhdl-insert-keyword " IS\n") 8868 (vhdl-template-begin-end 8869 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin 8870 (memq vhdl-insert-empty-lines '(unit all)))))) 8871 8872(defun vhdl-template-array (kind &optional secondary) 8873 "Insert array type definition." 8874 (interactive) 8875 (let ((start (point))) 8876 (vhdl-insert-keyword "ARRAY (") 8877 (when (or (vhdl-template-field "range" nil (not secondary) start (point)) 8878 secondary) 8879 (vhdl-insert-keyword ") OF ") 8880 (vhdl-template-field (if (eq kind 'type) "type" "nature")) 8881 (vhdl-insert-keyword ";")))) 8882 8883(defun vhdl-template-assert () 8884 "Insert an assertion statement." 8885 (interactive) 8886 (let ((start (point))) 8887 (vhdl-insert-keyword "ASSERT ") 8888 (when vhdl-conditions-in-parenthesis (insert "(")) 8889 (when (vhdl-template-field "condition (negated)" nil t start (point)) 8890 (when vhdl-conditions-in-parenthesis (insert ")")) 8891 (setq start (point)) 8892 (vhdl-insert-keyword " REPORT ") 8893 (unless (vhdl-template-field "string expression" nil nil nil nil t) 8894 (delete-region start (point))) 8895 (setq start (point)) 8896 (vhdl-insert-keyword " SEVERITY ") 8897 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 8898 (delete-region start (point))) 8899 (insert ";")))) 8900 8901(defun vhdl-template-attribute () 8902 "Insert an attribute declaration or specification." 8903 (interactive) 8904 (if (eq (vhdl-decision-query 8905 "attribute" "(d)eclaration or (s)pecification?" t) ?s) 8906 (vhdl-template-attribute-spec) 8907 (vhdl-template-attribute-decl))) 8908 8909(defun vhdl-template-attribute-decl () 8910 "Insert an attribute declaration." 8911 (interactive) 8912 (let ((start (point))) 8913 (vhdl-insert-keyword "ATTRIBUTE ") 8914 (when (vhdl-template-field "name" " : " t start (point)) 8915 (vhdl-template-field "type" ";") 8916 (vhdl-comment-insert-inline)))) 8917 8918(defun vhdl-template-attribute-spec () 8919 "Insert an attribute specification." 8920 (interactive) 8921 (let ((start (point))) 8922 (vhdl-insert-keyword "ATTRIBUTE ") 8923 (when (vhdl-template-field "name" nil t start (point)) 8924 (vhdl-insert-keyword " OF ") 8925 (vhdl-template-field "entity names | OTHERS | ALL" " : ") 8926 (vhdl-template-field "entity class") 8927 (vhdl-insert-keyword " IS ") 8928 (vhdl-template-field "expression" ";")))) 8929 8930(defun vhdl-template-block () 8931 "Insert a block." 8932 (interactive) 8933 (let ((margin (current-indentation)) 8934 (start (point)) 8935 label) 8936 (vhdl-insert-keyword ": BLOCK ") 8937 (goto-char start) 8938 (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) 8939 (forward-word-strictly 1) 8940 (forward-char 1) 8941 (insert "(") 8942 (if (vhdl-template-field "[guard expression]" nil t) 8943 (insert ")") 8944 (delete-char -2)) 8945 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 8946 (insert "\n") 8947 (vhdl-template-begin-end "BLOCK" label margin) 8948 (vhdl-comment-block)))) 8949 8950(defun vhdl-template-block-configuration () 8951 "Insert a block configuration statement." 8952 (interactive) 8953 (let ((margin (current-indentation)) 8954 (start (point))) 8955 (vhdl-insert-keyword "FOR ") 8956 (when (vhdl-template-field "block name" nil t start (point)) 8957 (vhdl-insert-keyword "\n\n") 8958 (indent-to margin) 8959 (vhdl-insert-keyword "END FOR;") 8960 (end-of-line 0) 8961 (indent-to (+ margin vhdl-basic-offset))))) 8962 8963(defun vhdl-template-break () 8964 "Insert a break statement." 8965 (interactive) 8966 (let (position) 8967 (vhdl-insert-keyword "BREAK") 8968 (setq position (point)) 8969 (insert " ") 8970 (while (or 8971 (progn (vhdl-insert-keyword "FOR ") 8972 (if (vhdl-template-field "[quantity name]" " USE " t) 8973 (progn (vhdl-template-field "quantity name" " => ") t) 8974 (delete-region (point) 8975 (progn (forward-word-strictly -1) (point))) 8976 nil)) 8977 (vhdl-template-field "[quantity name]" " => " t)) 8978 (vhdl-template-field "expression") 8979 (setq position (point)) 8980 (insert ", ")) 8981 (delete-region position (point)) 8982 (unless (vhdl-sequential-statement-p) 8983 (vhdl-insert-keyword " ON ") 8984 (if (vhdl-template-field "[sensitivity list]" nil t) 8985 (setq position (point)) 8986 (delete-region position (point)))) 8987 (vhdl-insert-keyword " WHEN ") 8988 (when vhdl-conditions-in-parenthesis (insert "(")) 8989 (if (vhdl-template-field "[condition]" nil t) 8990 (when vhdl-conditions-in-parenthesis (insert ")")) 8991 (delete-region position (point))) 8992 (insert ";"))) 8993 8994(defun vhdl-template-case (&optional kind) 8995 "Insert a case statement." 8996 (interactive) 8997 (let ((margin (current-indentation)) 8998 (start (point)) 8999 label) 9000 (unless kind (setq kind (if (or (vhdl-sequential-statement-p) 9001 (not (vhdl-standard-p 'ams))) 'is 'use))) 9002 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 9003 (vhdl-insert-keyword "CASE ") 9004 (vhdl-insert-keyword ": CASE ") 9005 (goto-char start) 9006 (setq label (vhdl-template-field "[label]" nil t)) 9007 (unless label (delete-char 2)) 9008 (forward-word-strictly 1) 9009 (forward-char 1)) 9010 (when (vhdl-template-field "expression" nil t start (point)) 9011 (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) 9012 (indent-to margin) 9013 (vhdl-insert-keyword "END CASE") 9014 (when label (insert " " label)) 9015 (insert ";") 9016 (forward-line -1) 9017 (indent-to (+ margin vhdl-basic-offset)) 9018 (vhdl-insert-keyword "WHEN ") 9019 (let ((position (point))) 9020 (insert " => ;\n") 9021 (indent-to (+ margin vhdl-basic-offset)) 9022 (vhdl-insert-keyword "WHEN OTHERS => null;") 9023 (goto-char position))))) 9024 9025(defun vhdl-template-case-is () 9026 "Insert a sequential case statement." 9027 (interactive) 9028 (vhdl-template-case 'is)) 9029 9030(defun vhdl-template-case-use () 9031 "Insert a simultaneous case statement." 9032 (interactive) 9033 (vhdl-template-case 'use)) 9034 9035(defun vhdl-template-component () 9036 "Insert a component declaration." 9037 (interactive) 9038 (vhdl-template-component-decl)) 9039 9040(defun vhdl-template-component-conf () 9041 "Insert a component configuration (uses `vhdl-template-configuration-spec' 9042since these are almost equivalent)." 9043 (interactive) 9044 (let ((margin (current-indentation)) 9045 (result (vhdl-template-configuration-spec t))) 9046 (when result 9047 (insert "\n") 9048 (indent-to margin) 9049 (vhdl-insert-keyword "END FOR;") 9050 (when (eq result 'no-use) 9051 (end-of-line -0))))) 9052 9053(defun vhdl-template-component-decl () 9054 "Insert a component declaration." 9055 (interactive) 9056 (let ((margin (current-indentation)) 9057 (start (point)) 9058 name end-column) 9059 (vhdl-insert-keyword "COMPONENT ") 9060 (when (setq name (vhdl-template-field "name" nil t start (point))) 9061 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 9062 (insert "\n\n") 9063 (indent-to margin) 9064 (vhdl-insert-keyword "END COMPONENT") 9065 (unless (vhdl-standard-p '87) (insert " " name)) 9066 (insert ";") 9067 (setq end-column (current-column)) 9068 (end-of-line -0) 9069 (indent-to (+ margin vhdl-basic-offset)) 9070 (vhdl-template-generic-list t t) 9071 (insert "\n") 9072 (indent-to (+ margin vhdl-basic-offset)) 9073 (vhdl-template-port-list t) 9074 (beginning-of-line 2) 9075 (forward-char end-column)))) 9076 9077(defun vhdl-template-component-inst () 9078 "Insert a component instantiation statement." 9079 (interactive) 9080 (let ((margin (current-indentation)) 9081 (start (point)) 9082 unit position) 9083 (when (vhdl-template-field "instance label" nil t start (point)) 9084 (insert ": ") 9085 (if (not (vhdl-use-direct-instantiation)) 9086 (vhdl-template-field "component name") 9087 ;; direct instantiation 9088 (setq unit (vhdl-template-field 9089 "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) 9090 (setq unit (upcase (or unit ""))) 9091 (cond ((equal unit "ENTITY") 9092 (let ((begin (point))) 9093 (vhdl-template-field "library name" "." t begin (point) nil 9094 (vhdl-work-library)) 9095 (vhdl-template-field "entity name" "(") 9096 (if (vhdl-template-field "[architecture name]" nil t) 9097 (insert ")") 9098 (delete-char -1)))) 9099 ((equal unit "CONFIGURATION") 9100 (vhdl-template-field "library name" "." nil nil nil nil 9101 (vhdl-work-library)) 9102 (vhdl-template-field "configuration name")) 9103 (t (vhdl-template-field "component name")))) 9104 (insert "\n") 9105 (indent-to (+ margin vhdl-basic-offset)) 9106 (setq position (point)) 9107 (vhdl-insert-keyword "GENERIC ") 9108 (when (vhdl-template-map position t t) 9109 (insert "\n") 9110 (indent-to (+ margin vhdl-basic-offset))) 9111 (setq position (point)) 9112 (vhdl-insert-keyword "PORT ") 9113 (unless (vhdl-template-map position t t) 9114 (delete-region (line-beginning-position) (point)) 9115 (delete-char -1)) 9116 (insert ";")))) 9117 9118(defun vhdl-template-conditional-signal-asst () 9119 "Insert a conditional signal assignment." 9120 (interactive) 9121 (when (vhdl-template-field "target signal") 9122 (insert " <= ") 9123 (let ((margin (current-column)) 9124 (start (point)) 9125 position) 9126 (vhdl-template-field "waveform") 9127 (setq position (point)) 9128 (vhdl-insert-keyword " WHEN ") 9129 (when vhdl-conditions-in-parenthesis (insert "(")) 9130 (while (and (vhdl-template-field "[condition]" nil t) 9131 (progn 9132 (when vhdl-conditions-in-parenthesis (insert ")")) 9133 (setq position (point)) 9134 (vhdl-insert-keyword " ELSE") 9135 (insert "\n") 9136 (indent-to margin) 9137 (vhdl-template-field "[waveform]" nil t))) 9138 (setq position (point)) 9139 (vhdl-insert-keyword " WHEN ") 9140 (when vhdl-conditions-in-parenthesis (insert "("))) 9141 (delete-region position (point)) 9142 (insert ";") 9143 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 9144 9145(defun vhdl-template-configuration () 9146 "Insert a configuration specification if within an architecture, 9147a block or component configuration if within a configuration declaration, 9148a configuration declaration if not within a design unit." 9149 (interactive) 9150 (vhdl-prepare-search-1 9151 (cond 9152 ((and (save-excursion ; architecture body 9153 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) 9154 (equal "ARCHITECTURE" (upcase (match-string 1)))) 9155 (vhdl-template-configuration-spec)) 9156 ((and (save-excursion ; configuration declaration 9157 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9158 (equal "CONFIGURATION" (upcase (match-string 1)))) 9159 (if (eq (vhdl-decision-query 9160 "configuration" "(b)lock or (c)omponent configuration?" t) ?c) 9161 (vhdl-template-component-conf) 9162 (vhdl-template-block-configuration))) 9163 (t (vhdl-template-configuration-decl))))) ; otherwise 9164 9165(defun vhdl-template-configuration-spec (&optional optional-use) 9166 "Insert a configuration specification." 9167 (interactive) 9168 (let ((margin (current-indentation)) 9169 (start (point)) 9170 aspect position) 9171 (vhdl-insert-keyword "FOR ") 9172 (when (vhdl-template-field "instance names | OTHERS | ALL" " : " 9173 t start (point)) 9174 (vhdl-template-field "component name" "\n") 9175 (indent-to (+ margin vhdl-basic-offset)) 9176 (setq start (point)) 9177 (vhdl-insert-keyword "USE ") 9178 (if (and optional-use 9179 (not (setq aspect (vhdl-template-field 9180 "[ENTITY | CONFIGURATION | OPEN]" " " t)))) 9181 (progn (delete-region start (point)) 'no-use) 9182 (unless optional-use 9183 (setq aspect (vhdl-template-field 9184 "ENTITY | CONFIGURATION | OPEN" " "))) 9185 (setq aspect (upcase (or aspect ""))) 9186 (cond ((equal aspect "ENTITY") 9187 (vhdl-template-field "library name" "." nil nil nil nil 9188 (vhdl-work-library)) 9189 (vhdl-template-field "entity name" "(") 9190 (if (vhdl-template-field "[architecture name]" nil t) 9191 (insert ")") 9192 (delete-char -1)) 9193 (insert "\n") 9194 (indent-to (+ margin (* 2 vhdl-basic-offset))) 9195 (setq position (point)) 9196 (vhdl-insert-keyword "GENERIC ") 9197 (when (vhdl-template-map position t t) 9198 (insert "\n") 9199 (indent-to (+ margin (* 2 vhdl-basic-offset)))) 9200 (setq position (point)) 9201 (vhdl-insert-keyword "PORT ") 9202 (unless (vhdl-template-map position t t) 9203 (delete-region (line-beginning-position) (point)) 9204 (delete-char -1)) 9205 (insert ";") 9206 t) 9207 ((equal aspect "CONFIGURATION") 9208 (vhdl-template-field "library name" "." nil nil nil nil 9209 (vhdl-work-library)) 9210 (vhdl-template-field "configuration name" ";")) 9211 (t (delete-char -1) (insert ";") t)))))) 9212 9213 9214(defun vhdl-template-configuration-decl () 9215 "Insert a configuration declaration." 9216 (interactive) 9217 (let ((margin (current-indentation)) 9218 (start (point)) 9219 entity-exists string name position) 9220 (vhdl-insert-keyword "CONFIGURATION ") 9221 (when (setq name (vhdl-template-field "name" nil t start (point))) 9222 (vhdl-insert-keyword " OF ") 9223 (save-excursion 9224 (vhdl-prepare-search-1 9225 (setq entity-exists (vhdl-re-search-backward 9226 "\\<entity \\(\\w*\\) is\\>" nil t)) 9227 (setq string (match-string 1)))) 9228 (if (and entity-exists (not (equal string ""))) 9229 (insert string) 9230 (vhdl-template-field "entity name")) 9231 (vhdl-insert-keyword " IS\n") 9232 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9233 (indent-to (+ margin vhdl-basic-offset)) 9234 (setq position (point)) 9235 (insert "\n") 9236 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9237 (indent-to margin) 9238 (vhdl-insert-keyword "END ") 9239 (unless (vhdl-standard-p '87) 9240 (vhdl-insert-keyword "CONFIGURATION ")) 9241 (insert name ";") 9242 (goto-char position)))) 9243 9244(defun vhdl-template-constant () 9245 "Insert a constant declaration." 9246 (interactive) 9247 (let ((start (point)) 9248 (in-arglist (vhdl-in-argument-list-p))) 9249 (vhdl-insert-keyword "CONSTANT ") 9250 (when (vhdl-template-field "name" nil t start (point)) 9251 (insert " : ") 9252 (when in-arglist (vhdl-insert-keyword "IN ")) 9253 (vhdl-template-field "type") 9254 (if in-arglist 9255 (progn (insert ";") 9256 (vhdl-comment-insert-inline)) 9257 (let ((position (point))) 9258 (insert " := ") 9259 (unless (vhdl-template-field "[initialization]" nil t) 9260 (delete-region position (point))) 9261 (insert ";") 9262 (vhdl-comment-insert-inline)))))) 9263 9264(defun vhdl-template-context () 9265 "Insert a context declaration." 9266 (interactive) 9267 (let ((margin (current-indentation)) 9268 (start (point)) 9269 entity-exists string name position) 9270 (vhdl-insert-keyword "CONTEXT ") 9271 (when (setq name (vhdl-template-field "name" nil t start (point))) 9272 (vhdl-insert-keyword " IS\n") 9273 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9274 (indent-to (+ margin vhdl-basic-offset)) 9275 (setq position (point)) 9276 (insert "\n") 9277 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9278 (indent-to margin) 9279 (vhdl-insert-keyword "END ") 9280 (unless (vhdl-standard-p '87) 9281 (vhdl-insert-keyword "CONTEXT ")) 9282 (insert name ";") 9283 (goto-char position)))) 9284 9285(defun vhdl-template-default () 9286 "Insert nothing." 9287 (interactive) 9288 (insert " ") 9289 (unexpand-abbrev) 9290 (backward-word-strictly 1) 9291 (vhdl-case-word 1) 9292 (forward-char 1)) 9293 9294(defun vhdl-template-default-indent () 9295 "Insert nothing and indent." 9296 (interactive) 9297 (insert " ") 9298 (unexpand-abbrev) 9299 (backward-word-strictly 1) 9300 (vhdl-case-word 1) 9301 (forward-char 1) 9302 (indent-according-to-mode)) 9303 9304(defun vhdl-template-disconnect () 9305 "Insert a disconnect statement." 9306 (interactive) 9307 (let ((start (point))) 9308 (vhdl-insert-keyword "DISCONNECT ") 9309 (when (vhdl-template-field "signal names | OTHERS | ALL" 9310 " : " t start (point)) 9311 (vhdl-template-field "type") 9312 (vhdl-insert-keyword " AFTER ") 9313 (vhdl-template-field "time expression" ";")))) 9314 9315(defun vhdl-template-else () 9316 "Insert an else statement." 9317 (interactive) 9318 (let (margin) 9319 (vhdl-prepare-search-1 9320 (vhdl-insert-keyword "ELSE") 9321 (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t)) 9322 (match-string 2)) 9323 (insert " ") 9324 (unless (vhdl-sequential-statement-p) 9325 (vhdl-insert-keyword " GENERATE")) 9326 (indent-according-to-mode) 9327 (setq margin (current-indentation)) 9328 (insert "\n") 9329 (indent-to (+ margin vhdl-basic-offset)))))) 9330 9331(defun vhdl-template-elsif () 9332 "Insert an elsif statement." 9333 (interactive) 9334 (let ((start (point)) 9335 margin) 9336 (vhdl-insert-keyword "ELSIF ") 9337 (when vhdl-conditions-in-parenthesis (insert "(")) 9338 (when (vhdl-template-field "condition" nil t start (point)) 9339 (when vhdl-conditions-in-parenthesis (insert ")")) 9340 (indent-according-to-mode) 9341 (setq margin (current-indentation)) 9342 (vhdl-insert-keyword 9343 (concat " " (cond ((vhdl-sequential-statement-p) "THEN") 9344 ((vhdl-standard-p 'ams) "USE") 9345 (t "GENERATE")) "\n")) 9346 (indent-to (+ margin vhdl-basic-offset))))) 9347 9348(defun vhdl-template-entity () 9349 "Insert an entity." 9350 (interactive) 9351 (let ((margin (current-indentation)) 9352 (start (point)) 9353 name end-column) 9354 (vhdl-insert-keyword "ENTITY ") 9355 (when (setq name (vhdl-template-field "name" nil t start (point))) 9356 (vhdl-insert-keyword " IS\n\n") 9357 (indent-to margin) 9358 (vhdl-insert-keyword "END ") 9359 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 9360 (insert name ";") 9361 (setq end-column (current-column)) 9362 (end-of-line -0) 9363 (indent-to (+ margin vhdl-basic-offset)) 9364 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9365 (indent-to (+ margin vhdl-basic-offset)) 9366 (when (vhdl-template-generic-list t) 9367 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 9368 (insert "\n") 9369 (indent-to (+ margin vhdl-basic-offset)) 9370 (when (vhdl-template-port-list t) 9371 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 9372 (beginning-of-line 2) 9373 (forward-char end-column)))) 9374 9375(defun vhdl-template-exit () 9376 "Insert an exit statement." 9377 (interactive) 9378 (let ((start (point))) 9379 (vhdl-insert-keyword "EXIT ") 9380 (if (vhdl-template-field "[loop label]" nil t start (point)) 9381 (let ((position (point))) 9382 (vhdl-insert-keyword " WHEN ") 9383 (when vhdl-conditions-in-parenthesis (insert "(")) 9384 (if (vhdl-template-field "[condition]" nil t) 9385 (when vhdl-conditions-in-parenthesis (insert ")")) 9386 (delete-region position (point)))) 9387 (delete-char -1)) 9388 (insert ";"))) 9389 9390(defun vhdl-template-file () 9391 "Insert a file declaration." 9392 (interactive) 9393 (let ((start (point))) 9394 (vhdl-insert-keyword "FILE ") 9395 (when (vhdl-template-field "name" nil t start (point)) 9396 (insert " : ") 9397 (vhdl-template-field "type") 9398 (unless (vhdl-standard-p '87) 9399 (vhdl-insert-keyword " OPEN ") 9400 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" 9401 nil t) 9402 (delete-char -6))) 9403 (vhdl-insert-keyword " IS ") 9404 (when (vhdl-standard-p '87) 9405 (vhdl-template-field "[IN | OUT]" " " t)) 9406 (vhdl-template-field "filename-string" nil nil nil nil t) 9407 (insert ";") 9408 (vhdl-comment-insert-inline)))) 9409 9410(defun vhdl-template-for () 9411 "Insert a block or component configuration if within a configuration 9412declaration, a configuration specification if within an architecture 9413declarative part (and not within a subprogram), a for-loop if within a 9414sequential statement part (subprogram or process), and a for-generate 9415otherwise." 9416 (interactive) 9417 (vhdl-prepare-search-1 9418 (cond 9419 ((vhdl-sequential-statement-p) ; sequential statement 9420 (vhdl-template-for-loop)) 9421 ((and (save-excursion ; configuration declaration 9422 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9423 (equal "CONFIGURATION" (upcase (match-string 1)))) 9424 (if (eq (vhdl-decision-query 9425 "for" "(b)lock or (c)omponent configuration?" t) ?c) 9426 (vhdl-template-component-conf) 9427 (vhdl-template-block-configuration))) 9428 ((and (save-excursion 9429 (re-search-backward ; architecture declarative part 9430 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) 9431 (equal "ARCHITECTURE" (upcase (match-string 1)))) 9432 (vhdl-template-configuration-spec)) 9433 (t (vhdl-template-for-generate))))) ; concurrent statement 9434 9435(defun vhdl-template-for-generate () 9436 "Insert a for-generate." 9437 (interactive) 9438 (let ((margin (current-indentation)) 9439 (start (point)) 9440 label position) 9441 (vhdl-insert-keyword ": FOR ") 9442 (setq position (point-marker)) 9443 (goto-char start) 9444 (when (setq label (vhdl-template-field "label" nil t start position)) 9445 (goto-char position) 9446 (vhdl-template-field "loop variable") 9447 (vhdl-insert-keyword " IN ") 9448 (vhdl-template-field "range") 9449 (vhdl-template-generate-body margin label)))) 9450 9451(defun vhdl-template-for-loop () 9452 "Insert a for loop." 9453 (interactive) 9454 (let ((margin (current-indentation)) 9455 (start (point)) 9456 label index) 9457 (if (not (eq vhdl-optional-labels 'all)) 9458 (vhdl-insert-keyword "FOR ") 9459 (vhdl-insert-keyword ": FOR ") 9460 (goto-char start) 9461 (setq label (vhdl-template-field "[label]" nil t)) 9462 (unless label (delete-char 2)) 9463 (forward-word-strictly 1) 9464 (forward-char 1)) 9465 (when (setq index (vhdl-template-field "loop variable" 9466 nil t start (point))) 9467 (vhdl-insert-keyword " IN ") 9468 (vhdl-template-field "range") 9469 (vhdl-insert-keyword " LOOP\n\n") 9470 (indent-to margin) 9471 (vhdl-insert-keyword "END LOOP") 9472 (if label 9473 (insert " " label ";") 9474 (insert ";") 9475 (when vhdl-self-insert-comments (insert " -- " index))) 9476 (forward-line -1) 9477 (indent-to (+ margin vhdl-basic-offset))))) 9478 9479(defun vhdl-template-function (&optional kind) 9480 "Insert a function declaration or body." 9481 (interactive) 9482 (let ((margin (current-indentation)) 9483 (start (point)) 9484 name) 9485 (vhdl-insert-keyword "FUNCTION ") 9486 (when (setq name (vhdl-template-field "name" nil t start (point))) 9487 (vhdl-template-argument-list t) 9488 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9489 (end-of-line) 9490 (insert "\n") 9491 (indent-to (+ margin vhdl-basic-offset)) 9492 (vhdl-insert-keyword "RETURN ") 9493 (vhdl-template-field "type") 9494 (if (if kind (eq kind 'body) 9495 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 9496 (progn (vhdl-insert-keyword " IS\n") 9497 (vhdl-template-begin-end 9498 (unless (vhdl-standard-p '87) "FUNCTION") name margin) 9499 (vhdl-comment-block)) 9500 (insert ";"))))) 9501 9502(defun vhdl-template-function-decl () 9503 "Insert a function declaration." 9504 (interactive) 9505 (vhdl-template-function 'decl)) 9506 9507(defun vhdl-template-function-body () 9508 "Insert a function declaration." 9509 (interactive) 9510 (vhdl-template-function 'body)) 9511 9512(defun vhdl-template-generate () 9513 "Insert a generation scheme." 9514 (interactive) 9515 (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) 9516 (vhdl-template-if-generate) 9517 (vhdl-template-for-generate))) 9518 9519(defun vhdl-template-generic () 9520 "Insert generic declaration, or generic map in instantiation statements." 9521 (interactive) 9522 (let ((start (point))) 9523 (vhdl-prepare-search-1 9524 (cond 9525 ((and (save-excursion ; entity declaration 9526 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 9527 (equal "ENTITY" (upcase (match-string 1)))) 9528 (vhdl-template-generic-list nil)) 9529 ((or (save-excursion 9530 (or (beginning-of-line) 9531 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 9532 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 9533 (vhdl-insert-keyword "GENERIC ") 9534 (vhdl-template-map start)) 9535 (t (vhdl-template-generic-list nil t)))))) 9536 9537(defun vhdl-template-group () 9538 "Insert group or group template declaration." 9539 (interactive) 9540 (let ((start (point))) 9541 (if (eq (vhdl-decision-query 9542 "group" "(d)eclaration or (t)emplate declaration?" t) ?t) 9543 (vhdl-template-group-template) 9544 (vhdl-template-group-decl)))) 9545 9546(defun vhdl-template-group-decl () 9547 "Insert group declaration." 9548 (interactive) 9549 (let ((start (point))) 9550 (vhdl-insert-keyword "GROUP ") 9551 (when (vhdl-template-field "name" " : " t start (point)) 9552 (vhdl-template-field "template name" " (") 9553 (vhdl-template-field "constituent list" ");") 9554 (vhdl-comment-insert-inline)))) 9555 9556(defun vhdl-template-group-template () 9557 "Insert group template declaration." 9558 (interactive) 9559 (let ((start (point))) 9560 (vhdl-insert-keyword "GROUP ") 9561 (when (vhdl-template-field "template name" nil t start (point)) 9562 (vhdl-insert-keyword " IS (") 9563 (vhdl-template-field "entity class list" ");") 9564 (vhdl-comment-insert-inline)))) 9565 9566(defun vhdl-template-if () 9567 "Insert a sequential if statement or an if-generate statement." 9568 (interactive) 9569 (if (vhdl-sequential-statement-p) 9570 (vhdl-template-if-then) 9571 (if (and (vhdl-standard-p 'ams) 9572 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) 9573 (vhdl-template-if-use) 9574 (vhdl-template-if-generate)))) 9575 9576(defun vhdl-template-if-generate () 9577 "Insert an if-generate." 9578 (interactive) 9579 (let ((margin (current-indentation)) 9580 (start (point)) 9581 label position) 9582 (vhdl-insert-keyword ": IF ") 9583 (setq position (point-marker)) 9584 (goto-char start) 9585 (when (setq label (vhdl-template-field "label" nil t start position)) 9586 (goto-char position) 9587 (when vhdl-conditions-in-parenthesis (insert "(")) 9588 (vhdl-template-field "condition") 9589 (when vhdl-conditions-in-parenthesis (insert ")")) 9590 (vhdl-template-generate-body margin label)))) 9591 9592(defun vhdl-template-if-then-use (kind) 9593 "Insert a sequential if statement." 9594 (interactive) 9595 (let ((margin (current-indentation)) 9596 (start (point)) 9597 label) 9598 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 9599 (vhdl-insert-keyword "IF ") 9600 (vhdl-insert-keyword ": IF ") 9601 (goto-char start) 9602 (setq label (vhdl-template-field "[label]" nil t)) 9603 (unless label (delete-char 2)) 9604 (forward-word-strictly 1) 9605 (forward-char 1)) 9606 (when vhdl-conditions-in-parenthesis (insert "(")) 9607 (when (vhdl-template-field "condition" nil t start (point)) 9608 (when vhdl-conditions-in-parenthesis (insert ")")) 9609 (vhdl-insert-keyword 9610 (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) 9611 (indent-to margin) 9612 (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE"))) 9613 (when label (insert " " label)) 9614 (insert ";") 9615 (forward-line -1) 9616 (indent-to (+ margin vhdl-basic-offset))))) 9617 9618(defun vhdl-template-if-then () 9619 "Insert a sequential if statement." 9620 (interactive) 9621 (vhdl-template-if-then-use 'then)) 9622 9623(defun vhdl-template-if-use () 9624 "Insert a simultaneous if statement." 9625 (interactive) 9626 (vhdl-template-if-then-use 'use)) 9627 9628(defun vhdl-template-instance () 9629 "Insert a component instantiation statement." 9630 (interactive) 9631 (vhdl-template-component-inst)) 9632 9633(defun vhdl-template-library () 9634 "Insert a library specification." 9635 (interactive) 9636 (let ((margin (current-indentation)) 9637 (start (point)) 9638 name end-pos) 9639 (vhdl-insert-keyword "LIBRARY ") 9640 (when (setq name (vhdl-template-field "names" nil t start (point))) 9641 (insert ";") 9642 (unless (string-match "," name) 9643 (setq end-pos (point)) 9644 (insert "\n") 9645 (indent-to margin) 9646 (vhdl-insert-keyword "USE ") 9647 (insert name) 9648 (vhdl-insert-keyword "..ALL;") 9649 (backward-char 5) 9650 (if (vhdl-template-field "package name") 9651 (forward-char 5) 9652 (delete-region end-pos (+ (point) 5))))))) 9653 9654(defun vhdl-template-limit () 9655 "Insert a limit." 9656 (interactive) 9657 (let ((start (point))) 9658 (vhdl-insert-keyword "LIMIT ") 9659 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " 9660 t start (point)) 9661 (vhdl-template-field "type") 9662 (vhdl-insert-keyword " WITH ") 9663 (vhdl-template-field "real expression" ";")))) 9664 9665(defun vhdl-template-loop () 9666 "Insert a loop." 9667 (interactive) 9668 (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) 9669 (cond ((eq char ?w) 9670 (vhdl-template-while-loop)) 9671 ((eq char ?f) 9672 (vhdl-template-for-loop)) 9673 (t (vhdl-template-bare-loop))))) 9674 9675(defun vhdl-template-bare-loop () 9676 "Insert a loop." 9677 (interactive) 9678 (let ((margin (current-indentation)) 9679 (start (point)) 9680 label) 9681 (if (not (eq vhdl-optional-labels 'all)) 9682 (vhdl-insert-keyword "LOOP ") 9683 (vhdl-insert-keyword ": LOOP ") 9684 (goto-char start) 9685 (setq label (vhdl-template-field "[label]" nil t)) 9686 (unless label (delete-char 2)) 9687 (forward-word-strictly 1) 9688 (delete-char 1)) 9689 (insert "\n\n") 9690 (indent-to margin) 9691 (vhdl-insert-keyword "END LOOP") 9692 (insert (if label (concat " " label ";") ";")) 9693 (forward-line -1) 9694 (indent-to (+ margin vhdl-basic-offset)))) 9695 9696(defun vhdl-template-map (&optional start optional secondary) 9697 "Insert a map specification with association list." 9698 (interactive) 9699 (let ((start (or start (point))) 9700 margin end-pos) 9701 (vhdl-insert-keyword "MAP (") 9702 (if (not vhdl-association-list-with-formals) 9703 (if (vhdl-template-field 9704 (concat (and optional "[") "association list" (and optional "]")) 9705 ")" (or (not secondary) optional) 9706 (and (not secondary) start) (point)) 9707 t 9708 (if (and optional secondary) (delete-region start (point))) 9709 nil) 9710 (if vhdl-argument-list-indent 9711 (setq margin (current-column)) 9712 (setq margin (+ (current-indentation) vhdl-basic-offset)) 9713 (insert "\n") 9714 (indent-to margin)) 9715 (if (vhdl-template-field 9716 (concat (and optional "[") "formal" (and optional "]")) 9717 " => " (or (not secondary) optional) 9718 (and (not secondary) start) (point)) 9719 (progn 9720 (vhdl-template-field "actual" ",") 9721 (setq end-pos (point)) 9722 (insert "\n") 9723 (indent-to margin) 9724 (while (vhdl-template-field "[formal]" " => " t) 9725 (vhdl-template-field "actual" ",") 9726 (setq end-pos (point)) 9727 (insert "\n") 9728 (indent-to margin)) 9729 (delete-region end-pos (point)) 9730 (delete-char -1) 9731 (insert ")") 9732 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9733 t) 9734 (when (and optional secondary) (delete-region start (point))) 9735 nil)))) 9736 9737(defun vhdl-template-modify (&optional noerror) 9738 "Actualize modification date." 9739 (interactive) 9740 (vhdl-prepare-search-2 9741 (save-excursion 9742 (goto-char (point-min)) 9743 (if (re-search-forward vhdl-modify-date-prefix-string nil t) 9744 (progn (delete-region (point) (progn (end-of-line) (point))) 9745 (vhdl-template-insert-date)) 9746 (unless noerror 9747 (error "ERROR: Modification date prefix string \"%s\" not found" 9748 vhdl-modify-date-prefix-string)))))) 9749 9750 9751(defun vhdl-template-modify-noerror () 9752 "Call `vhdl-template-modify' with NOERROR non-nil." 9753 (vhdl-template-modify t)) 9754 9755(defun vhdl-template-nature () 9756 "Insert a nature declaration." 9757 (interactive) 9758 (let ((start (point)) 9759 name mid-pos end-pos) 9760 (vhdl-insert-keyword "NATURE ") 9761 (when (setq name (vhdl-template-field "name" nil t start (point))) 9762 (vhdl-insert-keyword " IS ") 9763 (let ((definition 9764 (upcase 9765 (or (vhdl-template-field 9766 "across type | ARRAY | RECORD") 9767 "")))) 9768 (cond ((equal definition "") 9769 (insert ";")) 9770 ((equal definition "ARRAY") 9771 (delete-region (point) (progn (forward-word-strictly -1) 9772 (point))) 9773 (vhdl-template-array 'nature t)) 9774 ((equal definition "RECORD") 9775 (setq mid-pos (point-marker)) 9776 (delete-region (point) (progn (forward-word-strictly -1) 9777 (point))) 9778 (vhdl-template-record 'nature name t)) 9779 (t 9780 (vhdl-insert-keyword " ACROSS ") 9781 (vhdl-template-field "through type") 9782 (vhdl-insert-keyword " THROUGH ") 9783 (vhdl-template-field "reference name") 9784 (vhdl-insert-keyword " REFERENCE;"))) 9785 (when mid-pos 9786 (setq end-pos (point-marker)) 9787 (goto-char mid-pos) 9788 (end-of-line)) 9789 (vhdl-comment-insert-inline) 9790 (when end-pos (goto-char end-pos)))))) 9791 9792(defun vhdl-template-next () 9793 "Insert a next statement." 9794 (interactive) 9795 (let ((start (point))) 9796 (vhdl-insert-keyword "NEXT ") 9797 (if (vhdl-template-field "[loop label]" nil t start (point)) 9798 (let ((position (point))) 9799 (vhdl-insert-keyword " WHEN ") 9800 (when vhdl-conditions-in-parenthesis (insert "(")) 9801 (if (vhdl-template-field "[condition]" nil t) 9802 (when vhdl-conditions-in-parenthesis (insert ")")) 9803 (delete-region position (point)))) 9804 (delete-char -1)) 9805 (insert ";"))) 9806 9807(defun vhdl-template-others () 9808 "Insert an others aggregate." 9809 (interactive) 9810 (let ((start (point))) 9811 (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) 9812 (progn (unless vhdl-template-invoked-by-hook (insert "(")) 9813 (vhdl-insert-keyword "OTHERS => '") 9814 (when (vhdl-template-field "value" nil t start (point)) 9815 (insert "')"))) 9816 (vhdl-insert-keyword "OTHERS ")))) 9817 9818(defun vhdl-template-package (&optional kind) 9819 "Insert a package specification or body." 9820 (interactive) 9821 (let ((margin (current-indentation)) 9822 (start (point)) 9823 name body position) 9824 (vhdl-insert-keyword "PACKAGE ") 9825 (setq body (if kind (eq kind 'body) 9826 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) 9827 (when body 9828 (vhdl-insert-keyword "BODY ") 9829 (when (save-excursion 9830 (vhdl-prepare-search-1 9831 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) 9832 (insert (setq name (match-string 1))))) 9833 (when (or name 9834 (setq name (vhdl-template-field "name" nil t start (point)))) 9835 (vhdl-insert-keyword " IS\n") 9836 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9837 (indent-to (+ margin vhdl-basic-offset)) 9838 (setq position (point)) 9839 (insert "\n") 9840 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9841 (indent-to margin) 9842 (vhdl-insert-keyword "END ") 9843 (unless (vhdl-standard-p '87) 9844 (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) 9845 (insert (or name "") ";") 9846 (goto-char position)))) 9847 9848(defun vhdl-template-package-decl () 9849 "Insert a package specification." 9850 (interactive) 9851 (vhdl-template-package 'decl)) 9852 9853(defun vhdl-template-package-body () 9854 "Insert a package body." 9855 (interactive) 9856 (vhdl-template-package 'body)) 9857 9858(defun vhdl-template-port () 9859 "Insert a port declaration, or port map in instantiation statements." 9860 (interactive) 9861 (let ((start (point))) 9862 (vhdl-prepare-search-1 9863 (cond 9864 ((and (save-excursion ; entity declaration 9865 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 9866 (equal "ENTITY" (upcase (match-string 1)))) 9867 (vhdl-template-port-list nil)) 9868 ((or (save-excursion 9869 (or (beginning-of-line) 9870 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 9871 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 9872 (vhdl-insert-keyword "PORT ") 9873 (vhdl-template-map start)) 9874 (t (vhdl-template-port-list nil)))))) 9875 9876(defun vhdl-template-procedural () 9877 "Insert a procedural." 9878 (interactive) 9879 (let ((margin (current-indentation)) 9880 (start (point)) 9881 (case-fold-search t) 9882 label) 9883 (vhdl-insert-keyword "PROCEDURAL ") 9884 (when (memq vhdl-optional-labels '(process all)) 9885 (goto-char start) 9886 (insert ": ") 9887 (goto-char start) 9888 (setq label (vhdl-template-field "[label]" nil t)) 9889 (unless label (delete-char 2)) 9890 (forward-word-strictly 1) 9891 (forward-char 1)) 9892 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) 9893 (insert "\n") 9894 (vhdl-template-begin-end "PROCEDURAL" label margin) 9895 (vhdl-comment-block))) 9896 9897(defun vhdl-template-procedure (&optional kind) 9898 "Insert a procedure declaration or body." 9899 (interactive) 9900 (let ((margin (current-indentation)) 9901 (start (point)) 9902 name) 9903 (vhdl-insert-keyword "PROCEDURE ") 9904 (when (setq name (vhdl-template-field "name" nil t start (point))) 9905 (vhdl-template-argument-list) 9906 (if (if kind (eq kind 'body) 9907 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 9908 (progn (vhdl-insert-keyword " IS") 9909 (when vhdl-auto-align 9910 (vhdl-align-region-groups start (point) 1)) 9911 (end-of-line) (insert "\n") 9912 (vhdl-template-begin-end 9913 (unless (vhdl-standard-p '87) "PROCEDURE") 9914 name margin) 9915 (vhdl-comment-block)) 9916 (insert ";") 9917 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9918 (end-of-line))))) 9919 9920(defun vhdl-template-procedure-decl () 9921 "Insert a procedure declaration." 9922 (interactive) 9923 (vhdl-template-procedure 'decl)) 9924 9925(defun vhdl-template-procedure-body () 9926 "Insert a procedure body." 9927 (interactive) 9928 (vhdl-template-procedure 'body)) 9929 9930(defun vhdl-template-process (&optional kind) 9931 "Insert a process." 9932 (interactive) 9933 (let ((margin (current-indentation)) 9934 (start (point)) 9935 (reset-kind vhdl-reset-kind) 9936 label seq input-signals clock reset final-pos) 9937 (setq seq (if kind (eq kind 'seq) 9938 (eq (vhdl-decision-query 9939 "process" "(c)ombinational or (s)equential?" t) ?s))) 9940 (vhdl-insert-keyword "PROCESS ") 9941 (when (memq vhdl-optional-labels '(process all)) 9942 (goto-char start) 9943 (insert ": ") 9944 (goto-char start) 9945 (setq label (vhdl-template-field "[label]" nil t)) 9946 (unless label (delete-char 2)) 9947 (forward-word-strictly 1) 9948 (forward-char 1)) 9949 (insert "(") 9950 (if (not seq) 9951 (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all 9952 (progn (insert "all)") (setq input-signals "all"))) 9953 (setq input-signals 9954 (vhdl-template-field "[sensitivity list]" ")" t))) 9955 (setq input-signals "") 9956 (delete-char -2)) 9957 (setq clock (or (and (not (equal "" vhdl-clock-name)) 9958 (progn (insert vhdl-clock-name) vhdl-clock-name)) 9959 (vhdl-template-field "clock name") "<clock>")) 9960 (when (eq reset-kind 'query) 9961 (setq reset-kind 9962 (if (eq (vhdl-decision-query 9963 "" "(a)synchronous or (s)ynchronous reset?" t) ?a) 9964 'async 9965 'sync))) 9966 (when (eq reset-kind 'async) 9967 (insert ", ") 9968 (setq reset (or (and (not (equal "" vhdl-reset-name)) 9969 (progn (insert vhdl-reset-name) vhdl-reset-name)) 9970 (vhdl-template-field "reset name") "<reset>"))) 9971 (insert ")")) 9972 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 9973 (insert "\n") 9974 (vhdl-template-begin-end "PROCESS" label margin) 9975 (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind))) 9976 (when vhdl-prompt-for-comments 9977 (setq final-pos (point-marker)) 9978 (vhdl-prepare-search-2 9979 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) 9980 (vhdl-re-search-backward "\\<process\\>" nil t)) 9981 (end-of-line -0) 9982 (if (bobp) 9983 (progn (insert "\n") (forward-line -1)) 9984 (insert "\n")) 9985 (indent-to margin) 9986 (insert "-- purpose: ") 9987 (if (not (vhdl-template-field "[description]" nil t)) 9988 (vhdl-line-kill-entire) 9989 (insert "\n") 9990 (indent-to margin) 9991 (insert "-- type : ") 9992 (insert (if seq "sequential" "combinational") "\n") 9993 (indent-to margin) 9994 (insert "-- inputs : ") 9995 (if (not seq) 9996 (insert input-signals) 9997 (insert clock ", ") 9998 (when reset (insert reset ", ")) 9999 (unless (vhdl-template-field "[signal names]" nil t) 10000 (delete-char -2))) 10001 (insert "\n") 10002 (indent-to margin) 10003 (insert "-- outputs: ") 10004 (vhdl-template-field "[signal names]" nil t)))) 10005 (goto-char final-pos)))) 10006 10007(defun vhdl-template-process-comb () 10008 "Insert a combinational process." 10009 (interactive) 10010 (vhdl-template-process 'comb)) 10011 10012(defun vhdl-template-process-seq () 10013 "Insert a sequential process." 10014 (interactive) 10015 (vhdl-template-process 'seq)) 10016 10017(defun vhdl-template-quantity () 10018 "Insert a quantity declaration." 10019 (interactive) 10020 (if (vhdl-in-argument-list-p) 10021 (let ((start (point))) 10022 (vhdl-insert-keyword "QUANTITY ") 10023 (when (vhdl-template-field "names" nil t start (point)) 10024 (insert " : ") 10025 (vhdl-template-field "[IN | OUT]" " " t) 10026 (vhdl-template-field "type") 10027 (insert ";") 10028 (vhdl-comment-insert-inline))) 10029 (let ((char (vhdl-decision-query 10030 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) 10031 (cond ((eq char ?f) (vhdl-template-quantity-free)) 10032 ((eq char ?b) (vhdl-template-quantity-branch)) 10033 ((eq char ?s) (vhdl-template-quantity-source)) 10034 (t (vhdl-template-undo (point) (point))))))) 10035 10036(defun vhdl-template-quantity-free () 10037 "Insert a free quantity declaration." 10038 (interactive) 10039 (vhdl-insert-keyword "QUANTITY ") 10040 (vhdl-template-field "names") 10041 (insert " : ") 10042 (vhdl-template-field "type") 10043 (let ((position (point))) 10044 (insert " := ") 10045 (unless (vhdl-template-field "[initialization]" nil t) 10046 (delete-region position (point))) 10047 (insert ";") 10048 (vhdl-comment-insert-inline))) 10049 10050(defun vhdl-template-quantity-branch () 10051 "Insert a branch quantity declaration." 10052 (interactive) 10053 (let (position) 10054 (vhdl-insert-keyword "QUANTITY ") 10055 (when (vhdl-template-field "[across names]" " " t) 10056 (vhdl-insert-keyword "ACROSS ")) 10057 (when (vhdl-template-field "[through names]" " " t) 10058 (vhdl-insert-keyword "THROUGH ")) 10059 (vhdl-template-field "plus terminal name") 10060 (setq position (point)) 10061 (vhdl-insert-keyword " TO ") 10062 (unless (vhdl-template-field "[minus terminal name]" nil t) 10063 (delete-region position (point))) 10064 (insert ";") 10065 (vhdl-comment-insert-inline))) 10066 10067(defun vhdl-template-quantity-source () 10068 "Insert a source quantity declaration." 10069 (interactive) 10070 (vhdl-insert-keyword "QUANTITY ") 10071 (vhdl-template-field "names") 10072 (insert " : ") 10073 (vhdl-template-field "type" " ") 10074 (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) 10075 (progn (vhdl-insert-keyword "NOISE ") 10076 (vhdl-template-field "power expression")) 10077 (vhdl-insert-keyword "SPECTRUM ") 10078 (vhdl-template-field "magnitude expression" ", ") 10079 (vhdl-template-field "phase expression")) 10080 (insert ";") 10081 (vhdl-comment-insert-inline)) 10082 10083(defun vhdl-template-record (kind &optional name secondary) 10084 "Insert a record type declaration." 10085 (interactive) 10086 (let ((margin (current-indentation)) 10087 (start (point)) 10088 (first t)) 10089 (vhdl-insert-keyword "RECORD\n") 10090 (indent-to (+ margin vhdl-basic-offset)) 10091 (when (or (vhdl-template-field "element names" 10092 nil (not secondary) start (point)) 10093 secondary) 10094 (while (or first (vhdl-template-field "[element names]" nil t)) 10095 (insert " : ") 10096 (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") 10097 (vhdl-comment-insert-inline) 10098 (insert "\n") 10099 (indent-to (+ margin vhdl-basic-offset)) 10100 (setq first nil)) 10101 (delete-region (line-beginning-position) (point)) 10102 (indent-to margin) 10103 (vhdl-insert-keyword "END RECORD") 10104 (unless (vhdl-standard-p '87) (and name (insert " " name))) 10105 (insert ";") 10106 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 10107 10108(defun vhdl-template-report () 10109 "Insert a report statement." 10110 (interactive) 10111 (let ((start (point))) 10112 (vhdl-insert-keyword "REPORT ") 10113 (if (equal "\"\"" (vhdl-template-field 10114 "string expression" nil t start (point) t)) 10115 (delete-char -2) 10116 (setq start (point)) 10117 (vhdl-insert-keyword " SEVERITY ") 10118 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 10119 (delete-region start (point))) 10120 (insert ";")))) 10121 10122(defun vhdl-template-return () 10123 "Insert a return statement." 10124 (interactive) 10125 (let ((start (point))) 10126 (vhdl-insert-keyword "RETURN ") 10127 (unless (vhdl-template-field "[expression]" nil t start (point)) 10128 (delete-char -1)) 10129 (insert ";"))) 10130 10131(defun vhdl-template-selected-signal-asst () 10132 "Insert a selected signal assignment." 10133 (interactive) 10134 (let ((margin (current-indentation)) 10135 (start (point)) 10136 (choices t)) 10137 (let ((position (point))) 10138 (vhdl-insert-keyword " SELECT ") 10139 (goto-char position)) 10140 (vhdl-insert-keyword "WITH ") 10141 (when (vhdl-template-field "selector expression" 10142 nil t start (+ (point) 7)) 10143 (forward-word-strictly 1) 10144 (delete-char 1) 10145 (insert "\n") 10146 (indent-to (+ margin vhdl-basic-offset)) 10147 (vhdl-template-field "target signal" " <= ") 10148 (insert "\n") 10149 (indent-to (+ margin vhdl-basic-offset)) 10150 (vhdl-template-field "waveform") 10151 (vhdl-insert-keyword " WHEN ") 10152 (vhdl-template-field "choices" ",") 10153 (insert "\n") 10154 (indent-to (+ margin vhdl-basic-offset)) 10155 (while (and choices (vhdl-template-field "[waveform]" nil t)) 10156 (vhdl-insert-keyword " WHEN ") 10157 (if (setq choices (vhdl-template-field "[choices]" "," t)) 10158 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 10159 (vhdl-insert-keyword "OTHERS"))) 10160 (when choices 10161 (fixup-whitespace) 10162 (delete-char -2)) 10163 (insert ";") 10164 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 10165 10166(defun vhdl-template-signal () 10167 "Insert a signal declaration." 10168 (interactive) 10169 (let ((start (point)) 10170 (in-arglist (vhdl-in-argument-list-p))) 10171 (vhdl-insert-keyword "SIGNAL ") 10172 (when (vhdl-template-field "names" nil t start (point)) 10173 (insert " : ") 10174 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 10175 (vhdl-template-field "type") 10176 (if in-arglist 10177 (progn (insert ";") 10178 (vhdl-comment-insert-inline)) 10179 (let ((position (point))) 10180 (insert " := ") 10181 (unless (vhdl-template-field "[initialization]" nil t) 10182 (delete-region position (point))) 10183 (insert ";") 10184 (vhdl-comment-insert-inline)))))) 10185 10186(defun vhdl-template-subnature () 10187 "Insert a subnature declaration." 10188 (interactive) 10189 (let ((start (point)) 10190 position) 10191 (vhdl-insert-keyword "SUBNATURE ") 10192 (when (vhdl-template-field "name" nil t start (point)) 10193 (vhdl-insert-keyword " IS ") 10194 (vhdl-template-field "nature" " (") 10195 (if (vhdl-template-field "[index range]" nil t) 10196 (insert ")") 10197 (delete-char -2)) 10198 (setq position (point)) 10199 (vhdl-insert-keyword " TOLERANCE ") 10200 (if (equal "\"\"" (vhdl-template-field "[string expression]" 10201 nil t nil nil t)) 10202 (delete-region position (point)) 10203 (vhdl-insert-keyword " ACROSS ") 10204 (vhdl-template-field "string expression" nil nil nil nil t) 10205 (vhdl-insert-keyword " THROUGH")) 10206 (insert ";") 10207 (vhdl-comment-insert-inline)))) 10208 10209(defun vhdl-template-subprogram-body () 10210 "Insert a subprogram body." 10211 (interactive) 10212 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 10213 (vhdl-template-function-body) 10214 (vhdl-template-procedure-body))) 10215 10216(defun vhdl-template-subprogram-decl () 10217 "Insert a subprogram declaration." 10218 (interactive) 10219 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 10220 (vhdl-template-function-decl) 10221 (vhdl-template-procedure-decl))) 10222 10223(defun vhdl-template-subtype () 10224 "Insert a subtype declaration." 10225 (interactive) 10226 (let ((start (point))) 10227 (vhdl-insert-keyword "SUBTYPE ") 10228 (when (vhdl-template-field "name" nil t start (point)) 10229 (vhdl-insert-keyword " IS ") 10230 (vhdl-template-field "type" " ") 10231 (unless 10232 (vhdl-template-field "[RANGE value range | ( index range )]" nil t) 10233 (delete-char -1)) 10234 (insert ";") 10235 (vhdl-comment-insert-inline)))) 10236 10237(defun vhdl-template-terminal () 10238 "Insert a terminal declaration." 10239 (interactive) 10240 (let ((start (point))) 10241 (vhdl-insert-keyword "TERMINAL ") 10242 (when (vhdl-template-field "names" nil t start (point)) 10243 (insert " : ") 10244 (vhdl-template-field "nature") 10245 (insert ";") 10246 (vhdl-comment-insert-inline)))) 10247 10248(defun vhdl-template-type () 10249 "Insert a type declaration." 10250 (interactive) 10251 (let ((start (point)) 10252 name mid-pos end-pos) 10253 (vhdl-insert-keyword "TYPE ") 10254 (when (setq name (vhdl-template-field "name" nil t start (point))) 10255 (vhdl-insert-keyword " IS ") 10256 (let ((definition 10257 (upcase 10258 (or (vhdl-template-field 10259 "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) 10260 "")))) 10261 (cond ((equal definition "") 10262 (delete-char -4) 10263 (insert ";")) 10264 ((equal definition "ARRAY") 10265 (delete-region (point) (progn (forward-word-strictly -1) 10266 (point))) 10267 (vhdl-template-array 'type t)) 10268 ((equal definition "RECORD") 10269 (setq mid-pos (point-marker)) 10270 (delete-region (point) (progn (forward-word-strictly -1) 10271 (point))) 10272 (vhdl-template-record 'type name t)) 10273 ((equal definition "ACCESS") 10274 (insert " ") 10275 (vhdl-template-field "type" ";")) 10276 ((equal definition "FILE") 10277 (vhdl-insert-keyword " OF ") 10278 (vhdl-template-field "type" ";")) 10279 ((equal definition "ENUM") 10280 (kill-word -1) 10281 (insert "(") 10282 (setq end-pos (point-marker)) 10283 (insert ");")) 10284 (t (insert ";"))) 10285 (when mid-pos 10286 (setq end-pos (point-marker)) 10287 (goto-char mid-pos) 10288 (end-of-line)) 10289 (vhdl-comment-insert-inline) 10290 (when end-pos (goto-char end-pos)))))) 10291 10292(defun vhdl-template-use () 10293 "Insert a use clause." 10294 (interactive) 10295 (let ((start (point))) 10296 (vhdl-prepare-search-1 10297 (vhdl-insert-keyword "USE ") 10298 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) 10299 (vhdl-insert-keyword "..ALL;") 10300 (backward-char 6) 10301 (when (vhdl-template-field "library name" nil t start (+ (point) 6)) 10302 (forward-char 1) 10303 (vhdl-template-field "package name") 10304 (forward-char 5)))))) 10305 10306(defun vhdl-template-variable () 10307 "Insert a variable declaration." 10308 (interactive) 10309 (let ((start (point)) 10310 (in-arglist (vhdl-in-argument-list-p))) 10311 (vhdl-prepare-search-2 10312 (if (or (save-excursion 10313 (progn (vhdl-beginning-of-block) 10314 (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>"))) 10315 (save-excursion (backward-word-strictly 1) 10316 (looking-at "\\<shared\\>"))) 10317 (vhdl-insert-keyword "VARIABLE ") 10318 (if (vhdl-standard-p '87) 10319 (error "ERROR: Not within sequential block") 10320 (vhdl-insert-keyword "SHARED VARIABLE ")))) 10321 (when (vhdl-template-field "names" nil t start (point)) 10322 (insert " : ") 10323 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 10324 (vhdl-template-field "type") 10325 (if in-arglist 10326 (progn (insert ";") 10327 (vhdl-comment-insert-inline)) 10328 (let ((position (point))) 10329 (insert " := ") 10330 (unless (vhdl-template-field "[initialization]" nil t) 10331 (delete-region position (point))) 10332 (insert ";") 10333 (vhdl-comment-insert-inline)))))) 10334 10335(defun vhdl-template-wait () 10336 "Insert a wait statement." 10337 (interactive) 10338 (vhdl-insert-keyword "WAIT ") 10339 (unless (vhdl-template-field 10340 "[ON sensitivity list] [UNTIL condition] [FOR time expression]" 10341 nil t) 10342 (delete-char -1)) 10343 (insert ";")) 10344 10345(defun vhdl-template-when () 10346 "Indent correctly if within a case statement." 10347 (interactive) 10348 (let ((position (point)) 10349 margin) 10350 (vhdl-prepare-search-2 10351 (if (and (= (current-column) (current-indentation)) 10352 (vhdl-re-search-forward "\\<end\\>" nil t) 10353 (looking-at "\\s-*\\<case\\>")) 10354 (progn 10355 (setq margin (current-indentation)) 10356 (goto-char position) 10357 (delete-horizontal-space) 10358 (indent-to (+ margin vhdl-basic-offset))) 10359 (goto-char position))) 10360 (vhdl-insert-keyword "WHEN "))) 10361 10362(defun vhdl-template-while-loop () 10363 "Insert a while loop." 10364 (interactive) 10365 (let* ((margin (current-indentation)) 10366 (start (point)) 10367 label) 10368 (if (not (eq vhdl-optional-labels 'all)) 10369 (vhdl-insert-keyword "WHILE ") 10370 (vhdl-insert-keyword ": WHILE ") 10371 (goto-char start) 10372 (setq label (vhdl-template-field "[label]" nil t)) 10373 (unless label (delete-char 2)) 10374 (forward-word-strictly 1) 10375 (forward-char 1)) 10376 (when vhdl-conditions-in-parenthesis (insert "(")) 10377 (when (vhdl-template-field "condition" nil t start (point)) 10378 (when vhdl-conditions-in-parenthesis (insert ")")) 10379 (vhdl-insert-keyword " LOOP\n\n") 10380 (indent-to margin) 10381 (vhdl-insert-keyword "END LOOP") 10382 (insert (if label (concat " " label ";") ";")) 10383 (forward-line -1) 10384 (indent-to (+ margin vhdl-basic-offset))))) 10385 10386(defun vhdl-template-with () 10387 "Insert a with statement (i.e. selected signal assignment)." 10388 (interactive) 10389 (vhdl-prepare-search-1 10390 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) 10391 (equal ";" (match-string 1))) 10392 (vhdl-template-selected-signal-asst) 10393 (vhdl-insert-keyword "WITH ")))) 10394 10395;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10396;; Special templates 10397 10398(defun vhdl-template-clocked-wait () 10399 "Insert a wait statement for rising/falling clock edge." 10400 (interactive) 10401 (let ((start (point)) 10402 clock) 10403 (vhdl-insert-keyword "WAIT UNTIL ") 10404 (when (setq clock 10405 (or (and (not (equal "" vhdl-clock-name)) 10406 (progn (insert vhdl-clock-name) vhdl-clock-name)) 10407 (vhdl-template-field "clock name" nil t start (point)))) 10408 (insert "'event") 10409 (vhdl-insert-keyword " AND ") 10410 (insert clock) 10411 (insert 10412 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") 10413 (vhdl-comment-insert-inline 10414 (concat (if vhdl-clock-rising-edge "rising" "falling") 10415 " clock edge"))))) 10416 10417(defun vhdl-template-seq-process (clock reset reset-kind) 10418 "Insert a template for the body of a sequential process." 10419 (let ((margin (current-indentation)) 10420 position) 10421 (vhdl-insert-keyword "IF ") 10422 (when vhdl-conditions-in-parenthesis (insert "(")) 10423 (when (eq reset-kind 'async) 10424 (insert reset " = " 10425 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 10426 (when vhdl-conditions-in-parenthesis (insert ")")) 10427 (vhdl-insert-keyword " THEN") 10428 (vhdl-comment-insert-inline 10429 (concat "asynchronous reset (active " 10430 (if vhdl-reset-active-high "high" "low") ")")) 10431 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10432 (setq position (point)) 10433 (insert "\n") (indent-to margin) 10434 (vhdl-insert-keyword "ELSIF ") 10435 (when vhdl-conditions-in-parenthesis (insert "("))) 10436 (if (eq vhdl-clock-edge-condition 'function) 10437 (insert (if vhdl-clock-rising-edge "rising" "falling") 10438 "_edge(" clock ")") 10439 (insert clock "'event") 10440 (vhdl-insert-keyword " AND ") 10441 (insert clock " = " 10442 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) 10443 (when vhdl-conditions-in-parenthesis (insert ")")) 10444 (vhdl-insert-keyword " THEN") 10445 (vhdl-comment-insert-inline 10446 (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) 10447 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10448 (when (eq reset-kind 'sync) 10449 (vhdl-insert-keyword "IF ") 10450 (when vhdl-conditions-in-parenthesis (insert "(")) 10451 (setq reset (or (and (not (equal "" vhdl-reset-name)) 10452 (progn (insert vhdl-reset-name) vhdl-reset-name)) 10453 (vhdl-template-field "reset name") "<reset>")) 10454 (insert " = " 10455 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 10456 (when vhdl-conditions-in-parenthesis (insert ")")) 10457 (vhdl-insert-keyword " THEN") 10458 (vhdl-comment-insert-inline 10459 (concat "synchronous reset (active " 10460 (if vhdl-reset-active-high "high" "low") ")")) 10461 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 10462 (setq position (point)) 10463 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10464 (vhdl-insert-keyword "ELSE") 10465 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 10466 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10467 (vhdl-insert-keyword "END IF;")) 10468 (when (eq reset-kind 'none) 10469 (setq position (point))) 10470 (insert "\n") (indent-to margin) 10471 (vhdl-insert-keyword "END IF;") 10472 (goto-char position) 10473 reset)) 10474 10475(defun vhdl-template-standard-package (library package) 10476 "Insert specification of a standard package. Include a library 10477specification, if not already there." 10478 (let ((margin (current-indentation))) 10479 (unless (equal library "std") 10480 (unless (or (save-excursion 10481 (vhdl-prepare-search-1 10482 (and (not (bobp)) 10483 (re-search-backward 10484 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" 10485 library "\\|end\\)\\>") nil t) 10486 (match-string 2)))) 10487 (equal (downcase library) "work")) 10488 (vhdl-insert-keyword "LIBRARY ") 10489 (insert library ";") 10490 (when package 10491 (insert "\n") 10492 (indent-to margin)))) 10493 (when package 10494 (vhdl-insert-keyword "USE ") 10495 (insert library "." package) 10496 (vhdl-insert-keyword ".ALL;")))) 10497 10498(defun vhdl-template-package-numeric-bit () 10499 "Insert specification of `numeric_bit' package." 10500 (interactive) 10501 (vhdl-template-standard-package "ieee" "numeric_bit")) 10502 10503(defun vhdl-template-package-numeric-std () 10504 "Insert specification of `numeric_std' package." 10505 (interactive) 10506 (vhdl-template-standard-package "ieee" "numeric_std")) 10507 10508(defun vhdl-template-package-std-logic-1164 () 10509 "Insert specification of `std_logic_1164' package." 10510 (interactive) 10511 (vhdl-template-standard-package "ieee" "std_logic_1164")) 10512 10513(defun vhdl-template-package-std-logic-arith () 10514 "Insert specification of `std_logic_arith' package." 10515 (interactive) 10516 (vhdl-template-standard-package "ieee" "std_logic_arith")) 10517 10518(defun vhdl-template-package-std-logic-misc () 10519 "Insert specification of `std_logic_misc' package." 10520 (interactive) 10521 (vhdl-template-standard-package "ieee" "std_logic_misc")) 10522 10523(defun vhdl-template-package-std-logic-signed () 10524 "Insert specification of `std_logic_signed' package." 10525 (interactive) 10526 (vhdl-template-standard-package "ieee" "std_logic_signed")) 10527 10528(defun vhdl-template-package-std-logic-textio () 10529 "Insert specification of `std_logic_textio' package." 10530 (interactive) 10531 (vhdl-template-standard-package "ieee" "std_logic_textio")) 10532 10533(defun vhdl-template-package-std-logic-unsigned () 10534 "Insert specification of `std_logic_unsigned' package." 10535 (interactive) 10536 (vhdl-template-standard-package "ieee" "std_logic_unsigned")) 10537 10538(defun vhdl-template-package-textio () 10539 "Insert specification of `textio' package." 10540 (interactive) 10541 (vhdl-template-standard-package "std" "textio")) 10542 10543(defun vhdl-template-package-fundamental-constants () 10544 "Insert specification of `fundamental_constants' package." 10545 (interactive) 10546 (vhdl-template-standard-package "ieee" "fundamental_constants")) 10547 10548(defun vhdl-template-package-material-constants () 10549 "Insert specification of `material_constants' package." 10550 (interactive) 10551 (vhdl-template-standard-package "ieee" "material_constants")) 10552 10553(defun vhdl-template-package-energy-systems () 10554 "Insert specification of `energy_systems' package." 10555 (interactive) 10556 (vhdl-template-standard-package "ieee" "energy_systems")) 10557 10558(defun vhdl-template-package-electrical-systems () 10559 "Insert specification of `electrical_systems' package." 10560 (interactive) 10561 (vhdl-template-standard-package "ieee" "electrical_systems")) 10562 10563(defun vhdl-template-package-mechanical-systems () 10564 "Insert specification of `mechanical_systems' package." 10565 (interactive) 10566 (vhdl-template-standard-package "ieee" "mechanical_systems")) 10567 10568(defun vhdl-template-package-radiant-systems () 10569 "Insert specification of `radiant_systems' package." 10570 (interactive) 10571 (vhdl-template-standard-package "ieee" "radiant_systems")) 10572 10573(defun vhdl-template-package-thermal-systems () 10574 "Insert specification of `thermal_systems' package." 10575 (interactive) 10576 (vhdl-template-standard-package "ieee" "thermal_systems")) 10577 10578(defun vhdl-template-package-fluidic-systems () 10579 "Insert specification of `fluidic_systems' package." 10580 (interactive) 10581 (vhdl-template-standard-package "ieee" "fluidic_systems")) 10582 10583(defun vhdl-template-package-math-complex () 10584 "Insert specification of `math_complex' package." 10585 (interactive) 10586 (vhdl-template-standard-package "ieee" "math_complex")) 10587 10588(defun vhdl-template-package-math-real () 10589 "Insert specification of `math_real' package." 10590 (interactive) 10591 (vhdl-template-standard-package "ieee" "math_real")) 10592 10593(defun vhdl-template-directive (directive) 10594 "Insert directive." 10595 (unless (= (current-indentation) (current-column)) 10596 (delete-horizontal-space) 10597 (insert " ")) 10598 (insert "-- pragma " directive)) 10599 10600(defun vhdl-template-directive-translate-on () 10601 "Insert directive `translate_on'." 10602 (interactive) 10603 (vhdl-template-directive "translate_on")) 10604 10605(defun vhdl-template-directive-translate-off () 10606 "Insert directive `translate_off'." 10607 (interactive) 10608 (vhdl-template-directive "translate_off")) 10609 10610(defun vhdl-template-directive-synthesis-on () 10611 "Insert directive `synthesis_on'." 10612 (interactive) 10613 (vhdl-template-directive "synthesis_on")) 10614 10615(defun vhdl-template-directive-synthesis-off () 10616 "Insert directive `synthesis_off'." 10617 (interactive) 10618 (vhdl-template-directive "synthesis_off")) 10619 10620;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10621;; Header and footer templates 10622 10623(defun vhdl-template-header (&optional file-title) 10624 "Insert a VHDL file header." 10625 (interactive) 10626 (unless (equal vhdl-file-header "") 10627 (let (pos) 10628 (save-excursion 10629 (goto-char (point-min)) 10630 (vhdl-insert-string-or-file vhdl-file-header) 10631 (setq pos (point-marker))) 10632 (vhdl-template-replace-header-keywords 10633 (point-min-marker) pos file-title)))) 10634 10635(defun vhdl-template-footer () 10636 "Insert a VHDL file footer." 10637 (interactive) 10638 (unless (equal vhdl-file-footer "") 10639 (let (pos) 10640 (save-excursion 10641 (goto-char (point-max)) 10642 (setq pos (point-marker)) 10643 (vhdl-insert-string-or-file vhdl-file-footer) 10644 (unless (= (preceding-char) ?\n) 10645 (insert "\n"))) 10646 (vhdl-template-replace-header-keywords pos (point-max-marker))))) 10647 10648(defun vhdl-template-replace-header-keywords (beg end &optional file-title 10649 is-model) 10650 "Replace keywords in header and footer." 10651 (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project)) 10652 "")) 10653 (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project)) 10654 "")) 10655 pos) 10656 (vhdl-prepare-search-2 10657 (save-excursion 10658 (goto-char beg) 10659 (while (search-forward "<projectdesc>" end t) 10660 (replace-match project-desc t t)) 10661 (goto-char beg) 10662 (while (search-forward "<filename>" end t) 10663 (replace-match (buffer-name) t t)) 10664 (goto-char beg) 10665 (while (search-forward "<copyright>" end t) 10666 (replace-match vhdl-copyright-string t t)) 10667 (goto-char beg) 10668 (while (search-forward "<author>" end t) 10669 (replace-match "" t t) 10670 (insert (user-full-name)) 10671 (when user-mail-address (insert " <" user-mail-address ">"))) 10672 (goto-char beg) 10673 (while (search-forward "<authorfull>" end t) 10674 (replace-match (user-full-name) t t)) 10675 (goto-char beg) 10676 (while (search-forward "<login>" end t) 10677 (replace-match (user-login-name) t t)) 10678 (goto-char beg) 10679 (while (search-forward "<project>" end t) 10680 (replace-match project-title t t)) 10681 (goto-char beg) 10682 (while (search-forward "<company>" end t) 10683 (replace-match vhdl-company-name t t)) 10684 (goto-char beg) 10685 (while (search-forward "<platform>" end t) 10686 (replace-match vhdl-platform-spec t t)) 10687 (goto-char beg) 10688 (while (search-forward "<standard>" end t) 10689 (replace-match 10690 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") 10691 ((vhdl-standard-p '93) "'93/02") 10692 ((vhdl-standard-p '08) "'08")) 10693 (when (vhdl-standard-p 'ams) ", VHDL-AMS") 10694 (when (vhdl-standard-p 'math) ", Math Packages")) t t)) 10695 (goto-char beg) 10696 ;; Replace <RCS> with $, so that RCS for the source is 10697 ;; not over-enthusiastic with replacements 10698 (while (search-forward "<RCS>" end t) 10699 (replace-match "$" nil t)) 10700 (goto-char beg) 10701 (while (search-forward "<date>" end t) 10702 (replace-match "" t t) 10703 (vhdl-template-insert-date)) 10704 (goto-char beg) 10705 (while (search-forward "<year>" end t) 10706 (replace-match (format-time-string "%Y" nil) t t)) 10707 (goto-char beg) 10708 (when file-title 10709 (while (search-forward "<title string>" end t) 10710 (replace-match file-title t t)) 10711 (goto-char beg)) 10712 (let (string) 10713 (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) 10714 (save-match-data 10715 (setq string (read-string (concat (match-string 1) ": ")))) 10716 (replace-match string t t))) 10717 (goto-char beg) 10718 (when (and (not is-model) (search-forward "<cursor>" end t)) 10719 (replace-match "" t t) 10720 (setq pos (point)))) 10721 (when pos (goto-char pos)) 10722 (unless is-model 10723 (when (or (not project-title) (equal project-title "")) 10724 (message "You can specify a project title in user option `vhdl-project-alist'")) 10725 (when (or (not project-desc) (equal project-desc "")) 10726 (message "You can specify a project description in user option `vhdl-project-alist'")) 10727 (when (equal vhdl-platform-spec "") 10728 (message "You can specify a platform in user option `vhdl-platform-spec'")) 10729 (when (equal vhdl-company-name "") 10730 (message "You can specify a company name in user option `vhdl-company-name'")))))) 10731 10732;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10733;; Comment templates and functions 10734 10735(defun vhdl-comment-indent () 10736 "Indent comments." 10737 (let* ((position (point)) 10738 (col 10739 (progn 10740 (forward-line -1) 10741 (if (re-search-forward "--" position t) 10742 (- (current-column) 2) ; existing comment at bol stays there 10743 (goto-char position) 10744 (skip-chars-backward " \t") 10745 (max comment-column ; else indent to comment column 10746 (1+ (current-column))))))) ; except leave at least one space 10747 (goto-char position) 10748 col)) 10749 10750(defun vhdl-comment-insert () 10751 "Start a comment at the end of the line. 10752If on line with code, indent at least `comment-column'. 10753If starting after end-comment-column, start a new line." 10754 (interactive) 10755 (when (> (current-column) end-comment-column) (newline-and-indent)) 10756 (if (or (looking-at "\\s-*$") ; end of line 10757 (and (not unread-command-events) ; called with key binding or menu 10758 (not (end-of-line)))) 10759 (let (margin) 10760 (while (= (preceding-char) ?-) (delete-char -1)) 10761 (setq margin (current-column)) 10762 (delete-horizontal-space) 10763 (if (bolp) 10764 (progn (indent-to margin) (insert "--")) 10765 (insert " ") 10766 (indent-to comment-column) 10767 (insert "--")) 10768 (if (not unread-command-events) (insert " "))) 10769 ;; else code following current point implies commenting out code 10770 (let (next-input code) 10771 (while (= (preceding-char) ?-) (delete-char -2)) 10772 (while (= (setq next-input (read-char)) 13) ; CR 10773 (insert "--") ; or have a space after it? 10774 (forward-char -2) 10775 (forward-line 1) 10776 (message "Enter CR if commenting out a line of code.") 10777 (setq code t)) 10778 (unless code 10779 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? 10780 (push (vhdl-character-to-event next-input) ; pushback the char 10781 unread-command-events)))) 10782 10783(defun vhdl-comment-display (&optional line-exists) 10784 "Add 2 comment lines at the current indent, making a display comment." 10785 (interactive) 10786 (let ((margin (current-indentation))) 10787 (unless line-exists (vhdl-comment-display-line)) 10788 (insert "\n") (indent-to margin) 10789 (insert "\n") (indent-to margin) 10790 (vhdl-comment-display-line) 10791 (end-of-line -0) 10792 (insert "-- "))) 10793 10794(defun vhdl-comment-display-line () 10795 "Displays one line of dashes." 10796 (interactive) 10797 (while (= (preceding-char) ?-) (delete-char -2)) 10798 (insert "--") 10799 (let* ((col (current-column)) 10800 (len (- end-comment-column col))) 10801 (insert-char vhdl-comment-display-line-char len))) 10802 10803(defun vhdl-comment-append-inline () 10804 "Append empty inline comment to current line." 10805 (interactive) 10806 (end-of-line) 10807 (delete-horizontal-space) 10808 (insert " ") 10809 (indent-to comment-column) 10810 (insert "-- ")) 10811 10812(defun vhdl-comment-insert-inline (&optional string always-insert) 10813 "Insert inline comment." 10814 (when (or (and string (or vhdl-self-insert-comments always-insert)) 10815 (and (not string) vhdl-prompt-for-comments)) 10816 (let ((position (point))) 10817 (insert " ") 10818 (indent-to comment-column) 10819 (insert "-- ") 10820 (if (not (or (and string (progn (insert string) t)) 10821 (vhdl-template-field "[comment]" nil t))) 10822 (delete-region position (point)) 10823 (while (= (preceding-char) ?\ ) (delete-char -1)))))) 10824 10825(defun vhdl-comment-block () 10826 "Insert comment for code block." 10827 (when vhdl-prompt-for-comments 10828 (let ((final-pos (point-marker))) 10829 (vhdl-prepare-search-2 10830 (when (and (re-search-backward "^\\s-*begin\\>" nil t) 10831 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) 10832 (let (margin) 10833 (back-to-indentation) 10834 (setq margin (current-column)) 10835 (end-of-line -0) 10836 (if (bobp) 10837 (progn (insert "\n") (forward-line -1)) 10838 (insert "\n")) 10839 (indent-to margin) 10840 (insert "-- purpose: ") 10841 (unless (vhdl-template-field "[description]" nil t) 10842 (vhdl-line-kill-entire))))) 10843 (goto-char final-pos)))) 10844 10845(defun vhdl-comment-uncomment-region (beg end &optional arg) 10846 "Comment out region if not commented out, uncomment otherwise." 10847 (interactive "r\nP") 10848 (save-excursion 10849 (goto-char (1- end)) 10850 (end-of-line) 10851 (setq end (point-marker)) 10852 (goto-char beg) 10853 (beginning-of-line) 10854 (setq beg (point)) 10855 (if (looking-at (concat "\\s-*" comment-start)) 10856 (comment-region beg end '(4)) 10857 (comment-region beg end)))) 10858 10859(defun vhdl-comment-uncomment-line (&optional arg) 10860 "Comment out line if not commented out, uncomment otherwise." 10861 (interactive "p") 10862 (save-excursion 10863 (beginning-of-line) 10864 (let ((position (point))) 10865 (forward-line (or arg 1)) 10866 (vhdl-comment-uncomment-region position (point))))) 10867 10868(defun vhdl-comment-kill-region (beg end) 10869 "Kill comments in region." 10870 (interactive "r") 10871 (save-excursion 10872 (goto-char end) 10873 (setq end (point-marker)) 10874 (goto-char beg) 10875 (beginning-of-line) 10876 (while (< (point) end) 10877 (if (looking-at "^\\(\\s-*--.*\n\\)") 10878 (progn (delete-region (match-beginning 1) (match-end 1))) 10879 (beginning-of-line 2))))) 10880 10881(defun vhdl-comment-kill-inline-region (beg end) 10882 "Kill inline comments in region." 10883 (interactive "r") 10884 (save-excursion 10885 (goto-char end) 10886 (setq end (point-marker)) 10887 (goto-char beg) 10888 (beginning-of-line) 10889 (while (< (point) end) 10890 (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$") 10891 (delete-region (match-beginning 1) (match-end 1))) 10892 (beginning-of-line 2)))) 10893 10894;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10895;; Subtemplates 10896 10897(defun vhdl-template-begin-end (construct name margin &optional empty-lines) 10898 "Insert a begin ... end pair with optional name after the end. 10899Point is left between them." 10900 (let (position) 10901 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10902 (indent-to margin) 10903 (vhdl-insert-keyword "BEGIN") 10904 (when (and (or construct name) vhdl-self-insert-comments) 10905 (insert " --") 10906 (when construct (insert " ") (vhdl-insert-keyword construct)) 10907 (when name (insert " " name))) 10908 (insert "\n") 10909 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10910 (indent-to (+ margin vhdl-basic-offset)) 10911 (setq position (point)) 10912 (insert "\n") 10913 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10914 (indent-to margin) 10915 (vhdl-insert-keyword "END") 10916 (when construct (insert " ") (vhdl-insert-keyword construct)) 10917 (insert (if name (concat " " name) "") ";") 10918 (goto-char position))) 10919 10920(defun vhdl-template-argument-list (&optional is-function) 10921 "Read from user a procedure or function argument list." 10922 (insert " (") 10923 (let ((margin (current-column)) 10924 (start (point)) 10925 (end-pos (point)) 10926 not-empty interface semicolon-pos) 10927 (unless vhdl-argument-list-indent 10928 (setq margin (+ (current-indentation) vhdl-basic-offset)) 10929 (insert "\n") 10930 (indent-to margin)) 10931 (setq interface (vhdl-template-field 10932 (concat "[CONSTANT | SIGNAL" 10933 (unless is-function " | VARIABLE") "]") " " t)) 10934 (while (vhdl-template-field "[names]" nil t) 10935 (setq not-empty t) 10936 (insert " : ") 10937 (unless is-function 10938 (if (and interface (equal (upcase interface) "CONSTANT")) 10939 (vhdl-insert-keyword "IN ") 10940 (vhdl-template-field "[IN | OUT | INOUT]" " " t))) 10941 (vhdl-template-field "type") 10942 (setq semicolon-pos (point)) 10943 (insert ";") 10944 (vhdl-comment-insert-inline) 10945 (setq end-pos (point)) 10946 (insert "\n") 10947 (indent-to margin) 10948 (setq interface (vhdl-template-field 10949 (concat "[CONSTANT | SIGNAL" 10950 (unless is-function " | VARIABLE") "]") " " t))) 10951 (delete-region end-pos (point)) 10952 (when semicolon-pos (goto-char semicolon-pos)) 10953 (if not-empty 10954 (progn (delete-char 1) (insert ")")) 10955 (delete-char -2)))) 10956 10957(defun vhdl-template-generic-list (optional &optional no-value) 10958 "Read from user a generic spec argument list." 10959 (let (margin 10960 (start (point))) 10961 (vhdl-insert-keyword "GENERIC (") 10962 (setq margin (current-column)) 10963 (unless vhdl-argument-list-indent 10964 (let ((position (point))) 10965 (back-to-indentation) 10966 (setq margin (+ (current-column) vhdl-basic-offset)) 10967 (goto-char position) 10968 (insert "\n") 10969 (indent-to margin))) 10970 (let ((vhdl-generics (vhdl-template-field 10971 (concat (and optional "[") "name" 10972 (and no-value "s") (and optional "]")) 10973 nil optional))) 10974 (if (not vhdl-generics) 10975 (if optional 10976 (progn (vhdl-line-kill-entire) (end-of-line -0) 10977 (unless vhdl-argument-list-indent 10978 (vhdl-line-kill-entire) (end-of-line -0))) 10979 (vhdl-template-undo start (point)) 10980 nil ) 10981 (insert " : ") 10982 (let (semicolon-pos end-pos) 10983 (while vhdl-generics 10984 (vhdl-template-field "type") 10985 (if no-value 10986 (progn (setq semicolon-pos (point)) 10987 (insert ";")) 10988 (insert " := ") 10989 (unless (vhdl-template-field "[value]" nil t) 10990 (delete-char -4)) 10991 (setq semicolon-pos (point)) 10992 (insert ";")) 10993 (vhdl-comment-insert-inline) 10994 (setq end-pos (point)) 10995 (insert "\n") 10996 (indent-to margin) 10997 (setq vhdl-generics (vhdl-template-field 10998 (concat "[name" (and no-value "s") "]") 10999 " : " t))) 11000 (delete-region end-pos (point)) 11001 (goto-char semicolon-pos) 11002 (insert ")") 11003 (end-of-line) 11004 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 11005 t))))) 11006 11007(defun vhdl-template-port-list (optional) 11008 "Read from user a port spec argument list." 11009 (let ((start (point)) 11010 margin vhdl-ports object) 11011 (vhdl-insert-keyword "PORT (") 11012 (setq margin (current-column)) 11013 (unless vhdl-argument-list-indent 11014 (let ((position (point))) 11015 (back-to-indentation) 11016 (setq margin (+ (current-column) vhdl-basic-offset)) 11017 (goto-char position) 11018 (insert "\n") 11019 (indent-to margin))) 11020 (when (vhdl-standard-p 'ams) 11021 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 11022 " " t))) 11023 (setq vhdl-ports (vhdl-template-field 11024 (concat (and optional "[") "names" (and optional "]")) 11025 nil optional)) 11026 (if (not vhdl-ports) 11027 (if optional 11028 (progn (vhdl-line-kill-entire) (end-of-line -0) 11029 (unless vhdl-argument-list-indent 11030 (vhdl-line-kill-entire) (end-of-line -0))) 11031 (vhdl-template-undo start (point)) 11032 nil) 11033 (insert " : ") 11034 (let (semicolon-pos end-pos) 11035 (while vhdl-ports 11036 (cond ((or (null object) (equal "SIGNAL" (upcase object))) 11037 (vhdl-template-field "IN | OUT | INOUT" " ")) 11038 ((equal "QUANTITY" (upcase object)) 11039 (vhdl-template-field "[IN | OUT]" " " t))) 11040 (vhdl-template-field 11041 (if (and object (equal "TERMINAL" (upcase object))) 11042 "nature" "type")) 11043 (setq semicolon-pos (point)) 11044 (insert ";") 11045 (vhdl-comment-insert-inline) 11046 (setq end-pos (point)) 11047 (insert "\n") 11048 (indent-to margin) 11049 (when (vhdl-standard-p 'ams) 11050 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 11051 " " t))) 11052 (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) 11053 (delete-region end-pos (point)) 11054 (goto-char semicolon-pos) 11055 (insert ")") 11056 (end-of-line) 11057 (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) 11058 t)))) 11059 11060(defun vhdl-template-generate-body (margin label) 11061 "Insert body for generate template." 11062 (vhdl-insert-keyword " GENERATE") 11063 (insert "\n\n") 11064 (indent-to margin) 11065 (vhdl-insert-keyword "END GENERATE ") 11066 (insert label ";") 11067 (end-of-line 0) 11068 (indent-to (+ margin vhdl-basic-offset))) 11069 11070(defun vhdl-template-insert-date () 11071 "Insert date in appropriate format." 11072 (interactive) 11073 (insert 11074 (cond 11075 ;; 'american, 'european, 'scientific kept for backward compatibility 11076 ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) 11077 ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) 11078 ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) 11079 (t (format-time-string vhdl-date-format nil))))) 11080 11081;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11082;; Help functions 11083 11084(defun vhdl-electric-space (count) 11085 "Expand abbreviations and self-insert space(s), do indent-new-comment-line 11086if in comment and past end-comment-column." 11087 (interactive "p") 11088 (cond ((vhdl-in-comment-p) 11089 (self-insert-command count) 11090 (cond ((>= (current-column) (+ 2 end-comment-column)) 11091 (backward-char 1) 11092 (skip-chars-backward "^ \t\n\r\f") 11093 (indent-new-comment-line) 11094 (skip-chars-forward "^ \t\n\r\f") 11095 (forward-char 1)) 11096 ((>= (current-column) end-comment-column) 11097 (indent-new-comment-line)) 11098 (t nil))) 11099 ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) 11100 (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) 11101 (vhdl-prepare-search-1 11102 (or (expand-abbrev) (vhdl-fix-case-word -1))) 11103 (self-insert-command count)) 11104 (t (self-insert-command count)))) 11105 11106(defun vhdl-template-field (prompt &optional follow-string optional 11107 begin end is-string default) 11108 "Prompt for string and insert it in buffer with optional FOLLOW-STRING. 11109If OPTIONAL is nil, the prompt is left if an empty string is inserted. If 11110an empty string is inserted, return nil and call `vhdl-template-undo' for 11111the region between BEGIN and END. IS-STRING indicates whether a string 11112with double-quotes is to be inserted. DEFAULT specifies a default string." 11113 (let ((position (point)) 11114 string) 11115 (insert "<" prompt ">") 11116 (setq string 11117 (condition-case () 11118 (read-from-minibuffer (concat prompt ": ") 11119 (or (and is-string '("\"\"" . 2)) default) 11120 vhdl-minibuffer-local-map) 11121 (quit (if (and optional begin end) 11122 (progn (beep) "") 11123 (keyboard-quit))))) 11124 (when (or (not (equal string "")) optional) 11125 (delete-region position (point))) 11126 (when (and (equal string "") optional begin end) 11127 (vhdl-template-undo begin end) 11128 (message "Template aborted")) 11129 (unless (equal string "") 11130 (insert string) 11131 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords 11132 vhdl-keywords-regexp) 11133 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types 11134 vhdl-types-regexp) 11135 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes 11136 (concat "'" vhdl-attributes-regexp)) 11137 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values 11138 vhdl-enum-values-regexp) 11139 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants 11140 vhdl-constants-regexp)) 11141 (when (or (not (equal string "")) (not optional)) 11142 (insert (or follow-string ""))) 11143 (if (equal string "") nil string))) 11144 11145(defun vhdl-decision-query (string prompt &optional optional) 11146 "Query a decision from the user." 11147 (let ((start (point))) 11148 (when string (vhdl-insert-keyword (concat string " "))) 11149 (message "%s" (or prompt "")) 11150 (let ((char (read-char))) 11151 (delete-region start (point)) 11152 (if (and optional (eq char ?\r)) 11153 (progn (insert " ") 11154 (unexpand-abbrev) 11155 (throw 'abort "ERROR: Template aborted")) 11156 char)))) 11157 11158(defun vhdl-insert-keyword (keyword) 11159 "Insert KEYWORD and adjust case." 11160 (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) 11161 11162(defun vhdl-case-keyword (keyword) 11163 "Adjust case of KEYWORD." 11164 (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) 11165 11166(defun vhdl-case-word (num) 11167 "Adjust case of following NUM words." 11168 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) 11169 11170(defun vhdl-minibuffer-tab (&optional prefix-arg) 11171 "If preceding character is part of a word or a paren then hippie-expand, 11172else insert tab (used for word completion in VHDL minibuffer)." 11173 (interactive "P") 11174 (cond 11175 ;; expand word 11176 ((= (char-syntax (preceding-char)) ?w) 11177 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 11178 (case-replace nil) 11179 (hippie-expand-only-buffers 11180 (or (and (boundp 'hippie-expand-only-buffers) 11181 hippie-expand-only-buffers) 11182 '(vhdl-mode)))) 11183 (vhdl-expand-abbrev prefix-arg))) 11184 ;; expand parenthesis 11185 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 11186 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 11187 (case-replace nil)) 11188 (vhdl-expand-paren prefix-arg))) 11189 ;; insert tab 11190 (t (insert-tab)))) 11191 11192(defun vhdl-template-search-prompt () 11193 "Search for left out template prompts and query again." 11194 (interactive) 11195 (vhdl-prepare-search-2 11196 (when (or (re-search-forward 11197 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) 11198 (re-search-backward 11199 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) 11200 (let ((string (match-string 1))) 11201 (replace-match "") 11202 (vhdl-template-field string))))) 11203 11204(defun vhdl-template-undo (begin end) 11205 "Undo aborted template by deleting region and unexpanding the keyword." 11206 (cond (vhdl-template-invoked-by-hook 11207 (goto-char end) 11208 (insert " ") 11209 (delete-region begin end) 11210 (unexpand-abbrev)) 11211 (t (delete-region begin end)))) 11212 11213(defun vhdl-insert-string-or-file (string) 11214 "Insert STRING or file contents if STRING is an existing file name." 11215 (unless (equal string "") 11216 (let ((file-name 11217 (progn (string-match "^\\([^\n]+\\)" string) 11218 (vhdl-resolve-env-variable (match-string 1 string))))) 11219 (if (file-exists-p file-name) 11220 (forward-char (cadr (insert-file-contents file-name))) 11221 (insert string))))) 11222 11223(defun vhdl-beginning-of-block () 11224 "Move cursor to the beginning of the enclosing block." 11225 (let (pos) 11226 (vhdl-prepare-search-2 11227 (save-excursion 11228 (beginning-of-line) 11229 ;; search backward for block beginning or end 11230 (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) 11231 ;; not consider subprogram declarations 11232 (or (and (match-string 5) 11233 (save-match-data 11234 (save-excursion 11235 (goto-char (match-end 5)) 11236 (forward-word-strictly 1) 11237 (vhdl-forward-syntactic-ws) 11238 (when (looking-at "(") 11239 (forward-sexp)) 11240 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 11241 (match-string 1))) 11242 ;; not consider configuration specifications 11243 (and (match-string 6) 11244 (save-match-data 11245 (save-excursion 11246 (vhdl-end-of-block) 11247 (beginning-of-line) 11248 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 11249 (match-string 2)) 11250 ;; skip subblock if block end found 11251 (vhdl-beginning-of-block)))) 11252 (when pos (goto-char pos)))) 11253 11254(defun vhdl-end-of-block () 11255 "Move cursor to the end of the enclosing block." 11256 (let (pos) 11257 (vhdl-prepare-search-2 11258 (save-excursion 11259 (end-of-line) 11260 ;; search forward for block beginning or end 11261 (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|context\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) 11262 ;; not consider subprogram declarations 11263 (or (and (match-string 5) 11264 (save-match-data 11265 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 11266 (match-string 1))) 11267 ;; not consider configuration specifications 11268 (and (match-string 6) 11269 (save-match-data 11270 (save-excursion 11271 (vhdl-end-of-block) 11272 (beginning-of-line) 11273 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 11274 (not (match-string 2))) 11275 ;; skip subblock if block beginning found 11276 (vhdl-end-of-block)))) 11277 (when pos (goto-char pos)))) 11278 11279(defun vhdl-sequential-statement-p () 11280 "Check if point is within sequential statement part." 11281 (let ((start (point))) 11282 (save-excursion 11283 (vhdl-prepare-search-2 11284 ;; is sequential statement if ... 11285 (and (re-search-backward "^\\s-*begin\\>" nil t) 11286 ;; ... point is between "begin" and "end" of ... 11287 (progn (vhdl-end-of-block) 11288 (< start (point))) 11289 ;; ... a sequential block 11290 (progn (vhdl-beginning-of-block) 11291 (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>"))))))) 11292 11293(defun vhdl-in-argument-list-p () 11294 "Check if within an argument list." 11295 (save-excursion 11296 (vhdl-prepare-search-2 11297 (or (string-match "arglist" 11298 (format "%s" (caar (vhdl-get-syntactic-context)))) 11299 (progn (beginning-of-line) 11300 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) 11301 11302;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11303;; Abbrev hooks 11304 11305(defun vhdl-hooked-abbrev (func) 11306 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, 11307but not if inside a comment or quote." 11308 (if (or (vhdl-in-literal) 11309 (save-excursion 11310 (forward-word-strictly -1) 11311 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) 11312 (progn 11313 (insert " ") 11314 (unexpand-abbrev) 11315 (backward-word-strictly 1) 11316 (vhdl-case-word 1) 11317 (delete-char 1)) 11318 (if (not vhdl-electric-mode) 11319 (progn 11320 (insert " ") 11321 (unexpand-abbrev) 11322 (backward-word-strictly 1) 11323 (vhdl-case-word 1) 11324 (delete-char 1)) 11325 (let ((invoke-char vhdl-last-input-event) 11326 (abbrev-mode -1) 11327 (vhdl-template-invoked-by-hook t)) 11328 (let ((caught (catch 'abort 11329 (funcall func)))) 11330 (when (stringp caught) (message "%s" caught))) 11331 (when (= invoke-char ?-) (setq abbrev-start-location (point))) 11332 ;; delete CR which is still in event queue 11333 (if (fboundp 'enqueue-eval-event) 11334 (enqueue-eval-event 'delete-char -1) 11335 (push (vhdl-character-to-event ?\177) ; push back a delete char 11336 unread-command-events)))))) 11337 11338(defun vhdl-template-alias-hook () 11339 (vhdl-hooked-abbrev 'vhdl-template-alias)) 11340(defun vhdl-template-architecture-hook () 11341 (vhdl-hooked-abbrev 'vhdl-template-architecture)) 11342(defun vhdl-template-assert-hook () 11343 (vhdl-hooked-abbrev 'vhdl-template-assert)) 11344(defun vhdl-template-attribute-hook () 11345 (vhdl-hooked-abbrev 'vhdl-template-attribute)) 11346(defun vhdl-template-block-hook () 11347 (vhdl-hooked-abbrev 'vhdl-template-block)) 11348(defun vhdl-template-break-hook () 11349 (vhdl-hooked-abbrev 'vhdl-template-break)) 11350(defun vhdl-template-case-hook () 11351 (vhdl-hooked-abbrev 'vhdl-template-case)) 11352(defun vhdl-template-component-hook () 11353 (vhdl-hooked-abbrev 'vhdl-template-component)) 11354(defun vhdl-template-instance-hook () 11355 (vhdl-hooked-abbrev 'vhdl-template-instance)) 11356(defun vhdl-template-conditional-signal-asst-hook () 11357 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) 11358(defun vhdl-template-configuration-hook () 11359 (vhdl-hooked-abbrev 'vhdl-template-configuration)) 11360(defun vhdl-template-constant-hook () 11361 (vhdl-hooked-abbrev 'vhdl-template-constant)) 11362(defun vhdl-template-context-hook () 11363 (vhdl-hooked-abbrev 'vhdl-template-context)) 11364(defun vhdl-template-disconnect-hook () 11365 (vhdl-hooked-abbrev 'vhdl-template-disconnect)) 11366(defun vhdl-template-display-comment-hook () 11367 (vhdl-hooked-abbrev 'vhdl-comment-display)) 11368(defun vhdl-template-else-hook () 11369 (vhdl-hooked-abbrev 'vhdl-template-else)) 11370(defun vhdl-template-elsif-hook () 11371 (vhdl-hooked-abbrev 'vhdl-template-elsif)) 11372(defun vhdl-template-entity-hook () 11373 (vhdl-hooked-abbrev 'vhdl-template-entity)) 11374(defun vhdl-template-exit-hook () 11375 (vhdl-hooked-abbrev 'vhdl-template-exit)) 11376(defun vhdl-template-file-hook () 11377 (vhdl-hooked-abbrev 'vhdl-template-file)) 11378(defun vhdl-template-for-hook () 11379 (vhdl-hooked-abbrev 'vhdl-template-for)) 11380(defun vhdl-template-function-hook () 11381 (vhdl-hooked-abbrev 'vhdl-template-function)) 11382(defun vhdl-template-generic-hook () 11383 (vhdl-hooked-abbrev 'vhdl-template-generic)) 11384(defun vhdl-template-group-hook () 11385 (vhdl-hooked-abbrev 'vhdl-template-group)) 11386(defun vhdl-template-library-hook () 11387 (vhdl-hooked-abbrev 'vhdl-template-library)) 11388(defun vhdl-template-limit-hook () 11389 (vhdl-hooked-abbrev 'vhdl-template-limit)) 11390(defun vhdl-template-if-hook () 11391 (vhdl-hooked-abbrev 'vhdl-template-if)) 11392(defun vhdl-template-bare-loop-hook () 11393 (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) 11394(defun vhdl-template-map-hook () 11395 (vhdl-hooked-abbrev 'vhdl-template-map)) 11396(defun vhdl-template-nature-hook () 11397 (vhdl-hooked-abbrev 'vhdl-template-nature)) 11398(defun vhdl-template-next-hook () 11399 (vhdl-hooked-abbrev 'vhdl-template-next)) 11400(defun vhdl-template-others-hook () 11401 (vhdl-hooked-abbrev 'vhdl-template-others)) 11402(defun vhdl-template-package-hook () 11403 (vhdl-hooked-abbrev 'vhdl-template-package)) 11404(defun vhdl-template-port-hook () 11405 (vhdl-hooked-abbrev 'vhdl-template-port)) 11406(defun vhdl-template-procedural-hook () 11407 (vhdl-hooked-abbrev 'vhdl-template-procedural)) 11408(defun vhdl-template-procedure-hook () 11409 (vhdl-hooked-abbrev 'vhdl-template-procedure)) 11410(defun vhdl-template-process-hook () 11411 (vhdl-hooked-abbrev 'vhdl-template-process)) 11412(defun vhdl-template-quantity-hook () 11413 (vhdl-hooked-abbrev 'vhdl-template-quantity)) 11414(defun vhdl-template-report-hook () 11415 (vhdl-hooked-abbrev 'vhdl-template-report)) 11416(defun vhdl-template-return-hook () 11417 (vhdl-hooked-abbrev 'vhdl-template-return)) 11418(defun vhdl-template-selected-signal-asst-hook () 11419 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) 11420(defun vhdl-template-signal-hook () 11421 (vhdl-hooked-abbrev 'vhdl-template-signal)) 11422(defun vhdl-template-subnature-hook () 11423 (vhdl-hooked-abbrev 'vhdl-template-subnature)) 11424(defun vhdl-template-subtype-hook () 11425 (vhdl-hooked-abbrev 'vhdl-template-subtype)) 11426(defun vhdl-template-terminal-hook () 11427 (vhdl-hooked-abbrev 'vhdl-template-terminal)) 11428(defun vhdl-template-type-hook () 11429 (vhdl-hooked-abbrev 'vhdl-template-type)) 11430(defun vhdl-template-use-hook () 11431 (vhdl-hooked-abbrev 'vhdl-template-use)) 11432(defun vhdl-template-variable-hook () 11433 (vhdl-hooked-abbrev 'vhdl-template-variable)) 11434(defun vhdl-template-wait-hook () 11435 (vhdl-hooked-abbrev 'vhdl-template-wait)) 11436(defun vhdl-template-when-hook () 11437 (vhdl-hooked-abbrev 'vhdl-template-when)) 11438(defun vhdl-template-while-loop-hook () 11439 (vhdl-hooked-abbrev 'vhdl-template-while-loop)) 11440(defun vhdl-template-with-hook () 11441 (vhdl-hooked-abbrev 'vhdl-template-with)) 11442(defun vhdl-template-and-hook () 11443 (vhdl-hooked-abbrev 'vhdl-template-and)) 11444(defun vhdl-template-or-hook () 11445 (vhdl-hooked-abbrev 'vhdl-template-or)) 11446(defun vhdl-template-nand-hook () 11447 (vhdl-hooked-abbrev 'vhdl-template-nand)) 11448(defun vhdl-template-nor-hook () 11449 (vhdl-hooked-abbrev 'vhdl-template-nor)) 11450(defun vhdl-template-xor-hook () 11451 (vhdl-hooked-abbrev 'vhdl-template-xor)) 11452(defun vhdl-template-xnor-hook () 11453 (vhdl-hooked-abbrev 'vhdl-template-xnor)) 11454(defun vhdl-template-not-hook () 11455 (vhdl-hooked-abbrev 'vhdl-template-not)) 11456 11457(defun vhdl-template-default-hook () 11458 (vhdl-hooked-abbrev 'vhdl-template-default)) 11459(defun vhdl-template-default-indent-hook () 11460 (vhdl-hooked-abbrev 'vhdl-template-default-indent)) 11461 11462;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11463;; Template insertion from completion list 11464 11465(defun vhdl-template-insert-construct (name) 11466 "Insert the built-in construct template with NAME." 11467 (interactive 11468 (list (let ((completion-ignore-case t)) 11469 (completing-read "Construct name: " 11470 vhdl-template-construct-alist nil t)))) 11471 (vhdl-template-insert-fun 11472 (cadr (assoc name vhdl-template-construct-alist)))) 11473 11474(defun vhdl-template-insert-package (name) 11475 "Insert the built-in package template with NAME." 11476 (interactive 11477 (list (let ((completion-ignore-case t)) 11478 (completing-read "Package name: " 11479 vhdl-template-package-alist nil t)))) 11480 (vhdl-template-insert-fun 11481 (cadr (assoc name vhdl-template-package-alist)))) 11482 11483(defun vhdl-template-insert-directive (name) 11484 "Insert the built-in directive template with NAME." 11485 (interactive 11486 (list (let ((completion-ignore-case t)) 11487 (completing-read "Directive name: " 11488 vhdl-template-directive-alist nil t)))) 11489 (vhdl-template-insert-fun 11490 (cadr (assoc name vhdl-template-directive-alist)))) 11491 11492(defun vhdl-template-insert-fun (fun) 11493 "Call FUN to insert a built-in template." 11494 (let ((caught (catch 'abort (when fun (funcall fun))))) 11495 (when (stringp caught) (message "%s" caught)))) 11496 11497 11498;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11499;;; Models 11500;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11501 11502(defun vhdl-model-insert (model-name) 11503 "Insert the user model with name MODEL-NAME." 11504 (interactive 11505 (let ((completion-ignore-case t)) 11506 (list (completing-read "Model name: " vhdl-model-alist)))) 11507 (indent-according-to-mode) 11508 (let ((start (point-marker)) 11509 (margin (current-indentation)) 11510 model position prompt string end) 11511 (vhdl-prepare-search-2 11512 (when (setq model (assoc model-name vhdl-model-alist)) 11513 ;; insert model 11514 (beginning-of-line) 11515 (delete-horizontal-space) 11516 (goto-char start) 11517 (vhdl-insert-string-or-file (nth 1 model)) 11518 (setq end (point-marker)) 11519 ;; indent code 11520 (goto-char start) 11521 (beginning-of-line) 11522 (while (< (point) end) 11523 (unless (looking-at "^$") 11524 (insert-char ? margin)) 11525 (beginning-of-line 2)) 11526 (goto-char start) 11527 ;; insert clock 11528 (unless (equal "" vhdl-clock-name) 11529 (while (re-search-forward "<clock>" end t) 11530 (replace-match vhdl-clock-name))) 11531 (goto-char start) 11532 ;; insert reset 11533 (unless (equal "" vhdl-reset-name) 11534 (while (re-search-forward "<reset>" end t) 11535 (replace-match vhdl-reset-name))) 11536 ;; replace header prompts 11537 (vhdl-template-replace-header-keywords start end nil t) 11538 (goto-char start) 11539 ;; query other prompts 11540 (while (re-search-forward 11541 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) 11542 (unless (equal "cursor" (match-string 1)) 11543 (setq position (match-beginning 1)) 11544 (setq prompt (match-string 1)) 11545 (replace-match "") 11546 (setq string (vhdl-template-field prompt nil t)) 11547 ;; replace occurrences of same prompt 11548 (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) 11549 (replace-match (or string ""))) 11550 (goto-char position))) 11551 (goto-char start) 11552 ;; goto final position 11553 (if (re-search-forward "<cursor>" end t) 11554 (replace-match "") 11555 (goto-char end)))))) 11556 11557(defun vhdl-model-defun () 11558 "Define help and hook functions for user models." 11559 (let ((model-alist vhdl-model-alist) 11560 model-name model-keyword) 11561 (while model-alist 11562 ;; define functions for user models that can be invoked from menu and key 11563 ;; bindings and which themselves call `vhdl-model-insert' with the model 11564 ;; name as argument 11565 (setq model-name (nth 0 (car model-alist))) 11566 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () 11567 ,(concat "Insert model for \"" model-name "\".") 11568 (interactive) 11569 (vhdl-model-insert ,model-name))) 11570 ;; define hooks for user models that are invoked from keyword abbrevs 11571 (setq model-keyword (nth 3 (car model-alist))) 11572 (unless (equal model-keyword "") 11573 (eval `(defun 11574 ,(vhdl-function-name 11575 "vhdl-model" model-name "hook") () 11576 (vhdl-hooked-abbrev 11577 ',(vhdl-function-name "vhdl-model" model-name))))) 11578 (setq model-alist (cdr model-alist))))) 11579 11580(vhdl-model-defun) 11581 11582 11583;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11584;;; Port translation 11585;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11586 11587(defvar vhdl-port-list nil 11588 "Variable to hold last port map parsed.") 11589;; structure: (parenthesized expression means list of such entries) 11590;; (ent-name 11591;; ((generic-names) generic-type generic-init generic-comment group-comment) 11592;; ((port-names) port-object port-direct port-type port-comment group-comment) 11593;; (lib-name pack-key)) 11594 11595(defun vhdl-parse-string (string &optional optional) 11596 "Check that the text following point matches the regexp in STRING." 11597 (if (looking-at string) 11598 (progn (goto-char (match-end 0)) 11599 (when (vhdl-in-literal) 11600 (end-of-line)) 11601 (point)) 11602 (unless optional 11603 (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" 11604 (vhdl-current-line) string))) 11605 nil)) 11606 11607(defun vhdl-replace-string (regexp-cons string &optional adjust-case) 11608 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." 11609 (vhdl-prepare-search-1 11610 (if (string-match (car regexp-cons) string) 11611 (if adjust-case 11612 (funcall vhdl-file-name-case 11613 (replace-match (cdr regexp-cons) t nil string)) 11614 (replace-match (cdr regexp-cons) t nil string)) 11615 string))) 11616 11617(defun vhdl-parse-group-comment () 11618 "Parse comment and empty lines between groups of lines." 11619 (let ((start (point)) 11620 string) 11621 (vhdl-forward-comment (point-max)) 11622 (setq string (buffer-substring-no-properties start (point))) 11623 (vhdl-forward-syntactic-ws) 11624 ;; strip off leading blanks and first newline 11625 (while (string-match "^\\(\\s-+\\)" string) 11626 (setq string (concat (substring string 0 (match-beginning 1)) 11627 (substring string (match-end 1))))) 11628 (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) 11629 (substring string 1) 11630 string))) 11631 11632(defun vhdl-paste-group-comment (string indent) 11633 "Paste comment and empty lines from STRING between groups of lines 11634with INDENT." 11635 (let ((pos (point-marker))) 11636 (when (> indent 0) 11637 (while (string-match "^\\(--\\)" string) 11638 (setq string (concat (substring string 0 (match-beginning 1)) 11639 (make-string indent ? ) 11640 (substring string (match-beginning 1)))))) 11641 (beginning-of-line) 11642 (insert string) 11643 (goto-char pos))) 11644 11645(defvar vhdl-port-flattened nil 11646 "Indicates whether a port has been flattened.") 11647 11648(defun vhdl-port-flatten (&optional as-alist) 11649 "Flatten port list so that only one generic/port exists per line. 11650This operation is performed on an internally stored port and is only 11651reflected in a subsequent paste operation." 11652 (interactive) 11653 (if (not vhdl-port-list) 11654 (error "ERROR: No port has been read") 11655 (message "Flattening port for next paste...") 11656 (let ((new-vhdl-port-list (list (car vhdl-port-list))) 11657 (old-vhdl-port-list (cdr vhdl-port-list)) 11658 old-port-list new-port-list old-port new-port names) 11659 ;; traverse port list and flatten entries 11660 (while (cdr old-vhdl-port-list) 11661 (setq old-port-list (car old-vhdl-port-list)) 11662 (setq new-port-list nil) 11663 (while old-port-list 11664 (setq old-port (car old-port-list)) 11665 (setq names (car old-port)) 11666 (while names 11667 (setq new-port (cons (if as-alist (car names) (list (car names))) 11668 (cdr old-port))) 11669 (setq new-port-list (append new-port-list (list new-port))) 11670 (setq names (cdr names))) 11671 (setq old-port-list (cdr old-port-list))) 11672 (setq old-vhdl-port-list (cdr old-vhdl-port-list)) 11673 (setq new-vhdl-port-list (append new-vhdl-port-list 11674 (list new-port-list)))) 11675 (setq vhdl-port-list 11676 (append new-vhdl-port-list (list old-vhdl-port-list)) 11677 vhdl-port-flattened t) 11678 (message "Flattening port for next paste...done")))) 11679 11680(defvar vhdl-port-reversed-direction nil 11681 "Indicates whether port directions are reversed.") 11682 11683(defun vhdl-port-reverse-direction () 11684 "Reverse direction for all ports (useful in testbenches). 11685This operation is performed on an internally stored port and is only 11686reflected in a subsequent paste operation." 11687 (interactive) 11688 (if (not vhdl-port-list) 11689 (error "ERROR: No port has been read") 11690 (message "Reversing port directions for next paste...") 11691 (let ((port-list (nth 2 vhdl-port-list)) 11692 port-dir-car port-dir) 11693 ;; traverse port list and reverse directions 11694 (while port-list 11695 (setq port-dir-car (cddr (car port-list)) 11696 port-dir (car port-dir-car)) 11697 (setcar port-dir-car 11698 (cond ((equal port-dir "in") "out") 11699 ((equal port-dir "IN") "OUT") 11700 ((equal port-dir "out") "in") 11701 ((equal port-dir "OUT") "IN") 11702 (t port-dir))) 11703 (setq port-list (cdr port-list))) 11704 (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) 11705 (message "Reversing port directions for next paste...done")))) 11706 11707(defun vhdl-port-copy () 11708 "Get generic and port information from an entity or component declaration." 11709 (interactive) 11710 (save-excursion 11711 (let (parse-error end-of-list 11712 decl-type name generic-list port-list context-clause 11713 object names direct type init comment group-comment) 11714 (vhdl-prepare-search-2 11715 (setq 11716 parse-error 11717 (catch 'parse 11718 ;; check if within entity or component declaration 11719 (end-of-line) 11720 (when (or (not (re-search-backward 11721 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) 11722 (equal "END" (upcase (match-string 1)))) 11723 (throw 'parse "ERROR: Not within an entity or component declaration")) 11724 (setq decl-type (downcase (match-string-no-properties 1))) 11725 (forward-word-strictly 1) 11726 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") 11727 (setq name (match-string-no-properties 1)) 11728 (message "Reading port of %s \"%s\"..." decl-type name) 11729 (vhdl-forward-syntactic-ws) 11730 ;; parse generic clause 11731 (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t) 11732 ;; parse group comment and spacing 11733 (setq group-comment (vhdl-parse-group-comment)) 11734 (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) 11735 (while (not end-of-list) 11736 ;; parse names (accept extended identifiers) 11737 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 11738 (setq names (list (match-string-no-properties 1))) 11739 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 11740 (setq names 11741 (append names (list (match-string-no-properties 1))))) 11742 ;; parse type 11743 (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)") 11744 (setq type (match-string-no-properties 1)) 11745 (when (vhdl-in-comment-p) ; if stuck in comment 11746 (setq type (concat type (and (vhdl-parse-string ".*") 11747 (match-string-no-properties 0))))) 11748 (setq comment nil) 11749 (while (looking-at "(") 11750 (setq type 11751 (concat type 11752 (buffer-substring-no-properties 11753 (point) (progn (forward-sexp) (point))) 11754 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 11755 (match-string-no-properties 1))))) 11756 ;; special case: closing parenthesis is on separate line 11757 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11758 (setq comment (substring type (match-beginning 2))) 11759 (setq type (substring type 0 (match-beginning 1)))) 11760 ;; strip of trailing group-comment 11761 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11762 (setq type (substring type 0 (match-end 1))) 11763 ;; parse initialization expression 11764 (setq init nil) 11765 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) 11766 (vhdl-parse-string "\\([^();\n]*\\)") 11767 (setq init (match-string-no-properties 1)) 11768 (while (looking-at "(") 11769 (setq init 11770 (concat init 11771 (buffer-substring-no-properties 11772 (point) (progn (forward-sexp) (point))) 11773 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11774 (match-string-no-properties 1)))))) 11775 ;; special case: closing parenthesis is on separate line 11776 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 11777 (setq comment (substring init (match-beginning 2))) 11778 (setq init (substring init 0 (match-beginning 1))) 11779 (vhdl-forward-syntactic-ws)) 11780 (skip-chars-forward " \t") 11781 ;; parse inline comment, special case: as above, no initial. 11782 (unless comment 11783 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11784 (match-string-no-properties 1)))) 11785 (vhdl-forward-syntactic-ws) 11786 (setq end-of-list (vhdl-parse-string ")" t)) 11787 (vhdl-parse-string "\\s-*;\\s-*") 11788 ;; parse inline comment 11789 (unless comment 11790 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11791 (match-string-no-properties 1)))) 11792 ;; save everything in list 11793 (setq generic-list (append generic-list 11794 (list (list names type init 11795 comment group-comment)))) 11796 ;; parse group comment and spacing 11797 (setq group-comment (vhdl-parse-group-comment)))) 11798 ;; parse port clause 11799 (when (vhdl-parse-string "port[ \t\n\r\f]*(" t) 11800 ;; parse group comment and spacing 11801 (setq group-comment (vhdl-parse-group-comment)) 11802 (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) 11803 (while (not end-of-list) 11804 ;; parse object 11805 (setq object 11806 (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t) 11807 (match-string-no-properties 1))) 11808 ;; parse names (accept extended identifiers) 11809 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 11810 (setq names (list (match-string-no-properties 1))) 11811 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 11812 (setq names (append names (list (match-string-no-properties 1))))) 11813 ;; parse direction 11814 (vhdl-parse-string ":[ \t\n\r\f]*") 11815 (setq direct 11816 (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t) 11817 (match-string-no-properties 1))) 11818 ;; parse type 11819 (vhdl-parse-string "\\([^();\n]+\\)") 11820 (setq type (match-string-no-properties 1)) 11821 (when (vhdl-in-comment-p) ; if stuck in comment 11822 (setq type (concat type (and (vhdl-parse-string ".*") 11823 (match-string-no-properties 0))))) 11824 (setq comment nil) 11825 (while (looking-at "(") 11826 (setq type (concat type 11827 (buffer-substring-no-properties 11828 (point) (progn (forward-sexp) (point))) 11829 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11830 (match-string-no-properties 1))))) 11831 ;; special case: closing parenthesis is on separate line 11832 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11833 (setq comment (substring type (match-beginning 2))) 11834 (setq type (substring type 0 (match-beginning 1)))) 11835 ;; strip of trailing group-comment 11836 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11837 (setq type (substring type 0 (match-end 1))) 11838 (vhdl-forward-syntactic-ws) 11839 (setq end-of-list (vhdl-parse-string ")" t)) 11840 (vhdl-parse-string "\\s-*;\\s-*") 11841 ;; parse inline comment 11842 (unless comment 11843 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11844 (match-string-no-properties 1)))) 11845 ;; save everything in list 11846 (setq port-list (append port-list 11847 (list (list names object direct type 11848 comment group-comment)))) 11849 ;; parse group comment and spacing 11850 (setq group-comment (vhdl-parse-group-comment)))) 11851 ;; parse context clause 11852 (setq context-clause (vhdl-scan-context-clause)) 11853; ;; add surrounding package to context clause 11854; (when (and (equal decl-type "component") 11855; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) 11856; (setq context-clause 11857; (append context-clause 11858; (list (cons (vhdl-work-library) 11859; (match-string-no-properties 1)))))) 11860 (message "Reading port of %s \"%s\"...done" decl-type name) 11861 nil))) 11862 ;; finish parsing 11863 (if parse-error 11864 (error parse-error) 11865 (setq vhdl-port-list (list name generic-list port-list context-clause) 11866 vhdl-port-reversed-direction nil 11867 vhdl-port-flattened nil))))) 11868 11869(defun vhdl-port-paste-context-clause (&optional exclude-pack-name) 11870 "Paste a context clause." 11871 (let ((margin (current-indentation)) 11872 (clause-list (nth 3 vhdl-port-list)) 11873 clause) 11874 (while clause-list 11875 (setq clause (car clause-list)) 11876 (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) 11877 (downcase exclude-pack-name))) 11878 (save-excursion 11879 (re-search-backward 11880 (concat "^\\s-*use\\s-+" (car clause) 11881 "." (cdr clause) "\\>") nil t))) 11882 (vhdl-template-standard-package (car clause) (cdr clause)) 11883 (insert "\n")) 11884 (setq clause-list (cdr clause-list))))) 11885 11886(defun vhdl-port-paste-generic (&optional no-init) 11887 "Paste a generic clause." 11888 (let ((margin (current-indentation)) 11889 (generic-list (nth 1 vhdl-port-list)) 11890 list-margin start names generic) 11891 ;; paste generic clause 11892 (when generic-list 11893 (setq start (point)) 11894 (vhdl-insert-keyword "GENERIC (") 11895 (unless vhdl-argument-list-indent 11896 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11897 (setq list-margin (current-column)) 11898 (while generic-list 11899 (setq generic (car generic-list)) 11900 ;; paste group comment and spacing 11901 (when (memq vhdl-include-group-comments '(decl always)) 11902 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 11903 ;; paste names 11904 (setq names (nth 0 generic)) 11905 (while names 11906 (insert (car names)) 11907 (setq names (cdr names)) 11908 (when names (insert ", "))) 11909 ;; paste type 11910 (insert " : " (nth 1 generic)) 11911 ;; paste initialization 11912 (when (and (not no-init) (nth 2 generic)) 11913 (insert " := " (nth 2 generic))) 11914 (unless (cdr generic-list) (insert ")")) 11915 (insert ";") 11916 ;; paste comment 11917 (when (and vhdl-include-port-comments (nth 3 generic)) 11918 (vhdl-comment-insert-inline (nth 3 generic) t)) 11919 (setq generic-list (cdr generic-list)) 11920 (when generic-list (insert "\n") (indent-to list-margin))) 11921 ;; align generic clause 11922 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) 11923 11924(defun vhdl-port-paste-port () 11925 "Paste a port clause." 11926 (let ((margin (current-indentation)) 11927 (port-list (nth 2 vhdl-port-list)) 11928 list-margin start names port) 11929 ;; paste port clause 11930 (when port-list 11931 (setq start (point)) 11932 (vhdl-insert-keyword "PORT (") 11933 (unless vhdl-argument-list-indent 11934 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11935 (setq list-margin (current-column)) 11936 (while port-list 11937 (setq port (car port-list)) 11938 ;; paste group comment and spacing 11939 (when (memq vhdl-include-group-comments '(decl always)) 11940 (vhdl-paste-group-comment (nth 5 port) list-margin)) 11941 ;; paste object 11942 (when (nth 1 port) (insert (nth 1 port) " ")) 11943 ;; paste names 11944 (setq names (nth 0 port)) 11945 (while names 11946 (insert (car names)) 11947 (setq names (cdr names)) 11948 (when names (insert ", "))) 11949 ;; paste direction 11950 (insert " : ") 11951 (when (nth 2 port) (insert (nth 2 port) " ")) 11952 ;; paste type 11953 (insert (nth 3 port)) 11954 (unless (cdr port-list) (insert ")")) 11955 (insert ";") 11956 ;; paste comment 11957 (when (and vhdl-include-port-comments (nth 4 port)) 11958 (vhdl-comment-insert-inline (nth 4 port) t)) 11959 (setq port-list (cdr port-list)) 11960 (when port-list (insert "\n") (indent-to list-margin))) 11961 ;; align port clause 11962 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 11963 11964(defun vhdl-port-paste-declaration (kind &optional no-indent) 11965 "Paste as an entity or component declaration." 11966 (unless no-indent (indent-according-to-mode)) 11967 (let ((margin (current-indentation)) 11968 (name (nth 0 vhdl-port-list))) 11969 (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) 11970 (insert name) 11971 (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) 11972 (vhdl-insert-keyword " IS")) 11973 ;; paste generic and port clause 11974 (when (nth 1 vhdl-port-list) 11975 (insert "\n") 11976 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11977 (insert "\n")) 11978 (indent-to (+ margin vhdl-basic-offset)) 11979 (vhdl-port-paste-generic (eq kind 'component))) 11980 (when (nth 2 vhdl-port-list) 11981 (insert "\n") 11982 (when (and (memq vhdl-insert-empty-lines '(unit all)) 11983 (eq kind 'entity)) 11984 (insert "\n")) 11985 (indent-to (+ margin vhdl-basic-offset))) 11986 (vhdl-port-paste-port) 11987 (insert "\n") 11988 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11989 (insert "\n")) 11990 (indent-to margin) 11991 (vhdl-insert-keyword "END") 11992 (if (eq kind 'entity) 11993 (progn 11994 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) 11995 (insert " " name)) 11996 (vhdl-insert-keyword " COMPONENT") 11997 (unless (vhdl-standard-p '87) (insert " " name))) 11998 (insert ";"))) 11999 12000(defun vhdl-port-paste-entity (&optional no-indent) 12001 "Paste as an entity declaration." 12002 (interactive) 12003 (if (not vhdl-port-list) 12004 (error "ERROR: No port read") 12005 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) 12006 (vhdl-port-paste-declaration 'entity no-indent) 12007 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) 12008 12009(defun vhdl-port-paste-component (&optional no-indent) 12010 "Paste as a component declaration." 12011 (interactive) 12012 (if (not vhdl-port-list) 12013 (error "ERROR: No port read") 12014 (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) 12015 (vhdl-port-paste-declaration 'component no-indent) 12016 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) 12017 12018(defun vhdl-port-paste-generic-map (&optional secondary no-constants) 12019 "Paste as a generic map." 12020 (interactive) 12021 (unless secondary (indent-according-to-mode)) 12022 (let ((margin (current-indentation)) 12023 list-margin start generic 12024 (generic-list (nth 1 vhdl-port-list))) 12025 (when generic-list 12026 (setq start (point)) 12027 (vhdl-insert-keyword "GENERIC MAP (") 12028 (if (not vhdl-association-list-with-formals) 12029 ;; paste list of actual generics 12030 (while generic-list 12031 (insert (if no-constants 12032 (car (nth 0 (car generic-list))) 12033 (or (nth 2 (car generic-list)) " "))) 12034 (setq generic-list (cdr generic-list)) 12035 (insert (if generic-list ", " ")")) 12036 (when (and (not generic-list) secondary 12037 (null (nth 2 vhdl-port-list))) 12038 (insert ";"))) 12039 (unless vhdl-argument-list-indent 12040 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12041 (setq list-margin (current-column)) 12042 (while generic-list 12043 (setq generic (car generic-list)) 12044 ;; paste group comment and spacing 12045 (when (eq vhdl-include-group-comments 'always) 12046 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 12047 ;; paste formal and actual generic 12048 (insert (car (nth 0 generic)) " => " 12049 (if no-constants 12050 (vhdl-replace-string vhdl-actual-generic-name 12051 (car (nth 0 generic))) 12052 (or (nth 2 generic) ""))) 12053 (setq generic-list (cdr generic-list)) 12054 (insert (if generic-list "," ")")) 12055 (when (and (not generic-list) secondary 12056 (null (nth 2 vhdl-port-list))) 12057 (insert ";")) 12058 ;; paste comment 12059 (when (or vhdl-include-type-comments 12060 (and vhdl-include-port-comments (nth 3 generic))) 12061 (vhdl-comment-insert-inline 12062 (concat 12063 (when vhdl-include-type-comments 12064 (concat "[" (nth 1 generic) "] ")) 12065 (when vhdl-include-port-comments (nth 3 generic))) t)) 12066 (when generic-list (insert "\n") (indent-to list-margin))) 12067 ;; align generic map 12068 (when vhdl-auto-align 12069 (vhdl-align-region-groups start (point) 1 t)))))) 12070 12071(defun vhdl-port-paste-port-map () 12072 "Paste as a port map." 12073 (let ((margin (current-indentation)) 12074 list-margin start port 12075 (port-list (nth 2 vhdl-port-list))) 12076 (when port-list 12077 (setq start (point)) 12078 (vhdl-insert-keyword "PORT MAP (") 12079 (if (not vhdl-association-list-with-formals) 12080 ;; paste list of actual ports 12081 (while port-list 12082 (insert (vhdl-replace-string vhdl-actual-port-name 12083 (car (nth 0 (car port-list))))) 12084 (setq port-list (cdr port-list)) 12085 (insert (if port-list ", " ")"))) 12086 (unless vhdl-argument-list-indent 12087 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12088 (setq list-margin (current-column)) 12089 (while port-list 12090 (setq port (car port-list)) 12091 ;; paste group comment and spacing 12092 (when (eq vhdl-include-group-comments 'always) 12093 (vhdl-paste-group-comment (nth 5 port) list-margin)) 12094 ;; paste formal and actual port 12095 (insert (car (nth 0 port)) " => ") 12096 (insert (vhdl-replace-string vhdl-actual-port-name 12097 (car (nth 0 port)))) 12098 (setq port-list (cdr port-list)) 12099 (insert (if port-list "," ");")) 12100 ;; paste comment 12101 (when (or (and vhdl-include-direction-comments (nth 2 port)) 12102 vhdl-include-type-comments 12103 (and vhdl-include-port-comments (nth 4 port))) 12104 (vhdl-comment-insert-inline 12105 (concat 12106 (cond ((and vhdl-include-direction-comments 12107 vhdl-include-type-comments) 12108 (concat "[" (format "%-4s" (concat (nth 2 port) " ")) 12109 (nth 3 port) "] ")) 12110 ((and vhdl-include-direction-comments (nth 2 port)) 12111 (format "%-6s" (concat "[" (nth 2 port) "] "))) 12112 (vhdl-include-direction-comments " ") 12113 (vhdl-include-type-comments 12114 (concat "[" (nth 3 port) "] "))) 12115 (when vhdl-include-port-comments (nth 4 port))) t)) 12116 (when port-list (insert "\n") (indent-to list-margin))) 12117 ;; align port clause 12118 (when vhdl-auto-align 12119 (vhdl-align-region-groups start (point) 1)))))) 12120 12121(defun vhdl-port-paste-instance (&optional name no-indent title) 12122 "Paste as an instantiation." 12123 (interactive) 12124 (if (not vhdl-port-list) 12125 (error "ERROR: No port read") 12126 (let ((orig-vhdl-port-list vhdl-port-list)) 12127 ;; flatten local copy of port list (must be flat for port mapping) 12128 (vhdl-port-flatten) 12129 (unless no-indent (indent-according-to-mode)) 12130 (let ((margin (current-indentation))) 12131 ;; paste instantiation 12132 (cond (name 12133 (insert name)) 12134 ((equal (cdr vhdl-instance-name) "") 12135 (setq name (vhdl-template-field "instance name"))) 12136 ((string-match "%d" (cdr vhdl-instance-name)) 12137 (let ((n 1)) 12138 (while (save-excursion 12139 (setq name (format (vhdl-replace-string 12140 vhdl-instance-name 12141 (nth 0 vhdl-port-list)) n)) 12142 (goto-char (point-min)) 12143 (vhdl-re-search-forward name nil t)) 12144 (setq n (1+ n))) 12145 (insert name))) 12146 (t (insert (vhdl-replace-string vhdl-instance-name 12147 (nth 0 vhdl-port-list))))) 12148 (message "Pasting port as instantiation \"%s\"..." name) 12149 (insert ": ") 12150 (when title 12151 (save-excursion 12152 (beginning-of-line) 12153 (indent-to vhdl-basic-offset) 12154 (insert "-- instance \"" name "\"\n"))) 12155 (if (not (vhdl-use-direct-instantiation)) 12156 (insert (nth 0 vhdl-port-list)) 12157 (vhdl-insert-keyword "ENTITY ") 12158 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) 12159 (when (nth 1 vhdl-port-list) 12160 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 12161 (vhdl-port-paste-generic-map t t)) 12162 (when (nth 2 vhdl-port-list) 12163 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 12164 (vhdl-port-paste-port-map)) 12165 (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) 12166 (insert ";")) 12167 (message "Pasting port as instantiation \"%s\"...done" name)) 12168 (setq vhdl-port-list orig-vhdl-port-list)))) 12169 12170(defun vhdl-port-paste-constants (&optional no-indent) 12171 "Paste generics as constants." 12172 (interactive) 12173 (if (not vhdl-port-list) 12174 (error "ERROR: No port read") 12175 (let ((orig-vhdl-port-list vhdl-port-list)) 12176 (message "Pasting port as constants...") 12177 ;; flatten local copy of port list (must be flat for constant initial.) 12178 (vhdl-port-flatten) 12179 (unless no-indent (indent-according-to-mode)) 12180 (let ((margin (current-indentation)) 12181 start generic name 12182 (generic-list (nth 1 vhdl-port-list))) 12183 (when generic-list 12184 (setq start (point)) 12185 (while generic-list 12186 (setq generic (car generic-list)) 12187 ;; paste group comment and spacing 12188 (when (memq vhdl-include-group-comments '(decl always)) 12189 (vhdl-paste-group-comment (nth 4 generic) margin)) 12190 (vhdl-insert-keyword "CONSTANT ") 12191 ;; paste generic constants 12192 (setq name (nth 0 generic)) 12193 (when name 12194 (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) 12195 ;; paste type 12196 (insert " : " (nth 1 generic)) 12197 ;; paste initialization 12198 (when (nth 2 generic) 12199 (insert " := " (nth 2 generic))) 12200 (insert ";") 12201 ;; paste comment 12202 (when (and vhdl-include-port-comments (nth 3 generic)) 12203 (vhdl-comment-insert-inline (nth 3 generic) t)) 12204 (setq generic-list (cdr generic-list)) 12205 (when generic-list (insert "\n") (indent-to margin)))) 12206 ;; align signal list 12207 (when vhdl-auto-align 12208 (vhdl-align-region-groups start (point) 1)))) 12209 (message "Pasting port as constants...done") 12210 (setq vhdl-port-list orig-vhdl-port-list)))) 12211 12212(defun vhdl-port-paste-signals (&optional initialize no-indent) 12213 "Paste ports as internal signals." 12214 (interactive) 12215 (if (not vhdl-port-list) 12216 (error "ERROR: No port read") 12217 (message "Pasting port as signals...") 12218 (unless no-indent (indent-according-to-mode)) 12219 (let ((margin (current-indentation)) 12220 start port names type generic-list port-name constant-name pos 12221 (port-list (nth 2 vhdl-port-list))) 12222 (when port-list 12223 (setq start (point)) 12224 (while port-list 12225 (setq port (car port-list)) 12226 ;; paste group comment and spacing 12227 (when (memq vhdl-include-group-comments '(decl always)) 12228 (vhdl-paste-group-comment (nth 5 port) margin)) 12229 ;; paste object 12230 (if (nth 1 port) 12231 (insert (nth 1 port) " ") 12232 (vhdl-insert-keyword "SIGNAL ")) 12233 ;; paste actual port signals 12234 (setq names (nth 0 port)) 12235 (while names 12236 (insert (vhdl-replace-string vhdl-actual-port-name (car names))) 12237 (setq names (cdr names)) 12238 (when names (insert ", "))) 12239 ;; paste type 12240 (setq type (nth 3 port)) 12241 (setq generic-list (nth 1 vhdl-port-list)) 12242 (vhdl-prepare-search-1 12243 (setq pos 0) 12244 ;; replace formal by actual generics 12245 (while generic-list 12246 (setq port-name (car (nth 0 (car generic-list)))) 12247 (while (string-match (concat "\\<" port-name "\\>") type pos) 12248 (setq constant-name 12249 (save-match-data (vhdl-replace-string 12250 vhdl-actual-generic-name port-name))) 12251 (setq type (replace-match constant-name t nil type)) 12252 (setq pos (match-end 0))) 12253 (setq generic-list (cdr generic-list)))) 12254 (insert " : " type) 12255 ;; paste initialization (inputs only) 12256 (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) 12257 (insert " := " 12258 (cond ((string-match "integer" (nth 3 port)) "0") 12259 ((string-match "natural" (nth 3 port)) "0") 12260 ((string-match "positive" (nth 3 port)) "0") 12261 ((string-match "real" (nth 3 port)) "0.0") 12262 ((string-match "(.+)" (nth 3 port)) "(others => '0')") 12263 (t "'0'")))) 12264 (insert ";") 12265 ;; paste comment 12266 (when (or (and vhdl-include-direction-comments (nth 2 port)) 12267 (and vhdl-include-port-comments (nth 4 port))) 12268 (vhdl-comment-insert-inline 12269 (concat 12270 (cond ((and vhdl-include-direction-comments (nth 2 port)) 12271 (format "%-6s" (concat "[" (nth 2 port) "] "))) 12272 (vhdl-include-direction-comments " ")) 12273 (when vhdl-include-port-comments (nth 4 port))) t)) 12274 (setq port-list (cdr port-list)) 12275 (when port-list (insert "\n") (indent-to margin))) 12276 ;; align signal list 12277 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 12278 (message "Pasting port as signals...done"))) 12279 12280(defun vhdl-port-paste-initializations (&optional no-indent) 12281 "Paste ports as signal initializations." 12282 (interactive) 12283 (if (not vhdl-port-list) 12284 (error "ERROR: No port read") 12285 (let ((orig-vhdl-port-list vhdl-port-list)) 12286 (message "Pasting port as initializations...") 12287 ;; flatten local copy of port list (must be flat for signal initial.) 12288 (vhdl-port-flatten) 12289 (unless no-indent (indent-according-to-mode)) 12290 (let ((margin (current-indentation)) 12291 start port name 12292 (port-list (nth 2 vhdl-port-list))) 12293 (when port-list 12294 (setq start (point)) 12295 (while port-list 12296 (setq port (car port-list)) 12297 ;; paste actual port signal (inputs only) 12298 (when (equal "IN" (upcase (nth 2 port))) 12299 (setq name (car (nth 0 port))) 12300 (insert (vhdl-replace-string vhdl-actual-port-name name)) 12301 ;; paste initialization 12302 (insert " <= " 12303 (cond ((string-match "integer" (nth 3 port)) "0") 12304 ((string-match "natural" (nth 3 port)) "0") 12305 ((string-match "positive" (nth 3 port)) "0") 12306 ((string-match "real" (nth 3 port)) "0.0") 12307 ((string-match "(.+)" (nth 3 port)) "(others => '0')") 12308 (t "'0'")) 12309 ";")) 12310 (setq port-list (cdr port-list)) 12311 (when (and port-list 12312 (equal "IN" (upcase (nth 2 (car port-list))))) 12313 (insert "\n") (indent-to margin))) 12314 ;; align signal list 12315 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 12316 (message "Pasting port as initializations...done") 12317 (setq vhdl-port-list orig-vhdl-port-list)))) 12318 12319(defun vhdl-port-paste-testbench () 12320 "Paste as a bare-bones testbench." 12321 (interactive) 12322 (if (not vhdl-port-list) 12323 (error "ERROR: No port read") 12324 (let ((case-fold-search t) 12325 (ent-name (vhdl-replace-string vhdl-testbench-entity-name 12326 (nth 0 vhdl-port-list))) 12327 (source-buffer (current-buffer)) 12328 arch-name config-name ent-file-name arch-file-name 12329 ent-buffer arch-buffer position) 12330 ;; open entity file 12331 (unless (eq vhdl-testbench-create-files 'none) 12332 (setq ent-file-name 12333 (concat (vhdl-replace-string vhdl-testbench-entity-file-name 12334 ent-name t) 12335 "." (file-name-extension (buffer-file-name)))) 12336 (if (file-exists-p ent-file-name) 12337 (if (y-or-n-p 12338 (concat "File \"" ent-file-name "\" exists; overwrite? ")) 12339 (progn (find-file ent-file-name) 12340 (erase-buffer) 12341 (set-buffer-modified-p nil)) 12342 (if (eq vhdl-testbench-create-files 'separate) 12343 (setq ent-file-name nil) 12344 (error "ERROR: Pasting port as testbench...aborted"))) 12345 (find-file ent-file-name))) 12346 (unless (and (eq vhdl-testbench-create-files 'separate) 12347 (null ent-file-name)) 12348 ;; paste entity header 12349 (if vhdl-testbench-include-header 12350 (progn (vhdl-template-header 12351 (concat "Testbench for design \"" 12352 (nth 0 vhdl-port-list) "\"")) 12353 (goto-char (point-max))) 12354 (vhdl-comment-display-line) (insert "\n\n")) 12355 ;; paste std_logic_1164 package 12356 (when vhdl-testbench-include-library 12357 (vhdl-template-package-std-logic-1164) 12358 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) 12359 ;; paste entity declaration 12360 (vhdl-insert-keyword "ENTITY ") 12361 (insert ent-name) 12362 (vhdl-insert-keyword " IS") 12363 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 12364 (insert "\n") 12365 (vhdl-insert-keyword "END ") 12366 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 12367 (insert ent-name ";") 12368 (insert "\n\n") 12369 (vhdl-comment-display-line) (insert "\n")) 12370 ;; get architecture name 12371 (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") 12372 (read-from-minibuffer "architecture name: " 12373 nil vhdl-minibuffer-local-map) 12374 (vhdl-replace-string vhdl-testbench-architecture-name 12375 (nth 0 vhdl-port-list)))) 12376 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) 12377 ;; open architecture file 12378 (if (not (eq vhdl-testbench-create-files 'separate)) 12379 (insert "\n") 12380 (setq ent-buffer (current-buffer)) 12381 (setq arch-file-name 12382 (concat (vhdl-replace-string vhdl-testbench-architecture-file-name 12383 (concat ent-name " " arch-name) t) 12384 "." (file-name-extension (buffer-file-name)))) 12385 (when (and (file-exists-p arch-file-name) 12386 (not (y-or-n-p (concat "File \"" arch-file-name 12387 "\" exists; overwrite? ")))) 12388 (error "ERROR: Pasting port as testbench...aborted")) 12389 (find-file arch-file-name) 12390 (erase-buffer) 12391 (set-buffer-modified-p nil) 12392 ;; paste architecture header 12393 (if vhdl-testbench-include-header 12394 (progn (vhdl-template-header 12395 (concat "Testbench architecture for design \"" 12396 (nth 0 vhdl-port-list) "\"")) 12397 (goto-char (point-max))) 12398 (vhdl-comment-display-line) (insert "\n\n"))) 12399 ;; paste architecture body 12400 (vhdl-insert-keyword "ARCHITECTURE ") 12401 (insert arch-name) 12402 (vhdl-insert-keyword " OF ") 12403 (insert ent-name) 12404 (vhdl-insert-keyword " IS") 12405 (insert "\n\n") (indent-to vhdl-basic-offset) 12406 ;; paste component declaration 12407 (unless (vhdl-use-direct-instantiation) 12408 (vhdl-port-paste-component t) 12409 (insert "\n\n") (indent-to vhdl-basic-offset)) 12410 ;; paste constants 12411 (when (nth 1 vhdl-port-list) 12412 (insert "-- component generics\n") (indent-to vhdl-basic-offset) 12413 (vhdl-port-paste-constants t) 12414 (insert "\n\n") (indent-to vhdl-basic-offset)) 12415 ;; paste internal signals 12416 (insert "-- component ports\n") (indent-to vhdl-basic-offset) 12417 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) 12418 (insert "\n") 12419 ;; paste custom declarations 12420 (unless (equal "" vhdl-testbench-declarations) 12421 (insert "\n") 12422 (setq position (point)) 12423 (vhdl-insert-string-or-file vhdl-testbench-declarations) 12424 (vhdl-indent-region position (point))) 12425 (setq position (point)) 12426 (insert "\n\n") 12427 (vhdl-comment-display-line) (insert "\n") 12428 (when vhdl-testbench-include-configuration 12429 (setq config-name (vhdl-replace-string 12430 vhdl-testbench-configuration-name 12431 (concat ent-name " " arch-name))) 12432 (insert "\n") 12433 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) 12434 (vhdl-insert-keyword " OF ") (insert ent-name) 12435 (vhdl-insert-keyword " IS\n") 12436 (indent-to vhdl-basic-offset) 12437 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 12438 (indent-to vhdl-basic-offset) 12439 (vhdl-insert-keyword "END FOR;\n") 12440 (vhdl-insert-keyword "END ") (insert config-name ";\n\n") 12441 (vhdl-comment-display-line) (insert "\n")) 12442 (goto-char position) 12443 (vhdl-template-begin-end 12444 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) 12445 ;; paste instantiation 12446 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) 12447 (vhdl-port-paste-instance 12448 (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) 12449 (insert "\n") 12450 ;; paste custom statements 12451 (unless (equal "" vhdl-testbench-statements) 12452 (insert "\n") 12453 (setq position (point)) 12454 (vhdl-insert-string-or-file vhdl-testbench-statements) 12455 (vhdl-indent-region position (point))) 12456 (insert "\n") 12457 (indent-to vhdl-basic-offset) 12458 (unless (eq vhdl-testbench-create-files 'none) 12459 (setq arch-buffer (current-buffer)) 12460 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 12461 (set-buffer arch-buffer) (save-buffer)) 12462 (message "%s" 12463 (concat (format "Pasting port as testbench \"%s(%s)\"...done" 12464 ent-name arch-name) 12465 (and ent-file-name 12466 (format "\n File created: \"%s\"" ent-file-name)) 12467 (and arch-file-name 12468 (format "\n File created: \"%s\"" arch-file-name))))))) 12469 12470 12471;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12472;;; Subprogram interface translation 12473;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12474 12475(defvar vhdl-subprog-list nil 12476 "Variable to hold last subprogram interface parsed.") 12477;; structure: (parenthesized expression means list of such entries) 12478;; (subprog-name kind 12479;; ((names) object direct type init comment group-comment) 12480;; return-type return-comment group-comment) 12481 12482(defvar vhdl-subprog-flattened nil 12483 "Indicates whether an subprogram interface has been flattened.") 12484 12485(defun vhdl-subprog-flatten () 12486 "Flatten interface list so that only one parameter exists per line." 12487 (interactive) 12488 (if (not vhdl-subprog-list) 12489 (error "ERROR: No subprogram interface has been read") 12490 (message "Flattening subprogram interface...") 12491 (let ((old-subprog-list (nth 2 vhdl-subprog-list)) 12492 new-subprog-list old-subprog new-subprog names) 12493 ;; traverse parameter list and flatten entries 12494 (while old-subprog-list 12495 (setq old-subprog (car old-subprog-list)) 12496 (setq names (car old-subprog)) 12497 (while names 12498 (setq new-subprog (cons (list (car names)) (cdr old-subprog))) 12499 (setq new-subprog-list (append new-subprog-list (list new-subprog))) 12500 (setq names (cdr names))) 12501 (setq old-subprog-list (cdr old-subprog-list))) 12502 (setq vhdl-subprog-list 12503 (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) 12504 new-subprog-list (nth 3 vhdl-subprog-list) 12505 (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) 12506 vhdl-subprog-flattened t) 12507 (message "Flattening subprogram interface...done")))) 12508 12509(defun vhdl-subprog-copy () 12510 "Get interface information from a subprogram specification." 12511 (interactive) 12512 (save-excursion 12513 (let (parse-error pos end-of-list 12514 name kind param-list object names direct type init 12515 comment group-comment 12516 return-type return-comment return-group-comment) 12517 (vhdl-prepare-search-2 12518 (setq 12519 parse-error 12520 (catch 'parse 12521 ;; check if within function declaration 12522 (setq pos (point)) 12523 (end-of-line) 12524 (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) 12525 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) 12526 (goto-char (match-end 0)) 12527 (save-excursion (backward-char) 12528 (forward-sexp) 12529 (<= pos (point)))) 12530 (throw 'parse "ERROR: Not within a subprogram specification")) 12531 (setq name (match-string-no-properties 5)) 12532 (setq kind (if (match-string 2) 'procedure 'function)) 12533 (setq end-of-list (not (match-string 7))) 12534 (message "Reading interface of subprogram \"%s\"..." name) 12535 ;; parse parameter list 12536 (setq group-comment (vhdl-parse-group-comment)) 12537 (setq end-of-list (or end-of-list 12538 (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) 12539 (while (not end-of-list) 12540 ;; parse object 12541 (setq object 12542 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t) 12543 (match-string-no-properties 1))) 12544 ;; parse names (accept extended identifiers) 12545 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 12546 (setq names (list (match-string-no-properties 1))) 12547 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 12548 (setq names (append names (list (match-string-no-properties 1))))) 12549 ;; parse direction 12550 (vhdl-parse-string ":[ \t\n\r\f]*") 12551 (setq direct 12552 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t) 12553 (match-string-no-properties 1))) 12554 ;; parse type 12555 (vhdl-parse-string "\\([^():;\n]+\\)") 12556 (setq type (match-string-no-properties 1)) 12557 (setq comment nil) 12558 (while (looking-at "(") 12559 (setq type 12560 (concat type 12561 (buffer-substring-no-properties 12562 (point) (progn (forward-sexp) (point))) 12563 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 12564 (match-string-no-properties 1))))) 12565 ;; special case: closing parenthesis is on separate line 12566 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 12567 (setq comment (substring type (match-beginning 2))) 12568 (setq type (substring type 0 (match-beginning 1)))) 12569 ;; strip off trailing group-comment 12570 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 12571 (setq type (substring type 0 (match-end 1))) 12572 ;; parse initialization expression 12573 (setq init nil) 12574 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) 12575 (vhdl-parse-string "\\([^();\n]*\\)") 12576 (setq init (match-string-no-properties 1)) 12577 (while (looking-at "(") 12578 (setq init 12579 (concat init 12580 (buffer-substring-no-properties 12581 (point) (progn (forward-sexp) (point))) 12582 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 12583 (match-string-no-properties 1)))))) 12584 ;; special case: closing parenthesis is on separate line 12585 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 12586 (setq comment (substring init (match-beginning 2))) 12587 (setq init (substring init 0 (match-beginning 1))) 12588 (vhdl-forward-syntactic-ws)) 12589 (skip-chars-forward " \t") 12590 ;; parse inline comment, special case: as above, no initial. 12591 (unless comment 12592 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12593 (match-string-no-properties 1)))) 12594 (vhdl-forward-syntactic-ws) 12595 (setq end-of-list (vhdl-parse-string ")\\s-*" t)) 12596 ;; parse inline comment 12597 (unless comment 12598 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12599 (match-string-no-properties 1)))) 12600 (setq return-group-comment (vhdl-parse-group-comment)) 12601 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") 12602 ;; parse return type 12603 (when (match-string 3) 12604 (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*") 12605 (setq return-type (match-string-no-properties 1)) 12606 (when (and return-type 12607 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) 12608 (setq return-comment (substring return-type (match-beginning 2))) 12609 (setq return-type (substring return-type 0 (match-beginning 1)))) 12610 ;; strip of trailing group-comment 12611 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) 12612 (setq return-type (substring return-type 0 (match-end 1))) 12613 ;; parse return comment 12614 (unless return-comment 12615 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12616 (match-string-no-properties 1))))) 12617 ;; parse inline comment 12618 (unless comment 12619 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12620 (match-string-no-properties 1)))) 12621 ;; save everything in list 12622 (setq param-list (append param-list 12623 (list (list names object direct type init 12624 comment group-comment)))) 12625 ;; parse group comment and spacing 12626 (setq group-comment (vhdl-parse-group-comment))) 12627 (message "Reading interface of subprogram \"%s\"...done" name) 12628 nil))) 12629 ;; finish parsing 12630 (if parse-error 12631 (error parse-error) 12632 (setq vhdl-subprog-list 12633 (list name kind param-list return-type return-comment 12634 return-group-comment) 12635 vhdl-subprog-flattened nil))))) 12636 12637(defun vhdl-subprog-paste-specification (kind) 12638 "Paste as a subprogram specification." 12639 (indent-according-to-mode) 12640 (let ((margin (current-column)) 12641 (param-list (nth 2 vhdl-subprog-list)) 12642 list-margin start names param) 12643 ;; paste keyword and name 12644 (vhdl-insert-keyword 12645 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) 12646 (insert (nth 0 vhdl-subprog-list)) 12647 (if (not param-list) 12648 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 12649 (setq start (point)) 12650 ;; paste parameter list 12651 (insert " (") 12652 (unless vhdl-argument-list-indent 12653 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12654 (setq list-margin (current-column)) 12655 (while param-list 12656 (setq param (car param-list)) 12657 ;; paste group comment and spacing 12658 (when (memq vhdl-include-group-comments (list kind 'always)) 12659 (vhdl-paste-group-comment (nth 6 param) list-margin)) 12660 ;; paste object 12661 (when (nth 1 param) (insert (nth 1 param) " ")) 12662 ;; paste names 12663 (setq names (nth 0 param)) 12664 (while names 12665 (insert (car names)) 12666 (setq names (cdr names)) 12667 (when names (insert ", "))) 12668 ;; paste direction 12669 (insert " : ") 12670 (when (nth 2 param) (insert (nth 2 param) " ")) 12671 ;; paste type 12672 (insert (nth 3 param)) 12673 ;; paste initialization 12674 (when (nth 4 param) (insert " := " (nth 4 param))) 12675 ;; terminate line 12676 (if (cdr param-list) 12677 (insert ";") 12678 (insert ")") 12679 (when (null (nth 3 vhdl-subprog-list)) 12680 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) 12681 ;; paste comment 12682 (when (and vhdl-include-port-comments (nth 5 param)) 12683 (vhdl-comment-insert-inline (nth 5 param) t)) 12684 (setq param-list (cdr param-list)) 12685 (when param-list (insert "\n") (indent-to list-margin))) 12686 (when (nth 3 vhdl-subprog-list) 12687 (insert "\n") (indent-to list-margin) 12688 ;; paste group comment and spacing 12689 (when (memq vhdl-include-group-comments (list kind 'always)) 12690 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) 12691 ;; paste return type 12692 (insert "return " (nth 3 vhdl-subprog-list)) 12693 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 12694 (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) 12695 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) 12696 ;; align parameter list 12697 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) 12698 ;; paste body 12699 (when (eq kind 'body) 12700 (insert "\n") 12701 (vhdl-template-begin-end 12702 (unless (vhdl-standard-p '87) 12703 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) 12704 (nth 0 vhdl-subprog-list) margin)))) 12705 12706(defun vhdl-subprog-paste-declaration () 12707 "Paste as a subprogram declaration." 12708 (interactive) 12709 (if (not vhdl-subprog-list) 12710 (error "ERROR: No subprogram interface read") 12711 (message "Pasting interface as subprogram declaration \"%s\"..." 12712 (car vhdl-subprog-list)) 12713 ;; paste specification 12714 (vhdl-subprog-paste-specification 'decl) 12715 (message "Pasting interface as subprogram declaration \"%s\"...done" 12716 (car vhdl-subprog-list)))) 12717 12718(defun vhdl-subprog-paste-body () 12719 "Paste as a subprogram body." 12720 (interactive) 12721 (if (not vhdl-subprog-list) 12722 (error "ERROR: No subprogram interface read") 12723 (message "Pasting interface as subprogram body \"%s\"..." 12724 (car vhdl-subprog-list)) 12725 ;; paste specification and body 12726 (vhdl-subprog-paste-specification 'body) 12727 (message "Pasting interface as subprogram body \"%s\"...done" 12728 (car vhdl-subprog-list)))) 12729 12730(defun vhdl-subprog-paste-call () 12731 "Paste as a subprogram call." 12732 (interactive) 12733 (if (not vhdl-subprog-list) 12734 (error "ERROR: No subprogram interface read") 12735 (let ((orig-vhdl-subprog-list vhdl-subprog-list) 12736 param-list margin list-margin param start) 12737 ;; flatten local copy of interface list (must be flat for parameter mapping) 12738 (vhdl-subprog-flatten) 12739 (setq param-list (nth 2 vhdl-subprog-list)) 12740 (indent-according-to-mode) 12741 (setq margin (current-indentation)) 12742 (message "Pasting interface as subprogram call \"%s\"..." 12743 (car vhdl-subprog-list)) 12744 ;; paste name 12745 (insert (nth 0 vhdl-subprog-list)) 12746 (if (not param-list) 12747 (insert ";") 12748 (setq start (point)) 12749 ;; paste parameter list 12750 (insert " (") 12751 (unless vhdl-argument-list-indent 12752 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12753 (setq list-margin (current-column)) 12754 (while param-list 12755 (setq param (car param-list)) 12756 ;; paste group comment and spacing 12757 (when (eq vhdl-include-group-comments 'always) 12758 (vhdl-paste-group-comment (nth 6 param) list-margin)) 12759 ;; paste formal port 12760 (insert (car (nth 0 param)) " => ") 12761 (setq param-list (cdr param-list)) 12762 (insert (if param-list "," ");")) 12763 ;; paste comment 12764 (when (and vhdl-include-port-comments (nth 5 param)) 12765 (vhdl-comment-insert-inline (nth 5 param))) 12766 (when param-list (insert "\n") (indent-to list-margin))) 12767 ;; align parameter list 12768 (when vhdl-auto-align 12769 (vhdl-align-region-groups start (point) 1))) 12770 (message "Pasting interface as subprogram call \"%s\"...done" 12771 (car vhdl-subprog-list)) 12772 (setq vhdl-subprog-list orig-vhdl-subprog-list)))) 12773 12774 12775;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12776;;; Miscellaneous 12777;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12778 12779;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12780;; Hippie expand customization 12781 12782(defvar vhdl-expand-upper-case nil) 12783 12784(defun vhdl-try-expand-abbrev (old) 12785 "Try expanding abbreviations from `vhdl-abbrev-list'." 12786 (unless old 12787 (he-init-string (he-dabbrev-beg) (point)) 12788 (setq he-expand-list 12789 (let ((abbrev-list vhdl-abbrev-list) 12790 (sel-abbrev-list '())) 12791 (while abbrev-list 12792 (when (or (not (stringp (car abbrev-list))) 12793 (string-match 12794 (concat "^" he-search-string) (car abbrev-list))) 12795 (setq sel-abbrev-list 12796 (cons (car abbrev-list) sel-abbrev-list))) 12797 (setq abbrev-list (cdr abbrev-list))) 12798 (nreverse sel-abbrev-list)))) 12799 (while (and he-expand-list 12800 (or (not (stringp (car he-expand-list))) 12801 (he-string-member (car he-expand-list) he-tried-table t))) 12802 (unless (stringp (car he-expand-list)) 12803 (setq vhdl-expand-upper-case (car he-expand-list))) 12804 (setq he-expand-list (cdr he-expand-list))) 12805 (if (null he-expand-list) 12806 (progn (when old (he-reset-string)) 12807 nil) 12808 (he-substitute-string 12809 (if vhdl-expand-upper-case 12810 (upcase (car he-expand-list)) 12811 (car he-expand-list)) 12812 t) 12813 (setq he-expand-list (cdr he-expand-list)) 12814 t)) 12815 12816(defun vhdl-he-list-beg () 12817 "Also looks at the word before `(' in order to better match parenthesized 12818expressions (e.g. for index ranges of types and signals)." 12819 (save-excursion 12820 (condition-case () 12821 (progn (backward-up-list 1) 12822 (skip-syntax-backward "w_")) ; crashes in `viper-mode' 12823 (error ())) 12824 (point))) 12825 12826;; override `he-list-beg' from `hippie-exp' 12827(unless (and (boundp 'viper-mode) viper-mode) 12828 (defalias 'he-list-beg 'vhdl-he-list-beg)) 12829 12830;; function for expanding abbrevs and dabbrevs 12831(defalias 'vhdl-expand-abbrev (make-hippie-expand-function 12832 '(try-expand-dabbrev 12833 try-expand-dabbrev-all-buffers 12834 vhdl-try-expand-abbrev))) 12835 12836;; function for expanding parenthesis 12837(defalias 'vhdl-expand-paren (make-hippie-expand-function 12838 '(try-expand-list 12839 try-expand-list-all-buffers))) 12840 12841;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12842;; Line handling functions 12843 12844(defun vhdl-current-line () 12845 "Return the line number of the line containing point." 12846 (save-restriction 12847 (widen) 12848 (1+ (count-lines (point-min) (point-at-bol))))) 12849 12850(defun vhdl-line-kill-entire (&optional arg) 12851 "Delete entire line." 12852 (interactive "p") 12853 (beginning-of-line) 12854 (kill-line (or arg 1))) 12855 12856(defun vhdl-line-kill (&optional arg) 12857 "Kill current line." 12858 (interactive "p") 12859 (vhdl-line-kill-entire arg)) 12860 12861(defun vhdl-line-copy (&optional arg) 12862 "Copy current line." 12863 (interactive "p") 12864 (save-excursion 12865 (let ((position (point-at-bol))) 12866 (forward-line (or arg 1)) 12867 (copy-region-as-kill position (point))))) 12868 12869(defun vhdl-line-yank () 12870 "Yank entire line." 12871 (interactive) 12872 (beginning-of-line) 12873 (yank)) 12874 12875(defun vhdl-line-expand (&optional prefix-arg) 12876 "Hippie-expand current line." 12877 (interactive "P") 12878 (require 'hippie-exp) 12879 (let ((case-fold-search t) (case-replace nil) 12880 (hippie-expand-try-functions-list 12881 '(try-expand-line try-expand-line-all-buffers))) 12882 (hippie-expand prefix-arg))) 12883 12884(defun vhdl-line-transpose-next (&optional arg) 12885 "Interchange this line with next line." 12886 (interactive "p") 12887 (forward-line 1) 12888 (transpose-lines (or arg 1)) 12889 (forward-line -1)) 12890 12891(defun vhdl-line-transpose-previous (&optional arg) 12892 "Interchange this line with previous line." 12893 (interactive "p") 12894 (forward-line 1) 12895 (transpose-lines (- 0 (or arg 0))) 12896 (forward-line -1)) 12897 12898(defun vhdl-line-open () 12899 "Open a new line and indent." 12900 (interactive) 12901 (end-of-line -0) 12902 (newline-and-indent)) 12903 12904(defun vhdl-delete-indentation () 12905 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that 12906it works within comments too." 12907 (interactive) 12908 (let ((fill-prefix "-- ")) 12909 (delete-indentation))) 12910 12911;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12912;; Move functions 12913 12914(defun vhdl-forward-same-indent () 12915 "Move forward to next line with same indent." 12916 (interactive) 12917 (let ((pos (point)) 12918 (indent (current-indentation))) 12919 (beginning-of-line 2) 12920 (while (and (not (eobp)) 12921 (or (looking-at "^\\s-*\\(--.*\\)?$") 12922 (> (current-indentation) indent))) 12923 (beginning-of-line 2)) 12924 (if (= (current-indentation) indent) 12925 (back-to-indentation) 12926 (message "No following line with same indent found in this block") 12927 (goto-char pos) 12928 nil))) 12929 12930(defun vhdl-backward-same-indent () 12931 "Move backward to previous line with same indent." 12932 (interactive) 12933 (let ((pos (point)) 12934 (indent (current-indentation))) 12935 (beginning-of-line -0) 12936 (while (and (not (bobp)) 12937 (or (looking-at "^\\s-*\\(--.*\\)?$") 12938 (> (current-indentation) indent))) 12939 (beginning-of-line -0)) 12940 (if (= (current-indentation) indent) 12941 (back-to-indentation) 12942 (message "No preceding line with same indent found in this block") 12943 (goto-char pos) 12944 nil))) 12945 12946;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12947;; Statistics 12948 12949(defun vhdl-statistics-buffer () 12950 "Get some file statistics." 12951 (interactive) 12952 (let ((no-stats 0) 12953 (no-code-lines 0) 12954 (no-empty-lines 0) 12955 (no-comm-lines 0) 12956 (no-comments 0) 12957 (no-lines (count-lines (point-min) (point-max)))) 12958 (save-excursion 12959 ;; count statements 12960 (goto-char (point-min)) 12961 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) 12962 (if (match-string 1) 12963 (goto-char (match-end 1)) 12964 (setq no-stats (1+ no-stats)))) 12965 ;; count code lines 12966 (goto-char (point-min)) 12967 (while (not (eobp)) 12968 (unless (looking-at "^\\s-*\\(--.*\\)?$") 12969 (setq no-code-lines (1+ no-code-lines))) 12970 (beginning-of-line 2)) 12971 ;; count empty lines 12972 (goto-char (point-min)) 12973 (while (and (re-search-forward "^\\s-*$" nil t) 12974 (not (eq (point) (point-max)))) 12975 (if (match-string 1) 12976 (goto-char (match-end 1)) 12977 (setq no-empty-lines (1+ no-empty-lines)) 12978 (unless (eq (point) (point-max)) 12979 (forward-char)))) 12980 ;; count comment-only lines 12981 (goto-char (point-min)) 12982 (while (re-search-forward "^\\s-*--.*" nil t) 12983 (if (match-string 1) 12984 (goto-char (match-end 1)) 12985 (setq no-comm-lines (1+ no-comm-lines)))) 12986 ;; count comments 12987 (goto-char (point-min)) 12988 (while (re-search-forward "--.*" nil t) 12989 (if (match-string 1) 12990 (goto-char (match-end 1)) 12991 (setq no-comments (1+ no-comments))))) 12992 ;; print results 12993 (message "\n\ 12994File statistics: \"%s\"\n\ 12995-----------------------\n\ 12996# statements : %5d\n\ 12997# code lines : %5d\n\ 12998# empty lines : %5d\n\ 12999# comment lines : %5d\n\ 13000# comments : %5d\n\ 13001# total lines : %5d\n" 13002 (buffer-file-name) no-stats no-code-lines no-empty-lines 13003 no-comm-lines no-comments no-lines) 13004 (unless vhdl-emacs-21 (vhdl-show-messages)))) 13005 13006;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13007;; Help functions 13008 13009(defun vhdl-re-search-forward (regexp &optional bound noerror count) 13010 "Like `re-search-forward', but does not match within literals." 13011 (let (pos) 13012 (save-excursion 13013 (while (and (setq pos (re-search-forward regexp bound noerror count)) 13014 (save-match-data (vhdl-in-literal))))) 13015 (when pos (goto-char pos)) 13016 pos)) 13017 13018(defun vhdl-re-search-backward (regexp &optional bound noerror count) 13019 "Like `re-search-backward', but does not match within literals." 13020 (let (pos) 13021 (save-excursion 13022 (while (and (setq pos (re-search-backward regexp bound noerror count)) 13023 (save-match-data (vhdl-in-literal))))) 13024 (when pos (goto-char pos)) 13025 pos)) 13026 13027 13028;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13029;;; Project 13030;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13031 13032(defun vhdl-set-project (name) 13033 "Set current project to NAME." 13034 (interactive 13035 (list (let ((completion-ignore-case t)) 13036 (completing-read "Project name: " vhdl-project-alist nil t)))) 13037 (cond ((equal name "") 13038 (setq vhdl-project nil) 13039 (message "Current VHDL project: None")) 13040 ((assoc name vhdl-project-alist) 13041 (setq vhdl-project name) 13042 (message "Current VHDL project: \"%s\"" name)) 13043 (t 13044 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) 13045 (vhdl-speedbar-update-current-project)) 13046 13047(defun vhdl-set-default-project () 13048 "Set current project as default on startup." 13049 (interactive) 13050 (customize-set-variable 'vhdl-project vhdl-project) 13051 (customize-save-customized)) 13052 13053(defun vhdl-toggle-project (name token indent) 13054 "Set current project to NAME or unset if NAME is current project." 13055 (vhdl-set-project (if (equal name vhdl-project) "" name))) 13056 13057(defun vhdl-export-project (file-name) 13058 "Write project setup for current project." 13059 (interactive 13060 (let ((name (vhdl-resolve-env-variable 13061 (vhdl-replace-string 13062 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 13063 (concat (subst-char-in-string 13064 ? ?_ (or (vhdl-project-p) 13065 (error "ERROR: No current project"))) 13066 " " (user-login-name)))))) 13067 (list (read-file-name 13068 "Write project file: " 13069 (when (file-name-absolute-p name) "") nil nil name)))) 13070 (setq file-name (abbreviate-file-name file-name)) 13071 (let ((orig-buffer (current-buffer))) 13072 (unless (file-exists-p (file-name-directory file-name)) 13073 (make-directory (file-name-directory file-name) t)) 13074 (if (not (file-writable-p file-name)) 13075 (error "ERROR: File not writable: \"%s\"" file-name) 13076 (set-buffer (find-file-noselect file-name t t)) 13077 (erase-buffer) 13078 (insert ";; -*- Emacs-Lisp -*-\n\n" 13079 ";;; " (file-name-nondirectory file-name) 13080 " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" 13081 ";; Project : " vhdl-project "\n" 13082 ";; Saved : " (format-time-string "%Y-%m-%d %T ") 13083 (user-login-name) "\n\n\n" 13084 ";; project name\n" 13085 "(setq vhdl-project \"" vhdl-project "\")\n\n" 13086 ";; project setup\n" 13087 "(vhdl-aput 'vhdl-project-alist vhdl-project\n'") 13088 (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer)) 13089 (insert ")\n") 13090 (save-buffer) 13091 (kill-buffer (current-buffer)) 13092 (set-buffer orig-buffer)))) 13093 13094(defun vhdl-import-project (file-name &optional auto not-make-current) 13095 "Read project setup and set current project." 13096 (interactive 13097 (let ((name (vhdl-resolve-env-variable 13098 (vhdl-replace-string 13099 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 13100 (concat "" " " (user-login-name)))))) 13101 (list (read-file-name 13102 "Read project file: " (when (file-name-absolute-p name) "") nil t 13103 (file-name-directory name))))) 13104 (when (file-exists-p file-name) 13105 (condition-case () 13106 (let ((current-project vhdl-project)) 13107 (load-file file-name) 13108 (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10) 13109 (vhdl-adelete 'vhdl-project-alist vhdl-project) 13110 (error "")) 13111 (if not-make-current 13112 (setq vhdl-project current-project) 13113 (setq vhdl-compiler 13114 (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project))))) 13115 (vhdl-update-mode-menu) 13116 (vhdl-speedbar-refresh) 13117 (unless not-make-current 13118 (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s" 13119 vhdl-project vhdl-compiler (if auto " (auto-loaded)" "")))) 13120 (error (vhdl-warning 13121 (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) 13122 13123(defun vhdl-duplicate-project () 13124 "Duplicate setup of current project." 13125 (interactive) 13126 (let ((new-name (read-from-minibuffer "New project name: ")) 13127 (project-entry (vhdl-aget vhdl-project-alist vhdl-project))) 13128 (setq vhdl-project-alist 13129 (append vhdl-project-alist 13130 (list (cons new-name project-entry)))) 13131 (vhdl-update-mode-menu))) 13132 13133(defun vhdl-autoload-project () 13134 "Automatically load project setup at startup." 13135 (let ((file-name-list vhdl-project-file-name) 13136 file-list list-length) 13137 (while file-name-list 13138 (setq file-list 13139 (append file-list 13140 (file-expand-wildcards 13141 (vhdl-resolve-env-variable 13142 (vhdl-replace-string 13143 (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) 13144 (concat "* " (user-login-name))))))) 13145 (setq list-length (or list-length (length file-list))) 13146 (setq file-name-list (cdr file-name-list))) 13147 (while file-list 13148 (vhdl-import-project (expand-file-name (car file-list)) t 13149 (not (> list-length 0))) 13150 (setq list-length (1- list-length)) 13151 (setq file-list (cdr file-list))))) 13152(define-obsolete-function-alias 'vhdl-auto-load-project 13153 #'vhdl-autoload-project "27.1") 13154 13155;; automatically load project setup when idle after startup 13156(when (memq 'startup vhdl-project-autoload) 13157 (if noninteractive 13158 (vhdl-autoload-project) 13159 (vhdl-run-when-idle .1 nil 'vhdl-autoload-project))) 13160 13161 13162;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13163;;; Hideshow 13164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13165;; (using `hideshow.el') 13166 13167(defconst vhdl-hs-start-regexp 13168 (concat 13169 "\\(^\\)\\s-*\\(" 13170 ;; generic/port clause 13171 "\\(generic\\|port\\)[ \t\n\r\f]*(\\|" 13172 ;; component 13173 "component\\>\\|" 13174 ;; component instantiation 13175 "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*" 13176 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" 13177 "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*" 13178 "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|" 13179 ;; subprogram 13180 "\\(function\\|procedure\\)\\>\\|" 13181 ;; process, block 13182 "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|" 13183 ;; configuration declaration 13184 "configuration\\>" 13185 "\\)") 13186 "Regexp to match start of construct to hide.") 13187 13188(defun vhdl-hs-forward-sexp-func (count) 13189 "Find end of construct to hide (for hideshow). Only searches forward." 13190 (let ((pos (point))) 13191 (vhdl-prepare-search-2 13192 (beginning-of-line) 13193 (cond 13194 ;; generic/port clause 13195 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(") 13196 (goto-char (match-end 0)) 13197 (backward-char) 13198 (forward-sexp)) 13199 ;; component declaration 13200 ((looking-at "^\\s-*component\\>") 13201 (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) 13202 ;; component instantiation 13203 ((looking-at 13204 (concat 13205 "^\\s-*\\w+\\s-*:[ \t\n\r\f]*" 13206 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" 13207 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*" 13208 "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*(")) 13209 (goto-char (match-end 0)) 13210 (backward-char) 13211 (forward-sexp) 13212 (setq pos (point)) 13213 (vhdl-forward-syntactic-ws) 13214 (when (looking-at "port\\s-+map[ \t\n\r\f]*(") 13215 (goto-char (match-end 0)) 13216 (backward-char) 13217 (forward-sexp) 13218 (setq pos (point))) 13219 (goto-char pos)) 13220 ;; subprogram declaration/body 13221 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") 13222 (goto-char (match-end 0)) 13223 (vhdl-forward-syntactic-ws) 13224 (when (looking-at "(") 13225 (forward-sexp)) 13226 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) 13227 (vhdl-in-literal))) 13228 ;; subprogram body 13229 (when (match-string 2) 13230 (re-search-forward "^\\s-*\\<begin\\>" nil t) 13231 (backward-word-strictly 1) 13232 (vhdl-forward-sexp))) 13233 ;; block (recursive) 13234 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") 13235 (goto-char (match-end 0)) 13236 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) 13237 (match-beginning 2)) 13238 (vhdl-hs-forward-sexp-func count))) 13239 ;; process 13240 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") 13241 (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 13242 ;; configuration declaration 13243 ((looking-at "^\\s-*configuration\\>") 13244 (forward-word-strictly 4) 13245 (vhdl-forward-sexp)) 13246 (t (goto-char pos)))))) 13247 13248(defun vhdl-hideshow-init () 13249 "Initialize `hideshow'." 13250 (when vhdl-hideshow-menu 13251 (vhdl-hs-minor-mode 1))) 13252 13253(defun vhdl-hs-minor-mode (&optional arg) 13254 "Toggle hideshow minor mode and update menu bar." 13255 (interactive "P") 13256 (require 'hideshow) 13257 ;; check for hideshow version 5.x 13258 (if (not (boundp 'hs-block-start-mdata-select)) 13259 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") 13260 ;; initialize hideshow 13261 (unless (assoc 'vhdl-mode hs-special-modes-alist) 13262 (setq hs-special-modes-alist 13263 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" 13264 'vhdl-hs-forward-sexp-func nil) 13265 hs-special-modes-alist))) 13266 (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) 13267 (if vhdl-hide-all-init 13268 (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) 13269 (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) 13270 (hs-minor-mode arg) 13271 (force-mode-line-update))) ; hack to update menu bar 13272 13273 13274;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13275;;; Font locking 13276;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13277;; (using `font-lock.el') 13278 13279;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13280;; Help functions 13281 13282(defun vhdl-within-translate-off () 13283 "Return point if within translate-off region, else nil." 13284 (and (save-excursion 13285 (re-search-backward 13286 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) 13287 (equal "off" (match-string 1)) 13288 (point))) 13289 13290(defun vhdl-start-translate-off (limit) 13291 "Return point before translate-off pragma if before LIMIT, else nil." 13292 (when (re-search-forward 13293 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) 13294 (match-beginning 0))) 13295 13296(defun vhdl-end-translate-off (limit) 13297 "Return point after translate-on pragma if before LIMIT, else nil." 13298 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) 13299 13300(defun vhdl-match-translate-off (limit) 13301 "Match a translate-off block, setting match-data and returning t, else nil." 13302 (when (< (point) limit) 13303 (let ((start (or (vhdl-within-translate-off) 13304 (vhdl-start-translate-off limit))) 13305 (case-fold-search t)) 13306 (when start 13307 (let ((end (or (vhdl-end-translate-off limit) limit))) 13308 (set-match-data (list start end)) 13309 (goto-char end)))))) 13310 13311(defun vhdl-font-lock-match-item (limit) 13312 "Match, and move over, any declaration item after point. Adapted from 13313`font-lock-match-c-style-declaration-item-and-skip-to-next'." 13314 (condition-case nil 13315 (save-restriction 13316 (narrow-to-region (point-min) limit) 13317 ;; match item 13318 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") 13319 (save-match-data 13320 (goto-char (match-end 1)) 13321 ;; move to next item 13322 (if (looking-at "\\(\\s-*,\\)") 13323 (goto-char (match-end 1)) 13324 (end-of-line) t)))) 13325 (error t))) 13326 13327;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13328;; Syntax definitions 13329 13330(defconst vhdl-font-lock-syntactic-keywords 13331 '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\')))) 13332 "Mark single quotes as having string quote syntax in `c' instances.") 13333 13334(defvar vhdl-font-lock-keywords nil 13335 "Regular expressions to highlight in VHDL Mode.") 13336 13337(defvar vhdl-font-lock-keywords-0 nil 13338 ;; set in `vhdl-font-lock-init' because dependent on user options 13339 "For consideration as a value of `vhdl-font-lock-keywords'. 13340This does highlighting of template prompts and directives (pragmas).") 13341 13342(defvar vhdl-font-lock-keywords-1 nil 13343 ;; set in `vhdl-font-lock-init' because dependent on user options 13344 "For consideration as a value of `vhdl-font-lock-keywords'. 13345This does highlighting of keywords and standard identifiers.") 13346 13347(defconst vhdl-font-lock-keywords-2 13348 (list 13349 ;; highlight names of units, subprograms, and components when declared 13350 (list 13351 (concat 13352 "^\\s-*\\(" 13353 "architecture\\|configuration\\|context\\|entity\\|package" 13354 "\\(\\s-+body\\)?\\|" 13355 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" 13356 "\\)\\s-+\\(\\w+\\)") 13357 5 'font-lock-function-name-face) 13358 13359 ;; highlight entity names of architectures and configurations 13360 (list 13361 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" 13362 2 'font-lock-function-name-face) 13363 13364 ;; highlight labels of common constructs 13365 (list 13366 (concat 13367 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\(" 13368 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" 13369 "postponed\\|process\\|" 13370 (when (vhdl-standard-p 'ams) "procedural\\|") 13371 "with\\|while" 13372 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") 13373 1 'font-lock-function-name-face) 13374 13375 ;; highlight label and component name of component instantiations 13376 (list 13377 (concat 13378 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*" 13379 "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>") 13380 '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) 13381 13382 ;; highlight label and instantiated unit of component instantiations 13383 (list 13384 (concat 13385 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*" 13386 "\\(component\\|configuration\\|entity\\)\\s-+" 13387 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") 13388 '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) 13389 '(5 font-lock-function-name-face nil t) 13390 '(7 font-lock-function-name-face nil t)) 13391 13392 ;; highlight names and labels at end of constructs 13393 (list 13394 (concat 13395 "^\\s-*end\\s-+\\(\\(" 13396 "architecture\\|block\\|case\\|component\\|configuration\\|context\\|" 13397 "entity\\|for\\|function\\|generate\\|if\\|loop\\|package" 13398 "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|" 13399 (when (vhdl-standard-p 'ams) "procedural\\|") 13400 "units" 13401 "\\)\\s-+\\)?\\(\\w*\\)") 13402 5 'font-lock-function-name-face) 13403 13404 ;; highlight labels in exit and next statements 13405 (list 13406 (concat 13407 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") 13408 3 'font-lock-function-name-face) 13409 13410 ;; highlight entity name in attribute specifications 13411 (list 13412 (concat 13413 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") 13414 1 'font-lock-function-name-face) 13415 13416 ;; highlight labels in block and component specifications 13417 (list 13418 (concat 13419 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" 13420 "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)") 13421 '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) 13422 13423 ;; highlight names in library clauses 13424 (list "^\\s-*library\\>" 13425 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) 13426 13427 ;; highlight names in use clauses 13428 (list 13429 (concat 13430 "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" 13431 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") 13432 '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t) 13433 '(8 font-lock-function-name-face nil t)) 13434 13435 ;; highlight attribute name in attribute declarations/specifications 13436 (list 13437 (concat 13438 "^\\s-*attribute\\s-+\\(\\w+\\)") 13439 1 'vhdl-font-lock-attribute-face) 13440 13441 ;; highlight type/nature name in (sub)type/(sub)nature declarations 13442 (list 13443 (concat 13444 "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)") 13445 5 'font-lock-type-face) 13446 13447 ;; highlight signal/variable/constant declaration names 13448 (list "\\(:[^=]\\)" 13449 '(vhdl-font-lock-match-item 13450 (progn (goto-char (match-beginning 1)) 13451 (skip-syntax-backward " ") 13452 (skip-syntax-backward "w_") 13453 (skip-syntax-backward " ") 13454 (while (= (preceding-char) ?,) 13455 (backward-char 1) 13456 (skip-syntax-backward " ") 13457 (skip-syntax-backward "w_") 13458 (skip-syntax-backward " "))) 13459 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 13460 13461 ;; highlight formal parameters in component instantiations and subprogram 13462 ;; calls 13463 (list "\\(=>\\)" 13464 '(vhdl-font-lock-match-item 13465 (progn (goto-char (match-beginning 1)) 13466 (skip-syntax-backward " ") 13467 (while (= (preceding-char) ?\)) (backward-sexp)) 13468 (skip-syntax-backward "w_") 13469 (skip-syntax-backward " ") 13470 (when (memq (preceding-char) '(?n ?N ?|)) 13471 (goto-char (point-max)))) 13472 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 13473 13474 ;; highlight alias/group/quantity declaration names and for-loop/-generate 13475 ;; variables 13476 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" 13477 '(vhdl-font-lock-match-item 13478 (progn (goto-char (match-end 1)) (match-beginning 2)) 13479 nil (1 font-lock-variable-name-face))) 13480 13481 ;; highlight tool directives 13482 (list 13483 (concat 13484 "^\\s-*\\(`\\w+\\)") 13485 1 'font-lock-preprocessor-face) 13486 ) 13487 "For consideration as a value of `vhdl-font-lock-keywords'. 13488This does context sensitive highlighting of names and labels.") 13489 13490(defvar vhdl-font-lock-keywords-3 nil 13491 ;; set in `vhdl-font-lock-init' because dependent on user options 13492 "For consideration as a value of `vhdl-font-lock-keywords'. 13493This does highlighting of words with special syntax.") 13494 13495(defvar vhdl-font-lock-keywords-4 nil 13496 ;; set in `vhdl-font-lock-init' because dependent on user options 13497 "For consideration as a value of `vhdl-font-lock-keywords'. 13498This does highlighting of additional reserved words.") 13499 13500(defconst vhdl-font-lock-keywords-5 13501 ;; background highlight translate-off regions 13502 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) 13503 "For consideration as a value of `vhdl-font-lock-keywords'. 13504This does background highlighting of translate-off regions.") 13505 13506;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13507;; Font and color definitions 13508 13509(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face 13510 "Face name to use for prompts.") 13511 13512(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face 13513 "Face name to use for standardized attributes.") 13514 13515(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face 13516 "Face name to use for standardized enumeration values.") 13517 13518(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face 13519 "Face name to use for standardized functions and packages.") 13520 13521(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face 13522 "Face name to use for directives.") 13523 13524(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face 13525 "Face name to use for additional reserved words.") 13526 13527(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face 13528 "Face name to use for translate-off regions.") 13529 13530;; face names to use for words with special syntax. 13531(let ((syntax-alist vhdl-special-syntax-alist) 13532 name) 13533 (while syntax-alist 13534 (setq name (vhdl-function-name 13535 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 13536 (eval `(defvar ,name ',name 13537 ,(concat "Face name to use for " 13538 (nth 0 (car syntax-alist)) "."))) 13539 (setq syntax-alist (cdr syntax-alist)))) 13540 13541(defgroup vhdl-highlight-faces nil 13542 "Faces for highlighting." 13543 :group 'vhdl-highlight) 13544 13545;; add faces used from `font-lock' 13546(custom-add-to-group 13547 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) 13548(custom-add-to-group 13549 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) 13550(custom-add-to-group 13551 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) 13552(custom-add-to-group 13553 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) 13554(custom-add-to-group 13555 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) 13556(custom-add-to-group 13557 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) 13558 13559(defface vhdl-font-lock-prompt-face 13560 '((((min-colors 88) (class color) (background light)) 13561 (:foreground "Red1" :bold t)) 13562 (((class color) (background light)) (:foreground "Red" :bold t)) 13563 (((class color) (background dark)) (:foreground "Pink" :bold t)) 13564 (t (:inverse-video t))) 13565 "Font lock mode face used to highlight prompts." 13566 :group 'vhdl-highlight-faces) 13567 13568(defface vhdl-font-lock-attribute-face 13569 '((((class color) (background light)) (:foreground "Orchid")) 13570 (((class color) (background dark)) (:foreground "LightSteelBlue")) 13571 (t (:italic t :bold t))) 13572 "Font lock mode face used to highlight standardized attributes." 13573 :group 'vhdl-highlight-faces) 13574 13575(defface vhdl-font-lock-enumvalue-face 13576 '((((class color) (background light)) (:foreground "SaddleBrown")) 13577 (((class color) (background dark)) (:foreground "BurlyWood")) 13578 (t (:italic t :bold t))) 13579 "Font lock mode face used to highlight standardized enumeration values." 13580 :group 'vhdl-highlight-faces) 13581 13582(defface vhdl-font-lock-function-face 13583 '((((class color) (background light)) (:foreground "Cyan4")) 13584 (((class color) (background dark)) (:foreground "Orchid1")) 13585 (t (:italic t :bold t))) 13586 "Font lock mode face used to highlight standardized functions and packages." 13587 :group 'vhdl-highlight-faces) 13588 13589(defface vhdl-font-lock-directive-face 13590 '((((class color) (background light)) (:foreground "CadetBlue")) 13591 (((class color) (background dark)) (:foreground "Aquamarine")) 13592 (t (:italic t :bold t))) 13593 "Font lock mode face used to highlight directives." 13594 :group 'vhdl-highlight-faces) 13595 13596(defface vhdl-font-lock-reserved-words-face 13597 '((((class color) (background light)) (:foreground "Orange" :bold t)) 13598 (((min-colors 88) (class color) (background dark)) 13599 (:foreground "Yellow1" :bold t)) 13600 (((class color) (background dark)) (:foreground "Yellow" :bold t)) 13601 (t ())) 13602 "Font lock mode face used to highlight additional reserved words." 13603 :group 'vhdl-highlight-faces) 13604 13605(defface vhdl-font-lock-translate-off-face 13606 '((((class color) (background light)) (:background "LightGray")) 13607 (((class color) (background dark)) (:background "DimGray")) 13608 (t ())) 13609 "Font lock mode face used to background highlight translate-off regions." 13610 :group 'vhdl-highlight-faces) 13611 13612;; font lock mode faces used to highlight words with special syntax. 13613(let ((syntax-alist vhdl-special-syntax-alist)) 13614 (while syntax-alist 13615 (eval `(defface ,(vhdl-function-name 13616 "vhdl-font-lock" (caar syntax-alist) "face") 13617 '((((class color) (background light)) 13618 (:foreground ,(nth 2 (car syntax-alist)))) 13619 (((class color) (background dark)) 13620 (:foreground ,(nth 3 (car syntax-alist)))) 13621 (t ())) 13622 ,(concat "Font lock mode face used to highlight " 13623 (nth 0 (car syntax-alist)) ".") 13624 :group 'vhdl-highlight-faces)) 13625 (setq syntax-alist (cdr syntax-alist)))) 13626 13627;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13628;; Font lock initialization 13629 13630(defun vhdl-font-lock-init () 13631 "Initialize fontification." 13632 ;; highlight template prompts and directives 13633 (setq vhdl-font-lock-keywords-0 13634 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" 13635 vhdl-template-prompt-syntax ">\\)") 13636 2 'vhdl-font-lock-prompt-face t) 13637 (list (concat "--\\s-*" 13638 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") 13639 2 'vhdl-font-lock-directive-face t) 13640 ;; highlight c-preprocessor directives 13641 (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" 13642 '(1 font-lock-builtin-face) 13643 '(3 font-lock-variable-name-face nil t)))) 13644 ;; highlight keywords and standardized types, attributes, enumeration 13645 ;; values, and subprograms 13646 (setq vhdl-font-lock-keywords-1 13647 (list 13648 (list (concat "'" vhdl-attributes-regexp) 13649 1 'vhdl-font-lock-attribute-face) 13650 (list vhdl-types-regexp 1 'font-lock-type-face) 13651 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) 13652 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) 13653 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) 13654 (list vhdl-constants-regexp 1 'font-lock-constant-face) 13655 (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) 13656 ;; highlight words with special syntax. 13657 (setq vhdl-font-lock-keywords-3 13658 (let ((syntax-alist vhdl-special-syntax-alist) 13659 keywords) 13660 (while syntax-alist 13661 (setq keywords 13662 (cons 13663 (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1 13664 (vhdl-function-name 13665 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face") 13666 (nth 4 (car syntax-alist))) 13667 keywords)) 13668 (setq syntax-alist (cdr syntax-alist))) 13669 keywords)) 13670 ;; highlight additional reserved words 13671 (setq vhdl-font-lock-keywords-4 13672 (list (list vhdl-reserved-words-regexp 1 13673 'vhdl-font-lock-reserved-words-face))) 13674 ;; highlight everything together 13675 (setq vhdl-font-lock-keywords 13676 (append 13677 vhdl-font-lock-keywords-0 13678 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) 13679 (when (or vhdl-highlight-forbidden-words 13680 vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) 13681 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) 13682 (when vhdl-highlight-names vhdl-font-lock-keywords-2) 13683 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) 13684 13685;; initialize fontification for VHDL Mode 13686(vhdl-font-lock-init) 13687 13688(defun vhdl-fontify-buffer () 13689 "Re-initialize fontification and fontify buffer." 13690 (interactive) 13691 (setq font-lock-defaults 13692 `(vhdl-font-lock-keywords 13693 nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) 13694 beginning-of-line)) 13695 (when (fboundp 'font-lock-unset-defaults) 13696 (font-lock-unset-defaults)) ; not implemented in XEmacs 13697 (font-lock-set-defaults) 13698 (font-lock-mode nil) 13699 (font-lock-mode t)) 13700 13701;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13702;; Initialization for PostScript printing 13703 13704(defun vhdl-ps-print-settings () 13705 "Initialize custom face and page settings for PostScript printing." 13706 ;; define custom face settings 13707 (unless (or (not vhdl-print-customize-faces) 13708 ps-print-color-p) 13709 (set (make-local-variable 'ps-bold-faces) 13710 '(font-lock-keyword-face 13711 font-lock-type-face 13712 vhdl-font-lock-attribute-face 13713 vhdl-font-lock-enumvalue-face 13714 vhdl-font-lock-directive-face)) 13715 (set (make-local-variable 'ps-italic-faces) 13716 '(font-lock-comment-face 13717 font-lock-function-name-face 13718 font-lock-type-face 13719 vhdl-font-lock-attribute-face 13720 vhdl-font-lock-enumvalue-face 13721 vhdl-font-lock-directive-face)) 13722 (set (make-local-variable 'ps-underlined-faces) 13723 '(font-lock-string-face)) 13724 (setq ps-always-build-face-reference t)) 13725 ;; define page settings, so that a line containing 79 characters (default) 13726 ;; fits into one column 13727 (when vhdl-print-two-column 13728 (set (make-local-variable 'ps-landscape-mode) t) 13729 (set (make-local-variable 'ps-number-of-columns) 2) 13730 (set (make-local-variable 'ps-font-size) 7.0) 13731 (set (make-local-variable 'ps-header-title-font-size) 10.0) 13732 (set (make-local-variable 'ps-header-font-size) 9.0) 13733 (set (make-local-variable 'ps-header-offset) 12.0) 13734 (when (eq ps-paper-type 'letter) 13735 (set (make-local-variable 'ps-inter-column) 40.0) 13736 (set (make-local-variable 'ps-left-margin) 40.0) 13737 (set (make-local-variable 'ps-right-margin) 40.0)))) 13738 13739(defun vhdl-ps-print-init () 13740 "Initialize PostScript printing." 13741 (if (featurep 'xemacs) 13742 (when (boundp 'ps-print-color-p) 13743 (vhdl-ps-print-settings)) 13744 (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) 13745 (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) 13746 13747 13748;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13749;;; Hierarchy browser (using `speedbar.el') 13750;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13751;; Allows displaying the hierarchy of all VHDL design units contained in a 13752;; directory by using the speedbar. 13753 13754;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13755;; Variables 13756 13757(defvar vhdl-entity-alist nil 13758 "Cache with entities and corresponding architectures for each 13759project/directory.") 13760;; structure: (parenthesized expression means list of such entries) 13761;; (cache-key 13762;; (ent-key ent-name ent-file ent-line 13763;; (arch-key arch-name arch-file arch-line 13764;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key 13765;; inst-arch-key inst-conf-key inst-lib-key inst-path) 13766;; (lib-name pack-key)) 13767;; mra-key (lib-name pack-key)) 13768 13769(defvar vhdl-config-alist nil 13770 "Cache with configurations for each project/directory.") 13771;; structure: (parenthesized expression means list of such entries) 13772;; (cache-key 13773;; (conf-key conf-name conf-file conf-line ent-key arch-key 13774;; (inst-key inst-comp-name inst-ent-key inst-arch-key 13775;; inst-conf-key inst-lib-key) 13776;; (lib-name pack-key))) 13777 13778(defvar vhdl-package-alist nil 13779 "Cache with packages for each project/directory.") 13780;; structure: (parenthesized expression means list of such entries) 13781;; (cache-key 13782;; (pack-key pack-name pack-file pack-line 13783;; (comp-key comp-name comp-file comp-line) 13784;; (func-key func-name func-file func-line) 13785;; (lib-name pack-key) 13786;; pack-body-file pack-body-line 13787;; (func-key func-name func-body-file func-body-line) 13788;; (lib-name pack-key))) 13789 13790(defvar vhdl-ent-inst-alist nil 13791 "Cache with instantiated entities for each project/directory.") 13792;; structure: (parenthesized expression means list of such entries) 13793;; (cache-key (inst-ent-key)) 13794 13795(defvar vhdl-file-alist nil 13796 "Cache with design units in each file for each project/directory.") 13797;; structure: (parenthesized expression means list of such entries) 13798;; (cache-key 13799;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) 13800;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) 13801 13802(defvar vhdl-directory-alist nil 13803 "Cache with source directories for each project.") 13804;; structure: (parenthesized expression means list of such entries) 13805;; (cache-key (directory)) 13806 13807(defvar vhdl-speedbar-shown-unit-alist nil 13808 "Alist of design units simultaneously open in the current speedbar for each 13809directory and project.") 13810 13811(defvar vhdl-speedbar-shown-project-list nil 13812 "List of projects simultaneously open in the current speedbar.") 13813 13814(defvar vhdl-updated-project-list nil 13815 "List of projects and directories with updated files.") 13816 13817(defvar vhdl-modified-file-list nil 13818 "List of modified files to be rescanned for hierarchy updating.") 13819 13820(defvar vhdl-speedbar-hierarchy-depth 0 13821 "Depth of instantiation hierarchy to display.") 13822 13823(defvar vhdl-speedbar-show-projects nil 13824 "Non-nil means project hierarchy is displayed in speedbar, directory 13825hierarchy otherwise.") 13826 13827(defun vhdl-get-end-of-unit () 13828 "Return position of end of current unit." 13829 (let ((pos (point))) 13830 (save-excursion 13831 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1) 13832 (save-excursion 13833 (goto-char (match-beginning 0)) 13834 (vhdl-backward-syntactic-ws) 13835 (and (/= (preceding-char) ?\;) (not (bobp)))))) 13836 (re-search-backward "^[ \t]*end\\>" pos 1) 13837 (point)))) 13838 13839(defun vhdl-match-string-downcase (num &optional string) 13840 "Like `match-string-no-properties' with down-casing." 13841 (let ((match (match-string-no-properties num string))) 13842 (and match (downcase match)))) 13843 13844 13845;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13846;; Scan functions 13847 13848(defun vhdl-scan-context-clause () 13849 "Scan the context clause that precedes a design unit." 13850 (let (lib-alist) 13851 (save-excursion 13852 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t) 13853 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) 13854 (equal "USE" (upcase (match-string 1)))) 13855 (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") 13856 (push (cons (match-string-no-properties 1) 13857 (vhdl-match-string-downcase 2)) 13858 lib-alist))))) 13859 lib-alist)) 13860 13861(defun vhdl-scan-directory-contents (name &optional project update num-string 13862 non-final) 13863 "Scan contents of VHDL files in directory or file pattern NAME." 13864 (string-match "\\(.*[/\\]\\)\\(.*\\)" name) 13865 (let* ((dir-name (match-string 1 name)) 13866 (file-pattern (match-string 2 name)) 13867 (is-directory (= 0 (length file-pattern))) 13868 (file-list 13869 (if update 13870 (list name) 13871 (if is-directory 13872 (vhdl-get-source-files t dir-name) 13873 (vhdl-directory-files 13874 dir-name t (wildcard-to-regexp file-pattern))))) 13875 (key (or project dir-name)) 13876 (file-exclude-regexp 13877 (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) 13878 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) 13879 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) 13880 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) 13881 ent-alist conf-alist pack-alist ent-inst-list file-alist 13882 tmp-list tmp-entry no-files files-exist big-files) 13883 (when (or project update) 13884 (setq ent-alist (vhdl-aget vhdl-entity-alist key) 13885 conf-alist (vhdl-aget vhdl-config-alist key) 13886 pack-alist (vhdl-aget vhdl-package-alist key) 13887 ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key)) 13888 file-alist (vhdl-aget vhdl-file-alist key))) 13889 (when (and (not is-directory) (null file-list)) 13890 (message "No such file: \"%s\"" name)) 13891 (setq files-exist file-list) 13892 (when file-list 13893 (setq no-files (length file-list)) 13894 (message "Scanning %s %s\"%s\"..." 13895 (if is-directory "directory" "files") (or num-string "") name) 13896 ;; exclude files 13897 (unless (equal file-exclude-regexp "") 13898 (let ((case-fold-search nil) 13899 file-tmp-list) 13900 (while file-list 13901 (unless (string-match file-exclude-regexp (car file-list)) 13902 (push (car file-list) file-tmp-list)) 13903 (setq file-list (cdr file-list))) 13904 (setq file-list (nreverse file-tmp-list)))) 13905 ;; do for all files 13906 (while file-list 13907 (unless noninteractive 13908 (message "Scanning %s %s\"%s\"... (%2d%%)" 13909 (if is-directory "directory" "files") 13910 (or num-string "") name 13911 (floor (* 100.0 (- no-files (length file-list))) no-files))) 13912 (let ((file-name (abbreviate-file-name (car file-list))) 13913 ent-list arch-list arch-ent-list conf-list 13914 pack-list pack-body-list inst-list inst-ent-list) 13915 ;; scan file 13916 (vhdl-visit-file 13917 file-name nil 13918 (vhdl-prepare-search-2 13919 (save-excursion 13920 ;; scan for design units 13921 (if (and limit-design-file-size 13922 (< limit-design-file-size (buffer-size))) 13923 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) 13924 (setq big-files t)) 13925 ;; scan for entities 13926 (goto-char (point-min)) 13927 (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 13928 (let* ((ent-name (match-string-no-properties 1)) 13929 (ent-key (downcase ent-name)) 13930 (ent-entry (vhdl-aget ent-alist ent-key)) 13931 (lib-alist (vhdl-scan-context-clause))) 13932 (if (nth 1 ent-entry) 13933 (vhdl-warning-when-idle 13934 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13935 ent-name (nth 1 ent-entry) (nth 2 ent-entry) 13936 file-name (vhdl-current-line)) 13937 (push ent-key ent-list) 13938 (vhdl-aput 'ent-alist ent-key 13939 (list ent-name file-name (vhdl-current-line) 13940 (nth 3 ent-entry) (nth 4 ent-entry) 13941 lib-alist))))) 13942 ;; scan for architectures 13943 (goto-char (point-min)) 13944 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 13945 (let* ((arch-name (match-string-no-properties 1)) 13946 (arch-key (downcase arch-name)) 13947 (ent-name (match-string-no-properties 2)) 13948 (ent-key (downcase ent-name)) 13949 (ent-entry (vhdl-aget ent-alist ent-key)) 13950 (arch-alist (nth 3 ent-entry)) 13951 (arch-entry (vhdl-aget arch-alist arch-key)) 13952 (lib-arch-alist (vhdl-scan-context-clause))) 13953 (if arch-entry 13954 (vhdl-warning-when-idle 13955 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13956 arch-name ent-name (nth 1 arch-entry) 13957 (nth 2 arch-entry) file-name (vhdl-current-line)) 13958 (setq arch-list (cons arch-key arch-list) 13959 arch-ent-list (cons ent-key arch-ent-list)) 13960 (vhdl-aput 'arch-alist arch-key 13961 (list arch-name file-name (vhdl-current-line) 13962 nil lib-arch-alist)) 13963 (vhdl-aput 'ent-alist ent-key 13964 (list (or (nth 0 ent-entry) ent-name) 13965 (nth 1 ent-entry) (nth 2 ent-entry) 13966 (vhdl-sort-alist arch-alist) 13967 arch-key (nth 5 ent-entry)))))) 13968 ;; scan for configurations 13969 (goto-char (point-min)) 13970 (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 13971 (let* ((conf-name (match-string-no-properties 1)) 13972 (conf-key (downcase conf-name)) 13973 (conf-entry (vhdl-aget conf-alist conf-key)) 13974 (ent-name (match-string-no-properties 2)) 13975 (ent-key (downcase ent-name)) 13976 (lib-alist (vhdl-scan-context-clause)) 13977 (conf-line (vhdl-current-line)) 13978 (end-of-unit (vhdl-get-end-of-unit)) 13979 arch-key comp-conf-list inst-key-list 13980 inst-comp-key inst-ent-key inst-arch-key 13981 inst-conf-key inst-lib-key) 13982 (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)") 13983 (setq arch-key (vhdl-match-string-downcase 1))) 13984 (if conf-entry 13985 (vhdl-warning-when-idle 13986 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13987 conf-name ent-name (nth 1 conf-entry) 13988 (nth 2 conf-entry) file-name conf-line) 13989 (push conf-key conf-list) 13990 ;; scan for subconfigurations and subentities 13991 (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t) 13992 (setq inst-comp-key (vhdl-match-string-downcase 3) 13993 inst-key-list (split-string 13994 (vhdl-match-string-downcase 1) 13995 "[ \t\n\r\f]*,[ \t\n\r\f]*")) 13996 (vhdl-forward-syntactic-ws) 13997 (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?") 13998 (setq 13999 inst-lib-key (vhdl-match-string-downcase 3) 14000 inst-ent-key (and (match-string 2) 14001 (vhdl-match-string-downcase 4)) 14002 inst-arch-key (and (match-string 2) 14003 (vhdl-match-string-downcase 6)) 14004 inst-conf-key (and (not (match-string 2)) 14005 (vhdl-match-string-downcase 4))) 14006 (while inst-key-list 14007 (setq comp-conf-list 14008 (cons (list (car inst-key-list) 14009 inst-comp-key inst-ent-key 14010 inst-arch-key inst-conf-key 14011 inst-lib-key) 14012 comp-conf-list)) 14013 (setq inst-key-list (cdr inst-key-list))))) 14014 (vhdl-aput 'conf-alist conf-key 14015 (list conf-name file-name conf-line ent-key 14016 arch-key comp-conf-list lib-alist))))) 14017 ;; scan for packages 14018 (goto-char (point-min)) 14019 (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 14020 (let* ((pack-name (match-string-no-properties 2)) 14021 (pack-key (downcase pack-name)) 14022 (is-body (match-string-no-properties 1)) 14023 (pack-entry (vhdl-aget pack-alist pack-key)) 14024 (pack-line (vhdl-current-line)) 14025 (end-of-unit (vhdl-get-end-of-unit)) 14026 comp-name func-name comp-alist func-alist lib-alist) 14027 (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 14028 (vhdl-warning-when-idle 14029 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 14030 (if is-body " body" "") pack-name 14031 (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 14032 (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) 14033 file-name (vhdl-current-line)) 14034 ;; scan for context clauses 14035 (setq lib-alist (vhdl-scan-context-clause)) 14036 ;; scan for component and subprogram declarations/bodies 14037 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t) 14038 (if (equal (upcase (match-string 1)) "COMPONENT") 14039 (setq comp-name (match-string-no-properties 2) 14040 comp-alist 14041 (cons (list (downcase comp-name) comp-name 14042 file-name (vhdl-current-line)) 14043 comp-alist)) 14044 (setq func-name (match-string-no-properties 2) 14045 func-alist 14046 (cons (list (downcase func-name) func-name 14047 file-name (vhdl-current-line)) 14048 func-alist)))) 14049 (setq func-alist (nreverse func-alist)) 14050 (setq comp-alist (nreverse comp-alist)) 14051 (if is-body 14052 (push pack-key pack-body-list) 14053 (push pack-key pack-list)) 14054 (vhdl-aput 14055 'pack-alist pack-key 14056 (if is-body 14057 (list (or (nth 0 pack-entry) pack-name) 14058 (nth 1 pack-entry) (nth 2 pack-entry) 14059 (nth 3 pack-entry) (nth 4 pack-entry) 14060 (nth 5 pack-entry) 14061 file-name pack-line func-alist lib-alist) 14062 (list pack-name file-name pack-line 14063 comp-alist func-alist lib-alist 14064 (nth 6 pack-entry) (nth 7 pack-entry) 14065 (nth 8 pack-entry) (nth 9 pack-entry)))))))) 14066 ;; scan for hierarchy 14067 (if (and limit-hier-file-size 14068 (< limit-hier-file-size (buffer-size))) 14069 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) 14070 (setq big-files t)) 14071 ;; scan for architectures 14072 (goto-char (point-min)) 14073 (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 14074 (let* ((ent-name (match-string-no-properties 2)) 14075 (ent-key (downcase ent-name)) 14076 (arch-name (match-string-no-properties 1)) 14077 (arch-key (downcase arch-name)) 14078 (ent-entry (vhdl-aget ent-alist ent-key)) 14079 (arch-alist (nth 3 ent-entry)) 14080 (arch-entry (vhdl-aget arch-alist arch-key)) 14081 (beg-of-unit (point)) 14082 (end-of-unit (vhdl-get-end-of-unit)) 14083 (inst-no 0) 14084 inst-alist inst-path) 14085 ;; scan for contained instantiations 14086 (while (and (re-search-forward 14087 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" 14088 "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|" 14089 "component[ \t\n\r\f]+\\(\\w+\\)\\|" 14090 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" 14091 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" 14092 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) 14093 (or (not limit-hier-inst-no) 14094 (<= (if (or (match-string 14) 14095 (match-string 16)) 14096 inst-no 14097 (setq inst-no (1+ inst-no))) 14098 limit-hier-inst-no))) 14099 (cond 14100 ;; block/generate beginning found 14101 ((match-string 14) 14102 (setq inst-path 14103 (cons (match-string-no-properties 1) inst-path))) 14104 ;; block/generate end found 14105 ((match-string 16) 14106 (setq inst-path (cdr inst-path))) 14107 ;; instantiation found 14108 (t 14109 (let* ((inst-name (match-string-no-properties 1)) 14110 (inst-key (downcase inst-name)) 14111 (inst-comp-name 14112 (or (match-string-no-properties 3) 14113 (match-string-no-properties 6))) 14114 (inst-ent-key 14115 (or (and (match-string 8) 14116 (vhdl-match-string-downcase 11)) 14117 (and inst-comp-name 14118 (downcase inst-comp-name)))) 14119 (inst-arch-key (vhdl-match-string-downcase 13)) 14120 (inst-conf-key 14121 (and (not (match-string 8)) 14122 (vhdl-match-string-downcase 11))) 14123 (inst-lib-key (vhdl-match-string-downcase 10))) 14124 (goto-char (match-end 1)) 14125 (setq inst-list (cons inst-key inst-list) 14126 inst-ent-list 14127 (cons inst-ent-key inst-ent-list)) 14128 (setq inst-alist 14129 (append 14130 inst-alist 14131 (list (list inst-key inst-name file-name 14132 (vhdl-current-line) inst-comp-name 14133 inst-ent-key inst-arch-key 14134 inst-conf-key inst-lib-key 14135 (reverse inst-path))))))))) 14136 ;; scan for contained configuration specifications 14137 (goto-char beg-of-unit) 14138 (while (re-search-forward 14139 (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*" 14140 "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t) 14141 (let* ((inst-comp-name (match-string-no-properties 3)) 14142 (inst-ent-key 14143 (and (match-string 6) 14144 (vhdl-match-string-downcase 9))) 14145 (inst-arch-key (vhdl-match-string-downcase 11)) 14146 (inst-conf-key 14147 (and (not (match-string 6)) 14148 (vhdl-match-string-downcase 9))) 14149 (inst-lib-key (vhdl-match-string-downcase 8)) 14150 (inst-key-list 14151 (split-string (vhdl-match-string-downcase 1) 14152 "[ \t\n\r\f]*,[ \t\n\r\f]*")) 14153 (tmp-inst-alist inst-alist) 14154 inst-entry) 14155 (while tmp-inst-alist 14156 (when (and (or (equal "all" (car inst-key-list)) 14157 (member (nth 0 (car tmp-inst-alist)) 14158 inst-key-list)) 14159 (equal 14160 (downcase 14161 (or (nth 4 (car tmp-inst-alist)) "")) 14162 (downcase inst-comp-name))) 14163 (setq inst-entry (car tmp-inst-alist)) 14164 (setq inst-ent-list 14165 (cons (or inst-ent-key (nth 5 inst-entry)) 14166 (vhdl-delete 14167 (nth 5 inst-entry) inst-ent-list))) 14168 (setq inst-entry 14169 (list (nth 0 inst-entry) (nth 1 inst-entry) 14170 (nth 2 inst-entry) (nth 3 inst-entry) 14171 (nth 4 inst-entry) 14172 (or inst-ent-key (nth 5 inst-entry)) 14173 (or inst-arch-key (nth 6 inst-entry)) 14174 inst-conf-key inst-lib-key)) 14175 (setcar tmp-inst-alist inst-entry)) 14176 (setq tmp-inst-alist (cdr tmp-inst-alist))))) 14177 ;; save in cache 14178 (vhdl-aput 'arch-alist arch-key 14179 (list (nth 0 arch-entry) (nth 1 arch-entry) 14180 (nth 2 arch-entry) inst-alist 14181 (nth 4 arch-entry))) 14182 (vhdl-aput 'ent-alist ent-key 14183 (list (nth 0 ent-entry) (nth 1 ent-entry) 14184 (nth 2 ent-entry) 14185 (vhdl-sort-alist arch-alist) 14186 (nth 4 ent-entry) (nth 5 ent-entry))) 14187 (when (and limit-hier-inst-no 14188 (> inst-no limit-hier-inst-no)) 14189 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) 14190 (setq big-files t)) 14191 (goto-char end-of-unit)))) 14192 ;; remember design units for this file 14193 (vhdl-aput 'file-alist file-name 14194 (list ent-list arch-list arch-ent-list conf-list 14195 pack-list pack-body-list 14196 inst-list inst-ent-list)) 14197 (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) 14198 (setq file-list (cdr file-list)))) 14199 (when (or (and (not project) files-exist) 14200 (and project (not non-final))) 14201 ;; consistency checks: 14202 ;; check whether each architecture has a corresponding entity 14203 (setq tmp-list ent-alist) 14204 (while tmp-list 14205 (when (null (nth 2 (car tmp-list))) 14206 (setq tmp-entry (car (nth 4 (car tmp-list)))) 14207 (vhdl-warning-when-idle 14208 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 14209 (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) 14210 (nth 3 tmp-entry))) 14211 (setq tmp-list (cdr tmp-list))) 14212 ;; check whether configuration has a corresponding entity/architecture 14213 (setq tmp-list conf-alist) 14214 (while tmp-list 14215 (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)))) 14216 (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list))) 14217 (setq tmp-entry (car tmp-list)) 14218 (vhdl-warning-when-idle 14219 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" 14220 (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) 14221 (nth 2 tmp-entry) (nth 3 tmp-entry))) 14222 (setq tmp-entry (car tmp-list)) 14223 (vhdl-warning-when-idle 14224 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 14225 (nth 1 tmp-entry) (nth 4 tmp-entry) 14226 (nth 2 tmp-entry) (nth 3 tmp-entry))) 14227 (setq tmp-list (cdr tmp-list))) 14228 ;; check whether each package body has a package declaration 14229 (setq tmp-list pack-alist) 14230 (while tmp-list 14231 (when (null (nth 2 (car tmp-list))) 14232 (setq tmp-entry (car tmp-list)) 14233 (vhdl-warning-when-idle 14234 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" 14235 (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) 14236 (setq tmp-list (cdr tmp-list))) 14237 ;; sort lists 14238 (setq ent-alist (vhdl-sort-alist ent-alist)) 14239 (setq conf-alist (vhdl-sort-alist conf-alist)) 14240 (setq pack-alist (vhdl-sort-alist pack-alist)) 14241 ;; remember updated directory/project 14242 (add-to-list 'vhdl-updated-project-list (or project dir-name))) 14243 ;; clear directory alists 14244 (unless project 14245 (vhdl-adelete 'vhdl-entity-alist key) 14246 (vhdl-adelete 'vhdl-config-alist key) 14247 (vhdl-adelete 'vhdl-package-alist key) 14248 (vhdl-adelete 'vhdl-ent-inst-alist key) 14249 (vhdl-adelete 'vhdl-file-alist key)) 14250 ;; put directory contents into cache 14251 (vhdl-aput 'vhdl-entity-alist key ent-alist) 14252 (vhdl-aput 'vhdl-config-alist key conf-alist) 14253 (vhdl-aput 'vhdl-package-alist key pack-alist) 14254 (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list)) 14255 (vhdl-aput 'vhdl-file-alist key file-alist) 14256 ;; final messages 14257 (message "Scanning %s %s\"%s\"...done" 14258 (if is-directory "directory" "files") (or num-string "") name) 14259 (unless project (message "Scanning directory...done")) 14260 (when big-files 14261 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) 14262 ;; save cache when scanned non-interactively 14263 (when (or (not project) (not non-final)) 14264 (when (and noninteractive vhdl-speedbar-save-cache) 14265 (vhdl-save-cache key))) 14266 t)) 14267 14268(defun vhdl-scan-project-contents (project) 14269 "Scan the contents of all VHDL files found in the directories and files 14270of PROJECT." 14271 (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '(""))) 14272 (default-dir (vhdl-resolve-env-variable 14273 (nth 1 (vhdl-aget vhdl-project-alist project)))) 14274 (file-exclude-regexp 14275 (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) 14276 dir-list-tmp dir dir-name num-dir act-dir recursive) 14277 ;; clear project alists 14278 (vhdl-adelete 'vhdl-entity-alist project) 14279 (vhdl-adelete 'vhdl-config-alist project) 14280 (vhdl-adelete 'vhdl-package-alist project) 14281 (vhdl-adelete 'vhdl-ent-inst-alist project) 14282 (vhdl-adelete 'vhdl-file-alist project) 14283 ;; expand directory names by default-directory 14284 (message "Collecting source files...") 14285 (while dir-list 14286 (setq dir (vhdl-resolve-env-variable (car dir-list))) 14287 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) 14288 (setq recursive (match-string 1 dir) 14289 dir-name (match-string 3 dir)) 14290 (setq dir-list-tmp 14291 (cons (concat recursive 14292 (if (file-name-absolute-p dir-name) "" default-dir) 14293 dir-name) 14294 dir-list-tmp)) 14295 (setq dir-list (cdr dir-list))) 14296 ;; resolve path wildcards 14297 (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) 14298 ;; expand directories 14299 (while dir-list-tmp 14300 (setq dir (car dir-list-tmp)) 14301 ;; get subdirectories 14302 (if (string-match "-r \\(.*[/\\]\\)" dir) 14303 (setq dir-list (append dir-list (vhdl-get-subdirs 14304 (match-string 1 dir)))) 14305 (setq dir-list (append dir-list (list dir)))) 14306 (setq dir-list-tmp (cdr dir-list-tmp))) 14307 ;; exclude files 14308 (unless (equal file-exclude-regexp "") 14309 (let ((case-fold-search nil)) 14310 (while dir-list 14311 (unless (string-match file-exclude-regexp (car dir-list)) 14312 (push (car dir-list) dir-list-tmp)) 14313 (setq dir-list (cdr dir-list))) 14314 (setq dir-list (nreverse dir-list-tmp)))) 14315 (message "Collecting source files...done") 14316 ;; scan for design units for each directory in DIR-LIST 14317 (setq dir-list-tmp nil 14318 num-dir (length dir-list) 14319 act-dir 1) 14320 (while dir-list 14321 (setq dir-name (abbreviate-file-name 14322 (expand-file-name (car dir-list)))) 14323 (vhdl-scan-directory-contents dir-name project nil 14324 (format "(%s/%s) " act-dir num-dir) 14325 (cdr dir-list)) 14326 (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) 14327 (setq dir-list (cdr dir-list) 14328 act-dir (1+ act-dir))) 14329 (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) 14330 (message "Scanning project \"%s\"...done" project))) 14331 14332(defun vhdl-update-file-contents (file-name) 14333 "Update hierarchy information by contents of current buffer." 14334 (setq file-name (abbreviate-file-name file-name)) 14335 (let* ((dir-name (file-name-directory file-name)) 14336 (directory-alist vhdl-directory-alist) 14337 updated) 14338 (while directory-alist 14339 (when (member dir-name (nth 1 (car directory-alist))) 14340 (let* ((vhdl-project (nth 0 (car directory-alist))) 14341 (project (vhdl-project-p)) 14342 (ent-alist (vhdl-aget vhdl-entity-alist 14343 (or project dir-name))) 14344 (conf-alist (vhdl-aget vhdl-config-alist 14345 (or project dir-name))) 14346 (pack-alist (vhdl-aget vhdl-package-alist 14347 (or project dir-name))) 14348 (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist 14349 (or project dir-name)))) 14350 (file-alist (vhdl-aget vhdl-file-alist (or project dir-name))) 14351 (file-entry (vhdl-aget file-alist file-name)) 14352 (ent-list (nth 0 file-entry)) 14353 (arch-list (nth 1 file-entry)) 14354 (arch-ent-list (nth 2 file-entry)) 14355 (conf-list (nth 3 file-entry)) 14356 (pack-list (nth 4 file-entry)) 14357 (pack-body-list (nth 5 file-entry)) 14358 (inst-ent-list (nth 7 file-entry)) 14359 (cache-key (or project dir-name)) 14360 arch-alist key ent-key entry) 14361 ;; delete design units previously contained in this file: 14362 ;; entities 14363 (while ent-list 14364 (setq key (car ent-list) 14365 entry (vhdl-aget ent-alist key)) 14366 (when (equal file-name (nth 1 entry)) 14367 (if (nth 3 entry) 14368 (vhdl-aput 'ent-alist key 14369 (list (nth 0 entry) nil nil (nth 3 entry) nil)) 14370 (vhdl-adelete 'ent-alist key))) 14371 (setq ent-list (cdr ent-list))) 14372 ;; architectures 14373 (while arch-list 14374 (setq key (car arch-list) 14375 ent-key (car arch-ent-list) 14376 entry (vhdl-aget ent-alist ent-key) 14377 arch-alist (nth 3 entry)) 14378 (when (equal file-name (nth 1 (vhdl-aget arch-alist key))) 14379 (vhdl-adelete 'arch-alist key) 14380 (if (or (nth 1 entry) arch-alist) 14381 (vhdl-aput 'ent-alist ent-key 14382 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 14383 arch-alist (nth 4 entry) (nth 5 entry))) 14384 (vhdl-adelete 'ent-alist ent-key))) 14385 (setq arch-list (cdr arch-list) 14386 arch-ent-list (cdr arch-ent-list))) 14387 ;; configurations 14388 (while conf-list 14389 (setq key (car conf-list)) 14390 (when (equal file-name (nth 1 (vhdl-aget conf-alist key))) 14391 (vhdl-adelete 'conf-alist key)) 14392 (setq conf-list (cdr conf-list))) 14393 ;; package declarations 14394 (while pack-list 14395 (setq key (car pack-list) 14396 entry (vhdl-aget pack-alist key)) 14397 (when (equal file-name (nth 1 entry)) 14398 (if (nth 6 entry) 14399 (vhdl-aput 'pack-alist key 14400 (list (nth 0 entry) nil nil nil nil nil 14401 (nth 6 entry) (nth 7 entry) (nth 8 entry) 14402 (nth 9 entry))) 14403 (vhdl-adelete 'pack-alist key))) 14404 (setq pack-list (cdr pack-list))) 14405 ;; package bodies 14406 (while pack-body-list 14407 (setq key (car pack-body-list) 14408 entry (vhdl-aget pack-alist key)) 14409 (when (equal file-name (nth 6 entry)) 14410 (if (nth 1 entry) 14411 (vhdl-aput 'pack-alist key 14412 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 14413 (nth 3 entry) (nth 4 entry) (nth 5 entry) 14414 nil nil nil nil)) 14415 (vhdl-adelete 'pack-alist key))) 14416 (setq pack-body-list (cdr pack-body-list))) 14417 ;; instantiated entities 14418 (while inst-ent-list 14419 (setq ent-inst-list 14420 (vhdl-delete (car inst-ent-list) ent-inst-list)) 14421 (setq inst-ent-list (cdr inst-ent-list))) 14422 ;; update caches 14423 (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist) 14424 (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist) 14425 (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist) 14426 (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) 14427 ;; scan file 14428 (vhdl-scan-directory-contents file-name project t) 14429 (when (or (and vhdl-speedbar-show-projects project) 14430 (and (not vhdl-speedbar-show-projects) (not project))) 14431 (vhdl-speedbar-refresh project)) 14432 (setq updated t))) 14433 (setq directory-alist (cdr directory-alist))) 14434 updated)) 14435 14436(defun vhdl-update-hierarchy () 14437 "Update directory and hierarchy information in speedbar." 14438 (let ((file-list (reverse vhdl-modified-file-list)) 14439 updated) 14440 (when (and vhdl-speedbar-update-on-saving file-list) 14441 (while file-list 14442 (setq updated 14443 (or (vhdl-update-file-contents (car file-list)) 14444 updated)) 14445 (setq file-list (cdr file-list))) 14446 (setq vhdl-modified-file-list nil) 14447 (vhdl-speedbar-update-current-unit) 14448 (when updated (message "Updating hierarchy...done"))))) 14449 14450;; structure (parenthesized expression means list of such entries) 14451;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker 14452;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker 14453;; comp-lib-name level) 14454(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key 14455 conf-inst-alist level indent 14456 &optional include-top ent-hier) 14457 "Get instantiation hierarchy beginning in architecture ARCH-KEY of 14458entity ENT-KEY." 14459 (let* ((ent-entry (vhdl-aget ent-alist ent-key)) 14460 (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) 14461 (cdar (last (nth 3 ent-entry))))) 14462 (inst-alist (nth 3 arch-entry)) 14463 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry 14464 hier-list subcomp-list tmp-list inst-key inst-comp-name 14465 inst-ent-key inst-arch-key inst-conf-key inst-lib-key) 14466 (when (= level 0) (message "Extract design hierarchy...")) 14467 (when include-top 14468 (setq level (1+ level))) 14469 (when (member ent-key ent-hier) 14470 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) 14471 ;; process all instances 14472 (while inst-alist 14473 (setq inst-entry (car inst-alist) 14474 inst-key (nth 0 inst-entry) 14475 inst-comp-name (nth 4 inst-entry) 14476 inst-conf-key (nth 7 inst-entry)) 14477 ;; search entry in configuration's instantiations list 14478 (setq tmp-list conf-inst-alist) 14479 (while (and tmp-list 14480 (not (and (member (nth 0 (car tmp-list)) 14481 (list "all" inst-key)) 14482 (equal (nth 1 (car tmp-list)) 14483 (downcase (or inst-comp-name "")))))) 14484 (setq tmp-list (cdr tmp-list))) 14485 (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) 14486 (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key)) 14487 (when (and inst-conf-key (not inst-conf-entry)) 14488 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) 14489 ;; determine entity 14490 (setq inst-ent-key 14491 (or (nth 2 (car tmp-list)) ; from configuration 14492 (nth 3 inst-conf-entry) ; from subconfiguration 14493 (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry))) 14494 ; from configuration spec. 14495 (nth 5 inst-entry))) ; from direct instantiation 14496 (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key)) 14497 ;; determine architecture 14498 (setq inst-arch-key 14499 (or (nth 3 (car tmp-list)) ; from configuration 14500 (nth 4 inst-conf-entry) ; from subconfiguration 14501 (nth 6 inst-entry) ; from direct instantiation 14502 (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry))) 14503 ; from configuration spec. 14504 (nth 4 inst-ent-entry) ; MRA 14505 (caar (nth 3 inst-ent-entry)))) ; first alphabetically 14506 (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key)) 14507 ;; set library 14508 (setq inst-lib-key 14509 (or (nth 5 (car tmp-list)) ; from configuration 14510 (nth 8 inst-entry))) ; from direct instantiation 14511 ;; gather information for this instance 14512 (setq comp-entry 14513 (list (nth 1 inst-entry) 14514 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 14515 (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) 14516 (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) 14517 (or (nth 0 inst-arch-entry) inst-arch-key) 14518 (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) 14519 (or (nth 0 inst-conf-entry) inst-conf-key) 14520 (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) 14521 inst-lib-key level)) 14522 ;; get subcomponent hierarchy 14523 (setq subcomp-list (vhdl-get-hierarchy 14524 ent-alist conf-alist 14525 inst-ent-key inst-arch-key inst-conf-key 14526 (nth 5 inst-conf-entry) 14527 (1+ level) indent nil (cons ent-key ent-hier))) 14528 ;; add to list 14529 (setq hier-list (append hier-list (list comp-entry) subcomp-list)) 14530 (setq inst-alist (cdr inst-alist))) 14531 (when include-top 14532 (setq hier-list 14533 (cons (list nil nil (nth 0 ent-entry) 14534 (cons (nth 1 ent-entry) (nth 2 ent-entry)) 14535 (nth 0 arch-entry) 14536 (cons (nth 1 arch-entry) (nth 2 arch-entry)) 14537 nil nil 14538 nil (1- level)) 14539 hier-list))) 14540 (when (or (= level 0) (and include-top (= level 1))) (message "")) 14541 hier-list)) 14542 14543(defun vhdl-get-instantiations (ent-key indent) 14544 "Get all instantiations of entity ENT-KEY." 14545 (let ((ent-alist (vhdl-aget vhdl-entity-alist 14546 (vhdl-speedbar-line-key indent))) 14547 arch-alist inst-alist ent-inst-list 14548 ent-entry arch-entry inst-entry) 14549 (while ent-alist 14550 (setq ent-entry (car ent-alist)) 14551 (setq arch-alist (nth 4 ent-entry)) 14552 (while arch-alist 14553 (setq arch-entry (car arch-alist)) 14554 (setq inst-alist (nth 4 arch-entry)) 14555 (while inst-alist 14556 (setq inst-entry (car inst-alist)) 14557 (when (equal ent-key (nth 5 inst-entry)) 14558 (setq ent-inst-list 14559 (cons (list (nth 1 inst-entry) 14560 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 14561 (nth 1 ent-entry) 14562 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 14563 (nth 1 arch-entry) 14564 (cons (nth 2 arch-entry) (nth 3 arch-entry))) 14565 ent-inst-list))) 14566 (setq inst-alist (cdr inst-alist))) 14567 (setq arch-alist (cdr arch-alist))) 14568 (setq ent-alist (cdr ent-alist))) 14569 (nreverse ent-inst-list))) 14570 14571;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14572;; Caching in file 14573 14574(defun vhdl-save-caches () 14575 "Save all updated hierarchy caches to file." 14576 (interactive) 14577 (condition-case nil 14578 (when vhdl-speedbar-save-cache 14579 ;; update hierarchy 14580 (vhdl-update-hierarchy) 14581 (let ((project-list vhdl-updated-project-list)) 14582 (message "Saving hierarchy caches...") 14583 ;; write updated project caches 14584 (while project-list 14585 (vhdl-save-cache (car project-list)) 14586 (setq project-list (cdr project-list))) 14587 (message "Saving hierarchy caches...done"))) 14588 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") 14589 (sit-for 2))))) 14590 14591(defun vhdl-save-cache (key) 14592 "Save current hierarchy cache to file." 14593 (let* ((orig-buffer (current-buffer)) 14594 (vhdl-project key) 14595 (project (vhdl-project-p)) 14596 (default-directory key) 14597 (directory (abbreviate-file-name (vhdl-default-directory))) 14598 (file-name (vhdl-resolve-env-variable 14599 (vhdl-replace-string 14600 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 14601 (concat 14602 (subst-char-in-string ? ?_ (or project "dir")) 14603 " " (user-login-name))))) 14604 (file-dir-name (expand-file-name file-name directory)) 14605 (cache-key (or project directory)) 14606 (key (if project "project" "directory"))) 14607 (unless (file-exists-p (file-name-directory file-dir-name)) 14608 (make-directory (file-name-directory file-dir-name) t)) 14609 (if (not (file-writable-p file-dir-name)) 14610 (progn (vhdl-warning (format "File not writable: \"%s\"" 14611 (abbreviate-file-name file-dir-name))) 14612 (sit-for 2)) 14613 (message "Saving cache: \"%s\"" file-dir-name) 14614 (set-buffer (find-file-noselect file-dir-name t t)) 14615 (erase-buffer) 14616 (insert ";; -*- Emacs-Lisp -*-\n\n" 14617 ";;; " (file-name-nondirectory file-name) 14618 " - design hierarchy cache file for Emacs VHDL Mode " 14619 vhdl-version "\n") 14620 (insert "\n;; " (if project "Project " "Directory") " : ") 14621 (if project (insert project) (prin1 directory (current-buffer))) 14622 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") 14623 (user-login-name) "\n\n" 14624 "\n;; version number\n" 14625 "(setq vhdl-cache-version \"" vhdl-version "\")\n" 14626 "\n;; " (if project "project" "directory") " name" 14627 "\n(setq " key " ") 14628 (prin1 (or project directory) (current-buffer)) 14629 (insert ")\n") 14630 (when (member 'hierarchy vhdl-speedbar-save-cache) 14631 (insert "\n;; entity and architecture cache\n" 14632 "(vhdl-aput 'vhdl-entity-alist " key " '") 14633 (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer)) 14634 (insert ")\n\n;; configuration cache\n" 14635 "(vhdl-aput 'vhdl-config-alist " key " '") 14636 (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer)) 14637 (insert ")\n\n;; package cache\n" 14638 "(vhdl-aput 'vhdl-package-alist " key " '") 14639 (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer)) 14640 (insert ")\n\n;; instantiated entities cache\n" 14641 "(vhdl-aput 'vhdl-ent-inst-alist " key " '") 14642 (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer)) 14643 (insert ")\n\n;; design units per file cache\n" 14644 "(vhdl-aput 'vhdl-file-alist " key " '") 14645 (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer)) 14646 (when project 14647 (insert ")\n\n;; source directories in project cache\n" 14648 "(vhdl-aput 'vhdl-directory-alist " key " '") 14649 (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer))) 14650 (insert ")\n")) 14651 (when (member 'display vhdl-speedbar-save-cache) 14652 (insert "\n;; shown design units cache\n" 14653 "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") 14654 (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key) 14655 (current-buffer)) 14656 (insert ")\n")) 14657 (setq vhdl-updated-project-list 14658 (delete cache-key vhdl-updated-project-list)) 14659 (save-buffer) 14660 (kill-buffer (current-buffer)) 14661 (set-buffer orig-buffer)))) 14662 14663(defun vhdl-load-cache (key) 14664 "Load hierarchy cache information from file." 14665 (let* ((vhdl-project key) 14666 (default-directory key) 14667 (directory (vhdl-default-directory)) 14668 (file-name (vhdl-resolve-env-variable 14669 (vhdl-replace-string 14670 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 14671 (concat 14672 (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) 14673 " " (user-login-name))))) 14674 (file-dir-name (expand-file-name file-name directory)) 14675 vhdl-cache-version) 14676 (unless (memq 'vhdl-save-caches kill-emacs-hook) 14677 (add-hook 'kill-emacs-hook 'vhdl-save-caches)) 14678 (when (file-exists-p file-dir-name) 14679 (condition-case () 14680 (progn (load-file file-dir-name) 14681 (string< (mapconcat 14682 (lambda (a) (format "%3d" (string-to-number a))) 14683 (split-string "3.33" "\\.") "") 14684 (mapconcat 14685 (lambda (a) (format "%3d" (string-to-number a))) 14686 (split-string vhdl-cache-version "\\.") ""))) 14687 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) 14688 nil)))))) 14689 14690(defun vhdl-require-hierarchy-info () 14691 "Make sure that hierarchy information is available. Load cache or scan files 14692if required." 14693 (if (vhdl-project-p) 14694 (unless (or (assoc vhdl-project vhdl-file-alist) 14695 (vhdl-load-cache vhdl-project)) 14696 (vhdl-scan-project-contents vhdl-project)) 14697 (let ((directory (abbreviate-file-name default-directory))) 14698 (unless (or (assoc directory vhdl-file-alist) 14699 (vhdl-load-cache directory)) 14700 (vhdl-scan-directory-contents directory))))) 14701 14702;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14703;; Add hierarchy browser functionality to speedbar 14704 14705(defvar vhdl-speedbar-mode-map nil 14706 "Keymap used when in the VHDL hierarchy browser mode.") 14707 14708(defvar vhdl-speedbar-menu-items nil 14709 "Additional menu-items to add to speedbar frame.") 14710 14711(declare-function speedbar-add-supported-extension "speedbar" (extension)) 14712(declare-function speedbar-add-mode-functions-list "speedbar" (new-list)) 14713(declare-function speedbar-make-specialized-keymap "speedbar" ()) 14714(declare-function speedbar-change-initial-expansion-list "speedbar" 14715 (new-default)) 14716(declare-function speedbar-add-expansion-list "speedbar" (new-list)) 14717 14718(defun vhdl-speedbar-initialize () 14719 "Initialize speedbar." 14720 ;; general settings 14721 ;; VHDL file extensions (extracted from `auto-mode-alist') 14722 (let ((mode-alist auto-mode-alist)) 14723 (while mode-alist 14724 (when (eq (cdar mode-alist) 'vhdl-mode) 14725 (speedbar-add-supported-extension (caar mode-alist))) 14726 (setq mode-alist (cdr mode-alist)))) 14727 ;; hierarchy browser settings 14728 (when (boundp 'speedbar-mode-functions-list) 14729 ;; special functions 14730 (speedbar-add-mode-functions-list 14731 '("vhdl directory" 14732 (speedbar-item-info . vhdl-speedbar-item-info) 14733 (speedbar-line-directory . speedbar-files-line-directory))) 14734 (speedbar-add-mode-functions-list 14735 '("vhdl project" 14736 (speedbar-item-info . vhdl-speedbar-item-info) 14737 (speedbar-line-directory . vhdl-speedbar-line-project))) 14738 ;; keymap 14739 (unless vhdl-speedbar-mode-map 14740 (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) 14741 (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) 14742 (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) 14743 (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) 14744 (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) 14745 (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) 14746 (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) 14747 (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) 14748 (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) 14749 (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) 14750 (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) 14751 (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) 14752 (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) 14753 (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) 14754 (let ((key 0)) 14755 (while (<= key 9) 14756 (define-key vhdl-speedbar-mode-map (int-to-string key) 14757 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) 14758 (setq key (1+ key))))) 14759 (define-key speedbar-mode-map "h" 14760 (lambda () (interactive) 14761 (speedbar-change-initial-expansion-list "vhdl directory"))) 14762 (define-key speedbar-mode-map "H" 14763 (lambda () (interactive) 14764 (speedbar-change-initial-expansion-list "vhdl project"))) 14765 ;; menu 14766 (unless vhdl-speedbar-menu-items 14767 (setq 14768 vhdl-speedbar-menu-items 14769 `(["Edit" speedbar-edit-line t] 14770 ["Expand" speedbar-expand-line 14771 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))] 14772 ["Contract" vhdl-speedbar-contract-level t] 14773 ["Expand All" vhdl-speedbar-expand-all t] 14774 ["Contract All" vhdl-speedbar-contract-all t] 14775 ,(let ((key 0) (menu-list '("Hierarchy Depth"))) 14776 (while (<= key 9) 14777 (setq menu-list 14778 (cons `[,(if (= key 0) "All" (int-to-string key)) 14779 (vhdl-speedbar-set-depth ,key) 14780 :style radio 14781 :selected (= vhdl-speedbar-hierarchy-depth ,key) 14782 :keys ,(int-to-string key)] 14783 menu-list)) 14784 (setq key (1+ key))) 14785 (nreverse menu-list)) 14786 "--" 14787 ["Copy Port/Subprogram" vhdl-speedbar-port-copy 14788 (or (vhdl-speedbar-check-unit 'entity) 14789 (vhdl-speedbar-check-unit 'subprogram))] 14790 ["Place Component" vhdl-speedbar-place-component 14791 (vhdl-speedbar-check-unit 'entity)] 14792 ["Generate Configuration" vhdl-speedbar-configuration 14793 (vhdl-speedbar-check-unit 'architecture)] 14794 ["Select as MRA" vhdl-speedbar-select-mra 14795 (vhdl-speedbar-check-unit 'architecture)] 14796 ["Make" vhdl-speedbar-make-design 14797 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] 14798 ["Generate Makefile" vhdl-speedbar-generate-makefile 14799 (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] 14800 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy 14801 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) 14802 ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)] 14803 ["Rescan Project" vhdl-speedbar-rescan-hierarchy 14804 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) 14805 ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects] 14806 ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) 14807 ;; hook-ups 14808 (speedbar-add-expansion-list 14809 '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map 14810 vhdl-speedbar-display-directory)) 14811 (speedbar-add-expansion-list 14812 '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map 14813 vhdl-speedbar-display-projects)) 14814 (setq speedbar-stealthy-function-list 14815 (append 14816 '(("vhdl directory" vhdl-speedbar-update-current-unit) 14817 ("vhdl project" vhdl-speedbar-update-current-project 14818 vhdl-speedbar-update-current-unit)) 14819 speedbar-stealthy-function-list)) 14820 (when (eq vhdl-speedbar-display-mode 'directory) 14821 (setq speedbar-initial-expansion-list-name "vhdl directory")) 14822 (when (eq vhdl-speedbar-display-mode 'project) 14823 (setq speedbar-initial-expansion-list-name "vhdl project")) 14824 (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) 14825 14826(defun vhdl-speedbar (&optional arg) 14827 "Open/close speedbar." 14828 (interactive) 14829 (if (not (fboundp 'speedbar)) 14830 (error "WARNING: Speedbar is not available or not installed") 14831 (condition-case () 14832 (speedbar-frame-mode arg) 14833 (error (error "WARNING: An error occurred while opening speedbar"))))) 14834 14835;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14836;; Display functions 14837 14838(defvar vhdl-speedbar-last-selected-project nil 14839 "Name of last selected project.") 14840 14841;; macros must be defined in the file they are used (copied from `speedbar.el') 14842;;; (defmacro speedbar-with-writable (&rest forms) 14843;;; "Allow the buffer to be writable and evaluate FORMS." 14844;;; (list 'let '((inhibit-read-only t)) 14845;;; (cons 'progn forms))) 14846;;; (put 'speedbar-with-writable 'lisp-indent-function 0) 14847 14848(declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) 14849(declare-function speedbar-directory-buttons "speedbar" (directory _index)) 14850(declare-function speedbar-file-lists "speedbar" (directory)) 14851 14852(defun vhdl-speedbar-display-directory (directory depth &optional rescan) 14853 "Display directory and hierarchy information in speedbar." 14854 (setq vhdl-speedbar-show-projects nil) 14855 (setq speedbar-ignored-directory-regexp 14856 (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) 14857 (setq directory (abbreviate-file-name (file-name-as-directory directory))) 14858 (setq speedbar-last-selected-file nil) 14859 (speedbar-with-writable 14860 (condition-case nil 14861 (progn 14862 ;; insert directory path 14863 (speedbar-directory-buttons directory depth) 14864 ;; insert subdirectories 14865 (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth) 14866 ;; scan and insert hierarchy of current directory 14867 (vhdl-speedbar-insert-dir-hierarchy directory depth 14868 speedbar-power-click) 14869 ;; expand subdirectories 14870 (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) 14871 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) 14872 14873(defun vhdl-speedbar-display-projects (project depth &optional rescan) 14874 "Display projects and hierarchy information in speedbar." 14875 (setq vhdl-speedbar-show-projects t) 14876 (setq speedbar-ignored-directory-regexp ".") 14877 (setq speedbar-last-selected-file nil) 14878 (setq vhdl-speedbar-last-selected-project nil) 14879 (speedbar-with-writable 14880 (condition-case nil 14881 ;; insert projects 14882 (vhdl-speedbar-insert-projects) 14883 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) 14884 (setq speedbar-full-text-cache nil)) ; prevent caching 14885 14886(declare-function speedbar-make-tag-line "speedbar" 14887 (type char func data tag tfunc tdata tface depth)) 14888 14889(defun vhdl-speedbar-insert-projects () 14890 "Insert all projects in speedbar." 14891 (vhdl-speedbar-make-title-line "Projects:") 14892 (let ((project-alist (if vhdl-project-sort 14893 (vhdl-sort-alist (copy-alist vhdl-project-alist)) 14894 vhdl-project-alist)) 14895 (vhdl-speedbar-update-current-unit nil)) 14896 ;; insert projects 14897 (while project-alist 14898 (speedbar-make-tag-line 14899 'angle ?+ 'vhdl-speedbar-expand-project 14900 (caar project-alist) (caar project-alist) 14901 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) 14902 (setq project-alist (cdr project-alist))) 14903 (setq project-alist vhdl-project-alist) 14904 ;; expand projects 14905 (while project-alist 14906 (when (member (caar project-alist) vhdl-speedbar-shown-project-list) 14907 (goto-char (point-min)) 14908 (when (re-search-forward 14909 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) 14910 (goto-char (match-end 1)) 14911 (speedbar-do-function-pointer))) 14912 (setq project-alist (cdr project-alist))))) 14913 14914(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) 14915 "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, 14916otherwise use cached data." 14917 (when (or rescan (and (not (assoc project vhdl-file-alist)) 14918 (not (vhdl-load-cache project)))) 14919 (vhdl-scan-project-contents project)) 14920 ;; insert design hierarchy 14921 (vhdl-speedbar-insert-hierarchy 14922 (vhdl-aget vhdl-entity-alist project) 14923 (vhdl-aget vhdl-config-alist project) 14924 (vhdl-aget vhdl-package-alist project) 14925 (car (vhdl-aget vhdl-ent-inst-alist project)) indent) 14926 (insert (int-to-string indent) ":\n") 14927 (put-text-property (- (point) 3) (1- (point)) 'invisible t) 14928 (put-text-property (1- (point)) (point) 'invisible nil) 14929 ;; expand design units 14930 (vhdl-speedbar-expand-units project)) 14931 14932(defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) 14933 "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil, 14934otherwise use cached data." 14935 (when (or rescan (and (not (assoc directory vhdl-file-alist)) 14936 (not (vhdl-load-cache directory)))) 14937 (vhdl-scan-directory-contents directory)) 14938 ;; insert design hierarchy 14939 (vhdl-speedbar-insert-hierarchy 14940 (vhdl-aget vhdl-entity-alist directory) 14941 (vhdl-aget vhdl-config-alist directory) 14942 (vhdl-aget vhdl-package-alist directory) 14943 (car (vhdl-aget vhdl-ent-inst-alist directory)) depth) 14944 ;; expand design units 14945 (vhdl-speedbar-expand-units directory) 14946 (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) 14947 14948(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist 14949 ent-inst-list depth) 14950 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." 14951 (if (not (or ent-alist conf-alist pack-alist)) 14952 (vhdl-speedbar-make-title-line "No VHDL design units!" depth) 14953 (let (ent-entry conf-entry pack-entry) 14954 ;; insert entities 14955 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) 14956 (while ent-alist 14957 (setq ent-entry (car ent-alist)) 14958 (speedbar-make-tag-line 14959 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) 14960 (nth 1 ent-entry) 'vhdl-speedbar-find-file 14961 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 14962 'vhdl-speedbar-entity-face depth) 14963 (unless (nth 2 ent-entry) 14964 (end-of-line 0) (insert "!") (forward-char 1)) 14965 (unless (member (nth 0 ent-entry) ent-inst-list) 14966 (end-of-line 0) (insert " (top)") (forward-char 1)) 14967 (setq ent-alist (cdr ent-alist))) 14968 ;; insert configurations 14969 (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) 14970 (while conf-alist 14971 (setq conf-entry (car conf-alist)) 14972 (speedbar-make-tag-line 14973 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) 14974 (nth 1 conf-entry) 'vhdl-speedbar-find-file 14975 (cons (nth 2 conf-entry) (nth 3 conf-entry)) 14976 'vhdl-speedbar-configuration-face depth) 14977 (setq conf-alist (cdr conf-alist))) 14978 ;; insert packages 14979 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) 14980 (while pack-alist 14981 (setq pack-entry (car pack-alist)) 14982 (vhdl-speedbar-make-pack-line 14983 (nth 0 pack-entry) (nth 1 pack-entry) 14984 (cons (nth 2 pack-entry) (nth 3 pack-entry)) 14985 (cons (nth 7 pack-entry) (nth 8 pack-entry)) 14986 depth) 14987 (setq pack-alist (cdr pack-alist)))))) 14988 14989(declare-function speedbar-line-directory "speedbar" (&optional depth)) 14990 14991(defun vhdl-speedbar-rescan-hierarchy () 14992 "Rescan hierarchy for the directory or project under the cursor." 14993 (interactive) 14994 (let (key path) 14995 (cond 14996 ;; current project 14997 (vhdl-speedbar-show-projects 14998 (setq key (vhdl-speedbar-line-project)) 14999 (vhdl-scan-project-contents key)) 15000 ;; top-level directory 15001 ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) 15002 (re-search-forward "[0-9]+:" nil t) 15003 (vhdl-scan-directory-contents 15004 (abbreviate-file-name (speedbar-line-directory)))) 15005 ;; current directory 15006 (t (setq path (speedbar-line-directory)) 15007 (string-match "^\\(.+[/\\]\\)" path) 15008 (vhdl-scan-directory-contents 15009 (abbreviate-file-name (match-string 1 path))))) 15010 (vhdl-speedbar-refresh key))) 15011 15012(declare-function speedbar-goto-this-file "speedbar" (file)) 15013 15014(defun vhdl-speedbar-expand-dirs (directory) 15015 "Expand subdirectories in DIRECTORY according to 15016 `speedbar-shown-directories'." 15017 ;; (nicked from `speedbar-default-directory-list') 15018 (let ((sf (cdr (reverse speedbar-shown-directories))) 15019 (vhdl-speedbar-update-current-unit nil)) 15020 (setq speedbar-shown-directories 15021 (list (expand-file-name default-directory))) 15022 (while sf 15023 (when (speedbar-goto-this-file (car sf)) 15024 (beginning-of-line) 15025 (when (looking-at "[0-9]+:\\s-*<") 15026 (goto-char (match-end 0)) 15027 (speedbar-do-function-pointer))) 15028 (setq sf (cdr sf)))) 15029 (vhdl-speedbar-update-current-unit nil t)) 15030 15031(defun vhdl-speedbar-expand-units (key) 15032 "Expand design units in directory/project KEY according to 15033`vhdl-speedbar-shown-unit-alist'." 15034 (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15035 (vhdl-speedbar-update-current-unit nil) 15036 vhdl-updated-project-list) 15037 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) 15038 (vhdl-prepare-search-1 15039 (while unit-alist ; expand units 15040 (vhdl-speedbar-goto-this-unit key (caar unit-alist)) 15041 (beginning-of-line) 15042 (let ((arch-alist (nth 1 (car unit-alist))) 15043 position) 15044 (when (looking-at "^[0-9]+:\\s-*\\[") 15045 (goto-char (match-end 0)) 15046 (setq position (point)) 15047 (speedbar-do-function-pointer) 15048 (select-frame speedbar-frame) 15049 (while arch-alist ; expand architectures 15050 (goto-char position) 15051 (when (re-search-forward 15052 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" 15053 (car arch-alist) "\\>\\)") nil t) 15054 (beginning-of-line) 15055 (when (looking-at "^[0-9]+:\\s-*{") 15056 (goto-char (match-end 0)) 15057 (speedbar-do-function-pointer) 15058 (select-frame speedbar-frame))) 15059 (setq arch-alist (cdr arch-alist)))) 15060 (setq unit-alist (cdr unit-alist)))))) 15061 (vhdl-speedbar-update-current-unit nil t)) 15062 15063(declare-function speedbar-center-buffer-smartly "speedbar" ()) 15064 15065(defun vhdl-speedbar-contract-level () 15066 "Contract current level in current directory/project." 15067 (interactive) 15068 (when (or (save-excursion 15069 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) 15070 (and (save-excursion 15071 (beginning-of-line) (looking-at "^\\([0-9]+\\):")) 15072 (re-search-backward 15073 (format "^[0-%d]:\\s-*[[{<]-" 15074 (max (1- (string-to-number (match-string 1))) 0)) nil t))) 15075 (goto-char (match-end 0)) 15076 (speedbar-do-function-pointer) 15077 (speedbar-center-buffer-smartly))) 15078 15079(defun vhdl-speedbar-contract-all () 15080 "Contract all expanded design units in current directory/project." 15081 (interactive) 15082 (if (and vhdl-speedbar-show-projects 15083 (save-excursion (beginning-of-line) (looking-at "^0:"))) 15084 (progn (setq vhdl-speedbar-shown-project-list nil) 15085 (vhdl-speedbar-refresh)) 15086 (let ((key (vhdl-speedbar-line-key))) 15087 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) 15088 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) 15089 (when (memq 'display vhdl-speedbar-save-cache) 15090 (add-to-list 'vhdl-updated-project-list key))))) 15091 15092(defun vhdl-speedbar-expand-all () 15093 "Expand all design units in current directory/project." 15094 (interactive) 15095 (let* ((key (vhdl-speedbar-line-key)) 15096 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15097 (conf-alist (vhdl-aget vhdl-config-alist key)) 15098 (pack-alist (vhdl-aget vhdl-package-alist key)) 15099 arch-alist unit-alist subunit-alist) 15100 (add-to-list 'vhdl-speedbar-shown-project-list key) 15101 (while ent-alist 15102 (setq arch-alist (nth 4 (car ent-alist))) 15103 (setq subunit-alist nil) 15104 (while arch-alist 15105 (push (caar arch-alist) subunit-alist) 15106 (setq arch-alist (cdr arch-alist))) 15107 (push (list (caar ent-alist) subunit-alist) unit-alist) 15108 (setq ent-alist (cdr ent-alist))) 15109 (while conf-alist 15110 (push (list (caar conf-alist)) unit-alist) 15111 (setq conf-alist (cdr conf-alist))) 15112 (while pack-alist 15113 (push (list (caar pack-alist)) unit-alist) 15114 (setq pack-alist (cdr pack-alist))) 15115 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15116 (vhdl-speedbar-refresh) 15117 (when (memq 'display vhdl-speedbar-save-cache) 15118 (add-to-list 'vhdl-updated-project-list key)))) 15119 15120(declare-function speedbar-change-expand-button-char "speedbar" (char)) 15121(declare-function speedbar-delete-subblock "speedbar" (indent)) 15122 15123(defun vhdl-speedbar-expand-project (text token indent) 15124 "Expand/contract the project under the cursor." 15125 (cond 15126 ((string-match "\\+" text) ; expand project 15127 (speedbar-change-expand-button-char ?-) 15128 (unless (member token vhdl-speedbar-shown-project-list) 15129 (setq vhdl-speedbar-shown-project-list 15130 (cons token vhdl-speedbar-shown-project-list))) 15131 (speedbar-with-writable 15132 (save-excursion 15133 (end-of-line) (forward-char 1) 15134 (vhdl-speedbar-insert-project-hierarchy token (1+ indent) 15135 speedbar-power-click)))) 15136 ((string-match "-" text) ; contract project 15137 (speedbar-change-expand-button-char ?+) 15138 (setq vhdl-speedbar-shown-project-list 15139 (delete token vhdl-speedbar-shown-project-list)) 15140 (speedbar-delete-subblock indent)) 15141 (t (error "Nothing to display"))) 15142 (when (equal (selected-frame) speedbar-frame) 15143 (speedbar-center-buffer-smartly))) 15144 15145(defun vhdl-speedbar-expand-entity (text token indent) 15146 "Expand/contract the entity under the cursor." 15147 (cond 15148 ((string-match "\\+" text) ; expand entity 15149 (let* ((key (vhdl-speedbar-line-key indent)) 15150 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15151 (ent-entry (vhdl-aget ent-alist token)) 15152 (arch-alist (nth 3 ent-entry)) 15153 (inst-alist (vhdl-get-instantiations token indent)) 15154 (subpack-alist (nth 5 ent-entry)) 15155 (multiple-arch (> (length arch-alist) 1)) 15156 arch-entry inst-entry) 15157 (if (not (or arch-alist inst-alist subpack-alist)) 15158 (speedbar-change-expand-button-char ??) 15159 (speedbar-change-expand-button-char ?-) 15160 ;; add entity to `vhdl-speedbar-shown-unit-alist' 15161 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15162 (vhdl-aput 'unit-alist token nil) 15163 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15164 (speedbar-with-writable 15165 (save-excursion 15166 (end-of-line) (forward-char 1) 15167 ;; insert architectures 15168 (when arch-alist 15169 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) 15170 (while arch-alist 15171 (setq arch-entry (car arch-alist)) 15172 (speedbar-make-tag-line 15173 'curly ?+ 'vhdl-speedbar-expand-architecture 15174 (cons token (nth 0 arch-entry)) 15175 (nth 1 arch-entry) 'vhdl-speedbar-find-file 15176 (cons (nth 2 arch-entry) (nth 3 arch-entry)) 15177 'vhdl-speedbar-architecture-face (1+ indent)) 15178 (when (and multiple-arch 15179 (equal (nth 0 arch-entry) (nth 4 ent-entry))) 15180 (end-of-line 0) (insert " (mra)") (forward-char 1)) 15181 (setq arch-alist (cdr arch-alist))) 15182 ;; insert instantiations 15183 (when inst-alist 15184 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) 15185 (while inst-alist 15186 (setq inst-entry (car inst-alist)) 15187 (vhdl-speedbar-make-inst-line 15188 (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) 15189 (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) 15190 nil nil nil (1+ indent) 0 " in ") 15191 (setq inst-alist (cdr inst-alist))) 15192 ;; insert required packages 15193 (vhdl-speedbar-insert-subpackages 15194 subpack-alist (1+ indent) indent))) 15195 (when (memq 'display vhdl-speedbar-save-cache) 15196 (add-to-list 'vhdl-updated-project-list key)) 15197 (vhdl-speedbar-update-current-unit t t)))) 15198 ((string-match "-" text) ; contract entity 15199 (speedbar-change-expand-button-char ?+) 15200 ;; remove entity from `vhdl-speedbar-shown-unit-alist' 15201 (let* ((key (vhdl-speedbar-line-key indent)) 15202 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15203 (vhdl-adelete 'unit-alist token) 15204 (if unit-alist 15205 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15206 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15207 (speedbar-delete-subblock indent) 15208 (when (memq 'display vhdl-speedbar-save-cache) 15209 (add-to-list 'vhdl-updated-project-list key)))) 15210 (t (error "Nothing to display"))) 15211 (when (equal (selected-frame) speedbar-frame) 15212 (speedbar-center-buffer-smartly))) 15213 15214(defun vhdl-speedbar-expand-architecture (text token indent) 15215 "Expand/contract the architecture under the cursor." 15216 (cond 15217 ((string-match "\\+" text) ; expand architecture 15218 (let* ((key (vhdl-speedbar-line-key (1- indent))) 15219 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15220 (conf-alist (vhdl-aget vhdl-config-alist key)) 15221 (hier-alist (vhdl-get-hierarchy 15222 ent-alist conf-alist (car token) (cdr token) nil nil 15223 0 (1- indent))) 15224 (ent-entry (vhdl-aget ent-alist (car token))) 15225 (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token))) 15226 (subpack-alist (nth 4 arch-entry)) 15227 entry) 15228 (if (not (or hier-alist subpack-alist)) 15229 (speedbar-change-expand-button-char ??) 15230 (speedbar-change-expand-button-char ?-) 15231 ;; add architecture to `vhdl-speedbar-shown-unit-alist' 15232 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15233 (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) 15234 (vhdl-aput 'unit-alist (car token) 15235 (list (cons (cdr token) arch-alist))) 15236 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15237 (speedbar-with-writable 15238 (save-excursion 15239 (end-of-line) (forward-char 1) 15240 ;; insert instance hierarchy 15241 (when hier-alist 15242 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" 15243 (1+ indent))) 15244 (while hier-alist 15245 (setq entry (car hier-alist)) 15246 (when (or (= vhdl-speedbar-hierarchy-depth 0) 15247 (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 15248 (vhdl-speedbar-make-inst-line 15249 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 15250 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 15251 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) 15252 (setq hier-alist (cdr hier-alist))) 15253 ;; insert required packages 15254 (vhdl-speedbar-insert-subpackages 15255 subpack-alist (1+ indent) (1- indent)))) 15256 (when (memq 'display vhdl-speedbar-save-cache) 15257 (add-to-list 'vhdl-updated-project-list key)) 15258 (vhdl-speedbar-update-current-unit t t)))) 15259 ((string-match "-" text) ; contract architecture 15260 (speedbar-change-expand-button-char ?+) 15261 ;; remove architecture from `vhdl-speedbar-shown-unit-alist' 15262 (let* ((key (vhdl-speedbar-line-key (1- indent))) 15263 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15264 (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) 15265 (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) 15266 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15267 (speedbar-delete-subblock indent) 15268 (when (memq 'display vhdl-speedbar-save-cache) 15269 (add-to-list 'vhdl-updated-project-list key)))) 15270 (t (error "Nothing to display"))) 15271 (when (equal (selected-frame) speedbar-frame) 15272 (speedbar-center-buffer-smartly))) 15273 15274(defun vhdl-speedbar-expand-config (text token indent) 15275 "Expand/contract the configuration under the cursor." 15276 (cond 15277 ((string-match "\\+" text) ; expand configuration 15278 (let* ((key (vhdl-speedbar-line-key indent)) 15279 (conf-alist (vhdl-aget vhdl-config-alist key)) 15280 (conf-entry (vhdl-aget conf-alist token)) 15281 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15282 (hier-alist (vhdl-get-hierarchy 15283 ent-alist conf-alist (nth 3 conf-entry) 15284 (nth 4 conf-entry) token (nth 5 conf-entry) 15285 0 indent t)) 15286 (subpack-alist (nth 6 conf-entry)) 15287 entry) 15288 (if (not (or hier-alist subpack-alist)) 15289 (speedbar-change-expand-button-char ??) 15290 (speedbar-change-expand-button-char ?-) 15291 ;; add configuration to `vhdl-speedbar-shown-unit-alist' 15292 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15293 (vhdl-aput 'unit-alist token nil) 15294 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15295 (speedbar-with-writable 15296 (save-excursion 15297 (end-of-line) (forward-char 1) 15298 ;; insert instance hierarchy 15299 (when hier-alist 15300 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) 15301 (while hier-alist 15302 (setq entry (car hier-alist)) 15303 (when (or (= vhdl-speedbar-hierarchy-depth 0) 15304 (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 15305 (vhdl-speedbar-make-inst-line 15306 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 15307 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 15308 (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) 15309 (setq hier-alist (cdr hier-alist))) 15310 ;; insert required packages 15311 (vhdl-speedbar-insert-subpackages 15312 subpack-alist (1+ indent) indent))) 15313 (when (memq 'display vhdl-speedbar-save-cache) 15314 (add-to-list 'vhdl-updated-project-list key)) 15315 (vhdl-speedbar-update-current-unit t t)))) 15316 ((string-match "-" text) ; contract configuration 15317 (speedbar-change-expand-button-char ?+) 15318 ;; remove configuration from `vhdl-speedbar-shown-unit-alist' 15319 (let* ((key (vhdl-speedbar-line-key indent)) 15320 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15321 (vhdl-adelete 'unit-alist token) 15322 (if unit-alist 15323 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15324 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15325 (speedbar-delete-subblock indent) 15326 (when (memq 'display vhdl-speedbar-save-cache) 15327 (add-to-list 'vhdl-updated-project-list key)))) 15328 (t (error "Nothing to display"))) 15329 (when (equal (selected-frame) speedbar-frame) 15330 (speedbar-center-buffer-smartly))) 15331 15332(defun vhdl-speedbar-expand-package (text token indent) 15333 "Expand/contract the package under the cursor." 15334 (cond 15335 ((string-match "\\+" text) ; expand package 15336 (let* ((key (vhdl-speedbar-line-key indent)) 15337 (pack-alist (vhdl-aget vhdl-package-alist key)) 15338 (pack-entry (vhdl-aget pack-alist token)) 15339 (comp-alist (nth 3 pack-entry)) 15340 (func-alist (nth 4 pack-entry)) 15341 (func-body-alist (nth 8 pack-entry)) 15342 (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) 15343 comp-entry func-entry func-body-entry) 15344 (if (not (or comp-alist func-alist subpack-alist)) 15345 (speedbar-change-expand-button-char ??) 15346 (speedbar-change-expand-button-char ?-) 15347 ;; add package to `vhdl-speedbar-shown-unit-alist' 15348 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15349 (vhdl-aput 'unit-alist token nil) 15350 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15351 (speedbar-with-writable 15352 (save-excursion 15353 (end-of-line) (forward-char 1) 15354 ;; insert components 15355 (when comp-alist 15356 (vhdl-speedbar-make-title-line "Components:" (1+ indent))) 15357 (while comp-alist 15358 (setq comp-entry (car comp-alist)) 15359 (speedbar-make-tag-line 15360 nil nil nil 15361 (cons token (nth 0 comp-entry)) 15362 (nth 1 comp-entry) 'vhdl-speedbar-find-file 15363 (cons (nth 2 comp-entry) (nth 3 comp-entry)) 15364 'vhdl-speedbar-entity-face (1+ indent)) 15365 (setq comp-alist (cdr comp-alist))) 15366 ;; insert subprograms 15367 (when func-alist 15368 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) 15369 (while func-alist 15370 (setq func-entry (car func-alist) 15371 func-body-entry (vhdl-aget func-body-alist 15372 (car func-entry))) 15373 (when (nth 2 func-entry) 15374 (vhdl-speedbar-make-subprogram-line 15375 (nth 1 func-entry) 15376 (cons (nth 2 func-entry) (nth 3 func-entry)) 15377 (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) 15378 (1+ indent))) 15379 (setq func-alist (cdr func-alist))) 15380 ;; insert required packages 15381 (vhdl-speedbar-insert-subpackages 15382 subpack-alist (1+ indent) indent))) 15383 (when (memq 'display vhdl-speedbar-save-cache) 15384 (add-to-list 'vhdl-updated-project-list key)) 15385 (vhdl-speedbar-update-current-unit t t)))) 15386 ((string-match "-" text) ; contract package 15387 (speedbar-change-expand-button-char ?+) 15388 ;; remove package from `vhdl-speedbar-shown-unit-alist' 15389 (let* ((key (vhdl-speedbar-line-key indent)) 15390 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15391 (vhdl-adelete 'unit-alist token) 15392 (if unit-alist 15393 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15394 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15395 (speedbar-delete-subblock indent) 15396 (when (memq 'display vhdl-speedbar-save-cache) 15397 (add-to-list 'vhdl-updated-project-list key)))) 15398 (t (error "Nothing to display"))) 15399 (when (equal (selected-frame) speedbar-frame) 15400 (speedbar-center-buffer-smartly))) 15401 15402(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) 15403 "Insert required packages." 15404 (let* ((pack-alist (vhdl-aget vhdl-package-alist 15405 (vhdl-speedbar-line-key dir-indent))) 15406 pack-key lib-name pack-entry) 15407 (when subpack-alist 15408 (vhdl-speedbar-make-title-line "Packages Used:" indent)) 15409 (while subpack-alist 15410 (setq pack-key (cdar subpack-alist) 15411 lib-name (caar subpack-alist)) 15412 (setq pack-entry (vhdl-aget pack-alist pack-key)) 15413 (vhdl-speedbar-make-subpack-line 15414 (or (nth 0 pack-entry) pack-key) lib-name 15415 (cons (nth 1 pack-entry) (nth 2 pack-entry)) 15416 (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) 15417 (setq subpack-alist (cdr subpack-alist))))) 15418 15419;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15420;; Display help functions 15421 15422(defvar vhdl-speedbar-update-current-unit t 15423 "Non-nil means to run `vhdl-speedbar-update-current-unit'.") 15424 15425(defun vhdl-speedbar-update-current-project () 15426 "Highlight project that is currently active." 15427 (when (and vhdl-speedbar-show-projects 15428 (not (equal vhdl-speedbar-last-selected-project vhdl-project)) 15429 (and (boundp 'speedbar-frame) 15430 (frame-live-p speedbar-frame))) 15431 (let ((last-frame (selected-frame)) 15432 (project-alist vhdl-project-alist) 15433 pos) 15434 (select-frame speedbar-frame) 15435 (speedbar-with-writable 15436 (save-excursion 15437 (while project-alist 15438 (goto-char (point-min)) 15439 (when (re-search-forward 15440 (concat "<.> \\(" (caar project-alist) "\\)$") nil t) 15441 (put-text-property (match-beginning 1) (match-end 1) 'face 15442 (if (equal (caar project-alist) vhdl-project) 15443 'speedbar-selected-face 15444 'speedbar-directory-face)) 15445 (when (equal (caar project-alist) vhdl-project) 15446 (setq pos (1- (match-beginning 1))))) 15447 (setq project-alist (cdr project-alist)))) 15448 (when pos (goto-char pos))) 15449 (select-frame last-frame) 15450 (setq vhdl-speedbar-last-selected-project vhdl-project))) 15451 t) 15452 15453(declare-function speedbar-position-cursor-on-line "speedbar" ()) 15454 15455(defun vhdl-speedbar-update-current-unit (&optional no-position always) 15456 "Highlight all design units that are contained in the current file. 15457NO-POSITION non-nil means do not re-position cursor." 15458 (let ((last-frame (selected-frame)) 15459 (project-list vhdl-speedbar-shown-project-list) 15460 file-alist pos file-name) 15461 ;; get current file name 15462 (if (fboundp 'speedbar-select-attached-frame) 15463 (speedbar-select-attached-frame) 15464 (select-frame speedbar-attached-frame)) 15465 (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) 15466 (when (and vhdl-speedbar-update-current-unit 15467 (or always (not (equal file-name speedbar-last-selected-file)))) 15468 (if vhdl-speedbar-show-projects 15469 (while project-list 15470 (setq file-alist (append file-alist 15471 (vhdl-aget vhdl-file-alist 15472 (car project-list)))) 15473 (setq project-list (cdr project-list))) 15474 (setq file-alist 15475 (vhdl-aget vhdl-file-alist 15476 (abbreviate-file-name default-directory)))) 15477 (select-frame speedbar-frame) 15478 (set-buffer speedbar-buffer) 15479 (speedbar-with-writable 15480 (vhdl-prepare-search-1 15481 (save-excursion 15482 ;; unhighlight last units 15483 (let* ((file-entry (vhdl-aget file-alist 15484 speedbar-last-selected-file))) 15485 (vhdl-speedbar-update-units 15486 "\\[.] " (nth 0 file-entry) 15487 speedbar-last-selected-file 'vhdl-speedbar-entity-face) 15488 (vhdl-speedbar-update-units 15489 "{.} " (nth 1 file-entry) 15490 speedbar-last-selected-file 'vhdl-speedbar-architecture-face) 15491 (vhdl-speedbar-update-units 15492 "\\[.] " (nth 3 file-entry) 15493 speedbar-last-selected-file 'vhdl-speedbar-configuration-face) 15494 (vhdl-speedbar-update-units 15495 "[]>] " (nth 4 file-entry) 15496 speedbar-last-selected-file 'vhdl-speedbar-package-face) 15497 (vhdl-speedbar-update-units 15498 "\\[.].+(" '("body") 15499 speedbar-last-selected-file 'vhdl-speedbar-package-face) 15500 (vhdl-speedbar-update-units 15501 "> " (nth 6 file-entry) 15502 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) 15503 ;; highlight current units 15504 (let* ((file-entry (vhdl-aget file-alist file-name))) 15505 (setq 15506 pos (vhdl-speedbar-update-units 15507 "\\[.] " (nth 0 file-entry) 15508 file-name 'vhdl-speedbar-entity-selected-face pos) 15509 pos (vhdl-speedbar-update-units 15510 "{.} " (nth 1 file-entry) 15511 file-name 'vhdl-speedbar-architecture-selected-face pos) 15512 pos (vhdl-speedbar-update-units 15513 "\\[.] " (nth 3 file-entry) 15514 file-name 'vhdl-speedbar-configuration-selected-face pos) 15515 pos (vhdl-speedbar-update-units 15516 "[]>] " (nth 4 file-entry) 15517 file-name 'vhdl-speedbar-package-selected-face pos) 15518 pos (vhdl-speedbar-update-units 15519 "\\[.].+(" '("body") 15520 file-name 'vhdl-speedbar-package-selected-face pos) 15521 pos (vhdl-speedbar-update-units 15522 "> " (nth 6 file-entry) 15523 file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) 15524 ;; move speedbar so the first highlighted unit is visible 15525 (when (and pos (not no-position)) 15526 (goto-char pos) 15527 (speedbar-center-buffer-smartly) 15528 (speedbar-position-cursor-on-line)) 15529 (setq speedbar-last-selected-file file-name)) 15530 (select-frame last-frame) 15531 t)) 15532 15533(defun vhdl-speedbar-update-units (text unit-list file-name face 15534 &optional pos) 15535 "Help function to highlight design units." 15536 (while unit-list 15537 (goto-char (point-min)) 15538 (while (re-search-forward 15539 (concat text "\\(" (car unit-list) "\\)\\>") nil t) 15540 (when (equal file-name (car (get-text-property 15541 (match-beginning 1) 'speedbar-token))) 15542 (setq pos (or pos (point-marker))) 15543 (put-text-property (match-beginning 1) (match-end 1) 'face face))) 15544 (setq unit-list (cdr unit-list))) 15545 pos) 15546 15547(declare-function speedbar-make-button "speedbar" 15548 (start end face mouse function &optional token)) 15549 15550(defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker 15551 ent-name ent-file-marker 15552 arch-name arch-file-marker 15553 conf-name conf-file-marker 15554 lib-name depth offset delimiter) 15555 "Insert instantiation entry." 15556 (let ((start (point)) 15557 visible-start) 15558 (insert (int-to-string depth) ":") 15559 (put-text-property start (point) 'invisible t) 15560 (setq visible-start (point)) 15561 (insert-char ? (* depth speedbar-indentation-width)) 15562 (while (> offset 0) 15563 (insert "|") 15564 (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) 15565 (setq offset (1- offset))) 15566 (put-text-property visible-start (point) 'invisible nil) 15567 (setq start (point)) 15568 (insert ">") 15569 (speedbar-make-button start (point) nil nil nil) 15570 (setq visible-start (point)) 15571 (insert " ") 15572 (setq start (point)) 15573 (if (not inst-name) 15574 (insert "(top)") 15575 (insert inst-name) 15576 (speedbar-make-button 15577 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face 15578 'vhdl-speedbar-find-file inst-file-marker)) 15579 (insert delimiter) 15580 (when ent-name 15581 (setq start (point)) 15582 (insert ent-name) 15583 (speedbar-make-button 15584 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face 15585 'vhdl-speedbar-find-file ent-file-marker) 15586 (when arch-name 15587 (insert " (") 15588 (setq start (point)) 15589 (insert arch-name) 15590 (speedbar-make-button 15591 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face 15592 'vhdl-speedbar-find-file arch-file-marker) 15593 (insert ")")) 15594 (when conf-name 15595 (insert " (") 15596 (setq start (point)) 15597 (insert conf-name) 15598 (speedbar-make-button 15599 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face 15600 'vhdl-speedbar-find-file conf-file-marker) 15601 (insert ")"))) 15602 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) 15603 (setq start (point)) 15604 (insert " (" lib-name ")") 15605 (put-text-property (+ 2 start) (1- (point)) 'face 15606 'vhdl-speedbar-library-face)) 15607 (insert-char ?\n 1) 15608 (put-text-property visible-start (point) 'invisible nil))) 15609 15610(defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker 15611 body-file-marker depth) 15612 "Insert package entry." 15613 (let ((start (point)) 15614 visible-start) 15615 (insert (int-to-string depth) ":") 15616 (put-text-property start (point) 'invisible t) 15617 (setq visible-start (point)) 15618 (insert-char ? (* depth speedbar-indentation-width)) 15619 (put-text-property visible-start (point) 'invisible nil) 15620 (setq start (point)) 15621 (insert "[+]") 15622 (speedbar-make-button 15623 start (point) 'speedbar-button-face 'speedbar-highlight-face 15624 'vhdl-speedbar-expand-package pack-key) 15625 (setq visible-start (point)) 15626 (insert-char ? 1 nil) 15627 (setq start (point)) 15628 (insert pack-name) 15629 (speedbar-make-button 15630 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15631 'vhdl-speedbar-find-file pack-file-marker) 15632 (unless (car pack-file-marker) 15633 (insert "!")) 15634 (when (car body-file-marker) 15635 (insert " (") 15636 (setq start (point)) 15637 (insert "body") 15638 (speedbar-make-button 15639 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15640 'vhdl-speedbar-find-file body-file-marker) 15641 (insert ")")) 15642 (insert-char ?\n 1) 15643 (put-text-property visible-start (point) 'invisible nil))) 15644 15645(defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker 15646 pack-body-file-marker depth) 15647 "Insert used package entry." 15648 (let ((start (point)) 15649 visible-start) 15650 (insert (int-to-string depth) ":") 15651 (put-text-property start (point) 'invisible t) 15652 (setq visible-start (point)) 15653 (insert-char ? (* depth speedbar-indentation-width)) 15654 (put-text-property visible-start (point) 'invisible nil) 15655 (setq start (point)) 15656 (insert ">") 15657 (speedbar-make-button start (point) nil nil nil) 15658 (setq visible-start (point)) 15659 (insert " ") 15660 (setq start (point)) 15661 (insert pack-name) 15662 (speedbar-make-button 15663 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15664 'vhdl-speedbar-find-file pack-file-marker) 15665 (when (car pack-body-file-marker) 15666 (insert " (") 15667 (setq start (point)) 15668 (insert "body") 15669 (speedbar-make-button 15670 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15671 'vhdl-speedbar-find-file pack-body-file-marker) 15672 (insert ")")) 15673 (setq start (point)) 15674 (insert " (" lib-name ")") 15675 (put-text-property (+ 2 start) (1- (point)) 'face 15676 'vhdl-speedbar-library-face) 15677 (insert-char ?\n 1) 15678 (put-text-property visible-start (point) 'invisible nil))) 15679 15680(defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker 15681 func-body-file-marker 15682 depth) 15683 "Insert subprogram entry." 15684 (let ((start (point)) 15685 visible-start) 15686 (insert (int-to-string depth) ":") 15687 (put-text-property start (point) 'invisible t) 15688 (setq visible-start (point)) 15689 (insert-char ? (* depth speedbar-indentation-width)) 15690 (put-text-property visible-start (point) 'invisible nil) 15691 (setq start (point)) 15692 (insert ">") 15693 (speedbar-make-button start (point) nil nil nil) 15694 (setq visible-start (point)) 15695 (insert " ") 15696 (setq start (point)) 15697 (insert func-name) 15698 (speedbar-make-button 15699 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 15700 'vhdl-speedbar-find-file func-file-marker) 15701 (when (car func-body-file-marker) 15702 (insert " (") 15703 (setq start (point)) 15704 (insert "body") 15705 (speedbar-make-button 15706 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 15707 'vhdl-speedbar-find-file func-body-file-marker) 15708 (insert ")")) 15709 (insert-char ?\n 1) 15710 (put-text-property visible-start (point) 'invisible nil))) 15711 15712(defun vhdl-speedbar-make-title-line (text &optional depth) 15713 "Insert design unit title entry." 15714 (let ((start (point)) 15715 visible-start) 15716 (when depth 15717 (insert (int-to-string depth) ":") 15718 (put-text-property start (point) 'invisible t)) 15719 (setq visible-start (point)) 15720 (insert-char ? (* (or depth 0) speedbar-indentation-width)) 15721 (setq start (point)) 15722 (insert text) 15723 (speedbar-make-button start (point) nil nil nil nil) 15724 (insert-char ?\n 1) 15725 (put-text-property visible-start (point) 'invisible nil))) 15726 15727(defun vhdl-speedbar-insert-dirs (files level) 15728 "Insert subdirectories." 15729 (let ((dirs (car files))) 15730 (while dirs 15731 (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) 15732 (car dirs) 'speedbar-dir-follow nil 15733 'speedbar-directory-face level) 15734 (setq dirs (cdr dirs))))) 15735 15736(declare-function speedbar-reset-scanners "speedbar" ()) 15737 15738(defun vhdl-speedbar-dired (text token indent) 15739 "Speedbar click handler for directory expand button in hierarchy mode." 15740 (cond ((string-match "\\+" text) ; we have to expand this dir 15741 (setq speedbar-shown-directories 15742 (cons (expand-file-name 15743 (concat (speedbar-line-directory indent) token "/")) 15744 speedbar-shown-directories)) 15745 (speedbar-change-expand-button-char ?-) 15746 (speedbar-reset-scanners) 15747 (speedbar-with-writable 15748 (save-excursion 15749 (end-of-line) (forward-char 1) 15750 (vhdl-speedbar-insert-dirs 15751 (speedbar-file-lists 15752 (concat (speedbar-line-directory indent) token "/")) 15753 (1+ indent)) 15754 (speedbar-reset-scanners) 15755 (vhdl-speedbar-insert-dir-hierarchy 15756 (abbreviate-file-name 15757 (concat (speedbar-line-directory indent) token "/")) 15758 (1+ indent) speedbar-power-click))) 15759 (vhdl-speedbar-update-current-unit t t)) 15760 ((string-match "-" text) ; we have to contract this node 15761 (speedbar-reset-scanners) 15762 (let ((oldl speedbar-shown-directories) 15763 (newl nil) 15764 (td (expand-file-name 15765 (concat (speedbar-line-directory indent) token)))) 15766 (while oldl 15767 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) 15768 (push (car oldl) newl)) 15769 (setq oldl (cdr oldl))) 15770 (setq speedbar-shown-directories (nreverse newl))) 15771 (speedbar-change-expand-button-char ?+) 15772 (speedbar-delete-subblock indent)) 15773 (t (error "Nothing to display"))) 15774 (when (equal (selected-frame) speedbar-frame) 15775 (speedbar-center-buffer-smartly))) 15776 15777(declare-function speedbar-files-item-info "speedbar" ()) 15778 15779(defun vhdl-speedbar-item-info () 15780 "Derive and display information about this line item." 15781 (save-excursion 15782 (beginning-of-line) 15783 ;; skip invisible number info 15784 (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) 15785 (cond 15786 ;; project/directory entry 15787 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") 15788 (if vhdl-speedbar-show-projects 15789 (message "Project \"%s\"" (match-string-no-properties 1)) 15790 (speedbar-files-item-info))) 15791 ;; design unit entry 15792 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") 15793 (goto-char (match-end 1)) 15794 (let ((face (get-text-property (point) 'face))) 15795 (message 15796 "%s \"%s\" in \"%s\"" 15797 ;; design unit kind 15798 (cond ((or (eq face 'vhdl-speedbar-entity-face) 15799 (eq face 'vhdl-speedbar-entity-selected-face)) 15800 (if (equal (match-string 2) ">") "Component" "Entity")) 15801 ((or (eq face 'vhdl-speedbar-architecture-face) 15802 (eq face 'vhdl-speedbar-architecture-selected-face)) 15803 "Architecture") 15804 ((or (eq face 'vhdl-speedbar-configuration-face) 15805 (eq face 'vhdl-speedbar-configuration-selected-face)) 15806 "Configuration") 15807 ((or (eq face 'vhdl-speedbar-package-face) 15808 (eq face 'vhdl-speedbar-package-selected-face)) 15809 "Package") 15810 ((or (eq face 'vhdl-speedbar-instantiation-face) 15811 (eq face 'vhdl-speedbar-instantiation-selected-face)) 15812 "Instantiation") 15813 ((eq face 'vhdl-speedbar-subprogram-face) 15814 "Subprogram") 15815 (t "")) 15816 ;; design unit name 15817 (buffer-substring-no-properties 15818 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) 15819 (match-end 1)) 15820 ;; file name 15821 (file-relative-name 15822 (or (car (get-text-property (point) 'speedbar-token)) 15823 "?") 15824 (vhdl-default-directory))))) 15825 (t (message ""))))) 15826 15827(declare-function speedbar-line-text "speedbar" (&optional p)) 15828 15829(defun vhdl-speedbar-line-text () 15830 "Calls `speedbar-line-text' and removes text properties." 15831 (let ((string (speedbar-line-text))) 15832 (set-text-properties 0 (length string) nil string) 15833 string)) 15834 15835(defun vhdl-speedbar-higher-text () 15836 "Get speedbar-line-text of higher level." 15837 (let (depth string) 15838 (save-excursion 15839 (beginning-of-line) 15840 (looking-at "^\\([0-9]+\\):") 15841 (setq depth (string-to-number (match-string 1))) 15842 (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) 15843 (setq string (match-string 1)) 15844 (set-text-properties 0 (length string) nil string) 15845 string)))) 15846 15847;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15848;; Help functions 15849 15850(defun vhdl-speedbar-line-key (&optional indent) 15851 "Get currently displayed directory of project name." 15852 (if vhdl-speedbar-show-projects 15853 (vhdl-speedbar-line-project) 15854 (abbreviate-file-name 15855 (file-name-as-directory (speedbar-line-directory indent))))) 15856 15857(defun vhdl-speedbar-line-project (&optional indent) 15858 "Get currently displayed project name." 15859 (and vhdl-speedbar-show-projects 15860 (save-excursion 15861 (end-of-line) 15862 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) 15863 (match-string-no-properties 1)))) 15864 15865(defun vhdl-add-modified-file () 15866 "Add file to `vhdl-modified-file-list'." 15867 (when vhdl-file-alist 15868 (add-to-list 'vhdl-modified-file-list (buffer-file-name))) 15869 nil) 15870 15871(defun vhdl-resolve-paths (path-list) 15872 "Resolve path wildcards in PATH-LIST." 15873 (let (path-list-1 path-list-2 path-beg path-end dir) 15874 ;; eliminate non-existent directories 15875 (while path-list 15876 (setq dir (car path-list)) 15877 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) 15878 (if (file-directory-p (match-string 2 dir)) 15879 (push dir path-list-1) 15880 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) 15881 (setq path-list (cdr path-list))) 15882 ;; resolve path wildcards 15883 (while path-list-1 15884 (setq dir (car path-list-1)) 15885 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) 15886 (progn 15887 (setq path-beg (match-string 1 dir) 15888 path-end (match-string 5 dir)) 15889 (setq path-list-1 15890 (append 15891 (mapcar 15892 (function 15893 (lambda (var) (concat path-beg var path-end))) 15894 (let ((all-list (vhdl-directory-files 15895 (match-string 2 dir) t 15896 (concat "\\<" (wildcard-to-regexp 15897 (match-string 4 dir))))) 15898 dir-list) 15899 (while all-list 15900 (when (file-directory-p (car all-list)) 15901 (push (car all-list) dir-list)) 15902 (setq all-list (cdr all-list))) 15903 dir-list)) 15904 (cdr path-list-1)))) 15905 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) 15906 (when (file-directory-p (match-string 2 dir)) 15907 (push dir path-list-2)) 15908 (setq path-list-1 (cdr path-list-1)))) 15909 (nreverse path-list-2))) 15910 15911(defun vhdl-speedbar-goto-this-unit (directory unit) 15912 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." 15913 (let ((dest (point))) 15914 (if (and (if vhdl-speedbar-show-projects 15915 (progn (goto-char (point-min)) t) 15916 (speedbar-goto-this-file directory)) 15917 (re-search-forward (concat "[]}] " unit "\\>") nil t)) 15918 (progn (speedbar-position-cursor-on-line) 15919 t) 15920 (goto-char dest) 15921 nil))) 15922 15923(declare-function speedbar-find-file-in-frame "speedbar" (file)) 15924(declare-function speedbar-set-timer "speedbar" (timeout)) 15925;; speedbar loads dframe at runtime. 15926(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) 15927 15928(defun vhdl-speedbar-find-file (text token indent) 15929 "When user clicks on TEXT, load file with name and position in TOKEN. 15930Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file 15931is already shown in a buffer." 15932 (if (not (car token)) 15933 (error "ERROR: File cannot be found") 15934 (let ((buffer (get-file-buffer (car token)))) 15935 (speedbar-find-file-in-frame (car token)) 15936 (when (or vhdl-speedbar-jump-to-unit buffer) 15937 (goto-char (point-min)) 15938 (forward-line (1- (cdr token))) 15939 (recenter)) 15940 (vhdl-speedbar-update-current-unit t t) 15941 (speedbar-set-timer dframe-update-speed) 15942 (dframe-maybee-jump-to-attached-frame)))) 15943 15944(defun vhdl-speedbar-port-copy () 15945 "Copy the port of the entity/component or subprogram under the cursor." 15946 (interactive) 15947 (let ((is-entity (vhdl-speedbar-check-unit 'entity))) 15948 (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) 15949 (error "ERROR: No entity/component or subprogram under cursor") 15950 (beginning-of-line) 15951 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") 15952 (condition-case info 15953 (let ((token (get-text-property 15954 (match-beginning 3) 'speedbar-token))) 15955 (vhdl-visit-file (car token) t 15956 (progn (goto-char (point-min)) 15957 (forward-line (1- (cdr token))) 15958 (end-of-line) 15959 (if is-entity 15960 (vhdl-port-copy) 15961 (vhdl-subprog-copy))))) 15962 (error (error "ERROR: %s not scanned successfully\n (%s)" 15963 (if is-entity "Port" "Interface") (cadr info)))) 15964 (error "ERROR: No entity/component or subprogram on current line"))))) 15965 15966(defun vhdl-speedbar-place-component () 15967 "Place the entity/component under the cursor as component." 15968 (interactive) 15969 (if (not (vhdl-speedbar-check-unit 'entity)) 15970 (error "ERROR: No entity/component under cursor") 15971 (vhdl-speedbar-port-copy) 15972 (if (fboundp 'speedbar-select-attached-frame) 15973 (speedbar-select-attached-frame) 15974 (select-frame speedbar-attached-frame)) 15975 (vhdl-compose-place-component) 15976 (select-frame speedbar-frame))) 15977 15978(defun vhdl-speedbar-configuration () 15979 "Generate configuration for the architecture under the cursor." 15980 (interactive) 15981 (if (not (vhdl-speedbar-check-unit 'architecture)) 15982 (error "ERROR: No architecture under cursor") 15983 (let ((arch-name (vhdl-speedbar-line-text)) 15984 (ent-name (vhdl-speedbar-higher-text))) 15985 (if (fboundp 'speedbar-select-attached-frame) 15986 (speedbar-select-attached-frame) 15987 (select-frame speedbar-attached-frame)) 15988 (vhdl-compose-configuration ent-name arch-name)))) 15989 15990(defun vhdl-speedbar-select-mra () 15991 "Select the architecture under the cursor as MRA." 15992 (interactive) 15993 (if (not (vhdl-speedbar-check-unit 'architecture)) 15994 (error "ERROR: No architecture under cursor") 15995 (let* ((arch-key (downcase (vhdl-speedbar-line-text))) 15996 (ent-key (downcase (vhdl-speedbar-higher-text))) 15997 (ent-alist (vhdl-aget 15998 vhdl-entity-alist 15999 (or (vhdl-project-p) 16000 (abbreviate-file-name default-directory)))) 16001 (ent-entry (vhdl-aget ent-alist ent-key))) 16002 (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) 16003 (speedbar-refresh)))) 16004 16005(declare-function speedbar-line-file "speedbar" (&optional p)) 16006 16007(defun vhdl-speedbar-make-design () 16008 "Make (compile) design unit or directory/project under the cursor." 16009 (interactive) 16010 (if (not (save-excursion (beginning-of-line) 16011 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) 16012 (error "ERROR: No primary design unit or directory/project under cursor") 16013 (let ((is-unit (match-string 2)) 16014 (unit-name (vhdl-speedbar-line-text)) 16015 (vhdl-project (vhdl-speedbar-line-project)) 16016 (directory (file-name-as-directory 16017 (or (speedbar-line-file) (speedbar-line-directory))))) 16018 (if (fboundp 'speedbar-select-attached-frame) 16019 (speedbar-select-attached-frame) 16020 (select-frame speedbar-attached-frame)) 16021 (let ((default-directory directory)) 16022 (vhdl-make (and is-unit unit-name)))))) 16023 16024(defun vhdl-speedbar-generate-makefile () 16025 "Generate Makefile for directory/project under the cursor." 16026 (interactive) 16027 (let ((vhdl-project (vhdl-speedbar-line-project)) 16028 (default-directory (file-name-as-directory 16029 (or (speedbar-line-file) (speedbar-line-directory))))) 16030 (vhdl-generate-makefile))) 16031 16032(defun vhdl-speedbar-check-unit (design-unit) 16033 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its 16034expansion function)." 16035 (save-excursion 16036 (speedbar-position-cursor-on-line) 16037 (cond ((eq design-unit 'entity) 16038 (memq (get-text-property (match-end 0) 'face) 16039 '(vhdl-speedbar-entity-face 16040 vhdl-speedbar-entity-selected-face))) 16041 ((eq design-unit 'architecture) 16042 (memq (get-text-property (match-end 0) 'face) 16043 '(vhdl-speedbar-architecture-face 16044 vhdl-speedbar-architecture-selected-face))) 16045 ((eq design-unit 'subprogram) 16046 (eq (get-text-property (match-end 0) 'face) 16047 'vhdl-speedbar-subprogram-face)) 16048 (t nil)))) 16049 16050(defun vhdl-speedbar-set-depth (depth) 16051 "Set hierarchy display depth to DEPTH and refresh speedbar." 16052 (setq vhdl-speedbar-hierarchy-depth depth) 16053 (speedbar-refresh)) 16054 16055;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16056;; Fontification 16057 16058(defface vhdl-speedbar-entity-face 16059 '((((class color) (background light)) (:foreground "ForestGreen")) 16060 (((class color) (background dark)) (:foreground "PaleGreen"))) 16061 "Face used for displaying entity names." 16062 :group 'speedbar-faces) 16063 16064(defface vhdl-speedbar-architecture-face 16065 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) 16066 (((class color) (background light)) (:foreground "Blue")) 16067 16068 (((class color) (background dark)) (:foreground "LightSkyBlue"))) 16069 "Face used for displaying architecture names." 16070 :group 'speedbar-faces) 16071 16072(defface vhdl-speedbar-configuration-face 16073 '((((class color) (background light)) (:foreground "DarkGoldenrod")) 16074 (((class color) (background dark)) (:foreground "Salmon"))) 16075 "Face used for displaying configuration names." 16076 :group 'speedbar-faces) 16077 16078(defface vhdl-speedbar-package-face 16079 '((((class color) (background light)) (:foreground "Grey50")) 16080 (((class color) (background dark)) (:foreground "Grey80"))) 16081 "Face used for displaying package names." 16082 :group 'speedbar-faces) 16083 16084(defface vhdl-speedbar-library-face 16085 '((((class color) (background light)) (:foreground "Purple")) 16086 (((class color) (background dark)) (:foreground "Orchid1"))) 16087 "Face used for displaying library names." 16088 :group 'speedbar-faces) 16089 16090(defface vhdl-speedbar-instantiation-face 16091 '((((class color) (background light)) (:foreground "Brown")) 16092 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) 16093 (((class color) (background dark)) (:foreground "Yellow"))) 16094 "Face used for displaying instantiation names." 16095 :group 'speedbar-faces) 16096 16097(defface vhdl-speedbar-subprogram-face 16098 '((((class color) (background light)) (:foreground "Orchid4")) 16099 (((class color) (background dark)) (:foreground "BurlyWood2"))) 16100 "Face used for displaying subprogram names." 16101 :group 'speedbar-faces) 16102 16103(defface vhdl-speedbar-entity-selected-face 16104 '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) 16105 (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) 16106 "Face used for displaying entity names." 16107 :group 'speedbar-faces) 16108 16109(defface vhdl-speedbar-architecture-selected-face 16110 '((((min-colors 88) (class color) (background light)) (:foreground 16111 "Blue1" :underline t)) 16112 (((class color) (background light)) (:foreground "Blue" :underline t)) 16113 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) 16114 "Face used for displaying architecture names." 16115 :group 'speedbar-faces) 16116 16117(defface vhdl-speedbar-configuration-selected-face 16118 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) 16119 (((class color) (background dark)) (:foreground "Salmon" :underline t))) 16120 "Face used for displaying configuration names." 16121 :group 'speedbar-faces) 16122 16123(defface vhdl-speedbar-package-selected-face 16124 '((((class color) (background light)) (:foreground "Grey50" :underline t)) 16125 (((class color) (background dark)) (:foreground "Grey80" :underline t))) 16126 "Face used for displaying package names." 16127 :group 'speedbar-faces) 16128 16129(defface vhdl-speedbar-instantiation-selected-face 16130 '((((class color) (background light)) (:foreground "Brown" :underline t)) 16131 (((class color) (background dark)) (:foreground "Yellow" :underline t))) 16132 "Face used for displaying instantiation names." 16133 :group 'speedbar-faces) 16134 16135;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16136;; Initialization 16137 16138;; add speedbar 16139(when (fboundp 'speedbar) 16140 (let ((current-frame (selected-frame))) 16141 (condition-case () 16142 (when (and vhdl-speedbar-auto-open 16143 (not (and (boundp 'speedbar-frame) 16144 (frame-live-p speedbar-frame)))) 16145 (speedbar-frame-mode 1)) 16146 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))) 16147 (select-frame current-frame))) 16148 16149;; initialize speedbar 16150(if (not (boundp 'speedbar-frame)) 16151 (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize) 16152 (vhdl-speedbar-initialize) 16153 (when speedbar-frame (vhdl-speedbar-refresh))) 16154 16155 16156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16157;;; Structural composition 16158;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16159 16160(defun vhdl-get-components-package-name () 16161 "Return the name of the components package." 16162 (let ((project (vhdl-project-p))) 16163 (if project 16164 (vhdl-replace-string (car vhdl-components-package-name) 16165 (subst-char-in-string ? ?_ project)) 16166 (cdr vhdl-components-package-name)))) 16167 16168(defun vhdl-compose-new-component () 16169 "Create entity and architecture for new component." 16170 (interactive) 16171 (let* ((case-fold-search t) 16172 (ent-name (read-from-minibuffer "entity name: " 16173 nil vhdl-minibuffer-local-map)) 16174 (arch-name 16175 (if (equal (cdr vhdl-compose-architecture-name) "") 16176 (read-from-minibuffer "architecture name: " 16177 nil vhdl-minibuffer-local-map) 16178 (vhdl-replace-string vhdl-compose-architecture-name ent-name))) 16179 ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) 16180 (message "Creating component \"%s(%s)\"..." ent-name arch-name) 16181 ;; open entity file 16182 (unless (eq vhdl-compose-create-files 'none) 16183 (setq ent-file-name 16184 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16185 "." (file-name-extension (buffer-file-name)))) 16186 (when (and (file-exists-p ent-file-name) 16187 (not (y-or-n-p (concat "File \"" ent-file-name 16188 "\" exists; overwrite? ")))) 16189 (error "ERROR: Creating component...aborted")) 16190 (find-file ent-file-name) 16191 (erase-buffer) 16192 (set-buffer-modified-p nil)) 16193 ;; insert header 16194 (if vhdl-compose-include-header 16195 (progn (vhdl-template-header) 16196 (setq end-pos (point)) 16197 (goto-char (point-max))) 16198 (vhdl-comment-display-line) (insert "\n\n")) 16199 ;; insert library clause 16200 (vhdl-template-package-std-logic-1164) 16201 (when vhdl-use-components-package 16202 (insert "\n") 16203 (vhdl-template-standard-package (vhdl-work-library) 16204 (vhdl-get-components-package-name))) 16205 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") 16206 ;; insert entity declaration 16207 (vhdl-insert-keyword "ENTITY ") (insert ent-name) 16208 (vhdl-insert-keyword " IS\n") 16209 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16210 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") 16211 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 16212 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16213 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") 16214 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 16215 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16216 (vhdl-insert-keyword "END ") 16217 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 16218 (insert ent-name ";\n\n") 16219 (vhdl-comment-display-line) (insert "\n") 16220 ;; open architecture file 16221 (if (not (eq vhdl-compose-create-files 'separate)) 16222 (insert "\n") 16223 (goto-char (or end-pos (point-min))) 16224 (setq ent-buffer (current-buffer)) 16225 (setq arch-file-name 16226 (concat (vhdl-replace-string vhdl-architecture-file-name 16227 (concat ent-name " " arch-name) t) 16228 "." (file-name-extension (buffer-file-name)))) 16229 (when (and (file-exists-p arch-file-name) 16230 (not (y-or-n-p (concat "File \"" arch-file-name 16231 "\" exists; overwrite? ")))) 16232 (error "ERROR: Creating component...aborted")) 16233 (find-file arch-file-name) 16234 (erase-buffer) 16235 (set-buffer-modified-p nil) 16236 ;; insert header 16237 (if vhdl-compose-include-header 16238 (progn (vhdl-template-header) 16239 (goto-char (point-max))) 16240 (vhdl-comment-display-line) (insert "\n\n"))) 16241 ;; insert architecture body 16242 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) 16243 (vhdl-insert-keyword " OF ") (insert ent-name) 16244 (vhdl-insert-keyword " IS\n\n") 16245 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16246 (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") 16247 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16248 (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) 16249 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16250 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 16251 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) 16252 (vhdl-insert-keyword "BEGIN") 16253 (when vhdl-self-insert-comments 16254 (insert " -- ") 16255 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 16256 (insert arch-name)) 16257 (insert "\n\n") 16258 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16259 (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") 16260 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16261 (vhdl-insert-keyword "END ") 16262 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 16263 (insert arch-name ";\n\n") 16264 ;; insert footer and save 16265 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16266 (vhdl-template-footer) 16267 (vhdl-comment-display-line) (insert "\n")) 16268 (goto-char (or end-pos (point-min))) 16269 (setq arch-buffer (current-buffer)) 16270 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 16271 (set-buffer arch-buffer) (save-buffer) 16272 (message "%s" 16273 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) 16274 (and ent-file-name 16275 (format "\n File created: \"%s\"" ent-file-name)) 16276 (and arch-file-name 16277 (format "\n File created: \"%s\"" arch-file-name)))))) 16278 16279(defun vhdl-compose-place-component () 16280 "Place new component by pasting current port as component declaration and 16281component instantiation." 16282 (interactive) 16283 (if (not vhdl-port-list) 16284 (error "ERROR: No port has been read") 16285 (save-excursion 16286 (vhdl-prepare-search-2 16287 (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 16288 (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) 16289 (error "ERROR: No architecture found")) 16290 (let* ((ent-name (match-string 1)) 16291 (ent-file-name 16292 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16293 "." (file-name-extension (buffer-file-name)))) 16294 (orig-buffer (current-buffer))) 16295 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) 16296 ;; place component declaration 16297 (unless (or vhdl-use-components-package 16298 (vhdl-use-direct-instantiation) 16299 (save-excursion 16300 (re-search-forward 16301 (concat "^\\s-*component\\s-+" 16302 (car vhdl-port-list) "\\>") nil t))) 16303 (re-search-forward "^begin\\>" nil) 16304 (beginning-of-line) 16305 (skip-chars-backward " \t\n\r\f") 16306 (insert "\n\n") (indent-to vhdl-basic-offset) 16307 (vhdl-port-paste-component t)) 16308 ;; place component instantiation 16309 (re-search-forward "^end\\>" nil) 16310 (beginning-of-line) 16311 (skip-chars-backward " \t\n\r\f") 16312 (insert "\n\n") (indent-to vhdl-basic-offset) 16313 (vhdl-port-paste-instance nil t t) 16314 ;; place use clause for used packages 16315 (when (nth 3 vhdl-port-list) 16316 ;; open entity file 16317 (when (file-exists-p ent-file-name) 16318 (find-file ent-file-name)) 16319 (goto-char (point-min)) 16320 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) 16321 (error "ERROR: Entity not found: \"%s\"" ent-name)) 16322 (goto-char (match-beginning 0)) 16323 (if (and (save-excursion 16324 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) 16325 (match-string 1)) 16326 (progn (goto-char (match-end 0)) 16327 (beginning-of-line 2)) 16328 (insert "\n") 16329 (backward-char)) 16330 (vhdl-port-paste-context-clause) 16331 (switch-to-buffer orig-buffer)) 16332 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) 16333 16334(defun vhdl-compose-wire-components () 16335 "Connect components." 16336 (interactive) 16337 (save-excursion 16338 (vhdl-prepare-search-2 16339 (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 16340 (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) 16341 (error "ERROR: No architecture found")) 16342 (let* ((ent-name (match-string 1)) 16343 (ent-file-name 16344 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16345 "." (file-name-extension (buffer-file-name)))) 16346 (arch-decl-pos (point-marker)) 16347 (arch-stat-pos (re-search-forward "^begin\\>" nil)) 16348 (arch-end-pos (re-search-forward "^end\\>" nil)) 16349 (pack-name (vhdl-get-components-package-name)) 16350 (pack-file-name 16351 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 16352 "." (file-name-extension (buffer-file-name)))) 16353 inst-name comp-name comp-ent-name comp-ent-file-name has-generic 16354 port-alist generic-alist inst-alist 16355 signal-name signal-entry signal-alist local-list written-list 16356 single-in-list multi-in-list single-out-list multi-out-list 16357 constant-name constant-entry constant-alist single-list multi-list 16358 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos 16359 generic-beg-pos generic-pos generic-inst-pos generic-end-pos 16360 signal-beg-pos signal-pos 16361 constant-temp-pos port-temp-pos signal-temp-pos) 16362 (message "Wiring components...") 16363 ;; process all instances 16364 (goto-char arch-stat-pos) 16365 (while (re-search-forward 16366 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" 16367 "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)" 16368 "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|" 16369 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?" 16370 "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t) 16371 (setq inst-name (match-string-no-properties 1) 16372 comp-name (match-string-no-properties 4) 16373 comp-ent-name (match-string-no-properties 12) 16374 has-generic (or (match-string 7) (match-string 17))) 16375 ;; get port ... 16376 (if comp-name 16377 ;; ... from component declaration 16378 (vhdl-visit-file 16379 (when vhdl-use-components-package pack-file-name) t 16380 (save-excursion 16381 (goto-char (point-min)) 16382 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) 16383 (error "ERROR: Component declaration not found: \"%s\"" comp-name)) 16384 (vhdl-port-copy))) 16385 ;; ... from entity declaration (direct instantiation) 16386 (setq comp-ent-file-name 16387 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) 16388 "." (file-name-extension (buffer-file-name)))) 16389 (vhdl-visit-file 16390 comp-ent-file-name t 16391 (save-excursion 16392 (goto-char (point-min)) 16393 (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) 16394 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) 16395 (vhdl-port-copy)))) 16396 (vhdl-port-flatten t) 16397 (setq generic-alist (nth 1 vhdl-port-list) 16398 port-alist (nth 2 vhdl-port-list) 16399 vhdl-port-list nil) 16400 (setq constant-alist nil 16401 signal-alist nil) 16402 (when has-generic 16403 ;; process all constants in generic map 16404 (vhdl-forward-syntactic-ws) 16405 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) 16406 (setq constant-name (match-string-no-properties 3)) 16407 (setq constant-entry 16408 (cons constant-name 16409 (if (match-string 1) 16410 (or (vhdl-aget generic-alist (match-string 2)) 16411 (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 16412 (cdar generic-alist)))) 16413 (push constant-entry constant-alist) 16414 (setq constant-name (downcase constant-name)) 16415 (if (or (member constant-name single-list) 16416 (member constant-name multi-list)) 16417 (progn (setq single-list (delete constant-name single-list)) 16418 (vhdl--pushnew constant-name multi-list :test #'equal)) 16419 (vhdl--pushnew constant-name single-list :test #'equal)) 16420 (unless (match-string 1) 16421 (setq generic-alist (cdr generic-alist))) 16422 (vhdl-forward-syntactic-ws)) 16423 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t)) 16424 ;; process all signals in port map 16425 (vhdl-forward-syntactic-ws) 16426 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) 16427 (setq signal-name (match-string-no-properties 3)) 16428 (setq signal-entry 16429 (cons signal-name 16430 (if (match-string 1) 16431 (or (vhdl-aget port-alist (match-string 2)) 16432 (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 16433 (cdar port-alist)))) 16434 (push signal-entry signal-alist) 16435 (setq signal-name (downcase signal-name)) 16436 (if (equal (upcase (nth 2 signal-entry)) "IN") 16437 ;; input signal 16438 (cond 16439 ((member signal-name local-list) 16440 nil) 16441 ((or (member signal-name single-out-list) 16442 (member signal-name multi-out-list)) 16443 (setq single-out-list (delete signal-name single-out-list)) 16444 (setq multi-out-list (delete signal-name multi-out-list)) 16445 (vhdl--pushnew signal-name local-list :test #'equal)) 16446 ((member signal-name single-in-list) 16447 (setq single-in-list (delete signal-name single-in-list)) 16448 (vhdl--pushnew signal-name multi-in-list :test #'equal)) 16449 ((not (member signal-name multi-in-list)) 16450 (vhdl--pushnew signal-name single-in-list :test #'equal))) 16451 ;; output signal 16452 (cond 16453 ((member signal-name local-list) 16454 nil) 16455 ((or (member signal-name single-in-list) 16456 (member signal-name multi-in-list)) 16457 (setq single-in-list (delete signal-name single-in-list)) 16458 (setq multi-in-list (delete signal-name multi-in-list)) 16459 (vhdl--pushnew signal-name local-list :test #'equal)) 16460 ((member signal-name single-out-list) 16461 (setq single-out-list (delete signal-name single-out-list)) 16462 (vhdl--pushnew signal-name multi-out-list :test #'equal)) 16463 ((not (member signal-name multi-out-list)) 16464 (vhdl--pushnew signal-name single-out-list :test #'equal)))) 16465 (unless (match-string 1) 16466 (setq port-alist (cdr port-alist))) 16467 (vhdl-forward-syntactic-ws)) 16468 (push (list inst-name (nreverse constant-alist) 16469 (nreverse signal-alist)) 16470 inst-alist)) 16471 ;; prepare signal insertion 16472 (vhdl-goto-marker arch-decl-pos) 16473 (forward-line 1) 16474 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t) 16475 (setq signal-pos (point-marker)) 16476 (while (progn (vhdl-forward-syntactic-ws) 16477 (looking-at "signal\\>")) 16478 (beginning-of-line 2) 16479 (delete-region signal-pos (point))) 16480 (setq signal-beg-pos signal-pos) 16481 ;; open entity file 16482 (when (file-exists-p ent-file-name) 16483 (find-file ent-file-name)) 16484 (goto-char (point-min)) 16485 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) 16486 (error "ERROR: Entity not found: \"%s\"" ent-name)) 16487 ;; prepare generic clause insertion 16488 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t) 16489 (match-string 1)) 16490 (goto-char (match-beginning 0)) 16491 (indent-to vhdl-basic-offset) 16492 (insert "generic ();\n\n") 16493 (backward-char 4)) 16494 (backward-char) 16495 (setq generic-pos (point-marker)) 16496 (forward-sexp) (end-of-line) 16497 (delete-region generic-pos (point)) (delete-char 1) 16498 (insert "(\n") 16499 (when multi-list 16500 (insert "\n") 16501 (indent-to (* 2 vhdl-basic-offset)) 16502 (insert "-- global generics\n")) 16503 (setq generic-beg-pos (point-marker) generic-pos (point-marker) 16504 generic-inst-pos (point-marker) generic-end-pos (point-marker)) 16505 ;; prepare port clause insertion 16506 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t) 16507 (match-string 1)) 16508 (goto-char (match-beginning 0)) 16509 (indent-to vhdl-basic-offset) 16510 (insert "port ();\n\n") 16511 (backward-char 4)) 16512 (backward-char) 16513 (setq port-in-pos (point-marker)) 16514 (forward-sexp) (end-of-line) 16515 (delete-region port-in-pos (point)) (delete-char 1) 16516 (insert "(\n") 16517 (when (or multi-in-list multi-out-list) 16518 (insert "\n") 16519 (indent-to (* 2 vhdl-basic-offset)) 16520 (insert "-- global ports\n")) 16521 (setq port-beg-pos (point-marker) port-in-pos (point-marker) 16522 port-out-pos (point-marker) port-inst-pos (point-marker) 16523 port-end-pos (point-marker)) 16524 ;; insert generics, ports and signals 16525 (setq inst-alist (nreverse inst-alist)) 16526 (while inst-alist 16527 (setq inst-name (nth 0 (car inst-alist)) 16528 constant-alist (nth 1 (car inst-alist)) 16529 signal-alist (nth 2 (car inst-alist)) 16530 constant-temp-pos generic-inst-pos 16531 port-temp-pos port-inst-pos 16532 signal-temp-pos signal-pos) 16533 ;; generics 16534 (while constant-alist 16535 (setq constant-name (downcase (caar constant-alist)) 16536 constant-entry (car constant-alist)) 16537 (unless (string-match "^[0-9]+" constant-name) 16538 (cond ((member constant-name written-list) 16539 nil) 16540 ((member constant-name multi-list) 16541 (vhdl-goto-marker generic-pos) 16542 (setq generic-end-pos 16543 (vhdl-max-marker 16544 generic-end-pos 16545 (vhdl-compose-insert-generic constant-entry))) 16546 (setq generic-pos (point-marker)) 16547 (vhdl--pushnew constant-name written-list :test #'equal)) 16548 (t 16549 (vhdl-goto-marker 16550 (vhdl-max-marker generic-inst-pos generic-pos)) 16551 (setq generic-end-pos 16552 (vhdl-compose-insert-generic constant-entry)) 16553 (setq generic-inst-pos (point-marker)) 16554 (vhdl--pushnew constant-name written-list :test #'equal)))) 16555 (setq constant-alist (cdr constant-alist))) 16556 (when (/= constant-temp-pos generic-inst-pos) 16557 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) 16558 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16559 (insert "-- generics for \"" inst-name "\"\n") 16560 (vhdl-goto-marker generic-inst-pos)) 16561 ;; ports and signals 16562 (while signal-alist 16563 (setq signal-name (downcase (caar signal-alist)) 16564 signal-entry (car signal-alist)) 16565 (cond ((member signal-name written-list) 16566 nil) 16567 ((member signal-name multi-in-list) 16568 (vhdl-goto-marker port-in-pos) 16569 (setq port-end-pos 16570 (vhdl-max-marker 16571 port-end-pos (vhdl-compose-insert-port signal-entry))) 16572 (setq port-in-pos (point-marker)) 16573 (vhdl--pushnew signal-name written-list :test #'equal)) 16574 ((member signal-name multi-out-list) 16575 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) 16576 (setq port-end-pos 16577 (vhdl-max-marker 16578 port-end-pos (vhdl-compose-insert-port signal-entry))) 16579 (setq port-out-pos (point-marker)) 16580 (vhdl--pushnew signal-name written-list :test #'equal)) 16581 ((or (member signal-name single-in-list) 16582 (member signal-name single-out-list)) 16583 (vhdl-goto-marker 16584 (vhdl-max-marker 16585 port-inst-pos 16586 (vhdl-max-marker port-out-pos port-in-pos))) 16587 (setq port-end-pos (vhdl-compose-insert-port signal-entry)) 16588 (setq port-inst-pos (point-marker)) 16589 (vhdl--pushnew signal-name written-list :test #'equal)) 16590 ((equal (upcase (nth 2 signal-entry)) "OUT") 16591 (vhdl-goto-marker signal-pos) 16592 (vhdl-compose-insert-signal signal-entry) 16593 (setq signal-pos (point-marker)) 16594 (vhdl--pushnew signal-name written-list :test #'equal))) 16595 (setq signal-alist (cdr signal-alist))) 16596 (when (/= port-temp-pos port-inst-pos) 16597 (vhdl-goto-marker 16598 (vhdl-max-marker port-temp-pos 16599 (vhdl-max-marker port-in-pos port-out-pos))) 16600 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16601 (insert "-- ports to \"" inst-name "\"\n") 16602 (vhdl-goto-marker port-inst-pos)) 16603 (when (/= signal-temp-pos signal-pos) 16604 (vhdl-goto-marker signal-temp-pos) 16605 (insert "\n") (indent-to vhdl-basic-offset) 16606 (insert "-- outputs of \"" inst-name "\"\n") 16607 (vhdl-goto-marker signal-pos)) 16608 (setq inst-alist (cdr inst-alist))) 16609 ;; finalize generic/port clause 16610 (vhdl-goto-marker generic-end-pos) (backward-char) 16611 (when (= generic-beg-pos generic-end-pos) 16612 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16613 (insert ";") (backward-char)) 16614 (insert ")") 16615 (vhdl-goto-marker port-end-pos) (backward-char) 16616 (when (= port-beg-pos port-end-pos) 16617 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16618 (insert ";") (backward-char)) 16619 (insert ")") 16620 ;; align everything 16621 (when vhdl-auto-align 16622 (vhdl-goto-marker generic-beg-pos) 16623 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) 16624 (vhdl-align-region-groups port-beg-pos port-end-pos 1) 16625 (vhdl-goto-marker signal-beg-pos) 16626 (vhdl-align-region-groups signal-beg-pos signal-pos)) 16627 (switch-to-buffer (marker-buffer signal-beg-pos)) 16628 (message "Wiring components...done"))))) 16629 16630(defun vhdl-compose-insert-generic (entry) 16631 "Insert ENTRY as generic declaration." 16632 (let (pos) 16633 (indent-to (* 2 vhdl-basic-offset)) 16634 (insert (nth 0 entry) " : " (nth 1 entry)) 16635 (when (nth 2 entry) 16636 (insert " := " (nth 2 entry))) 16637 (insert ";") 16638 (setq pos (point-marker)) 16639 (when (and vhdl-include-port-comments (nth 3 entry)) 16640 (vhdl-comment-insert-inline (nth 3 entry) t)) 16641 (insert "\n") 16642 pos)) 16643 16644(defun vhdl-compose-insert-port (entry) 16645 "Insert ENTRY as port declaration." 16646 (let (pos) 16647 (indent-to (* 2 vhdl-basic-offset)) 16648 (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") 16649 (setq pos (point-marker)) 16650 (when (and vhdl-include-port-comments (nth 4 entry)) 16651 (vhdl-comment-insert-inline (nth 4 entry) t)) 16652 (insert "\n") 16653 pos)) 16654 16655(defun vhdl-compose-insert-signal (entry) 16656 "Insert ENTRY as signal declaration." 16657 (indent-to vhdl-basic-offset) 16658 (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") 16659 (when (and vhdl-include-port-comments (nth 4 entry)) 16660 (vhdl-comment-insert-inline (nth 4 entry) t)) 16661 (insert "\n")) 16662 16663(defun vhdl-compose-components-package () 16664 "Generate a package containing component declarations for all entities in the 16665current project/directory." 16666 (interactive) 16667 (vhdl-require-hierarchy-info) 16668 (let* ((project (vhdl-project-p)) 16669 (pack-name (vhdl-get-components-package-name)) 16670 (pack-file-name 16671 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 16672 "." (file-name-extension (buffer-file-name)))) 16673 (ent-alist (vhdl-aget vhdl-entity-alist 16674 (or project 16675 (abbreviate-file-name default-directory)))) 16676 (lazy-lock-minimum-size 0) 16677 clause-pos component-pos) 16678 (message "Generating components package \"%s\"..." pack-name) 16679 ;; open package file 16680 (when (and (file-exists-p pack-file-name) 16681 (not (y-or-n-p (concat "File \"" pack-file-name 16682 "\" exists; overwrite? ")))) 16683 (error "ERROR: Generating components package...aborted")) 16684 (find-file pack-file-name) 16685 (erase-buffer) 16686 ;; insert header 16687 (if vhdl-compose-include-header 16688 (progn (vhdl-template-header 16689 (concat "Components package (generated by Emacs VHDL Mode " 16690 vhdl-version ")")) 16691 (goto-char (point-max))) 16692 (vhdl-comment-display-line) (insert "\n\n")) 16693 ;; insert std_logic_1164 package 16694 (vhdl-template-package-std-logic-1164) 16695 (insert "\n") (setq clause-pos (point-marker)) 16696 (insert "\n") (vhdl-comment-display-line) (insert "\n\n") 16697 ;; insert package declaration 16698 (vhdl-insert-keyword "PACKAGE ") (insert pack-name) 16699 (vhdl-insert-keyword " IS\n\n") 16700 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16701 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 16702 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16703 (indent-to vhdl-basic-offset) 16704 (setq component-pos (point-marker)) 16705 (insert "\n\n") (vhdl-insert-keyword "END ") 16706 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) 16707 (insert pack-name ";\n\n") 16708 ;; insert footer 16709 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16710 (vhdl-template-footer) 16711 (vhdl-comment-display-line) (insert "\n")) 16712 ;; insert component declarations 16713 (while ent-alist 16714 (vhdl-visit-file (nth 2 (car ent-alist)) nil 16715 (progn (goto-char (point-min)) 16716 (forward-line (1- (nth 3 (car ent-alist)))) 16717 (end-of-line) 16718 (vhdl-port-copy))) 16719 (goto-char component-pos) 16720 (vhdl-port-paste-component t) 16721 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) 16722 (setq component-pos (point-marker)) 16723 (goto-char clause-pos) 16724 (vhdl-port-paste-context-clause pack-name) 16725 (setq clause-pos (point-marker)) 16726 (setq ent-alist (cdr ent-alist))) 16727 (goto-char (point-min)) 16728 (save-buffer) 16729 (message "Generating components package \"%s\"...done\n File created: \"%s\"" 16730 pack-name pack-file-name))) 16731 16732(defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist 16733 conf-alist inst-alist 16734 &optional insert-conf) 16735 "Generate block configuration for architecture." 16736 (let ((margin (current-indentation)) 16737 (beg (point-at-bol)) 16738 ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) 16739 ;; insert block configuration (for architecture) 16740 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 16741 (setq margin (+ margin vhdl-basic-offset)) 16742 ;; process all instances 16743 (while inst-alist 16744 (setq inst-entry (car inst-alist)) 16745 ;; is component? 16746 (when (nth 4 inst-entry) 16747 (setq insert-conf t) 16748 (setq inst-path (nth 9 inst-entry)) 16749 ;; skip common path with previous instance 16750 (while (and inst-path (equal (car inst-path) (car inst-prev-path))) 16751 (setq inst-path (cdr inst-path) 16752 inst-prev-path (cdr inst-prev-path))) 16753 ;; insert block configuration end (for previous block/generate) 16754 (while inst-prev-path 16755 (setq margin (- margin vhdl-basic-offset)) 16756 (indent-to margin) 16757 (vhdl-insert-keyword "END FOR;\n") 16758 (setq inst-prev-path (cdr inst-prev-path))) 16759 ;; insert block configuration beginning (for current block/generate) 16760 (indent-to margin) 16761 (while inst-path 16762 (setq margin (+ margin vhdl-basic-offset)) 16763 (vhdl-insert-keyword "FOR ") 16764 (insert (car inst-path) "\n") 16765 (indent-to margin) 16766 (setq inst-path (cdr inst-path))) 16767 ;; insert component configuration beginning 16768 (vhdl-insert-keyword "FOR ") 16769 (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") 16770 ;; find subconfiguration 16771 (setq conf-key (nth 7 inst-entry)) 16772 (setq tmp-alist conf-alist) 16773 ;; use first configuration found for instance's entity 16774 (while (and tmp-alist (null conf-key)) 16775 (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) 16776 (setq conf-key (nth 0 (car tmp-alist)))) 16777 (setq tmp-alist (cdr tmp-alist))) 16778 (setq conf-entry (vhdl-aget conf-alist conf-key)) 16779 ;; insert binding indication ... 16780 ;; ... with subconfiguration (if exists) 16781 (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) 16782 (progn 16783 (indent-to (+ margin vhdl-basic-offset)) 16784 (vhdl-insert-keyword "USE CONFIGURATION ") 16785 (insert (vhdl-work-library) "." (nth 0 conf-entry)) 16786 (insert ";\n")) 16787 ;; ... with entity (if exists) 16788 (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry))) 16789 (when ent-entry 16790 (indent-to (+ margin vhdl-basic-offset)) 16791 (vhdl-insert-keyword "USE ENTITY ") 16792 (insert (vhdl-work-library) "." (nth 0 ent-entry)) 16793 ;; insert architecture name (if architecture exists) 16794 (when (nth 3 ent-entry) 16795 (setq arch-name 16796 ;; choose architecture name a) from configuration, 16797 ;; b) from mra, or c) from first architecture 16798 (or (nth 0 (vhdl-aget (nth 3 ent-entry) 16799 (or (nth 6 inst-entry) 16800 (nth 4 ent-entry)))) 16801 (nth 1 (car (nth 3 ent-entry))))) 16802 (insert "(" arch-name ")")) 16803 (insert ";\n") 16804 ;; insert block configuration (for architecture of subcomponent) 16805 (when (and vhdl-compose-configuration-hierarchical 16806 (nth 3 ent-entry)) 16807 (indent-to (+ margin vhdl-basic-offset)) 16808 (vhdl-compose-configuration-architecture 16809 (nth 0 ent-entry) arch-name ent-alist conf-alist 16810 (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name))))))) 16811 ;; insert component configuration end 16812 (indent-to margin) 16813 (vhdl-insert-keyword "END FOR;\n") 16814 (setq inst-prev-path (nth 9 inst-entry))) 16815 (setq inst-alist (cdr inst-alist))) 16816 ;; insert block configuration end (for block/generate) 16817 (while inst-prev-path 16818 (setq margin (- margin vhdl-basic-offset)) 16819 (indent-to margin) 16820 (vhdl-insert-keyword "END FOR;\n") 16821 (setq inst-prev-path (cdr inst-prev-path))) 16822 (indent-to (- margin vhdl-basic-offset)) 16823 ;; insert block configuration end or remove beginning (for architecture) 16824 (if insert-conf 16825 (vhdl-insert-keyword "END FOR;\n") 16826 (delete-region beg (point))))) 16827 16828(defun vhdl-compose-configuration (&optional ent-name arch-name) 16829 "Generate configuration declaration." 16830 (interactive) 16831 (vhdl-require-hierarchy-info) 16832 (let ((ent-alist (vhdl-aget vhdl-entity-alist 16833 (or (vhdl-project-p) 16834 (abbreviate-file-name default-directory)))) 16835 (conf-alist (vhdl-aget vhdl-config-alist 16836 (or (vhdl-project-p) 16837 (abbreviate-file-name default-directory)))) 16838 (from-speedbar ent-name) 16839 inst-alist conf-name conf-file-name pos) 16840 (vhdl-prepare-search-2 16841 ;; get entity and architecture name 16842 (unless ent-name 16843 (save-excursion 16844 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 16845 (not (equal "END" (upcase (match-string 1)))) 16846 (setq ent-name (match-string-no-properties 3)) 16847 (setq arch-name (match-string-no-properties 2))) 16848 (error "ERROR: Not within an architecture")))) 16849 (setq conf-name (vhdl-replace-string 16850 vhdl-compose-configuration-name 16851 (concat ent-name " " arch-name))) 16852 (setq inst-alist 16853 (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name))) 16854 (downcase arch-name))))) 16855 (message "Generating configuration \"%s\"..." conf-name) 16856 (if vhdl-compose-configuration-create-file 16857 ;; open configuration file 16858 (progn 16859 (setq conf-file-name 16860 (concat (vhdl-replace-string vhdl-configuration-file-name 16861 conf-name t) 16862 "." (file-name-extension (buffer-file-name)))) 16863 (when (and (file-exists-p conf-file-name) 16864 (not (y-or-n-p (concat "File \"" conf-file-name 16865 "\" exists; overwrite? ")))) 16866 (error "ERROR: Creating configuration...aborted")) 16867 (find-file conf-file-name) 16868 (erase-buffer) 16869 (set-buffer-modified-p nil) 16870 ;; insert header 16871 (if vhdl-compose-include-header 16872 (progn (vhdl-template-header 16873 (concat "Configuration declaration for design \"" 16874 ent-name "(" arch-name ")\"")) 16875 (goto-char (point-max))) 16876 (vhdl-comment-display-line) (insert "\n\n"))) 16877 ;; goto end of architecture 16878 (unless from-speedbar 16879 (re-search-forward "^end\\>" nil) 16880 (end-of-line) (insert "\n\n") 16881 (vhdl-comment-display-line) (insert "\n\n"))) 16882 ;; insert library clause 16883 (setq pos (point)) 16884 (vhdl-template-standard-package (vhdl-work-library) nil) 16885 (when (/= pos (point)) 16886 (insert "\n\n")) 16887 ;; insert configuration 16888 (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) 16889 (vhdl-insert-keyword " OF ") (insert ent-name) 16890 (vhdl-insert-keyword " IS\n") 16891 (indent-to vhdl-basic-offset) 16892 ;; insert block configuration (for architecture) 16893 (vhdl-compose-configuration-architecture 16894 ent-name arch-name ent-alist conf-alist inst-alist t) 16895 (vhdl-insert-keyword "END ") (insert conf-name ";") 16896 (when conf-file-name 16897 ;; insert footer and save 16898 (insert "\n\n") 16899 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16900 (vhdl-template-footer) 16901 (vhdl-comment-display-line) (insert "\n")) 16902 (save-buffer)) 16903 (message "%s" 16904 (concat (format "Generating configuration \"%s\"...done" conf-name) 16905 (and conf-file-name 16906 (format "\n File created: \"%s\"" conf-file-name)))))) 16907 16908 16909;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16910;;; Compilation / Makefile generation 16911;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16912;; (using `compile.el') 16913 16914(defvar vhdl-compile-post-command "" 16915 "String appended to compile command after file name.") 16916 16917(defun vhdl-makefile-name () 16918 "Return the Makefile name of the current project or the current compiler if 16919no project is defined." 16920 (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project)) 16921 (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler))) 16922 (vhdl-replace-string 16923 (cons "\\(.*\\)\n\\(.*\\)" 16924 (or (nth 8 project-alist) (nth 8 compiler-alist))) 16925 (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) 16926 16927(defun vhdl-compile-directory () 16928 "Return the directory where compilation/make should be run." 16929 (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t))) 16930 (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 16931 (directory (vhdl-resolve-env-variable 16932 (if project 16933 (vhdl-replace-string 16934 (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) 16935 (nth 6 compiler))))) 16936 (file-name-as-directory 16937 (if (file-name-absolute-p directory) 16938 directory 16939 (expand-file-name directory (vhdl-default-directory)))))) 16940 16941(defun vhdl-uniquify (in-list) 16942 "Remove duplicate elements from IN-LIST." 16943 (let (out-list) 16944 (while in-list 16945 (vhdl--pushnew (car in-list) out-list :test #'equal) 16946 (setq in-list (cdr in-list))) 16947 out-list)) 16948 16949(defun vhdl-set-compiler (name) 16950 "Set current compiler to NAME." 16951 (interactive 16952 (list (let ((completion-ignore-case t)) 16953 (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) 16954 (if (assoc name vhdl-compiler-alist) 16955 (progn (setq vhdl-compiler name) 16956 (message "Current compiler: \"%s\"" vhdl-compiler)) 16957 (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) 16958 16959;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16960;; Compilation 16961 16962(defun vhdl-compile-init () 16963 "Initialize for compilation." 16964 (when (and (not vhdl-emacs-22) 16965 (or (null compilation-error-regexp-alist) 16966 (not (assoc (car (nth 11 (car vhdl-compiler-alist))) 16967 compilation-error-regexp-alist)))) 16968 ;; `compilation-error-regexp-alist' 16969 (let ((commands-alist vhdl-compiler-alist) 16970 regexp-alist sublist) 16971 (while commands-alist 16972 (setq sublist (nth 11 (car commands-alist))) 16973 (unless (or (equal "" (car sublist)) 16974 (assoc (car sublist) regexp-alist)) 16975 (push (list (nth 0 sublist) 16976 (if (and (featurep 'xemacs) (not (nth 1 sublist))) 16977 9 16978 (nth 1 sublist)) 16979 (nth 2 sublist) (nth 3 sublist)) 16980 regexp-alist)) 16981 (setq commands-alist (cdr commands-alist))) 16982 (setq compilation-error-regexp-alist 16983 (append compilation-error-regexp-alist (nreverse regexp-alist)))) 16984 ;; `compilation-file-regexp-alist' 16985 (let ((commands-alist vhdl-compiler-alist) 16986 regexp-alist sublist) 16987 ;; matches vhdl-mode file name output 16988 (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) 16989 (while commands-alist 16990 (setq sublist (nth 12 (car commands-alist))) 16991 (unless (or (equal "" (car sublist)) 16992 (assoc (car sublist) regexp-alist)) 16993 (push sublist regexp-alist)) 16994 (setq commands-alist (cdr commands-alist))) 16995 (setq compilation-file-regexp-alist 16996 (append compilation-file-regexp-alist (nreverse regexp-alist)))))) 16997 16998(defvar vhdl-compile-file-name nil 16999 "Name of file to be compiled.") 17000 17001(defun vhdl-compile-print-file-name () 17002 "Function called within `compile' to print out file name for compilers that 17003do not print any file names." 17004 (insert "Compiling \"" vhdl-compile-file-name "\"\n")) 17005 17006(defun vhdl-get-compile-options (project compiler file-name 17007 &optional file-options-only) 17008 "Get compiler options. Returning nil means do not compile this file." 17009 (let* ((compiler-options (nth 1 compiler)) 17010 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) 17011 (project-options (nth 0 project-entry)) 17012 (exception-list (and file-name (nth 2 project-entry))) 17013 (work-library (vhdl-work-library)) 17014 (case-fold-search nil) 17015 file-options) 17016 (while (and exception-list 17017 (not (string-match (caar exception-list) file-name))) 17018 (setq exception-list (cdr exception-list))) 17019 (if (and exception-list (not (cdar exception-list))) 17020 nil 17021 (if (and file-options-only (not exception-list)) 17022 'default 17023 (setq file-options (cdar exception-list)) 17024 ;; insert library name in compiler-specific options 17025 (setq compiler-options 17026 (vhdl-replace-string (cons "\\(.*\\)" compiler-options) 17027 work-library)) 17028 ;; insert compiler-specific options in project-specific options 17029 (when project-options 17030 (setq project-options 17031 (vhdl-replace-string 17032 (cons "\\(.*\\)\n\\(.*\\)" project-options) 17033 (concat work-library "\n" compiler-options)))) 17034 ;; insert project-specific options in file-specific options 17035 (when file-options 17036 (setq file-options 17037 (vhdl-replace-string 17038 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) 17039 (concat work-library "\n" compiler-options "\n" 17040 project-options)))) 17041 ;; return options 17042 (or file-options project-options compiler-options))))) 17043 17044(defun vhdl-get-make-options (project compiler) 17045 "Get make options." 17046 (let* ((compiler-options (nth 3 compiler)) 17047 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) 17048 (project-options (nth 1 project-entry)) 17049 (makefile-name (vhdl-makefile-name))) 17050 ;; insert Makefile name in compiler-specific options 17051 (setq compiler-options 17052 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) 17053 makefile-name)) 17054 ;; insert compiler-specific options in project-specific options 17055 (when project-options 17056 (setq project-options 17057 (vhdl-replace-string 17058 (cons "\\(.*\\)\n\\(.*\\)" project-options) 17059 (concat makefile-name "\n" compiler-options)))) 17060 ;; return options 17061 (or project-options compiler-options))) 17062 17063(defun vhdl-compile () 17064 "Compile current buffer using the VHDL compiler specified in 17065`vhdl-compiler'." 17066 (interactive) 17067 (vhdl-compile-init) 17068 (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) 17069 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17070 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17071 (command (nth 0 compiler)) 17072 (default-directory (vhdl-compile-directory)) 17073 (file-name (if vhdl-compile-absolute-path 17074 (buffer-file-name) 17075 (file-relative-name (buffer-file-name)))) 17076 (options (vhdl-get-compile-options project compiler file-name)) 17077 compilation-process-setup-function) 17078 (unless (file-directory-p default-directory) 17079 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 17080 ;; put file name into quotes if it contains spaces 17081 (when (string-match " " file-name) 17082 (setq file-name (concat "\"" file-name "\""))) 17083 ;; print out file name if compiler does not 17084 (setq vhdl-compile-file-name (if vhdl-compile-absolute-path 17085 (buffer-file-name) 17086 (file-relative-name (buffer-file-name)))) 17087 (when (and (= 0 (nth 1 (nth 10 compiler))) 17088 (= 0 (nth 1 (nth 11 compiler)))) 17089 (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) 17090 ;; run compilation 17091 (if options 17092 (when command 17093 (compile (concat command " " options " " file-name 17094 (unless (equal vhdl-compile-post-command "") 17095 (concat " " vhdl-compile-post-command))))) 17096 (vhdl-warning "Your project settings tell me not to compile this file")))) 17097 17098(defvar vhdl-make-target "all" 17099 "Default target for `vhdl-make' command.") 17100 17101(defun vhdl-make (&optional target) 17102 "Call make command for compilation of all updated source files (requires 17103`Makefile'). Optional argument TARGET allows you to compile the design 17104specified by a target." 17105 (interactive) 17106 (setq vhdl-make-target 17107 (or target (read-from-minibuffer "Target: " vhdl-make-target 17108 vhdl-minibuffer-local-map))) 17109 (vhdl-compile-init) 17110 (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) 17111 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17112 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17113 (command (nth 2 compiler)) 17114 (options (vhdl-get-make-options project compiler)) 17115 (default-directory (vhdl-compile-directory))) 17116 (unless (file-directory-p default-directory) 17117 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 17118 ;; run make 17119 (compile (concat (if (equal command "") "make" command) 17120 " " options " " vhdl-make-target)))) 17121 17122;; Emacs 22+ setup 17123(defvar vhdl-error-regexp-emacs-alist 17124 ;; Get regexps from `vhdl-compiler-alist' 17125 (let ((compiler-alist vhdl-compiler-alist) 17126 (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) 17127 (while compiler-alist 17128 ;; only add regexps for currently selected compiler 17129 (when (or (not vhdl-compile-use-local-error-regexp) 17130 (equal vhdl-compiler (nth 0 (car compiler-alist)))) 17131 ;; add error message regexps 17132 (setq error-regexp-alist 17133 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) 17134 (nth 11 (car compiler-alist))) 17135 error-regexp-alist)) 17136 ;; add filename regexps 17137 (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) 17138 (setq error-regexp-alist 17139 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) 17140 (nth 12 (car compiler-alist))) 17141 error-regexp-alist)))) 17142 (setq compiler-alist (cdr compiler-alist))) 17143 error-regexp-alist) 17144 "List of regexps for VHDL compilers. For Emacs 22+.") 17145 17146;; Add error regexps using compilation-mode-hook. 17147(defun vhdl-error-regexp-add-emacs () 17148 "Set up Emacs compile for VHDL." 17149 (interactive) 17150 (when (and (boundp 'compilation-error-regexp-alist-alist) 17151 (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) 17152 ;; remove all other compilers 17153 (when vhdl-compile-use-local-error-regexp 17154 (setq compilation-error-regexp-alist nil)) 17155 ;; add VHDL compilers 17156 (mapcar 17157 (lambda (item) 17158 (push (car item) compilation-error-regexp-alist) 17159 (push item compilation-error-regexp-alist-alist)) 17160 vhdl-error-regexp-emacs-alist))) 17161 17162(when vhdl-emacs-22 17163 (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) 17164 17165;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17166;; Makefile generation 17167 17168(defun vhdl-generate-makefile () 17169 "Generate `Makefile'." 17170 (interactive) 17171 (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17172 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17173 (command (nth 4 compiler))) 17174 ;; generate makefile 17175 (if command 17176 (let ((default-directory (vhdl-compile-directory))) 17177 (compile (vhdl-replace-string 17178 (cons "\\(.*\\) \\(.*\\)" command) 17179 (concat (vhdl-makefile-name) " " (vhdl-work-library))))) 17180 (vhdl-generate-makefile-1)))) 17181 17182(defun vhdl-get-packages (lib-alist work-library) 17183 "Get packages from LIB-ALIST that belong to WORK-LIBRARY." 17184 (let (pack-list) 17185 (while lib-alist 17186 (when (equal (downcase (caar lib-alist)) (downcase work-library)) 17187 (push (cdar lib-alist) pack-list)) 17188 (setq lib-alist (cdr lib-alist))) 17189 pack-list)) 17190 17191(defun vhdl-generate-makefile-1 () 17192 "Generate Makefile for current project or directory." 17193 ;; scan hierarchy if required 17194 (if (vhdl-project-p) 17195 (unless (or (assoc vhdl-project vhdl-file-alist) 17196 (vhdl-load-cache vhdl-project)) 17197 (vhdl-scan-project-contents vhdl-project)) 17198 (let ((directory (abbreviate-file-name default-directory))) 17199 (unless (or (assoc directory vhdl-file-alist) 17200 (vhdl-load-cache directory)) 17201 (vhdl-scan-directory-contents directory)))) 17202 (let* ((directory (abbreviate-file-name (vhdl-default-directory))) 17203 (project (vhdl-project-p)) 17204 (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) 17205 (conf-alist (vhdl-aget vhdl-config-alist (or project directory))) 17206 (pack-alist (vhdl-aget vhdl-package-alist (or project directory))) 17207 (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 17208 '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" 17209 "\\1.vhd" "\\1_body.vhd" identity))) 17210 (mapping-exist 17211 (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) 17212 (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) 17213 (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) 17214 (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) 17215 (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) 17216 (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) 17217 (adjust-case (nth 5 regexp-list)) 17218 (work-library (downcase (vhdl-work-library))) 17219 (compile-directory (expand-file-name (vhdl-compile-directory) 17220 default-directory)) 17221 (makefile-name (vhdl-makefile-name)) 17222 rule-alist arch-alist inst-alist 17223 target-list depend-list unit-list prim-list second-list subcomp-list 17224 lib-alist lib-body-alist pack-list all-pack-list 17225 ent-key ent-file-name arch-key arch-file-name ent-arch-key 17226 conf-key conf-file-name pack-key pack-file-name 17227 ent-entry arch-entry conf-entry pack-entry inst-entry 17228 pack-body-key pack-body-file-name inst-ent-key inst-conf-key 17229 tmp-key tmp-list rule) 17230 ;; check prerequisites 17231 (unless (file-exists-p compile-directory) 17232 (make-directory compile-directory t)) 17233 (unless mapping-exist 17234 (vhdl-warning 17235 (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\"" 17236 vhdl-compiler vhdl-compiler) t)) 17237 (message "Generating makefile \"%s\"..." makefile-name) 17238 ;; rules for all entities 17239 (setq tmp-list ent-alist) 17240 (while ent-alist 17241 (setq ent-entry (car ent-alist) 17242 ent-key (nth 0 ent-entry)) 17243 (when (nth 2 ent-entry) 17244 (setq ent-file-name (if vhdl-compile-absolute-path 17245 (nth 2 ent-entry) 17246 (file-relative-name (nth 2 ent-entry) 17247 compile-directory)) 17248 arch-alist (nth 4 ent-entry) 17249 lib-alist (nth 6 ent-entry) 17250 rule (vhdl-aget rule-alist ent-file-name) 17251 target-list (nth 0 rule) 17252 depend-list (nth 1 rule) 17253 second-list nil 17254 subcomp-list nil) 17255 (setq tmp-key (vhdl-replace-string 17256 ent-regexp 17257 (funcall adjust-case 17258 (concat ent-key " " work-library)))) 17259 (push (cons ent-key tmp-key) unit-list) 17260 ;; rule target for this entity 17261 (push ent-key target-list) 17262 ;; rule dependencies for all used packages 17263 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17264 (setq depend-list (append depend-list pack-list)) 17265 (setq all-pack-list pack-list) 17266 ;; add rule 17267 (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list)) 17268 ;; rules for all corresponding architectures 17269 (while arch-alist 17270 (setq arch-entry (car arch-alist) 17271 arch-key (nth 0 arch-entry) 17272 ent-arch-key (concat ent-key "-" arch-key) 17273 arch-file-name (if vhdl-compile-absolute-path 17274 (nth 2 arch-entry) 17275 (file-relative-name (nth 2 arch-entry) 17276 compile-directory)) 17277 inst-alist (nth 4 arch-entry) 17278 lib-alist (nth 5 arch-entry) 17279 rule (vhdl-aget rule-alist arch-file-name) 17280 target-list (nth 0 rule) 17281 depend-list (nth 1 rule)) 17282 (setq tmp-key (vhdl-replace-string 17283 arch-regexp 17284 (funcall adjust-case 17285 (concat arch-key " " ent-key " " 17286 work-library)))) 17287 (setq unit-list 17288 (cons (cons ent-arch-key tmp-key) unit-list)) 17289 (push ent-arch-key second-list) 17290 ;; rule target for this architecture 17291 (push ent-arch-key target-list) 17292 ;; rule dependency for corresponding entity 17293 (push ent-key depend-list) 17294 ;; rule dependencies for contained component instantiations 17295 (while inst-alist 17296 (setq inst-entry (car inst-alist)) 17297 (when (or (null (nth 8 inst-entry)) 17298 (equal (downcase (nth 8 inst-entry)) work-library)) 17299 (setq inst-ent-key (or (nth 7 inst-entry) 17300 (nth 5 inst-entry))) 17301 (setq depend-list (cons inst-ent-key depend-list) 17302 subcomp-list (cons inst-ent-key subcomp-list))) 17303 (setq inst-alist (cdr inst-alist))) 17304 ;; rule dependencies for all used packages 17305 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17306 (setq depend-list (append depend-list pack-list)) 17307 (setq all-pack-list (append all-pack-list pack-list)) 17308 ;; add rule 17309 (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) 17310 (setq arch-alist (cdr arch-alist))) 17311 (push (list ent-key second-list (append subcomp-list all-pack-list)) 17312 prim-list)) 17313 (setq ent-alist (cdr ent-alist))) 17314 (setq ent-alist tmp-list) 17315 ;; rules for all configurations 17316 (setq tmp-list conf-alist) 17317 (while conf-alist 17318 (setq conf-entry (car conf-alist) 17319 conf-key (nth 0 conf-entry) 17320 conf-file-name (if vhdl-compile-absolute-path 17321 (nth 2 conf-entry) 17322 (file-relative-name (nth 2 conf-entry) 17323 compile-directory)) 17324 ent-key (nth 4 conf-entry) 17325 arch-key (nth 5 conf-entry) 17326 inst-alist (nth 6 conf-entry) 17327 lib-alist (nth 7 conf-entry) 17328 rule (vhdl-aget rule-alist conf-file-name) 17329 target-list (nth 0 rule) 17330 depend-list (nth 1 rule) 17331 subcomp-list (list ent-key)) 17332 (setq tmp-key (vhdl-replace-string 17333 conf-regexp 17334 (funcall adjust-case 17335 (concat conf-key " " work-library)))) 17336 (push (cons conf-key tmp-key) unit-list) 17337 ;; rule target for this configuration 17338 (push conf-key target-list) 17339 ;; rule dependency for corresponding entity and architecture 17340 (setq depend-list 17341 (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) 17342 ;; rule dependencies for used packages 17343 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17344 (setq depend-list (append depend-list pack-list)) 17345 ;; rule dependencies for contained component configurations 17346 (while inst-alist 17347 (setq inst-entry (car inst-alist)) 17348 (setq inst-ent-key (nth 2 inst-entry) 17349 inst-conf-key (nth 4 inst-entry)) 17350 (when (equal (downcase (nth 5 inst-entry)) work-library) 17351 (when inst-ent-key 17352 (setq depend-list (cons inst-ent-key depend-list) 17353 subcomp-list (cons inst-ent-key subcomp-list))) 17354 (when inst-conf-key 17355 (setq depend-list (cons inst-conf-key depend-list) 17356 subcomp-list (cons inst-conf-key subcomp-list)))) 17357 (setq inst-alist (cdr inst-alist))) 17358 ;; add rule 17359 (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list)) 17360 (push (list conf-key nil (append subcomp-list pack-list)) prim-list) 17361 (setq conf-alist (cdr conf-alist))) 17362 (setq conf-alist tmp-list) 17363 ;; rules for all packages 17364 (setq tmp-list pack-alist) 17365 (while pack-alist 17366 (setq pack-entry (car pack-alist) 17367 pack-key (nth 0 pack-entry) 17368 pack-body-key nil) 17369 (when (nth 2 pack-entry) 17370 (setq pack-file-name (if vhdl-compile-absolute-path 17371 (nth 2 pack-entry) 17372 (file-relative-name (nth 2 pack-entry) 17373 compile-directory)) 17374 lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) 17375 rule (vhdl-aget rule-alist pack-file-name) 17376 target-list (nth 0 rule) depend-list (nth 1 rule)) 17377 (setq tmp-key (vhdl-replace-string 17378 pack-regexp 17379 (funcall adjust-case 17380 (concat pack-key " " work-library)))) 17381 (push (cons pack-key tmp-key) unit-list) 17382 ;; rule target for this package 17383 (push pack-key target-list) 17384 ;; rule dependencies for all used packages 17385 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17386 (setq depend-list (append depend-list pack-list)) 17387 (setq all-pack-list pack-list) 17388 ;; add rule 17389 (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list)) 17390 ;; rules for this package's body 17391 (when (nth 7 pack-entry) 17392 (setq pack-body-key (concat pack-key "-body") 17393 pack-body-file-name (if vhdl-compile-absolute-path 17394 (nth 7 pack-entry) 17395 (file-relative-name (nth 7 pack-entry) 17396 compile-directory)) 17397 rule (vhdl-aget rule-alist pack-body-file-name) 17398 target-list (nth 0 rule) 17399 depend-list (nth 1 rule)) 17400 (setq tmp-key (vhdl-replace-string 17401 pack-body-regexp 17402 (funcall adjust-case 17403 (concat pack-key " " work-library)))) 17404 (setq unit-list 17405 (cons (cons pack-body-key tmp-key) unit-list)) 17406 ;; rule target for this package's body 17407 (push pack-body-key target-list) 17408 ;; rule dependency for corresponding package declaration 17409 (push pack-key depend-list) 17410 ;; rule dependencies for all used packages 17411 (setq pack-list (vhdl-get-packages lib-body-alist work-library)) 17412 (setq depend-list (append depend-list pack-list)) 17413 (setq all-pack-list (append all-pack-list pack-list)) 17414 ;; add rule 17415 (vhdl-aput 'rule-alist pack-body-file-name 17416 (list target-list depend-list))) 17417 (setq prim-list 17418 (cons (list pack-key (when pack-body-key (list pack-body-key)) 17419 all-pack-list) 17420 prim-list))) 17421 (setq pack-alist (cdr pack-alist))) 17422 (setq pack-alist tmp-list) 17423 ;; generate Makefile 17424 (let* ((project (vhdl-aget vhdl-project-alist project)) 17425 (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 17426 (compiler-id (nth 9 compiler)) 17427 (library-directory 17428 (vhdl-resolve-env-variable 17429 (vhdl-replace-string 17430 (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) 17431 compiler-id))) 17432 (makefile-path-name (expand-file-name 17433 makefile-name compile-directory)) 17434 (orig-buffer (current-buffer)) 17435 cell second-list subcomp-list options unit-key unit-name) 17436 ;; sort lists 17437 (setq unit-list (vhdl-sort-alist unit-list)) 17438 (setq prim-list (vhdl-sort-alist prim-list)) 17439 (setq tmp-list rule-alist) 17440 (while tmp-list ; pre-sort rule targets 17441 (setq cell (cdar tmp-list)) 17442 (setcar cell (sort (car cell) 'string<)) 17443 (setq tmp-list (cdr tmp-list))) 17444 (setq rule-alist ; sort by first rule target 17445 (sort rule-alist 17446 (function (lambda (a b) 17447 (string< (car (cadr a)) (car (cadr b))))))) 17448 ;; open and clear Makefile 17449 (set-buffer (find-file-noselect makefile-path-name t t)) 17450 (erase-buffer) 17451 (insert "# -*- Makefile -*-\n" 17452 "### " (file-name-nondirectory makefile-name) 17453 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version 17454 "\n") 17455 (if project 17456 (insert "\n# Project : " (nth 0 project)) 17457 (insert "\n# Directory : \"" directory "\"")) 17458 (insert "\n# Platform : " vhdl-compiler 17459 "\n# Generated : " (format-time-string "%Y-%m-%d %T ") 17460 (user-login-name) "\n") 17461 ;; insert compile and option variable settings 17462 (insert "\n\n# Define compilation command and options\n" 17463 "\nCOMPILE = " (nth 0 compiler) 17464 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) 17465 (if (equal vhdl-compile-post-command "") "" 17466 (concat "\nPOST-COMPILE = " vhdl-compile-post-command)) 17467 "\n") 17468 ;; insert library paths 17469 (setq library-directory 17470 (directory-file-name 17471 (if (file-name-absolute-p library-directory) 17472 library-directory 17473 (file-relative-name 17474 (expand-file-name library-directory directory) 17475 compile-directory)))) 17476 (insert "\n\n# Define library paths\n" 17477 "\nLIBRARY-" work-library " = " library-directory "\n") 17478 (unless mapping-exist 17479 (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library 17480 ")/make" "\n")) 17481 ;; insert variable definitions for all library unit files 17482 (insert "\n\n# Define library unit files\n") 17483 (setq tmp-list unit-list) 17484 (while unit-list 17485 (insert "\nUNIT-" work-library "-" (caar unit-list) 17486 " = \\\n\t$(LIBRARY-" work-library 17487 (if mapping-exist "" "-make") ")/" (cdar unit-list)) 17488 (setq unit-list (cdr unit-list))) 17489 ;; insert variable definition for list of all library unit files 17490 (insert "\n\n\n# Define list of all library unit files\n" 17491 "\nALL_UNITS =") 17492 (setq unit-list tmp-list) 17493 (while unit-list 17494 (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") 17495 (setq unit-list (cdr unit-list))) 17496 (insert "\n") 17497 (setq unit-list tmp-list) 17498 ;; insert `make all' rule 17499 (insert "\n\n\n# Rule for compiling entire design\n" 17500 "\n" (nth 0 vhdl-makefile-default-targets) " :" 17501 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) 17502 " \\\n\t\t$(ALL_UNITS)\n") 17503 ;; insert `make clean' rule 17504 (insert "\n\n# Rule for cleaning entire design\n" 17505 "\n" (nth 1 vhdl-makefile-default-targets) " : " 17506 "\n\t-rm -f $(ALL_UNITS)\n") 17507 ;; insert `make library' rule 17508 (insert "\n\n# Rule for creating library directory\n" 17509 "\n" (nth 2 vhdl-makefile-default-targets) " :" 17510 " \\\n\t\t$(LIBRARY-" work-library ")" 17511 (if mapping-exist "" 17512 (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n")) 17513 "\n" 17514 "\n$(LIBRARY-" work-library ") :" 17515 "\n\t" 17516 (vhdl-replace-string 17517 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) 17518 (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) 17519 "\n") 17520 (unless mapping-exist 17521 (insert "\n$(LIBRARY-" work-library "-make) :" 17522 "\n\t" 17523 "mkdir -p $(LIBRARY-" work-library "-make)\n")) 17524 ;; insert '.PHONY' declaration 17525 (insert "\n\n.PHONY : " 17526 (nth 0 vhdl-makefile-default-targets) " " 17527 (nth 1 vhdl-makefile-default-targets) " " 17528 (nth 2 vhdl-makefile-default-targets) "\n") 17529 ;; insert rule for each library unit 17530 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") 17531 (while prim-list 17532 (setq second-list (sort (nth 1 (car prim-list)) 'string<)) 17533 (setq subcomp-list 17534 (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) 17535 (setq unit-key (caar prim-list) 17536 unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) 17537 (nth 0 (vhdl-aget conf-alist unit-key)) 17538 (nth 0 (vhdl-aget pack-alist unit-key)))) 17539 (insert "\n" unit-key) 17540 (unless (equal unit-key unit-name) 17541 (insert " \\\n" unit-name)) 17542 (insert " :" 17543 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) 17544 (while subcomp-list 17545 (when (and (assoc (car subcomp-list) unit-list) 17546 (not (equal unit-key (car subcomp-list)))) 17547 (insert " \\\n\t\t" (car subcomp-list))) 17548 (setq subcomp-list (cdr subcomp-list))) 17549 (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") 17550 (while second-list 17551 (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") 17552 (setq second-list (cdr second-list))) 17553 (insert "\n") 17554 (setq prim-list (cdr prim-list))) 17555 ;; insert rule for each library unit file 17556 (insert "\n\n# Rules for compiling single library unit files\n") 17557 (while rule-alist 17558 (setq rule (car rule-alist)) 17559 ;; get compiler options for this file 17560 (setq options 17561 (vhdl-get-compile-options project compiler (nth 0 rule) t)) 17562 ;; insert rule if file is supposed to be compiled 17563 (setq target-list (nth 1 rule) 17564 depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) 17565 ;; insert targets 17566 (setq tmp-list target-list) 17567 (while target-list 17568 (insert "\n$(UNIT-" work-library "-" (car target-list) ")" 17569 (if (cdr target-list) " \\" " :")) 17570 (setq target-list (cdr target-list))) 17571 (setq target-list tmp-list) 17572 ;; insert file name as first dependency 17573 (insert " \\\n\t\t" (nth 0 rule)) 17574 ;; insert dependencies (except if also target or unit does not exist) 17575 (while depend-list 17576 (when (and (not (member (car depend-list) target-list)) 17577 (assoc (car depend-list) unit-list)) 17578 (insert " \\\n\t\t" 17579 "$(UNIT-" work-library "-" (car depend-list) ")")) 17580 (setq depend-list (cdr depend-list))) 17581 ;; insert compile command 17582 (if options 17583 (insert "\n\t$(COMPILE) " 17584 (if (eq options 'default) "$(OPTIONS)" options) " " 17585 (nth 0 rule) 17586 (if (equal vhdl-compile-post-command "") "" 17587 " $(POST-COMPILE)") "\n") 17588 (insert "\n")) 17589 (unless (and options mapping-exist) 17590 (setq tmp-list target-list) 17591 (while target-list 17592 (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n") 17593 (setq target-list (cdr target-list))) 17594 (setq target-list tmp-list)) 17595 (setq rule-alist (cdr rule-alist))) 17596 17597 (insert "\n\n### " makefile-name " ends here\n") 17598 ;; run Makefile generation hook 17599 (run-hooks 'vhdl-makefile-generation-hook) 17600 (message "Generating makefile \"%s\"...done" makefile-name) 17601 ;; save and close file 17602 (if (file-writable-p makefile-path-name) 17603 (progn (save-buffer) 17604 (kill-buffer (current-buffer)) 17605 (set-buffer orig-buffer) 17606 (when (fboundp 'add-to-history) 17607 (add-to-history 'file-name-history makefile-path-name))) 17608 (vhdl-warning-when-idle 17609 (format "File not writable: \"%s\"" 17610 (abbreviate-file-name makefile-path-name))) 17611 (switch-to-buffer (current-buffer)))))) 17612 17613 17614;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17615;;; Bug reports 17616;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17617;; (using `reporter.el') 17618 17619(defconst vhdl-mode-help-address 17620 "Reto Zimmermann <reto@gnu.org>" 17621 "Address for VHDL Mode bug reports.") 17622 17623(defun vhdl-submit-bug-report () 17624 "Submit via mail a bug report on VHDL Mode." 17625 (interactive) 17626 ;; load in reporter 17627 (and 17628 (y-or-n-p "Do you want to submit a report on VHDL Mode? ") 17629 (let ((reporter-prompt-for-summary-p t)) 17630 (reporter-submit-bug-report 17631 vhdl-mode-help-address 17632 (concat "VHDL Mode " vhdl-version) 17633 (list 17634 ;; report all important user options 17635 'vhdl-offsets-alist 17636 'vhdl-comment-only-line-offset 17637 'tab-width 17638 'vhdl-electric-mode 17639 'vhdl-stutter-mode 17640 'vhdl-indent-tabs-mode 17641 'vhdl-project-alist 17642 'vhdl-project 17643 'vhdl-project-file-name 17644 'vhdl-project-autoload 17645 'vhdl-project-sort 17646 'vhdl-compiler-alist 17647 'vhdl-compiler 17648 'vhdl-compile-use-local-error-regexp 17649 'vhdl-makefile-default-targets 17650 'vhdl-makefile-generation-hook 17651 'vhdl-default-library 17652 'vhdl-standard 17653 'vhdl-basic-offset 17654 'vhdl-upper-case-keywords 17655 'vhdl-upper-case-types 17656 'vhdl-upper-case-attributes 17657 'vhdl-upper-case-enum-values 17658 'vhdl-upper-case-constants 17659 'vhdl-use-direct-instantiation 17660 'vhdl-array-index-record-field-in-sensitivity-list 17661 'vhdl-compose-configuration-name 17662 'vhdl-entity-file-name 17663 'vhdl-architecture-file-name 17664 'vhdl-configuration-file-name 17665 'vhdl-package-file-name 17666 'vhdl-file-name-case 17667 'vhdl-electric-keywords 17668 'vhdl-optional-labels 17669 'vhdl-insert-empty-lines 17670 'vhdl-argument-list-indent 17671 'vhdl-association-list-with-formals 17672 'vhdl-conditions-in-parenthesis 17673 'vhdl-sensitivity-list-all 17674 'vhdl-zero-string 17675 'vhdl-one-string 17676 'vhdl-file-header 17677 'vhdl-file-footer 17678 'vhdl-company-name 17679 'vhdl-copyright-string 17680 'vhdl-platform-spec 17681 'vhdl-date-format 17682 'vhdl-modify-date-prefix-string 17683 'vhdl-modify-date-on-saving 17684 'vhdl-reset-kind 17685 'vhdl-reset-active-high 17686 'vhdl-clock-rising-edge 17687 'vhdl-clock-edge-condition 17688 'vhdl-clock-name 17689 'vhdl-reset-name 17690 'vhdl-model-alist 17691 'vhdl-include-port-comments 17692 'vhdl-include-direction-comments 17693 'vhdl-include-type-comments 17694 'vhdl-include-group-comments 17695 'vhdl-actual-generic-name 17696 'vhdl-actual-port-name 17697 'vhdl-instance-name 17698 'vhdl-testbench-entity-name 17699 'vhdl-testbench-architecture-name 17700 'vhdl-testbench-configuration-name 17701 'vhdl-testbench-dut-name 17702 'vhdl-testbench-include-header 17703 'vhdl-testbench-declarations 17704 'vhdl-testbench-statements 17705 'vhdl-testbench-initialize-signals 17706 'vhdl-testbench-include-library 17707 'vhdl-testbench-include-configuration 17708 'vhdl-testbench-create-files 17709 'vhdl-testbench-entity-file-name 17710 'vhdl-testbench-architecture-file-name 17711 'vhdl-compose-create-files 17712 'vhdl-compose-configuration-create-file 17713 'vhdl-compose-configuration-hierarchical 17714 'vhdl-compose-configuration-use-subconfiguration 17715 'vhdl-compose-include-header 17716 'vhdl-compose-architecture-name 17717 'vhdl-components-package-name 17718 'vhdl-use-components-package 17719 'vhdl-self-insert-comments 17720 'vhdl-prompt-for-comments 17721 'vhdl-inline-comment-column 17722 'vhdl-end-comment-column 17723 'vhdl-auto-align 17724 'vhdl-align-groups 17725 'vhdl-align-group-separate 17726 'vhdl-align-same-indent 17727 'vhdl-highlight-keywords 17728 'vhdl-highlight-names 17729 'vhdl-highlight-special-words 17730 'vhdl-highlight-forbidden-words 17731 'vhdl-highlight-verilog-keywords 17732 'vhdl-highlight-translate-off 17733 'vhdl-highlight-case-sensitive 17734 'vhdl-special-syntax-alist 17735 'vhdl-forbidden-words 17736 'vhdl-forbidden-syntax 17737 'vhdl-directive-keywords 17738 'vhdl-speedbar-auto-open 17739 'vhdl-speedbar-display-mode 17740 'vhdl-speedbar-scan-limit 17741 'vhdl-speedbar-jump-to-unit 17742 'vhdl-speedbar-update-on-saving 17743 'vhdl-speedbar-save-cache 17744 'vhdl-speedbar-cache-file-name 17745 'vhdl-index-menu 17746 'vhdl-source-file-menu 17747 'vhdl-hideshow-menu 17748 'vhdl-hide-all-init 17749 'vhdl-print-two-column 17750 'vhdl-print-customize-faces 17751 'vhdl-intelligent-tab 17752 'vhdl-indent-syntax-based 17753 'vhdl-indent-comment-like-next-code-line 17754 'vhdl-word-completion-case-sensitive 17755 'vhdl-word-completion-in-minibuffer 17756 'vhdl-underscore-is-part-of-word 17757 'vhdl-mode-hook) 17758 (function 17759 (lambda () 17760 (insert 17761 (if vhdl-special-indent-hook 17762 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" 17763 "vhdl-special-indent-hook is set to '" 17764 (format "%s" vhdl-special-indent-hook) 17765 ".\nPerhaps this is your problem?\n" 17766 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") 17767 "\n")))) 17768 nil 17769 "Hi Reto,")))) 17770 17771 17772;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17773;;; Documentation 17774;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17775 17776(defconst vhdl-doc-release-notes nil 17777 "\ 17778Release Notes for VHDL Mode 3.37 17779================================ 17780 17781- Added support for VHDL'08: 17782 - New keywords, types, functions, attributes, operators, packages 17783 - Context declaration 17784 - Block comments 17785 - Directives 17786 - `all' keyword in sensitivity list 17787 17788 17789Release Notes for VHDL Mode 3.34 17790================================ 17791 17792- Added support for GNU Emacs 22/23/24: 17793 - Compilation error parsing fixed for new `compile.el' package. 17794 17795- Port translation: Derive actual generic name from formal generic name. 17796 17797- New user options: 17798 `vhdl-actual-generic-name': Specify how actual generic names are obtained. 17799 17800 17801Release Notes for VHDL Mode 3.33 17802================================ 17803 17804New Features 17805------------ 17806 17807CONFIGURATION DECLARATION GENERATION: 17808 - Automatic generation of a configuration declaration for a design. 17809 (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) 17810 17811 17812Key Bindings 17813------------ 17814 17815For Emacs compliance the following key bindings have been changed: 17816 17817- `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region' 17818- `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer' 17819- `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer' 17820- `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...' 17821 17822 17823User Options 17824------------ 17825 17826`vhdl-configuration-file-name': (new) 17827 Specify how the configuration file name is obtained. 17828`vhdl-compose-configuration-name': (new) 17829 Specify how the configuration name is obtained. 17830`vhdl-compose-configuration-create-file': (new) 17831 Specify whether a new file should be created for a configuration. 17832`vhdl-compose-configuration-hierarchical': (new) 17833 Specify whether hierarchical configurations should be created. 17834`vhdl-compose-configuration-use-subconfiguration': (new) 17835 Specify whether subconfigurations should be used inside configurations. 17836`vhdl-makefile-default-targets': (new) 17837 Customize names of Makefile default targets. 17838`vhdl-indent-comment-like-next-code-line': (new) 17839 Specify whether comment lines are indented like following code line. 17840`vhdl-array-index-record-field-in-sensitivity-list': (new) 17841 Specify whether to include array indices / record fields in sensitivity list. 17842") 17843 17844 17845(defconst vhdl-doc-keywords nil 17846 "\ 17847Reserved words in VHDL 17848---------------------- 17849 17850VHDL'08 (IEEE Std 1076-2008): 17851 `vhdl-08-keywords' : keywords 17852 `vhdl-08-types' : standardized types 17853 `vhdl-08-attributes' : standardized attributes 17854 `vhdl-08-functions' : standardized functions 17855 `vhdl-08-packages' : standardized packages and libraries 17856 17857VHDL'93/02 (IEEE Std 1076-1993/2002): 17858 `vhdl-02-keywords' : keywords 17859 `vhdl-02-types' : standardized types 17860 `vhdl-02-attributes' : standardized attributes 17861 `vhdl-02-enum-values' : standardized enumeration values 17862 `vhdl-02-functions' : standardized functions 17863 `vhdl-02-packages' : standardized packages and libraries 17864 17865VHDL-AMS (IEEE Std 1076.1 / 1076.1.1): 17866 `vhdl-ams-keywords' : keywords 17867 `vhdl-ams-types' : standardized types 17868 `vhdl-ams-attributes' : standardized attributes 17869 `vhdl-ams-enum-values' : standardized enumeration values 17870 `vhdl-ams-constants' : standardized constants 17871 `vhdl-ams-functions' : standardized functions 17872 17873Math Packages (IEEE Std 1076.2): 17874 `vhdl-math-types' : standardized types 17875 `vhdl-math-constants' : standardized constants 17876 `vhdl-math-functions' : standardized functions 17877 `vhdl-math-packages' : standardized packages 17878 17879Forbidden words: 17880 `vhdl-verilog-keywords' : Verilog reserved words 17881 17882NOTE: click `mouse-2' on variable names above (not in XEmacs).") 17883 17884 17885(defconst vhdl-doc-coding-style nil 17886 "\ 17887For VHDL coding style and naming convention guidelines, see the following 17888references: 17889 17890[1] Ben Cohen. 17891 \"VHDL Coding Styles and Methodologies\". 17892 Kluwer Academic Publishers, 1999. 17893 http://members.aol.com/vhdlcohen/vhdl/ 17894 17895[2] Michael Keating and Pierre Bricaud. 17896 \"Reuse Methodology Manual, Second Edition\". 17897 Kluwer Academic Publishers, 1999. 17898 http://www.openmore.com/openmore/rmm2.html 17899 17900[3] European Space Agency. 17901 \"VHDL Modelling Guidelines\". 17902 https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf 17903 17904Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' 17905to visually support naming conventions.") 17906 17907 17908(defun vhdl-version () 17909 "Echo the current version of VHDL Mode in the minibuffer." 17910 (interactive) 17911 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) 17912 (vhdl-keep-region-active)) 17913 17914(defun vhdl-doc-variable (variable) 17915 "Display VARIABLE's documentation in *Help* buffer." 17916 (interactive) 17917 (unless (featurep 'xemacs) 17918 (help-setup-xref (list #'vhdl-doc-variable variable) 17919 (called-interactively-p 'interactive))) 17920 (with-output-to-temp-buffer 17921 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17922 (princ (documentation-property variable 'variable-documentation)) 17923 (with-current-buffer standard-output 17924 (help-mode)) 17925 (help-print-return-message))) 17926 17927(defun vhdl-doc-mode () 17928 "Display VHDL Mode documentation in *Help* buffer." 17929 (interactive) 17930 (unless (featurep 'xemacs) 17931 (help-setup-xref (list #'vhdl-doc-mode) 17932 (called-interactively-p 'interactive))) 17933 (with-output-to-temp-buffer 17934 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17935 (princ mode-name) 17936 (princ " mode:\n") 17937 (princ (documentation 'vhdl-mode)) 17938 (with-current-buffer standard-output 17939 (help-mode)) 17940 (help-print-return-message))) 17941 17942 17943;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17944 17945(provide 'vhdl-mode) 17946 17947;;; vhdl-mode.el ends here 17948