1;;; vhdl-mode.el --- major mode for editing VHDL code -*- lexical-binding: t; -*- 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: https://guest.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;; Reto also said in Apr 2021 that he preferred to keep the XEmacs 17;; compatibility code. 18 19(defconst vhdl-version "3.38.1" 20 "VHDL Mode version number.") 21 22(defconst vhdl-time-stamp "2015-03-12" 23 "VHDL Mode time stamp for last update.") 24 25;; This file is part of GNU Emacs. 26 27;; GNU Emacs is free software: you can redistribute it and/or modify 28;; it under the terms of the GNU General Public License as published by 29;; the Free Software Foundation, either version 3 of the License, or 30;; (at your option) any later version. 31 32;; GNU Emacs is distributed in the hope that it will be useful, 33;; but WITHOUT ANY WARRANTY; without even the implied warranty of 34;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 35;; GNU General Public License for more details. 36 37;; You should have received a copy of the GNU General Public License 38;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 39 40;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 41;;; Commentary: 42;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 43 44;; This package provides an Emacs major mode for editing VHDL code. 45;; It includes the following features: 46 47;; - Syntax highlighting 48;; - Indentation 49;; - Template insertion (electrification) 50;; - Insertion of file headers 51;; - Insertion of user-specified models 52;; - Port translation / testbench generation 53;; - Structural composition 54;; - Configuration generation 55;; - Sensitivity list updating 56;; - File browser 57;; - Design hierarchy browser 58;; - Source file compilation (syntax analysis) 59;; - Makefile generation 60;; - Code hiding 61;; - Word/keyword completion 62;; - Block commenting 63;; - Code fixing/alignment/beautification 64;; - PostScript printing 65;; - VHDL'87/'93/'02/'08 and VHDL-AMS supported 66;; - Comprehensive menu 67;; - Fully customizable 68;; - Works under GNU Emacs (recommended) and XEmacs 69 70;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71;; Documentation 72 73;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs. 74 75;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 76;; Emacs Versions 77 78;; this updated version was only tested on: GNU Emacs 24.1 79 80;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81;; Installation 82 83;; Prerequisites: GNU Emacs >= 21, XEmacs 20/21. 84 85;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation 86;; or into an arbitrary directory that is added to the load path by the 87;; following line in your Emacs start-up file `.emacs': 88 89;; (push (expand-file-name "<directory-name>") load-path) 90 91;; If you already have the compiled `vhdl-mode.elc' file, put it in the same 92;; directory. Otherwise, byte-compile the source file: 93;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET 94;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el 95 96;; Add the following lines to the `site-start.el' file in the `site-lisp' 97;; directory of your Emacs installation or to your Emacs start-up file `.emacs' 98;; (not required in Emacs): 99 100;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) 101;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) 102 103;; More detailed installation instructions are included in the official 104;; VHDL Mode distribution. 105 106;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 107;; Acknowledgments 108 109;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> 110;; and Steve Grout. 111 112;; Fontification approach suggested by Ken Wood <ken@eda.com.au>. 113;; Ideas about alignment from John Wiegley <johnw@gnu.org>. 114 115;; Many thanks to all the users who sent me bug reports and enhancement 116;; requests. 117;; Thanks to Colin Marquardt for his serious beta testing, his innumerable 118;; enhancement suggestions and the fruitful discussions. 119;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. 120;; Thanks to Ulf Klaperski for the indentation speedup hint. 121 122;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated 123;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for 124;; giving me the opportunity to develop this code. 125;; This work has been funded in part by MICROSWISS, a Microelectronics Program 126;; of the Swiss Government. 127 128;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 129 130;;; Code: 131 132(eval-when-compile 133 (condition-case nil (require 'cl-lib) (file-missing (require 'cl))) 134 (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew))) 135 136;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' 137;; even for relatively simple cases such as used here. We only test <25 138;; because it's easier and sufficient. 139(when (< emacs-major-version 25) 140 (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) 141 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(when (< emacs-major-version 28) ; preloaded in Emacs 28 2163 (require 'easymenu)) 2164(require 'hippie-exp) 2165 2166;; optional (minimize warning messages during compile) 2167(unless (featurep 'xemacs) 2168(eval-when-compile 2169 (require 'font-lock) 2170 (require 'ps-print) 2171 (require 'speedbar))) ; for speedbar-with-writable 2172 2173(defun vhdl-aput (alist-symbol key &optional value) 2174 "Insert a key-value pair into an alist. 2175The alist is referenced by ALIST-SYMBOL. The key-value pair is made 2176from KEY and VALUE. If the key-value pair referenced by KEY can be 2177found in the alist, the value of KEY will be set to VALUE. If the 2178key-value pair cannot be found in the alist, it will be inserted into 2179the head of the alist." 2180 (let* ((alist (symbol-value alist-symbol)) 2181 (elem (assoc key alist))) 2182 (if elem 2183 (setcdr elem value) 2184 (set alist-symbol (cons (cons key value) alist))))) 2185 2186(defun vhdl-adelete (alist-symbol key) 2187 "Delete a key-value pair from the alist. 2188Alist is referenced by ALIST-SYMBOL and the key-value pair to remove 2189is pair matching KEY." 2190 (let ((alist (symbol-value alist-symbol)) alist-cdr) 2191 (while (equal key (caar alist)) 2192 (setq alist (cdr alist)) 2193 (set alist-symbol alist)) 2194 (while (setq alist-cdr (cdr alist)) 2195 (if (equal key (caar alist-cdr)) 2196 (setcdr alist (cdr alist-cdr)) 2197 (setq alist alist-cdr))))) 2198 2199(defun vhdl-aget (alist key) 2200 "Return the value in ALIST that is associated with KEY. 2201If KEY is not found, then nil is returned." 2202 (cdr (assoc key alist))) 2203 2204;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2205;;; Compatibility 2206;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2207 2208;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2209;; XEmacs compatibility 2210 2211;; active regions 2212(defun vhdl-keep-region-active () 2213 "Do whatever is necessary to keep the region active in XEmacs. 2214Ignore byte-compiler warnings you might see." 2215 (and (featurep 'xemacs) 2216 (setq zmacs-region-stays t))) 2217 2218;; `wildcard-to-regexp' is included only in XEmacs 21 2219(unless (fboundp 'wildcard-to-regexp) 2220 (defun wildcard-to-regexp (wildcard) 2221 "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'." 2222 (let* ((i (string-match "[*?]" wildcard)) 2223 (result (substring wildcard 0 i)) 2224 (len (length wildcard))) 2225 (when i 2226 (while (< i len) 2227 (let ((ch (aref wildcard i))) 2228 (setq result (concat result 2229 (cond ((eq ch ?*) "[^\000]*") 2230 ((eq ch ??) "[^\000]") 2231 (t (char-to-string ch))))) 2232 (setq i (1+ i))))) 2233 (concat "\\`" result "\\'")))) 2234 2235;; `regexp-opt' undefined (`xemacs-devel' not installed) 2236;; `regexp-opt' accelerates fontification by 10-20% 2237(unless (fboundp 'regexp-opt) 2238; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") 2239 (defun regexp-opt (strings &optional paren) 2240 (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) 2241 (concat open (mapconcat #'regexp-quote strings "\\|") close)))) 2242 2243;; `match-string-no-properties' undefined (XEmacs, what else?) 2244(unless (fboundp 'match-string-no-properties) 2245 (defalias 'match-string-no-properties #'match-string)) 2246 2247;; `subst-char-in-string' undefined (XEmacs) 2248(unless (fboundp 'subst-char-in-string) 2249 (defun subst-char-in-string (fromchar tochar string &optional inplace) 2250 (let ((i (length string)) 2251 (newstr (if inplace string (copy-sequence string)))) 2252 (while (> i 0) 2253 (setq i (1- i)) 2254 (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) 2255 newstr))) 2256 2257;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) 2258(when (and (featurep 'xemacs) (string< itimer-version "1.09") 2259 (not noninteractive)) 2260 (load "itimer") 2261 (when (string< itimer-version "1.09") 2262 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") 2263 (beep) (sit-for 5))) 2264 2265;; `file-expand-wildcards' undefined (XEmacs) 2266(unless (fboundp 'file-expand-wildcards) 2267 (defun file-expand-wildcards (pattern &optional full) 2268 "Taken from Emacs's `files.el'." 2269 (let* ((nondir (file-name-nondirectory pattern)) 2270 (dirpart (file-name-directory pattern)) 2271 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 2272 (mapcar #'file-name-as-directory 2273 (file-expand-wildcards (directory-file-name dirpart))) 2274 (list dirpart))) 2275 contents) 2276 (while dirs 2277 (when (or (null (car dirs)) ; Possible if DIRPART is not wild. 2278 (file-directory-p (directory-file-name (car dirs)))) 2279 (let ((this-dir-contents 2280 (delq nil 2281 (mapcar #'(lambda (name) 2282 (unless (string-match "\\`\\.\\.?\\'" 2283 (file-name-nondirectory name)) 2284 name)) 2285 (directory-files (or (car dirs) ".") full 2286 (wildcard-to-regexp nondir)))))) 2287 (setq contents 2288 (nconc 2289 (if (and (car dirs) (not full)) 2290 (mapcar (lambda (name) (concat (car dirs) name)) 2291 this-dir-contents) 2292 this-dir-contents) 2293 contents)))) 2294 (setq dirs (cdr dirs))) 2295 contents))) 2296 2297;; `member-ignore-case' undefined (XEmacs) 2298(unless (fboundp 'member-ignore-case) 2299 (defalias 'member-ignore-case #'member)) 2300 2301;; `last-input-char' obsolete in Emacs 24, `last-input-event' different 2302;; behavior in XEmacs 2303(defvar vhdl-last-input-event) 2304(if (featurep 'xemacs) 2305 (defvaralias 'vhdl-last-input-event 'last-input-char) 2306 (defvaralias 'vhdl-last-input-event 'last-input-event)) 2307 2308;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2309;; Compatibility with older VHDL Mode versions 2310 2311(defvar vhdl-warnings nil 2312 "Warnings to tell the user during start up.") 2313 2314(defun vhdl-run-when-idle (secs repeat function) 2315 "Wait until idle, then run FUNCTION." 2316 (if (fboundp 'start-itimer) 2317 (start-itimer "vhdl-mode" function secs repeat t) 2318 ;; explicitly activate timer (necessary when Emacs is already idle) 2319 (aset (run-with-idle-timer secs repeat function) 0 nil))) 2320 2321(defun vhdl-warning-when-idle (&rest args) 2322 "Wait until idle, then print out warning STRING and beep." 2323 (let ((message (apply #'format-message args))) 2324 (if noninteractive 2325 (vhdl-warning message t) 2326 (unless vhdl-warnings 2327 (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) 2328 (push message vhdl-warnings)))) 2329 2330(defun vhdl-warning (string &optional nobeep) 2331 "Print out warning STRING and beep." 2332 (message "WARNING: %s" string) 2333 (unless (or nobeep noninteractive) (beep))) 2334 2335(defun vhdl-print-warnings () 2336 "Print out messages in variable `vhdl-warnings'." 2337 (let ((no-warnings (length vhdl-warnings))) 2338 (setq vhdl-warnings (nreverse vhdl-warnings)) 2339 (while vhdl-warnings 2340 (message "WARNING: %s" (car vhdl-warnings)) 2341 (setq vhdl-warnings (cdr vhdl-warnings))) 2342 (beep) 2343 (when (> no-warnings 1) 2344 (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) 2345 2346;; Backward compatibility checks and fixes 2347;; option `vhdl-compiler' changed format 2348(unless (stringp vhdl-compiler) 2349 (setq vhdl-compiler "ModelSim") 2350 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) 2351 2352;; option `vhdl-standard' changed format 2353(unless (listp vhdl-standard) 2354 (setq vhdl-standard '(87 nil)) 2355 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) 2356 2357;; option `vhdl-model-alist' changed format 2358(when (= (length (car vhdl-model-alist)) 3) 2359 (let ((old-alist vhdl-model-alist) 2360 new-alist) 2361 (while old-alist 2362 (push (append (car old-alist) '("")) new-alist) 2363 (setq old-alist (cdr old-alist))) 2364 (setq vhdl-model-alist (nreverse new-alist))) 2365 (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) 2366 2367;; option `vhdl-project-alist' changed format 2368(when (= (length (car vhdl-project-alist)) 3) 2369 (let ((old-alist vhdl-project-alist) 2370 new-alist) 2371 (while old-alist 2372 (push (append (car old-alist) '("")) new-alist) 2373 (setq old-alist (cdr old-alist))) 2374 (setq vhdl-project-alist (nreverse new-alist))) 2375 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2376 2377;; option `vhdl-project-alist' changed format (3.31.1) 2378(when (= (length (car vhdl-project-alist)) 4) 2379 (let ((old-alist vhdl-project-alist) 2380 new-alist elem) 2381 (while old-alist 2382 (setq elem (car old-alist)) 2383 (setq new-alist 2384 (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) 2385 nil "./" "work" "work/" "Makefile" (nth 3 elem)) 2386 new-alist)) 2387 (setq old-alist (cdr old-alist))) 2388 (setq vhdl-project-alist (nreverse new-alist))) 2389 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) 2390 2391;; option `vhdl-project-alist' changed format (3.31.12) 2392(when (= (length (car vhdl-project-alist)) 10) 2393 (let ((tmp-alist vhdl-project-alist)) 2394 (while tmp-alist 2395 (setcdr (nthcdr 3 (car tmp-alist)) 2396 (cons "" (nthcdr 4 (car tmp-alist)))) 2397 (setq tmp-alist (cdr tmp-alist)))) 2398 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2399 2400;; option `vhdl-compiler-alist' changed format (3.31.1) 2401(when (= (length (car vhdl-compiler-alist)) 7) 2402 (let ((old-alist vhdl-compiler-alist) 2403 new-alist elem) 2404 (while old-alist 2405 (setq elem (car old-alist)) 2406 (setq new-alist 2407 (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" 2408 (if (equal (nth 3 elem) "") nil (nth 3 elem)) 2409 (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) 2410 (nth 5 elem) (nth 6 elem) nil) 2411 new-alist)) 2412 (setq old-alist (cdr old-alist))) 2413 (setq vhdl-compiler-alist (nreverse new-alist))) 2414 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) 2415 2416;; option `vhdl-compiler-alist' changed format (3.31.10) 2417(when (= (length (car vhdl-compiler-alist)) 12) 2418 (let ((tmp-alist vhdl-compiler-alist)) 2419 (while tmp-alist 2420 (setcdr (nthcdr 4 (car tmp-alist)) 2421 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) 2422 (setq tmp-alist (cdr tmp-alist)))) 2423 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2424 2425;; option `vhdl-compiler-alist' changed format (3.31.11) 2426(when (= (length (car vhdl-compiler-alist)) 13) 2427 (let ((tmp-alist vhdl-compiler-alist)) 2428 (while tmp-alist 2429 (setcdr (nthcdr 3 (car tmp-alist)) 2430 (cons "" (nthcdr 4 (car tmp-alist)))) 2431 (setq tmp-alist (cdr tmp-alist)))) 2432 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2433 2434;; option `vhdl-compiler-alist' changed format (3.32.7) 2435(when (= (length (nth 11 (car vhdl-compiler-alist))) 3) 2436 (let ((tmp-alist vhdl-compiler-alist)) 2437 (while tmp-alist 2438 (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) 2439 '(0 . nil)) 2440 (setq tmp-alist (cdr tmp-alist)))) 2441 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2442 2443;; option `vhdl-project': empty value changed from "" to nil (3.31.1) 2444(when (equal vhdl-project "") 2445 (setq vhdl-project nil) 2446 (customize-save-variable 'vhdl-project vhdl-project)) 2447 2448;; option `vhdl-project-file-name': changed format (3.31.17 beta) 2449(when (stringp vhdl-project-file-name) 2450 (setq vhdl-project-file-name (list vhdl-project-file-name)) 2451 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) 2452 2453;; option `speedbar-indentation-width': introduced in speedbar 0.10 2454(if (not (boundp 'speedbar-indentation-width)) 2455 (defvar speedbar-indentation-width 2) 2456 ;; set default to 2 if not already customized 2457 (unless (get 'speedbar-indentation-width 'saved-value) 2458 (setq speedbar-indentation-width 2))) 2459 2460;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2461;;; Help functions / inline substitutions / macros 2462;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2463 2464(defun vhdl-standard-p (standard) 2465 "Check if STANDARD is specified as used standard." 2466 (or (eq standard (car vhdl-standard)) 2467 (memq standard (cadr vhdl-standard)))) 2468 2469(defun vhdl-project-p (&optional warning) 2470 "Return non-nil if a project is displayed, i.e. directories or files are 2471specified." 2472 (if (assoc vhdl-project vhdl-project-alist) 2473 vhdl-project 2474 (when (and vhdl-project warning) 2475 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) 2476 nil)) 2477 2478(defun vhdl-resolve-env-variable (string) 2479 "Resolve environment variables in STRING." 2480 (while (string-match "\\(.*\\)\\${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) 2481 (setq string (concat (match-string 1 string) 2482 (getenv (match-string 2 string)) 2483 (match-string 4 string)))) 2484 string) 2485 2486(defun vhdl-default-directory () 2487 "Return the default directory of the current project or the directory of the 2488current buffer if no project is defined." 2489 (if (vhdl-project-p) 2490 (expand-file-name (vhdl-resolve-env-variable 2491 (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) 2492 default-directory)) 2493 2494(defmacro vhdl-prepare-search-1 (&rest body) 2495 "Enable case insensitive search and switch to syntax table that includes `_', 2496then execute BODY, and finally restore the old environment. Used for 2497consistent searching." 2498 (declare (debug t)) 2499 `(let ((case-fold-search t)) ; case insensitive search 2500 ;; use extended syntax table 2501 (with-syntax-table vhdl-mode-ext-syntax-table 2502 ,@body))) 2503 2504(defmacro vhdl-prepare-search-2 (&rest body) 2505 "Enable case insensitive search, switch to syntax table that includes `_', 2506arrange to ignore `intangible' overlays, then execute BODY, and finally restore 2507the old environment. Used for consistent searching." 2508 (declare (debug t)) 2509 `(let ((case-fold-search t) ; case insensitive search 2510 (inhibit-point-motion-hooks t)) 2511 ;; use extended syntax table 2512 (with-syntax-table vhdl-mode-ext-syntax-table 2513 ;; execute BODY safely 2514 (progn ,@body)))) 2515 2516(defmacro vhdl-visit-file (file-name issue-error &rest body) 2517 "Visit file FILE-NAME and execute BODY." 2518 (declare (debug t) (indent 2)) 2519 `(vhdl--visit-file ,file-name ,issue-error (lambda () . ,body))) 2520 2521(defun vhdl--visit-file (file-name issue-error body-fun) 2522 (if (null file-name) 2523 (funcall body-fun) 2524 (unless (file-directory-p file-name) 2525 (let ((source-buffer (current-buffer)) 2526 (visiting-buffer (find-buffer-visiting file-name)) 2527 file-opened) 2528 (when (or (and visiting-buffer (set-buffer visiting-buffer)) 2529 (condition-case () 2530 (progn (set-buffer (create-file-buffer file-name)) 2531 (setq file-opened t) 2532 (vhdl-insert-file-contents file-name) 2533 (let ((st (copy-syntax-table (syntax-table)))) 2534 (modify-syntax-entry ?\- ". 12" st) 2535 (modify-syntax-entry ?\n ">" st) 2536 (modify-syntax-entry ?\^M ">" st) 2537 (modify-syntax-entry ?_ "w" st) 2538 ;; FIXME: We should arguably reset the 2539 ;; syntax-table after running `body-fun'. 2540 (set-syntax-table st)) 2541 t) 2542 (error 2543 (if issue-error 2544 (progn 2545 (when file-opened (kill-buffer (current-buffer))) 2546 (set-buffer source-buffer) 2547 (error "ERROR: File cannot be opened: \"%s\"" file-name)) 2548 (vhdl-warning (format "File cannot be opened: \"%s\"" file-name) t) 2549 nil)))) 2550 (condition-case info 2551 (funcall body-fun) 2552 (error 2553 (if issue-error 2554 (progn 2555 (when file-opened (kill-buffer (current-buffer))) 2556 (set-buffer source-buffer) 2557 (error (cadr info))) 2558 (vhdl-warning (cadr info)))))) 2559 (when file-opened (kill-buffer (current-buffer))) 2560 (set-buffer source-buffer))))) 2561 2562(defun vhdl-insert-file-contents (filename) 2563 "Nicked from `insert-file-contents-literally', but allow coding system 2564conversion." 2565 (let ((format-alist nil) 2566 (after-insert-file-functions nil) 2567 (jka-compr-compression-info-list nil)) 2568 (insert-file-contents filename t))) 2569 2570(defun vhdl-sort-alist (alist) 2571 "Sort ALIST." 2572 (sort alist (lambda (a b) (string< (car a) (car b))))) 2573 2574(defun vhdl-get-subdirs (directory) 2575 "Recursively get subdirectories of DIRECTORY." 2576 (let ((dir-list (list (file-name-as-directory directory))) 2577 file-list) 2578 (setq file-list (vhdl-directory-files directory t "\\w.*")) 2579 (while file-list 2580 (when (file-directory-p (car file-list)) 2581 (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) 2582 (setq file-list (cdr file-list))) 2583 dir-list)) 2584 2585(defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) 2586 "As `aput', but delete key-value pair if VALUE is nil." 2587 (if value 2588 (vhdl-aput alist-symbol key value) 2589 (vhdl-adelete alist-symbol key))) 2590 2591(defun vhdl-delete (elt list) 2592 "Delete by side effect the first occurrence of ELT as a member of LIST." 2593 (push nil list) 2594 (let ((list1 list)) 2595 (while (and (cdr list1) (not (equal elt (cadr list1)))) 2596 (setq list1 (cdr list1))) 2597 (when list 2598 (setcdr list1 (cddr list1)))) 2599 (cdr list)) 2600 2601(declare-function speedbar-refresh "speedbar" (&optional arg)) 2602(declare-function speedbar-do-function-pointer "speedbar" ()) 2603 2604(defun vhdl-speedbar-refresh (&optional key) 2605 "Refresh directory or project with name KEY." 2606 (when (and (boundp 'speedbar-frame) 2607 (frame-live-p speedbar-frame)) 2608 (let (;; (pos (point)) 2609 (last-frame (selected-frame))) 2610 (if (null key) 2611 (speedbar-refresh) 2612 (select-frame speedbar-frame) 2613 (when (save-excursion 2614 (goto-char (point-min)) 2615 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) 2616 (goto-char (match-end 1)) 2617 (speedbar-do-function-pointer) 2618 (backward-char 2) 2619 (speedbar-do-function-pointer) 2620 (message "Refreshing speedbar...done")) 2621 (select-frame last-frame))))) 2622 2623(defun vhdl-show-messages () 2624 "Get *Messages* buffer to show recent messages." 2625 (interactive) 2626 (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) 2627 2628(defun vhdl-use-direct-instantiation () 2629 "Return whether direct instantiation is used." 2630 (or (eq vhdl-use-direct-instantiation 'always) 2631 (and (eq vhdl-use-direct-instantiation 'standard) 2632 (not (vhdl-standard-p '87))))) 2633 2634(defun vhdl-max-marker (marker1 marker2) 2635 "Return larger marker." 2636 (if (> marker1 marker2) marker1 marker2)) 2637 2638(defun vhdl-goto-marker (marker) 2639 "Goto marker in appropriate buffer." 2640 (when (markerp marker) 2641 (set-buffer (marker-buffer marker))) 2642 (goto-char marker)) 2643 2644(defun vhdl-menu-split (list title) 2645 "Split menu LIST into several submenus, if number of 2646elements > `vhdl-menu-max-size'." 2647 (if (> (length list) vhdl-menu-max-size) 2648 (let ((remain list) 2649 (result '()) 2650 (sublist '()) 2651 (menuno 1) 2652 (i 0)) 2653 (while remain 2654 (push (car remain) sublist) 2655 (setq remain (cdr remain)) 2656 (setq i (+ i 1)) 2657 (if (= i vhdl-menu-max-size) 2658 (progn 2659 (push (cons (format "%s %s" title menuno) 2660 (nreverse sublist)) result) 2661 (setq i 0) 2662 (setq menuno (+ menuno 1)) 2663 (setq sublist '())))) 2664 (and sublist 2665 (push (cons (format "%s %s" title menuno) 2666 (nreverse sublist)) result)) 2667 (nreverse result)) 2668 list)) 2669 2670 2671;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2672;;; Bindings 2673;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2674 2675;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2676;; Key bindings 2677 2678(defvar vhdl-template-map nil 2679 "Keymap for VHDL templates.") 2680 2681(defun vhdl-template-map-init () 2682 "Initialize `vhdl-template-map'." 2683 (setq vhdl-template-map (make-sparse-keymap)) 2684 ;; key bindings for VHDL templates 2685 (define-key vhdl-template-map "al" #'vhdl-template-alias) 2686 (define-key vhdl-template-map "ar" #'vhdl-template-architecture) 2687 (define-key vhdl-template-map "at" #'vhdl-template-assert) 2688 (define-key vhdl-template-map "ad" #'vhdl-template-attribute-decl) 2689 (define-key vhdl-template-map "as" #'vhdl-template-attribute-spec) 2690 (define-key vhdl-template-map "bl" #'vhdl-template-block) 2691 (define-key vhdl-template-map "ca" #'vhdl-template-case-is) 2692 (define-key vhdl-template-map "cd" #'vhdl-template-component-decl) 2693 (define-key vhdl-template-map "ci" #'vhdl-template-component-inst) 2694 (define-key vhdl-template-map "cs" #'vhdl-template-conditional-signal-asst) 2695 (define-key vhdl-template-map "Cb" #'vhdl-template-block-configuration) 2696 (define-key vhdl-template-map "Cc" #'vhdl-template-component-conf) 2697 (define-key vhdl-template-map "Cd" #'vhdl-template-configuration-decl) 2698 (define-key vhdl-template-map "Cs" #'vhdl-template-configuration-spec) 2699 (define-key vhdl-template-map "co" #'vhdl-template-constant) 2700 (define-key vhdl-template-map "ct" #'vhdl-template-context) 2701 (define-key vhdl-template-map "di" #'vhdl-template-disconnect) 2702 (define-key vhdl-template-map "el" #'vhdl-template-else) 2703 (define-key vhdl-template-map "ei" #'vhdl-template-elsif) 2704 (define-key vhdl-template-map "en" #'vhdl-template-entity) 2705 (define-key vhdl-template-map "ex" #'vhdl-template-exit) 2706 (define-key vhdl-template-map "fi" #'vhdl-template-file) 2707 (define-key vhdl-template-map "fg" #'vhdl-template-for-generate) 2708 (define-key vhdl-template-map "fl" #'vhdl-template-for-loop) 2709 (define-key vhdl-template-map "\C-f" #'vhdl-template-footer) 2710 (define-key vhdl-template-map "fb" #'vhdl-template-function-body) 2711 (define-key vhdl-template-map "fd" #'vhdl-template-function-decl) 2712 (define-key vhdl-template-map "ge" #'vhdl-template-generic) 2713 (define-key vhdl-template-map "gd" #'vhdl-template-group-decl) 2714 (define-key vhdl-template-map "gt" #'vhdl-template-group-template) 2715 (define-key vhdl-template-map "\C-h" #'vhdl-template-header) 2716 (define-key vhdl-template-map "ig" #'vhdl-template-if-generate) 2717 (define-key vhdl-template-map "it" #'vhdl-template-if-then) 2718 (define-key vhdl-template-map "li" #'vhdl-template-library) 2719 (define-key vhdl-template-map "lo" #'vhdl-template-bare-loop) 2720 (define-key vhdl-template-map "\C-m" #'vhdl-template-modify) 2721 (define-key vhdl-template-map "\C-t" #'vhdl-template-insert-date) 2722 (define-key vhdl-template-map "ma" #'vhdl-template-map) 2723 (define-key vhdl-template-map "ne" #'vhdl-template-next) 2724 (define-key vhdl-template-map "ot" #'vhdl-template-others) 2725 (define-key vhdl-template-map "Pd" #'vhdl-template-package-decl) 2726 (define-key vhdl-template-map "Pb" #'vhdl-template-package-body) 2727 (define-key vhdl-template-map "(" #'vhdl-template-paired-parens) 2728 (define-key vhdl-template-map "po" #'vhdl-template-port) 2729 (define-key vhdl-template-map "pb" #'vhdl-template-procedure-body) 2730 (define-key vhdl-template-map "pd" #'vhdl-template-procedure-decl) 2731 (define-key vhdl-template-map "pc" #'vhdl-template-process-comb) 2732 (define-key vhdl-template-map "ps" #'vhdl-template-process-seq) 2733 (define-key vhdl-template-map "rp" #'vhdl-template-report) 2734 (define-key vhdl-template-map "rt" #'vhdl-template-return) 2735 (define-key vhdl-template-map "ss" #'vhdl-template-selected-signal-asst) 2736 (define-key vhdl-template-map "si" #'vhdl-template-signal) 2737 (define-key vhdl-template-map "su" #'vhdl-template-subtype) 2738 (define-key vhdl-template-map "ty" #'vhdl-template-type) 2739 (define-key vhdl-template-map "us" #'vhdl-template-use) 2740 (define-key vhdl-template-map "va" #'vhdl-template-variable) 2741 (define-key vhdl-template-map "wa" #'vhdl-template-wait) 2742 (define-key vhdl-template-map "wl" #'vhdl-template-while-loop) 2743 (define-key vhdl-template-map "wi" #'vhdl-template-with) 2744 (define-key vhdl-template-map "wc" #'vhdl-template-clocked-wait) 2745 (define-key vhdl-template-map "\C-pb" #'vhdl-template-package-numeric-bit) 2746 (define-key vhdl-template-map "\C-pn" #'vhdl-template-package-numeric-std) 2747 (define-key vhdl-template-map "\C-ps" #'vhdl-template-package-std-logic-1164) 2748 (define-key vhdl-template-map "\C-pA" #'vhdl-template-package-std-logic-arith) 2749 (define-key vhdl-template-map "\C-pM" #'vhdl-template-package-std-logic-misc) 2750 (define-key vhdl-template-map "\C-pS" #'vhdl-template-package-std-logic-signed) 2751 (define-key vhdl-template-map "\C-pT" #'vhdl-template-package-std-logic-textio) 2752 (define-key vhdl-template-map "\C-pU" #'vhdl-template-package-std-logic-unsigned) 2753 (define-key vhdl-template-map "\C-pt" #'vhdl-template-package-textio) 2754 (define-key vhdl-template-map "\C-dn" #'vhdl-template-directive-translate-on) 2755 (define-key vhdl-template-map "\C-df" #'vhdl-template-directive-translate-off) 2756 (define-key vhdl-template-map "\C-dN" #'vhdl-template-directive-synthesis-on) 2757 (define-key vhdl-template-map "\C-dF" #'vhdl-template-directive-synthesis-off) 2758 (define-key vhdl-template-map "\C-q" #'vhdl-template-search-prompt) 2759 (when (vhdl-standard-p 'ams) 2760 (define-key vhdl-template-map "br" #'vhdl-template-break) 2761 (define-key vhdl-template-map "cu" #'vhdl-template-case-use) 2762 (define-key vhdl-template-map "iu" #'vhdl-template-if-use) 2763 (define-key vhdl-template-map "lm" #'vhdl-template-limit) 2764 (define-key vhdl-template-map "na" #'vhdl-template-nature) 2765 (define-key vhdl-template-map "pa" #'vhdl-template-procedural) 2766 (define-key vhdl-template-map "qf" #'vhdl-template-quantity-free) 2767 (define-key vhdl-template-map "qb" #'vhdl-template-quantity-branch) 2768 (define-key vhdl-template-map "qs" #'vhdl-template-quantity-source) 2769 (define-key vhdl-template-map "sn" #'vhdl-template-subnature) 2770 (define-key vhdl-template-map "te" #'vhdl-template-terminal) 2771 ) 2772 (when (vhdl-standard-p 'math) 2773 (define-key vhdl-template-map "\C-pc" #'vhdl-template-package-math-complex) 2774 (define-key vhdl-template-map "\C-pr" #'vhdl-template-package-math-real) 2775 )) 2776 2777;; initialize template map for VHDL Mode 2778(vhdl-template-map-init) 2779 2780(defun vhdl-function-name (prefix string &optional postfix) 2781 "Generate a Lisp function name. 2782PREFIX, STRING and optional POSTFIX are concatenated by `-' and spaces in 2783STRING are replaced by `-' and substrings are converted to lower case." 2784 (let ((name prefix)) 2785 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) 2786 (setq name 2787 (concat name "-" (downcase (substring string 0 (match-end 1))))) 2788 (setq string (substring string (match-beginning 2)))) 2789 (when postfix (setq name (concat name "-" postfix))) 2790 (intern name))) 2791 2792(defvar vhdl-model-map nil 2793 "Keymap for VHDL models.") 2794 2795(defun vhdl-model-map-init () 2796 "Initialize `vhdl-model-map'." 2797 (setq vhdl-model-map (make-sparse-keymap)) 2798 ;; key bindings for VHDL models 2799 (let ((model-alist vhdl-model-alist) model) 2800 (while model-alist 2801 (setq model (car model-alist)) 2802 (define-key vhdl-model-map (nth 2 model) 2803 (vhdl-function-name "vhdl-model" (nth 0 model))) 2804 (setq model-alist (cdr model-alist))))) 2805 2806;; initialize user model map for VHDL Mode 2807(vhdl-model-map-init) 2808 2809(defvar vhdl-mode-map nil 2810 "Keymap for VHDL Mode.") 2811 2812(defun vhdl-mode-map-init () 2813 "Initialize `vhdl-mode-map'." 2814 (setq vhdl-mode-map (make-sparse-keymap)) 2815 ;; template key bindings 2816 (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) 2817 ;; model key bindings 2818 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) 2819 ;; standard key bindings 2820 (define-key vhdl-mode-map "\M-a" #'vhdl-beginning-of-statement) 2821 (define-key vhdl-mode-map "\M-e" #'vhdl-end-of-statement) 2822 (define-key vhdl-mode-map "\M-\C-f" #'vhdl-forward-sexp) 2823 (define-key vhdl-mode-map "\M-\C-b" #'vhdl-backward-sexp) 2824 (define-key vhdl-mode-map "\M-\C-u" #'vhdl-backward-up-list) 2825 (define-key vhdl-mode-map "\M-\C-a" #'vhdl-backward-same-indent) 2826 (define-key vhdl-mode-map "\M-\C-e" #'vhdl-forward-same-indent) 2827 (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs 2828 (define-key vhdl-mode-map "\M-\C-h" #'vhdl-mark-defun)) 2829 (define-key vhdl-mode-map "\M-\C-q" #'vhdl-indent-sexp) 2830 (define-key vhdl-mode-map "\M-^" #'vhdl-delete-indentation) 2831 ;; mode specific key bindings 2832 (define-key vhdl-mode-map "\C-c\C-m\C-e" #'vhdl-electric-mode) 2833 (define-key vhdl-mode-map "\C-c\C-m\C-s" #'vhdl-stutter-mode) 2834 (define-key vhdl-mode-map "\C-c\C-s\C-p" #'vhdl-set-project) 2835 (define-key vhdl-mode-map "\C-c\C-p\C-d" #'vhdl-duplicate-project) 2836 (define-key vhdl-mode-map "\C-c\C-p\C-m" #'vhdl-import-project) 2837 (define-key vhdl-mode-map "\C-c\C-p\C-x" #'vhdl-export-project) 2838 (define-key vhdl-mode-map "\C-c\C-s\C-k" #'vhdl-set-compiler) 2839 (define-key vhdl-mode-map "\C-c\C-k" #'vhdl-compile) 2840 (define-key vhdl-mode-map "\C-c\M-\C-k" #'vhdl-make) 2841 (define-key vhdl-mode-map "\C-c\M-k" #'vhdl-generate-makefile) 2842 (define-key vhdl-mode-map "\C-c\C-p\C-w" #'vhdl-port-copy) 2843 (define-key vhdl-mode-map "\C-c\C-p\M-w" #'vhdl-port-copy) 2844 (define-key vhdl-mode-map "\C-c\C-p\C-e" #'vhdl-port-paste-entity) 2845 (define-key vhdl-mode-map "\C-c\C-p\C-c" #'vhdl-port-paste-component) 2846 (define-key vhdl-mode-map "\C-c\C-p\C-i" #'vhdl-port-paste-instance) 2847 (define-key vhdl-mode-map "\C-c\C-p\C-s" #'vhdl-port-paste-signals) 2848 (define-key vhdl-mode-map "\C-c\C-p\M-c" #'vhdl-port-paste-constants) 2849 (define-key vhdl-mode-map 2850 ;; `... C-g' not allowed in XEmacs. 2851 (if (featurep 'xemacs) "\C-c\C-p\M-g" "\C-c\C-p\C-g") 2852 #'vhdl-port-paste-generic-map) 2853 (define-key vhdl-mode-map "\C-c\C-p\C-z" #'vhdl-port-paste-initializations) 2854 (define-key vhdl-mode-map "\C-c\C-p\C-t" #'vhdl-port-paste-testbench) 2855 (define-key vhdl-mode-map "\C-c\C-p\C-f" #'vhdl-port-flatten) 2856 (define-key vhdl-mode-map "\C-c\C-p\C-r" #'vhdl-port-reverse-direction) 2857 (define-key vhdl-mode-map "\C-c\C-s\C-w" #'vhdl-subprog-copy) 2858 (define-key vhdl-mode-map "\C-c\C-s\M-w" #'vhdl-subprog-copy) 2859 (define-key vhdl-mode-map "\C-c\C-s\C-d" #'vhdl-subprog-paste-declaration) 2860 (define-key vhdl-mode-map "\C-c\C-s\C-b" #'vhdl-subprog-paste-body) 2861 (define-key vhdl-mode-map "\C-c\C-s\C-c" #'vhdl-subprog-paste-call) 2862 (define-key vhdl-mode-map "\C-c\C-s\C-f" #'vhdl-subprog-flatten) 2863 (define-key vhdl-mode-map "\C-c\C-m\C-n" #'vhdl-compose-new-component) 2864 (define-key vhdl-mode-map "\C-c\C-m\C-p" #'vhdl-compose-place-component) 2865 (define-key vhdl-mode-map "\C-c\C-m\C-w" #'vhdl-compose-wire-components) 2866 (define-key vhdl-mode-map "\C-c\C-m\C-f" #'vhdl-compose-configuration) 2867 (define-key vhdl-mode-map "\C-c\C-m\C-k" #'vhdl-compose-components-package) 2868 (define-key vhdl-mode-map "\C-c\C-c" #'vhdl-comment-uncomment-region) 2869 (define-key vhdl-mode-map "\C-c-" #'vhdl-comment-append-inline) 2870 (define-key vhdl-mode-map "\C-c\M--" #'vhdl-comment-display-line) 2871 (define-key vhdl-mode-map "\C-c\C-i\C-l" #'indent-according-to-mode) 2872 (define-key vhdl-mode-map "\C-c\C-i\C-g" #'vhdl-indent-group) 2873 (define-key vhdl-mode-map "\M-\C-\\" #'indent-region) 2874 (define-key vhdl-mode-map "\C-c\C-i\C-b" #'vhdl-indent-buffer) 2875 (define-key vhdl-mode-map "\C-c\C-a\C-g" #'vhdl-align-group) 2876 (define-key vhdl-mode-map "\C-c\C-a\C-a" #'vhdl-align-group) 2877 (define-key vhdl-mode-map "\C-c\C-a\C-i" #'vhdl-align-same-indent) 2878 (define-key vhdl-mode-map "\C-c\C-a\C-l" #'vhdl-align-list) 2879 (define-key vhdl-mode-map "\C-c\C-a\C-d" #'vhdl-align-declarations) 2880 (define-key vhdl-mode-map "\C-c\C-a\M-a" #'vhdl-align-region) 2881 (define-key vhdl-mode-map "\C-c\C-a\C-b" #'vhdl-align-buffer) 2882 (define-key vhdl-mode-map "\C-c\C-a\C-c" #'vhdl-align-inline-comment-group) 2883 (define-key vhdl-mode-map "\C-c\C-a\M-c" #'vhdl-align-inline-comment-region) 2884 (define-key vhdl-mode-map "\C-c\C-f\C-l" #'vhdl-fill-list) 2885 (define-key vhdl-mode-map "\C-c\C-f\C-f" #'vhdl-fill-list) 2886 (define-key vhdl-mode-map "\C-c\C-f\C-g" #'vhdl-fill-group) 2887 (define-key vhdl-mode-map "\C-c\C-f\C-i" #'vhdl-fill-same-indent) 2888 (define-key vhdl-mode-map "\C-c\C-f\M-f" #'vhdl-fill-region) 2889 (define-key vhdl-mode-map "\C-c\C-l\C-w" #'vhdl-line-kill) 2890 (define-key vhdl-mode-map "\C-c\C-l\M-w" #'vhdl-line-copy) 2891 (define-key vhdl-mode-map "\C-c\C-l\C-y" #'vhdl-line-yank) 2892 (define-key vhdl-mode-map "\C-c\C-l\t" #'vhdl-line-expand) 2893 (define-key vhdl-mode-map "\C-c\C-l\C-n" #'vhdl-line-transpose-next) 2894 (define-key vhdl-mode-map "\C-c\C-l\C-p" #'vhdl-line-transpose-previous) 2895 (define-key vhdl-mode-map "\C-c\C-l\C-o" #'vhdl-line-open) 2896 (define-key vhdl-mode-map "\C-c\C-l\C-g" #'goto-line) 2897 (define-key vhdl-mode-map "\C-c\C-l\C-c" #'vhdl-comment-uncomment-line) 2898 (define-key vhdl-mode-map "\C-c\C-x\C-s" #'vhdl-fix-statement-region) 2899 (define-key vhdl-mode-map "\C-c\C-x\M-s" #'vhdl-fix-statement-buffer) 2900 (define-key vhdl-mode-map "\C-c\C-x\C-p" #'vhdl-fix-clause) 2901 (define-key vhdl-mode-map "\C-c\C-x\M-c" #'vhdl-fix-case-region) 2902 (define-key vhdl-mode-map "\C-c\C-x\C-c" #'vhdl-fix-case-buffer) 2903 (define-key vhdl-mode-map "\C-c\C-x\M-w" #'vhdl-fixup-whitespace-region) 2904 (define-key vhdl-mode-map "\C-c\C-x\C-w" #'vhdl-fixup-whitespace-buffer) 2905 (define-key vhdl-mode-map "\C-c\M-b" #'vhdl-beautify-region) 2906 (define-key vhdl-mode-map "\C-c\C-b" #'vhdl-beautify-buffer) 2907 (define-key vhdl-mode-map "\C-c\C-u\C-s" #'vhdl-update-sensitivity-list-process) 2908 (define-key vhdl-mode-map "\C-c\C-u\M-s" #'vhdl-update-sensitivity-list-buffer) 2909 (define-key vhdl-mode-map "\C-c\C-i\C-f" #'vhdl-fontify-buffer) 2910 (define-key vhdl-mode-map "\C-c\C-i\C-s" #'vhdl-statistics-buffer) 2911 (define-key vhdl-mode-map "\C-c\M-m" #'vhdl-show-messages) 2912 (define-key vhdl-mode-map "\C-c\C-h" #'vhdl-doc-mode) 2913 (define-key vhdl-mode-map "\C-c\C-v" #'vhdl-version) 2914 (define-key vhdl-mode-map "\M-\t" #'insert-tab) 2915 ;; insert commands bindings 2916 (define-key vhdl-mode-map "\C-c\C-i\C-t" #'vhdl-template-insert-construct) 2917 (define-key vhdl-mode-map "\C-c\C-i\C-p" #'vhdl-template-insert-package) 2918 (define-key vhdl-mode-map "\C-c\C-i\C-d" #'vhdl-template-insert-directive) 2919 (define-key vhdl-mode-map "\C-c\C-i\C-m" #'vhdl-model-insert) 2920 ;; electric key bindings 2921 (define-key vhdl-mode-map " " #'vhdl-electric-space) 2922 (when vhdl-intelligent-tab 2923 (define-key vhdl-mode-map "\t" #'vhdl-electric-tab)) 2924 (define-key vhdl-mode-map "\r" #'vhdl-electric-return) 2925 (define-key vhdl-mode-map "-" #'vhdl-electric-dash) 2926 (define-key vhdl-mode-map "[" #'vhdl-electric-open-bracket) 2927 (define-key vhdl-mode-map "]" #'vhdl-electric-close-bracket) 2928 (define-key vhdl-mode-map "'" #'vhdl-electric-quote) 2929 (define-key vhdl-mode-map ";" #'vhdl-electric-semicolon) 2930 (define-key vhdl-mode-map "," #'vhdl-electric-comma) 2931 (define-key vhdl-mode-map "." #'vhdl-electric-period) 2932 (when (vhdl-standard-p 'ams) 2933 (define-key vhdl-mode-map "=" #'vhdl-electric-equal))) 2934 2935;; initialize mode map for VHDL Mode 2936(vhdl-mode-map-init) 2937 2938;; define special minibuffer keymap for enabling word completion in minibuffer 2939;; (useful in template generator prompts) 2940(defvar vhdl-minibuffer-local-map 2941 (let ((map (make-sparse-keymap))) 2942 (set-keymap-parent map minibuffer-local-map) 2943 (when vhdl-word-completion-in-minibuffer 2944 (define-key map "\t" #'vhdl-minibuffer-tab)) 2945 map) 2946 "Keymap for minibuffer used in VHDL Mode.") 2947 2948;; set up electric character functions to work with 2949;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) 2950(mapc 2951 (lambda (sym) 2952 (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) 2953 (put sym 'pending-delete t)) ; for `pending-delete-mode' (XEmacs) 2954 '(vhdl-electric-space 2955 vhdl-electric-tab 2956 vhdl-electric-return 2957 vhdl-electric-dash 2958 vhdl-electric-open-bracket 2959 vhdl-electric-close-bracket 2960 vhdl-electric-quote 2961 vhdl-electric-semicolon 2962 vhdl-electric-comma 2963 vhdl-electric-period 2964 vhdl-electric-equal)) 2965 2966;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2967;; Syntax table 2968 2969(defvar vhdl-mode-syntax-table 2970 (let ((st (make-syntax-table))) 2971 ;; define punctuation 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 (modify-syntax-entry ?\\ "." st) 2987 (modify-syntax-entry ?\| "." st) 2988 ;; define string 2989 (modify-syntax-entry ?\" "\"" st) 2990 ;; define underscore 2991 (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st) 2992 ;; single-line comments 2993 (modify-syntax-entry ?\- ". 12b" st) 2994 ;; multi-line comments 2995 (modify-syntax-entry ?\/ ". 14b" st) 2996 (modify-syntax-entry ?* ". 23" st) 2997 (modify-syntax-entry ?\n "> b" st) 2998 (modify-syntax-entry ?\^M "> b" st) 2999 ;; define parentheses to match 3000 (modify-syntax-entry ?\( "()" st) 3001 (modify-syntax-entry ?\) ")(" st) 3002 (modify-syntax-entry ?\[ "(]" st) 3003 (modify-syntax-entry ?\] ")[" st) 3004 (modify-syntax-entry ?\{ "(}" st) 3005 (modify-syntax-entry ?\} "){" st) 3006 st) 3007 "Syntax table used in `vhdl-mode' buffers.") 3008 3009(defvar vhdl-mode-ext-syntax-table 3010 ;; Extended syntax table including '_' (for simpler search regexps). 3011 (let ((st (copy-syntax-table vhdl-mode-syntax-table))) 3012 (modify-syntax-entry ?_ "w" st) 3013 st) 3014 "Syntax table extended by `_' used in `vhdl-mode' buffers.") 3015 3016(defvar vhdl-syntactic-context nil 3017 "Buffer local variable containing syntactic analysis list.") 3018(make-variable-buffer-local 'vhdl-syntactic-context) 3019 3020;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3021;; Abbrev hook bindings 3022 3023(defvar vhdl-mode-abbrev-table nil 3024 "Abbrev table to use in `vhdl-mode' buffers.") 3025 3026(defun vhdl-mode-abbrev-table-init () 3027 "Initialize `vhdl-mode-abbrev-table'." 3028 (define-abbrev-table 'vhdl-mode-abbrev-table 3029 (append 3030 (when (memq 'vhdl vhdl-electric-keywords) 3031 ;; VHDL'02 keywords 3032 (mapcar (if (featurep 'xemacs) 3033 (lambda (x) (list (car x) "" (cdr x) 0)) 3034 (lambda (x) (list (car x) "" (cdr x) 0 'system))) 3035 '( 3036 ("--" . vhdl-template-display-comment-hook) 3037 ("abs" . vhdl-template-default-hook) 3038 ("access" . vhdl-template-default-hook) 3039 ("after" . vhdl-template-default-hook) 3040 ("alias" . vhdl-template-alias-hook) 3041 ("all" . vhdl-template-default-hook) 3042 ("and" . vhdl-template-default-hook) 3043 ("arch" . vhdl-template-architecture-hook) 3044 ("architecture" . vhdl-template-architecture-hook) 3045 ("array" . vhdl-template-default-hook) 3046 ("assert" . vhdl-template-assert-hook) 3047 ("attr" . vhdl-template-attribute-hook) 3048 ("attribute" . vhdl-template-attribute-hook) 3049 ("begin" . vhdl-template-default-indent-hook) 3050 ("block" . vhdl-template-block-hook) 3051 ("body" . vhdl-template-default-hook) 3052 ("buffer" . vhdl-template-default-hook) 3053 ("bus" . vhdl-template-default-hook) 3054 ("case" . vhdl-template-case-hook) 3055 ("comp" . vhdl-template-component-hook) 3056 ("component" . vhdl-template-component-hook) 3057 ("cond" . vhdl-template-conditional-signal-asst-hook) 3058 ("conditional" . vhdl-template-conditional-signal-asst-hook) 3059 ("conf" . vhdl-template-configuration-hook) 3060 ("configuration" . vhdl-template-configuration-hook) 3061 ("cons" . vhdl-template-constant-hook) 3062 ("constant" . vhdl-template-constant-hook) 3063 ("context" . vhdl-template-context-hook) 3064 ("disconnect" . vhdl-template-disconnect-hook) 3065 ("downto" . vhdl-template-default-hook) 3066 ("else" . vhdl-template-else-hook) 3067 ("elseif" . vhdl-template-elsif-hook) 3068 ("elsif" . vhdl-template-elsif-hook) 3069 ("end" . vhdl-template-default-indent-hook) 3070 ("entity" . vhdl-template-entity-hook) 3071 ("exit" . vhdl-template-exit-hook) 3072 ("file" . vhdl-template-file-hook) 3073 ("for" . vhdl-template-for-hook) 3074 ("func" . vhdl-template-function-hook) 3075 ("function" . vhdl-template-function-hook) 3076 ("generic" . vhdl-template-generic-hook) 3077 ("group" . vhdl-template-group-hook) 3078 ("guarded" . vhdl-template-default-hook) 3079 ("if" . vhdl-template-if-hook) 3080 ("impure" . vhdl-template-default-hook) 3081 ("in" . vhdl-template-default-hook) 3082 ("inertial" . vhdl-template-default-hook) 3083 ("inout" . vhdl-template-default-hook) 3084 ("inst" . vhdl-template-instance-hook) 3085 ("instance" . vhdl-template-instance-hook) 3086 ("is" . vhdl-template-default-hook) 3087 ("label" . vhdl-template-default-hook) 3088 ("library" . vhdl-template-library-hook) 3089 ("linkage" . vhdl-template-default-hook) 3090 ("literal" . vhdl-template-default-hook) 3091 ("loop" . vhdl-template-bare-loop-hook) 3092 ("map" . vhdl-template-map-hook) 3093 ("mod" . vhdl-template-default-hook) 3094 ("nand" . vhdl-template-default-hook) 3095 ("new" . vhdl-template-default-hook) 3096 ("next" . vhdl-template-next-hook) 3097 ("nor" . vhdl-template-default-hook) 3098 ("not" . vhdl-template-default-hook) 3099 ("null" . vhdl-template-default-hook) 3100 ("of" . vhdl-template-default-hook) 3101 ("on" . vhdl-template-default-hook) 3102 ("open" . vhdl-template-default-hook) 3103 ("or" . vhdl-template-default-hook) 3104 ("others" . vhdl-template-others-hook) 3105 ("out" . vhdl-template-default-hook) 3106 ("pack" . vhdl-template-package-hook) 3107 ("package" . vhdl-template-package-hook) 3108 ("port" . vhdl-template-port-hook) 3109 ("postponed" . vhdl-template-default-hook) 3110 ("procedure" . vhdl-template-procedure-hook) 3111 ("process" . vhdl-template-process-hook) 3112 ("pure" . vhdl-template-default-hook) 3113 ("range" . vhdl-template-default-hook) 3114 ("record" . vhdl-template-default-hook) 3115 ("register" . vhdl-template-default-hook) 3116 ("reject" . vhdl-template-default-hook) 3117 ("rem" . vhdl-template-default-hook) 3118 ("report" . vhdl-template-report-hook) 3119 ("return" . vhdl-template-return-hook) 3120 ("rol" . vhdl-template-default-hook) 3121 ("ror" . vhdl-template-default-hook) 3122 ("select" . vhdl-template-selected-signal-asst-hook) 3123 ("severity" . vhdl-template-default-hook) 3124 ("shared" . vhdl-template-default-hook) 3125 ("sig" . vhdl-template-signal-hook) 3126 ("signal" . vhdl-template-signal-hook) 3127 ("sla" . vhdl-template-default-hook) 3128 ("sll" . vhdl-template-default-hook) 3129 ("sra" . vhdl-template-default-hook) 3130 ("srl" . vhdl-template-default-hook) 3131 ("subtype" . vhdl-template-subtype-hook) 3132 ("then" . vhdl-template-default-hook) 3133 ("to" . vhdl-template-default-hook) 3134 ("transport" . vhdl-template-default-hook) 3135 ("type" . vhdl-template-type-hook) 3136 ("unaffected" . vhdl-template-default-hook) 3137 ("units" . vhdl-template-default-hook) 3138 ("until" . vhdl-template-default-hook) 3139 ("use" . vhdl-template-use-hook) 3140 ("var" . vhdl-template-variable-hook) 3141 ("variable" . vhdl-template-variable-hook) 3142 ("wait" . vhdl-template-wait-hook) 3143 ("when" . vhdl-template-when-hook) 3144 ("while" . vhdl-template-while-loop-hook) 3145 ("with" . vhdl-template-with-hook) 3146 ("xnor" . vhdl-template-default-hook) 3147 ("xor" . vhdl-template-default-hook) 3148 ))) 3149 ;; VHDL-AMS keywords 3150 (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) 3151 (mapcar (if (featurep 'xemacs) 3152 (lambda (x) (list (car x) "" (cdr x) 0)) 3153 (lambda (x) (list (car x) "" (cdr x) 0 'system))) 3154 '( 3155 ("across" . vhdl-template-default-hook) 3156 ("break" . vhdl-template-break-hook) 3157 ("limit" . vhdl-template-limit-hook) 3158 ("nature" . vhdl-template-nature-hook) 3159 ("noise" . vhdl-template-default-hook) 3160 ("procedural" . vhdl-template-procedural-hook) 3161 ("quantity" . vhdl-template-quantity-hook) 3162 ("reference" . vhdl-template-default-hook) 3163 ("spectrum" . vhdl-template-default-hook) 3164 ("subnature" . vhdl-template-subnature-hook) 3165 ("terminal" . vhdl-template-terminal-hook) 3166 ("through" . vhdl-template-default-hook) 3167 ("tolerance" . vhdl-template-default-hook) 3168 ))) 3169 ;; user model keywords 3170 (when (memq 'user vhdl-electric-keywords) 3171 (let (abbrev-list keyword) 3172 (dolist (elem vhdl-model-alist) 3173 (setq keyword (nth 3 elem)) 3174 (unless (equal keyword "") 3175 (push (list keyword "" 3176 (vhdl-function-name 3177 "vhdl-model" (nth 0 elem) "hook") 3178 0 'system) 3179 abbrev-list))) 3180 abbrev-list))))) 3181 3182;; initialize abbrev table for VHDL Mode 3183(vhdl-mode-abbrev-table-init) 3184 3185;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3186;; Template completion lists 3187 3188(defvar vhdl-template-construct-alist nil 3189 "List of built-in construct templates.") 3190 3191(defun vhdl-template-construct-alist-init () 3192 "Initialize `vhdl-template-construct-alist'." 3193 (setq 3194 vhdl-template-construct-alist 3195 (append 3196 '( 3197 ("alias declaration" vhdl-template-alias) 3198 ("architecture body" vhdl-template-architecture) 3199 ("assertion" vhdl-template-assert) 3200 ("attribute declaration" vhdl-template-attribute-decl) 3201 ("attribute specification" vhdl-template-attribute-spec) 3202 ("block configuration" vhdl-template-block-configuration) 3203 ("block statement" vhdl-template-block) 3204 ("case statement" vhdl-template-case-is) 3205 ("component configuration" vhdl-template-component-conf) 3206 ("component declaration" vhdl-template-component-decl) 3207 ("component instantiation statement" vhdl-template-component-inst) 3208 ("conditional signal assignment" vhdl-template-conditional-signal-asst) 3209 ("configuration declaration" vhdl-template-configuration-decl) 3210 ("configuration specification" vhdl-template-configuration-spec) 3211 ("constant declaration" vhdl-template-constant) 3212 ("context declaration" vhdl-template-context) 3213 ("disconnection specification" vhdl-template-disconnect) 3214 ("entity declaration" vhdl-template-entity) 3215 ("exit statement" vhdl-template-exit) 3216 ("file declaration" vhdl-template-file) 3217 ("generate statement" vhdl-template-generate) 3218 ("generic clause" vhdl-template-generic) 3219 ("group declaration" vhdl-template-group-decl) 3220 ("group template declaration" vhdl-template-group-template) 3221 ("if statement" vhdl-template-if-then) 3222 ("library clause" vhdl-template-library) 3223 ("loop statement" vhdl-template-loop) 3224 ("next statement" vhdl-template-next) 3225 ("package declaration" vhdl-template-package-decl) 3226 ("package body" vhdl-template-package-body) 3227 ("port clause" vhdl-template-port) 3228 ("process statement" vhdl-template-process) 3229 ("report statement" vhdl-template-report) 3230 ("return statement" vhdl-template-return) 3231 ("selected signal assignment" vhdl-template-selected-signal-asst) 3232 ("signal declaration" vhdl-template-signal) 3233 ("subprogram declaration" vhdl-template-subprogram-decl) 3234 ("subprogram body" vhdl-template-subprogram-body) 3235 ("subtype declaration" vhdl-template-subtype) 3236 ("type declaration" vhdl-template-type) 3237 ("use clause" vhdl-template-use) 3238 ("variable declaration" vhdl-template-variable) 3239 ("wait statement" vhdl-template-wait) 3240 ) 3241 (when (vhdl-standard-p 'ams) 3242 '( 3243 ("break statement" vhdl-template-break) 3244 ("nature declaration" vhdl-template-nature) 3245 ("quantity declaration" vhdl-template-quantity) 3246 ("simultaneous case statement" vhdl-template-case-use) 3247 ("simultaneous if statement" vhdl-template-if-use) 3248 ("simultaneous procedural statement" vhdl-template-procedural) 3249 ("step limit specification" vhdl-template-limit) 3250 ("subnature declaration" vhdl-template-subnature) 3251 ("terminal declaration" vhdl-template-terminal) 3252 ))))) 3253 3254;; initialize for VHDL Mode 3255(vhdl-template-construct-alist-init) 3256 3257(defvar vhdl-template-package-alist nil 3258 "List of built-in package templates.") 3259 3260(defun vhdl-template-package-alist-init () 3261 "Initialize `vhdl-template-package-alist'." 3262 (setq 3263 vhdl-template-package-alist 3264 (append 3265 '( 3266 ("numeric_bit" vhdl-template-package-numeric-bit) 3267 ("numeric_std" vhdl-template-package-numeric-std) 3268 ("std_logic_1164" vhdl-template-package-std-logic-1164) 3269 ("std_logic_arith" vhdl-template-package-std-logic-arith) 3270 ("std_logic_misc" vhdl-template-package-std-logic-misc) 3271 ("std_logic_signed" vhdl-template-package-std-logic-signed) 3272 ("std_logic_textio" vhdl-template-package-std-logic-textio) 3273 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) 3274 ("textio" vhdl-template-package-textio) 3275 ) 3276 (when (vhdl-standard-p 'math) 3277 '( 3278 ("math_complex" vhdl-template-package-math-complex) 3279 ("math_real" vhdl-template-package-math-real) 3280 ))))) 3281 3282;; initialize for VHDL Mode 3283(vhdl-template-package-alist-init) 3284 3285(defvar vhdl-template-directive-alist 3286 '( 3287 ("translate_on" vhdl-template-directive-translate-on) 3288 ("translate_off" vhdl-template-directive-translate-off) 3289 ("synthesis_on" vhdl-template-directive-synthesis-on) 3290 ("synthesis_off" vhdl-template-directive-synthesis-off) 3291 ) 3292 "List of built-in directive templates.") 3293 3294 3295;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3296;;; Menus 3297;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3298 3299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3300;; VHDL menu (using `easy-menu.el') 3301 3302(defun vhdl-customize () 3303 "Call the customize function with `vhdl' as argument." 3304 (interactive) 3305 (customize-browse 'vhdl)) 3306 3307(defun vhdl-create-mode-menu () 3308 "Create VHDL Mode menu." 3309 `("VHDL" 3310 ,(append 3311 '("Project" 3312 ["None" (vhdl-set-project "") 3313 :style radio :selected (null vhdl-project)] 3314 "--") 3315 ;; add menu entries for defined projects 3316 (let ((project-alist vhdl-project-alist) menu-list name) 3317 (while project-alist 3318 (setq name (caar project-alist)) 3319 (setq menu-list 3320 (cons `[,name (vhdl-set-project ,name) 3321 :style radio :selected (equal ,name vhdl-project)] 3322 menu-list)) 3323 (setq project-alist (cdr project-alist))) 3324 (setq menu-list 3325 (if vhdl-project-sort 3326 (sort menu-list 3327 (lambda (a b) (string< (elt a 0) (elt b 0)))) 3328 (nreverse menu-list))) 3329 (vhdl-menu-split menu-list "Project")) 3330 '("--" "--" 3331 ["Select Project..." vhdl-set-project t] 3332 ["Set As Default Project" vhdl-set-default-project t] 3333 "--" 3334 ["Duplicate Project" vhdl-duplicate-project vhdl-project] 3335 ["Import Project..." vhdl-import-project 3336 :keys "C-c C-p C-m" :active t] 3337 ["Export Project" vhdl-export-project vhdl-project] 3338 "--" 3339 ["Customize Project..." (customize-option 'vhdl-project-alist) t])) 3340 "--" 3341 ("Compile" 3342 ["Compile Buffer" vhdl-compile t] 3343 ["Stop Compilation" kill-compilation t] 3344 "--" 3345 ["Make" vhdl-make t] 3346 ["Generate Makefile" vhdl-generate-makefile t] 3347 "--" 3348 ["Next Error" next-error t] 3349 ["Previous Error" previous-error t] 3350 ["First Error" first-error t] 3351 "--" 3352 ,(append 3353 '("Compiler") 3354 ;; add menu entries for defined compilers 3355 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3356 (while comp-alist 3357 (setq name (caar comp-alist)) 3358 (setq menu-list 3359 (cons `[,name (setq vhdl-compiler ,name) 3360 :style radio :selected (equal ,name vhdl-compiler)] 3361 menu-list)) 3362 (setq comp-alist (cdr comp-alist))) 3363 (setq menu-list (nreverse menu-list)) 3364 (vhdl-menu-split menu-list "Compiler")) 3365 '("--" "--" 3366 ["Select Compiler..." vhdl-set-compiler t] 3367 "--" 3368 ["Customize Compiler..." 3369 (customize-option 'vhdl-compiler-alist) t]))) 3370 "--" 3371 ,(append 3372 '("Template" 3373 ("VHDL Construct 1" 3374 ["Alias" vhdl-template-alias t] 3375 ["Architecture" vhdl-template-architecture t] 3376 ["Assert" vhdl-template-assert t] 3377 ["Attribute (Decl)" vhdl-template-attribute-decl t] 3378 ["Attribute (Spec)" vhdl-template-attribute-spec t] 3379 ["Block" vhdl-template-block t] 3380 ["Case" vhdl-template-case-is t] 3381 ["Component (Decl)" vhdl-template-component-decl t] 3382 ["(Component) Instance" vhdl-template-component-inst t] 3383 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] 3384 ["Configuration (Block)" vhdl-template-block-configuration t] 3385 ["Configuration (Comp)" vhdl-template-component-conf t] 3386 ["Configuration (Decl)" vhdl-template-configuration-decl t] 3387 ["Configuration (Spec)" vhdl-template-configuration-spec t] 3388 ["Constant" vhdl-template-constant t] 3389 ["Context" vhdl-template-context t] 3390 ["Disconnect" vhdl-template-disconnect t] 3391 ["Else" vhdl-template-else t] 3392 ["Elsif" vhdl-template-elsif t] 3393 ["Entity" vhdl-template-entity t] 3394 ["Exit" vhdl-template-exit t] 3395 ["File" vhdl-template-file t] 3396 ["For (Generate)" vhdl-template-for-generate t] 3397 ["For (Loop)" vhdl-template-for-loop t] 3398 ["Function (Body)" vhdl-template-function-body t] 3399 ["Function (Decl)" vhdl-template-function-decl t] 3400 ["Generic" vhdl-template-generic t] 3401 ["Group (Decl)" vhdl-template-group-decl t] 3402 ["Group (Template)" vhdl-template-group-template t]) 3403 ("VHDL Construct 2" 3404 ["If (Generate)" vhdl-template-if-generate t] 3405 ["If (Then)" vhdl-template-if-then t] 3406 ["Library" vhdl-template-library t] 3407 ["Loop" vhdl-template-bare-loop t] 3408 ["Map" vhdl-template-map t] 3409 ["Next" vhdl-template-next t] 3410 ["Others (Aggregate)" vhdl-template-others t] 3411 ["Package (Decl)" vhdl-template-package-decl t] 3412 ["Package (Body)" vhdl-template-package-body t] 3413 ["Port" vhdl-template-port t] 3414 ["Procedure (Body)" vhdl-template-procedure-body t] 3415 ["Procedure (Decl)" vhdl-template-procedure-decl t] 3416 ["Process (Comb)" vhdl-template-process-comb t] 3417 ["Process (Seq)" vhdl-template-process-seq t] 3418 ["Report" vhdl-template-report t] 3419 ["Return" vhdl-template-return t] 3420 ["Select" vhdl-template-selected-signal-asst t] 3421 ["Signal" vhdl-template-signal t] 3422 ["Subtype" vhdl-template-subtype t] 3423 ["Type" vhdl-template-type t] 3424 ["Use" vhdl-template-use t] 3425 ["Variable" vhdl-template-variable t] 3426 ["Wait" vhdl-template-wait t] 3427 ["(Clocked Wait)" vhdl-template-clocked-wait t] 3428 ["When" vhdl-template-when t] 3429 ["While (Loop)" vhdl-template-while-loop t] 3430 ["With" vhdl-template-with t])) 3431 (when (vhdl-standard-p 'ams) 3432 '(("VHDL-AMS Construct" 3433 ["Break" vhdl-template-break t] 3434 ["Case (Use)" vhdl-template-case-use t] 3435 ["If (Use)" vhdl-template-if-use t] 3436 ["Limit" vhdl-template-limit t] 3437 ["Nature" vhdl-template-nature t] 3438 ["Procedural" vhdl-template-procedural t] 3439 ["Quantity (Free)" vhdl-template-quantity-free t] 3440 ["Quantity (Branch)" vhdl-template-quantity-branch t] 3441 ["Quantity (Source)" vhdl-template-quantity-source t] 3442 ["Subnature" vhdl-template-subnature t] 3443 ["Terminal" vhdl-template-terminal t]))) 3444 '(["Insert Construct..." vhdl-template-insert-construct 3445 :keys "C-c C-i C-t"] 3446 "--") 3447 (list 3448 (append 3449 '("Package") 3450 '(["numeric_bit" vhdl-template-package-numeric-bit t] 3451 ["numeric_std" vhdl-template-package-numeric-std t] 3452 ["std_logic_1164" vhdl-template-package-std-logic-1164 t] 3453 ["textio" vhdl-template-package-textio t] 3454 "--" 3455 ["std_logic_arith" vhdl-template-package-std-logic-arith t] 3456 ["std_logic_signed" vhdl-template-package-std-logic-signed t] 3457 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] 3458 ["std_logic_misc" vhdl-template-package-std-logic-misc t] 3459 ["std_logic_textio" vhdl-template-package-std-logic-textio t] 3460 "--") 3461 (when (vhdl-standard-p 'ams) 3462 '(["fundamental_constants" vhdl-template-package-fundamental-constants t] 3463 ["material_constants" vhdl-template-package-material-constants t] 3464 ["energy_systems" vhdl-template-package-energy-systems t] 3465 ["electrical_systems" vhdl-template-package-electrical-systems t] 3466 ["mechanical_systems" vhdl-template-package-mechanical-systems t] 3467 ["radiant_systems" vhdl-template-package-radiant-systems t] 3468 ["thermal_systems" vhdl-template-package-thermal-systems t] 3469 ["fluidic_systems" vhdl-template-package-fluidic-systems t] 3470 "--")) 3471 (when (vhdl-standard-p 'math) 3472 '(["math_complex" vhdl-template-package-math-complex t] 3473 ["math_real" vhdl-template-package-math-real t] 3474 "--")) 3475 '(["Insert Package..." vhdl-template-insert-package 3476 :keys "C-c C-i C-p"]))) 3477 '(("Directive" 3478 ["translate_on" vhdl-template-directive-translate-on t] 3479 ["translate_off" vhdl-template-directive-translate-off t] 3480 ["synthesis_on" vhdl-template-directive-synthesis-on t] 3481 ["synthesis_off" vhdl-template-directive-synthesis-off t] 3482 "--" 3483 ["Insert Directive..." vhdl-template-insert-directive 3484 :keys "C-c C-i C-d"]) 3485 "--" 3486 ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] 3487 ["Insert Footer" vhdl-template-footer t] 3488 ["Insert Date" vhdl-template-insert-date t] 3489 ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] 3490 "--" 3491 ["Query Next Prompt" vhdl-template-search-prompt t])) 3492 ,(append 3493 '("Model") 3494 ;; add menu entries for defined models 3495 (let ((model-alist vhdl-model-alist) menu-list model) 3496 (while model-alist 3497 (setq model (car model-alist)) 3498 (setq menu-list 3499 (cons 3500 (vector 3501 (nth 0 model) 3502 (vhdl-function-name "vhdl-model" (nth 0 model)) 3503 :keys (concat "C-c C-m " (key-description (nth 2 model)))) 3504 menu-list)) 3505 (setq model-alist (cdr model-alist))) 3506 (setq menu-list (nreverse menu-list)) 3507 (vhdl-menu-split menu-list "Model")) 3508 '("--" "--" 3509 ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] 3510 ["Customize Model..." (customize-option 'vhdl-model-alist) t])) 3511 ("Port" 3512 ["Copy" vhdl-port-copy t] 3513 "--" 3514 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] 3515 ["Paste As Component" vhdl-port-paste-component vhdl-port-list] 3516 ["Paste As Instance" vhdl-port-paste-instance 3517 :keys "C-c C-p C-i" :active vhdl-port-list] 3518 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] 3519 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] 3520 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] 3521 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] 3522 "--" 3523 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] 3524 "--" 3525 ["Flatten" vhdl-port-flatten 3526 :style toggle :selected vhdl-port-flattened :active vhdl-port-list] 3527 ["Reverse Direction" vhdl-port-reverse-direction 3528 :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) 3529 ("Compose" 3530 ["New Component" vhdl-compose-new-component t] 3531 ["Copy Component" vhdl-port-copy t] 3532 ["Place Component" vhdl-compose-place-component vhdl-port-list] 3533 ["Wire Components" vhdl-compose-wire-components t] 3534 "--" 3535 ["Generate Configuration" vhdl-compose-configuration t] 3536 ["Generate Components Package" vhdl-compose-components-package t]) 3537 ("Subprogram" 3538 ["Copy" vhdl-subprog-copy t] 3539 "--" 3540 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] 3541 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] 3542 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] 3543 "--" 3544 ["Flatten" vhdl-subprog-flatten 3545 :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) 3546 "--" 3547 ("Comment" 3548 ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] 3549 "--" 3550 ["Insert Inline Comment" vhdl-comment-append-inline t] 3551 ["Insert Horizontal Line" vhdl-comment-display-line t] 3552 ["Insert Display Comment" vhdl-comment-display t] 3553 "--" 3554 ["Fill Comment" fill-paragraph t] 3555 ["Fill Comment Region" fill-region (mark)] 3556 ["Kill Comment Region" vhdl-comment-kill-region (mark)] 3557 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) 3558 ("Line" 3559 ["Kill" vhdl-line-kill t] 3560 ["Copy" vhdl-line-copy t] 3561 ["Yank" vhdl-line-yank t] 3562 ["Expand" vhdl-line-expand t] 3563 "--" 3564 ["Transpose Next" vhdl-line-transpose-next t] 3565 ["Transpose Prev" vhdl-line-transpose-previous t] 3566 ["Open" vhdl-line-open t] 3567 ["Join" vhdl-delete-indentation t] 3568 "--" 3569 ["Goto" goto-line t] 3570 ["(Un)Comment Out" vhdl-comment-uncomment-line t]) 3571 ("Move" 3572 ["Forward Statement" vhdl-end-of-statement t] 3573 ["Backward Statement" vhdl-beginning-of-statement t] 3574 ["Forward Expression" vhdl-forward-sexp t] 3575 ["Backward Expression" vhdl-backward-sexp t] 3576 ["Forward Same Indent" vhdl-forward-same-indent t] 3577 ["Backward Same Indent" vhdl-backward-same-indent t] 3578 ["Forward Function" vhdl-end-of-defun t] 3579 ["Backward Function" vhdl-beginning-of-defun t] 3580 ["Mark Function" vhdl-mark-defun t]) 3581 "--" 3582 ("Indent" 3583 ["Line" indent-according-to-mode :keys "C-c C-i C-l"] 3584 ["Group" vhdl-indent-group :keys "C-c C-i C-g"] 3585 ["Region" indent-region (mark)] 3586 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) 3587 ("Align" 3588 ["Group" vhdl-align-group t] 3589 ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] 3590 ["List" vhdl-align-list t] 3591 ["Declarations" vhdl-align-declarations t] 3592 ["Region" vhdl-align-region (mark)] 3593 ["Buffer" vhdl-align-buffer t] 3594 "--" 3595 ["Inline Comment Group" vhdl-align-inline-comment-group t] 3596 ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] 3597 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) 3598 ("Fill" 3599 ["List" vhdl-fill-list t] 3600 ["Group" vhdl-fill-group t] 3601 ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] 3602 ["Region" vhdl-fill-region (mark)]) 3603 ("Beautify" 3604 ["Region" vhdl-beautify-region (mark)] 3605 ["Buffer" vhdl-beautify-buffer t]) 3606 ("Fix" 3607 ["Generic/Port Clause" vhdl-fix-clause t] 3608 ["Generic/Port Clause Buffer" vhdl-fix-clause t] 3609 "--" 3610 ["Case Region" vhdl-fix-case-region (mark)] 3611 ["Case Buffer" vhdl-fix-case-buffer t] 3612 "--" 3613 ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] 3614 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] 3615 "--" 3616 ["Statement Region" vhdl-fix-statement-region (mark)] 3617 ["Statement Buffer" vhdl-fix-statement-buffer t] 3618 "--" 3619 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) 3620 ("Update" 3621 ["Sensitivity List" vhdl-update-sensitivity-list-process t] 3622 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) 3623 "--" 3624 ["Fontify Buffer" vhdl-fontify-buffer t] 3625 ["Statistics Buffer" vhdl-statistics-buffer t] 3626 ["Show Messages" vhdl-show-messages t] 3627 ["Syntactic Info" vhdl-show-syntactic-information t] 3628 "--" 3629 ["Speedbar" vhdl-speedbar t] 3630 ["Hide/Show" vhdl-hs-minor-mode t] 3631 "--" 3632 ("Documentation" 3633 ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] 3634 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] 3635 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] 3636 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) 3637 ["Version" vhdl-version t] 3638 ["Bug Report..." vhdl-submit-bug-report t] 3639 "--" 3640 ("Options" 3641 ("Mode" 3642 ["Electric Mode" 3643 (progn (customize-set-variable 'vhdl-electric-mode 3644 (not vhdl-electric-mode)) 3645 (vhdl-mode-line-update)) 3646 :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] 3647 ["Stutter Mode" 3648 (progn (customize-set-variable 'vhdl-stutter-mode 3649 (not vhdl-stutter-mode)) 3650 (vhdl-mode-line-update)) 3651 :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] 3652 ["Indent Tabs Mode" 3653 (progn (customize-set-variable 'vhdl-indent-tabs-mode 3654 (not vhdl-indent-tabs-mode)) 3655 (setq indent-tabs-mode vhdl-indent-tabs-mode)) 3656 :style toggle :selected vhdl-indent-tabs-mode] 3657 "--" 3658 ["Customize Group..." (customize-group 'vhdl-mode) t]) 3659 ("Project" 3660 ["Project Setup..." (customize-option 'vhdl-project-alist) t] 3661 ,(append 3662 '("Selected Project at Startup" 3663 ["None" (progn (customize-set-variable 'vhdl-project nil) 3664 (vhdl-set-project "")) 3665 :style radio :selected (null vhdl-project)] 3666 "--") 3667 ;; add menu entries for defined projects 3668 (let ((project-alist vhdl-project-alist) menu-list name) 3669 (while project-alist 3670 (setq name (caar project-alist)) 3671 (setq menu-list 3672 (cons `[,name (progn (customize-set-variable 3673 'vhdl-project ,name) 3674 (vhdl-set-project ,name)) 3675 :style radio :selected (equal ,name vhdl-project)] 3676 menu-list)) 3677 (setq project-alist (cdr project-alist))) 3678 (setq menu-list (nreverse menu-list)) 3679 (vhdl-menu-split menu-list "Project"))) 3680 ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] 3681 ("Auto Load Setup File" 3682 ["At Startup" 3683 (customize-set-variable 'vhdl-project-autoload 3684 (if (memq 'startup vhdl-project-autoload) 3685 (delq 'startup vhdl-project-autoload) 3686 (cons 'startup vhdl-project-autoload))) 3687 :style toggle :selected (memq 'startup vhdl-project-autoload)]) 3688 ["Sort Projects" 3689 (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) 3690 :style toggle :selected vhdl-project-sort] 3691 "--" 3692 ["Customize Group..." (customize-group 'vhdl-project) t]) 3693 ("Compiler" 3694 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] 3695 ,(append 3696 '("Selected Compiler at Startup") 3697 ;; add menu entries for defined compilers 3698 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3699 (while comp-alist 3700 (setq name (caar comp-alist)) 3701 (setq menu-list 3702 (cons `[,name (customize-set-variable 'vhdl-compiler ,name) 3703 :style radio :selected (equal ,name vhdl-compiler)] 3704 menu-list)) 3705 (setq comp-alist (cdr comp-alist))) 3706 (setq menu-list (nreverse menu-list)) 3707 (vhdl-menu-split menu-list "Compiler"))) 3708 ["Use Local Error Regexp" 3709 (customize-set-variable 'vhdl-compile-use-local-error-regexp 3710 (not vhdl-compile-use-local-error-regexp)) 3711 :style toggle :selected vhdl-compile-use-local-error-regexp] 3712 ["Makefile Default Targets..." 3713 (customize-option 'vhdl-makefile-default-targets) t] 3714 ["Makefile Generation Hook..." 3715 (customize-option 'vhdl-makefile-generation-hook) t] 3716 ["Default Library Name" (customize-option 'vhdl-default-library) t] 3717 "--" 3718 ["Customize Group..." (customize-group 'vhdl-compiler) t]) 3719 ("Style" 3720 ("VHDL Standard" 3721 ["VHDL'87" 3722 (progn (customize-set-variable 'vhdl-standard 3723 (list '87 (cadr vhdl-standard))) 3724 (vhdl-activate-customizations)) 3725 :style radio :selected (eq '87 (car vhdl-standard))] 3726 ["VHDL'93/02" 3727 (progn (customize-set-variable 'vhdl-standard 3728 (list '93 (cadr vhdl-standard))) 3729 (vhdl-activate-customizations)) 3730 :style radio :selected (eq '93 (car vhdl-standard))] 3731 ["VHDL'08" 3732 (progn (customize-set-variable 'vhdl-standard 3733 (list '08 (cadr vhdl-standard))) 3734 (vhdl-activate-customizations)) 3735 :style radio :selected (eq '08 (car vhdl-standard))] 3736 "--" 3737 ["VHDL-AMS" 3738 (progn (customize-set-variable 3739 'vhdl-standard (list (car vhdl-standard) 3740 (if (memq 'ams (cadr vhdl-standard)) 3741 (delq 'ams (cadr vhdl-standard)) 3742 (cons 'ams (cadr vhdl-standard))))) 3743 (vhdl-activate-customizations)) 3744 :style toggle :selected (memq 'ams (cadr vhdl-standard))] 3745 ["Math Packages" 3746 (progn (customize-set-variable 3747 'vhdl-standard (list (car vhdl-standard) 3748 (if (memq 'math (cadr vhdl-standard)) 3749 (delq 'math (cadr vhdl-standard)) 3750 (cons 'math (cadr vhdl-standard))))) 3751 (vhdl-activate-customizations)) 3752 :style toggle :selected (memq 'math (cadr vhdl-standard))]) 3753 ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] 3754 ["Upper Case Keywords" 3755 (customize-set-variable 'vhdl-upper-case-keywords 3756 (not vhdl-upper-case-keywords)) 3757 :style toggle :selected vhdl-upper-case-keywords] 3758 ["Upper Case Types" 3759 (customize-set-variable 'vhdl-upper-case-types 3760 (not vhdl-upper-case-types)) 3761 :style toggle :selected vhdl-upper-case-types] 3762 ["Upper Case Attributes" 3763 (customize-set-variable 'vhdl-upper-case-attributes 3764 (not vhdl-upper-case-attributes)) 3765 :style toggle :selected vhdl-upper-case-attributes] 3766 ["Upper Case Enumeration Values" 3767 (customize-set-variable 'vhdl-upper-case-enum-values 3768 (not vhdl-upper-case-enum-values)) 3769 :style toggle :selected vhdl-upper-case-enum-values] 3770 ["Upper Case Constants" 3771 (customize-set-variable 'vhdl-upper-case-constants 3772 (not vhdl-upper-case-constants)) 3773 :style toggle :selected vhdl-upper-case-constants] 3774 ("Use Direct Instantiation" 3775 ["Never" 3776 (customize-set-variable 'vhdl-use-direct-instantiation 'never) 3777 :style radio :selected (eq 'never vhdl-use-direct-instantiation)] 3778 ["Standard" 3779 (customize-set-variable 'vhdl-use-direct-instantiation 'standard) 3780 :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] 3781 ["Always" 3782 (customize-set-variable 'vhdl-use-direct-instantiation 'always) 3783 :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) 3784 ["Include Array Index and Record Field in Sensitivity List" 3785 (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list 3786 (not vhdl-array-index-record-field-in-sensitivity-list)) 3787 :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list] 3788 "--" 3789 ["Customize Group..." (customize-group 'vhdl-style) t]) 3790 ("Naming" 3791 ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] 3792 ["Architecture File Name..." 3793 (customize-option 'vhdl-architecture-file-name) t] 3794 ["Configuration File Name..." 3795 (customize-option 'vhdl-configuration-file-name) t] 3796 ["Package File Name..." (customize-option 'vhdl-package-file-name) t] 3797 ("File Name Case" 3798 ["As Is" 3799 (customize-set-variable 'vhdl-file-name-case 'identity) 3800 :style radio :selected (eq 'identity vhdl-file-name-case)] 3801 ["Lower Case" 3802 (customize-set-variable 'vhdl-file-name-case 'downcase) 3803 :style radio :selected (eq 'downcase vhdl-file-name-case)] 3804 ["Upper Case" 3805 (customize-set-variable 'vhdl-file-name-case 'upcase) 3806 :style radio :selected (eq 'upcase vhdl-file-name-case)] 3807 ["Capitalize" 3808 (customize-set-variable 'vhdl-file-name-case 'capitalize) 3809 :style radio :selected (eq 'capitalize vhdl-file-name-case)]) 3810 "--" 3811 ["Customize Group..." (customize-group 'vhdl-naming) t]) 3812 ("Template" 3813 ("Electric Keywords" 3814 ["VHDL Keywords" 3815 (customize-set-variable 'vhdl-electric-keywords 3816 (if (memq 'vhdl vhdl-electric-keywords) 3817 (delq 'vhdl vhdl-electric-keywords) 3818 (cons 'vhdl vhdl-electric-keywords))) 3819 :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] 3820 ["User Model Keywords" 3821 (customize-set-variable 'vhdl-electric-keywords 3822 (if (memq 'user vhdl-electric-keywords) 3823 (delq 'user vhdl-electric-keywords) 3824 (cons 'user vhdl-electric-keywords))) 3825 :style toggle :selected (memq 'user vhdl-electric-keywords)]) 3826 ("Insert Optional Labels" 3827 ["None" 3828 (customize-set-variable 'vhdl-optional-labels 'none) 3829 :style radio :selected (eq 'none vhdl-optional-labels)] 3830 ["Processes Only" 3831 (customize-set-variable 'vhdl-optional-labels 'process) 3832 :style radio :selected (eq 'process vhdl-optional-labels)] 3833 ["All Constructs" 3834 (customize-set-variable 'vhdl-optional-labels 'all) 3835 :style radio :selected (eq 'all vhdl-optional-labels)]) 3836 ("Insert Empty Lines" 3837 ["None" 3838 (customize-set-variable 'vhdl-insert-empty-lines 'none) 3839 :style radio :selected (eq 'none vhdl-insert-empty-lines)] 3840 ["Design Units Only" 3841 (customize-set-variable 'vhdl-insert-empty-lines 'unit) 3842 :style radio :selected (eq 'unit vhdl-insert-empty-lines)] 3843 ["All Constructs" 3844 (customize-set-variable 'vhdl-insert-empty-lines 'all) 3845 :style radio :selected (eq 'all vhdl-insert-empty-lines)]) 3846 ["Argument List Indent" 3847 (customize-set-variable 'vhdl-argument-list-indent 3848 (not vhdl-argument-list-indent)) 3849 :style toggle :selected vhdl-argument-list-indent] 3850 ["Association List with Formals" 3851 (customize-set-variable 'vhdl-association-list-with-formals 3852 (not vhdl-association-list-with-formals)) 3853 :style toggle :selected vhdl-association-list-with-formals] 3854 ["Conditions in Parenthesis" 3855 (customize-set-variable 'vhdl-conditions-in-parenthesis 3856 (not vhdl-conditions-in-parenthesis)) 3857 :style toggle :selected vhdl-conditions-in-parenthesis] 3858 ["Sensitivity List uses 'all'" 3859 (customize-set-variable 'vhdl-sensitivity-list-all 3860 (not vhdl-sensitivity-list-all)) 3861 :style toggle :selected vhdl-sensitivity-list-all] 3862 ["Zero String..." (customize-option 'vhdl-zero-string) t] 3863 ["One String..." (customize-option 'vhdl-one-string) t] 3864 ("File Header" 3865 ["Header String..." (customize-option 'vhdl-file-header) t] 3866 ["Footer String..." (customize-option 'vhdl-file-footer) t] 3867 ["Company Name..." (customize-option 'vhdl-company-name) t] 3868 ["Copyright String..." (customize-option 'vhdl-copyright-string) t] 3869 ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] 3870 ["Date Format..." (customize-option 'vhdl-date-format) t] 3871 ["Modify Date Prefix String..." 3872 (customize-option 'vhdl-modify-date-prefix-string) t] 3873 ["Modify Date on Saving" 3874 (progn (customize-set-variable 'vhdl-modify-date-on-saving 3875 (not vhdl-modify-date-on-saving)) 3876 (vhdl-activate-customizations)) 3877 :style toggle :selected vhdl-modify-date-on-saving]) 3878 ("Sequential Process" 3879 ("Kind of Reset" 3880 ["None" 3881 (customize-set-variable 'vhdl-reset-kind 'none) 3882 :style radio :selected (eq 'none vhdl-reset-kind)] 3883 ["Synchronous" 3884 (customize-set-variable 'vhdl-reset-kind 'sync) 3885 :style radio :selected (eq 'sync vhdl-reset-kind)] 3886 ["Asynchronous" 3887 (customize-set-variable 'vhdl-reset-kind 'async) 3888 :style radio :selected (eq 'async vhdl-reset-kind)] 3889 ["Query" 3890 (customize-set-variable 'vhdl-reset-kind 'query) 3891 :style radio :selected (eq 'query vhdl-reset-kind)]) 3892 ["Reset is Active High" 3893 (customize-set-variable 'vhdl-reset-active-high 3894 (not vhdl-reset-active-high)) 3895 :style toggle :selected vhdl-reset-active-high] 3896 ["Use Rising Clock Edge" 3897 (customize-set-variable 'vhdl-clock-rising-edge 3898 (not vhdl-clock-rising-edge)) 3899 :style toggle :selected vhdl-clock-rising-edge] 3900 ("Clock Edge Condition" 3901 ["Standard" 3902 (customize-set-variable 'vhdl-clock-edge-condition 'standard) 3903 :style radio :selected (eq 'standard vhdl-clock-edge-condition)] 3904 ["Function \"rising_edge\"" 3905 (customize-set-variable 'vhdl-clock-edge-condition 'function) 3906 :style radio :selected (eq 'function vhdl-clock-edge-condition)]) 3907 ["Clock Name..." (customize-option 'vhdl-clock-name) t] 3908 ["Reset Name..." (customize-option 'vhdl-reset-name) t]) 3909 "--" 3910 ["Customize Group..." (customize-group 'vhdl-template) t]) 3911 ("Model" 3912 ["Model Definition..." (customize-option 'vhdl-model-alist) t]) 3913 ("Port" 3914 ["Include Port Comments" 3915 (customize-set-variable 'vhdl-include-port-comments 3916 (not vhdl-include-port-comments)) 3917 :style toggle :selected vhdl-include-port-comments] 3918 ["Include Direction Comments" 3919 (customize-set-variable 'vhdl-include-direction-comments 3920 (not vhdl-include-direction-comments)) 3921 :style toggle :selected vhdl-include-direction-comments] 3922 ["Include Type Comments" 3923 (customize-set-variable 'vhdl-include-type-comments 3924 (not vhdl-include-type-comments)) 3925 :style toggle :selected vhdl-include-type-comments] 3926 ("Include Group Comments" 3927 ["Never" 3928 (customize-set-variable 'vhdl-include-group-comments 'never) 3929 :style radio :selected (eq 'never vhdl-include-group-comments)] 3930 ["Declarations" 3931 (customize-set-variable 'vhdl-include-group-comments 'decl) 3932 :style radio :selected (eq 'decl vhdl-include-group-comments)] 3933 ["Always" 3934 (customize-set-variable 'vhdl-include-group-comments 'always) 3935 :style radio :selected (eq 'always vhdl-include-group-comments)]) 3936 ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] 3937 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] 3938 ["Instance Name..." (customize-option 'vhdl-instance-name) t] 3939 ("Testbench" 3940 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] 3941 ["Architecture Name..." 3942 (customize-option 'vhdl-testbench-architecture-name) t] 3943 ["Configuration Name..." 3944 (customize-option 'vhdl-testbench-configuration-name) t] 3945 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] 3946 ["Include Header" 3947 (customize-set-variable 'vhdl-testbench-include-header 3948 (not vhdl-testbench-include-header)) 3949 :style toggle :selected vhdl-testbench-include-header] 3950 ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] 3951 ["Statements..." (customize-option 'vhdl-testbench-statements) t] 3952 ["Initialize Signals" 3953 (customize-set-variable 'vhdl-testbench-initialize-signals 3954 (not vhdl-testbench-initialize-signals)) 3955 :style toggle :selected vhdl-testbench-initialize-signals] 3956 ["Include Library Clause" 3957 (customize-set-variable 'vhdl-testbench-include-library 3958 (not vhdl-testbench-include-library)) 3959 :style toggle :selected vhdl-testbench-include-library] 3960 ["Include Configuration" 3961 (customize-set-variable 'vhdl-testbench-include-configuration 3962 (not vhdl-testbench-include-configuration)) 3963 :style toggle :selected vhdl-testbench-include-configuration] 3964 ("Create Files" 3965 ["None" 3966 (customize-set-variable 'vhdl-testbench-create-files 'none) 3967 :style radio :selected (eq 'none vhdl-testbench-create-files)] 3968 ["Single" 3969 (customize-set-variable 'vhdl-testbench-create-files 'single) 3970 :style radio :selected (eq 'single vhdl-testbench-create-files)] 3971 ["Separate" 3972 (customize-set-variable 'vhdl-testbench-create-files 'separate) 3973 :style radio :selected (eq 'separate vhdl-testbench-create-files)]) 3974 ["Testbench Entity File Name..." 3975 (customize-option 'vhdl-testbench-entity-file-name) t] 3976 ["Testbench Architecture File Name..." 3977 (customize-option 'vhdl-testbench-architecture-file-name) t]) 3978 "--" 3979 ["Customize Group..." (customize-group 'vhdl-port) t]) 3980 ("Compose" 3981 ["Architecture Name..." 3982 (customize-option 'vhdl-compose-architecture-name) t] 3983 ["Configuration Name..." 3984 (customize-option 'vhdl-compose-configuration-name) t] 3985 ["Components Package Name..." 3986 (customize-option 'vhdl-components-package-name) t] 3987 ["Use Components Package" 3988 (customize-set-variable 'vhdl-use-components-package 3989 (not vhdl-use-components-package)) 3990 :style toggle :selected vhdl-use-components-package] 3991 ["Include Header" 3992 (customize-set-variable 'vhdl-compose-include-header 3993 (not vhdl-compose-include-header)) 3994 :style toggle :selected vhdl-compose-include-header] 3995 ("Create Entity/Architecture Files" 3996 ["None" 3997 (customize-set-variable 'vhdl-compose-create-files 'none) 3998 :style radio :selected (eq 'none vhdl-compose-create-files)] 3999 ["Single" 4000 (customize-set-variable 'vhdl-compose-create-files 'single) 4001 :style radio :selected (eq 'single vhdl-compose-create-files)] 4002 ["Separate" 4003 (customize-set-variable 'vhdl-compose-create-files 'separate) 4004 :style radio :selected (eq 'separate vhdl-compose-create-files)]) 4005 ["Create Configuration File" 4006 (customize-set-variable 'vhdl-compose-configuration-create-file 4007 (not vhdl-compose-configuration-create-file)) 4008 :style toggle :selected vhdl-compose-configuration-create-file] 4009 ["Hierarchical Configuration" 4010 (customize-set-variable 'vhdl-compose-configuration-hierarchical 4011 (not vhdl-compose-configuration-hierarchical)) 4012 :style toggle :selected vhdl-compose-configuration-hierarchical] 4013 ["Use Subconfiguration" 4014 (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration 4015 (not vhdl-compose-configuration-use-subconfiguration)) 4016 :style toggle :selected vhdl-compose-configuration-use-subconfiguration] 4017 "--" 4018 ["Customize Group..." (customize-group 'vhdl-compose) t]) 4019 ("Comment" 4020 ["Self Insert Comments" 4021 (customize-set-variable 'vhdl-self-insert-comments 4022 (not vhdl-self-insert-comments)) 4023 :style toggle :selected vhdl-self-insert-comments] 4024 ["Prompt for Comments" 4025 (customize-set-variable 'vhdl-prompt-for-comments 4026 (not vhdl-prompt-for-comments)) 4027 :style toggle :selected vhdl-prompt-for-comments] 4028 ["Inline Comment Column..." 4029 (customize-option 'vhdl-inline-comment-column) t] 4030 ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] 4031 "--" 4032 ["Customize Group..." (customize-group 'vhdl-comment) t]) 4033 ("Beautify" 4034 ["Auto Align Templates" 4035 (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) 4036 :style toggle :selected vhdl-auto-align] 4037 ["Align Line Groups" 4038 (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) 4039 :style toggle :selected vhdl-align-groups] 4040 ["Group Separation String..." 4041 (customize-option 'vhdl-align-group-separate) t] 4042 ["Align Lines with Same Indent" 4043 (customize-set-variable 'vhdl-align-same-indent 4044 (not vhdl-align-same-indent)) 4045 :style toggle :selected vhdl-align-same-indent] 4046 ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] 4047 "--" 4048 ["Customize Group..." (customize-group 'vhdl-beautify) t]) 4049 ("Highlight" 4050 ["Highlighting On/Off..." 4051 (customize-option 4052 (if (fboundp 'global-font-lock-mode) 4053 'global-font-lock-mode 'font-lock-auto-fontify)) t] 4054 ["Highlight Keywords" 4055 (progn (customize-set-variable 'vhdl-highlight-keywords 4056 (not vhdl-highlight-keywords)) 4057 (vhdl-fontify-buffer)) 4058 :style toggle :selected vhdl-highlight-keywords] 4059 ["Highlight Names" 4060 (progn (customize-set-variable 'vhdl-highlight-names 4061 (not vhdl-highlight-names)) 4062 (vhdl-fontify-buffer)) 4063 :style toggle :selected vhdl-highlight-names] 4064 ["Highlight Special Words" 4065 (progn (customize-set-variable 'vhdl-highlight-special-words 4066 (not vhdl-highlight-special-words)) 4067 (vhdl-fontify-buffer)) 4068 :style toggle :selected vhdl-highlight-special-words] 4069 ["Highlight Forbidden Words" 4070 (progn (customize-set-variable 'vhdl-highlight-forbidden-words 4071 (not vhdl-highlight-forbidden-words)) 4072 (vhdl-fontify-buffer)) 4073 :style toggle :selected vhdl-highlight-forbidden-words] 4074 ["Highlight Verilog Keywords" 4075 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords 4076 (not vhdl-highlight-verilog-keywords)) 4077 (vhdl-fontify-buffer)) 4078 :style toggle :selected vhdl-highlight-verilog-keywords] 4079 ["Highlight \"translate_off\"" 4080 (progn (customize-set-variable 'vhdl-highlight-translate-off 4081 (not vhdl-highlight-translate-off)) 4082 (vhdl-fontify-buffer)) 4083 :style toggle :selected vhdl-highlight-translate-off] 4084 ["Case Sensitive Highlighting" 4085 (progn (customize-set-variable 'vhdl-highlight-case-sensitive 4086 (not vhdl-highlight-case-sensitive)) 4087 (vhdl-fontify-buffer)) 4088 :style toggle :selected vhdl-highlight-case-sensitive] 4089 ["Special Syntax Definition..." 4090 (customize-option 'vhdl-special-syntax-alist) t] 4091 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] 4092 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] 4093 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] 4094 ["Colors..." (customize-group 'vhdl-highlight-faces) t] 4095 "--" 4096 ["Customize Group..." (customize-group 'vhdl-highlight) t]) 4097 ("Speedbar" 4098 ["Auto Open at Startup" 4099 (customize-set-variable 'vhdl-speedbar-auto-open 4100 (not vhdl-speedbar-auto-open)) 4101 :style toggle :selected vhdl-speedbar-auto-open] 4102 ("Default Displaying Mode" 4103 ["Files" 4104 (customize-set-variable 'vhdl-speedbar-display-mode 'files) 4105 :style radio :selected (eq 'files vhdl-speedbar-display-mode)] 4106 ["Directory Hierarchy" 4107 (customize-set-variable 'vhdl-speedbar-display-mode 'directory) 4108 :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] 4109 ["Project Hierarchy" 4110 (customize-set-variable 'vhdl-speedbar-display-mode 'project) 4111 :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) 4112 ["Indentation Offset..." 4113 (customize-option 'speedbar-indentation-width) t] 4114 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] 4115 ["Jump to Unit when Opening" 4116 (customize-set-variable 'vhdl-speedbar-jump-to-unit 4117 (not vhdl-speedbar-jump-to-unit)) 4118 :style toggle :selected vhdl-speedbar-jump-to-unit] 4119 ["Update Hierarchy on File Saving" 4120 (customize-set-variable 'vhdl-speedbar-update-on-saving 4121 (not vhdl-speedbar-update-on-saving)) 4122 :style toggle :selected vhdl-speedbar-update-on-saving] 4123 ("Save in Cache File" 4124 ["Hierarchy Information" 4125 (customize-set-variable 'vhdl-speedbar-save-cache 4126 (if (memq 'hierarchy vhdl-speedbar-save-cache) 4127 (delq 'hierarchy vhdl-speedbar-save-cache) 4128 (cons 'hierarchy vhdl-speedbar-save-cache))) 4129 :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] 4130 ["Displaying Status" 4131 (customize-set-variable 'vhdl-speedbar-save-cache 4132 (if (memq 'display vhdl-speedbar-save-cache) 4133 (delq 'display vhdl-speedbar-save-cache) 4134 (cons 'display vhdl-speedbar-save-cache))) 4135 :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) 4136 ["Cache File Name..." 4137 (customize-option 'vhdl-speedbar-cache-file-name) t] 4138 "--" 4139 ["Customize Group..." (customize-group 'vhdl-speedbar) t]) 4140 ("Menu" 4141 ["Add Index Menu when Loading File" 4142 (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) 4143 (vhdl-index-menu-init)) 4144 :style toggle :selected vhdl-index-menu] 4145 ["Add Source File Menu when Loading File" 4146 (progn (customize-set-variable 'vhdl-source-file-menu 4147 (not vhdl-source-file-menu)) 4148 (vhdl-add-source-files-menu)) 4149 :style toggle :selected vhdl-source-file-menu] 4150 ["Add Hideshow Menu at Startup" 4151 (progn (customize-set-variable 'vhdl-hideshow-menu 4152 (not vhdl-hideshow-menu)) 4153 (vhdl-activate-customizations)) 4154 :style toggle :selected vhdl-hideshow-menu] 4155 ["Hide Everything Initially" 4156 (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) 4157 :style toggle :selected vhdl-hide-all-init] 4158 "--" 4159 ["Customize Group..." (customize-group 'vhdl-menu) t]) 4160 ("Print" 4161 ["In Two Column Format" 4162 (progn (customize-set-variable 'vhdl-print-two-column 4163 (not vhdl-print-two-column)) 4164 (message "Activate new setting by saving options and restarting Emacs")) 4165 :style toggle :selected vhdl-print-two-column] 4166 ["Use Customized Faces" 4167 (progn (customize-set-variable 'vhdl-print-customize-faces 4168 (not vhdl-print-customize-faces)) 4169 (message "Activate new setting by saving options and restarting Emacs")) 4170 :style toggle :selected vhdl-print-customize-faces] 4171 "--" 4172 ["Customize Group..." (customize-group 'vhdl-print) t]) 4173 ("Miscellaneous" 4174 ["Use Intelligent Tab" 4175 (progn (customize-set-variable 'vhdl-intelligent-tab 4176 (not vhdl-intelligent-tab)) 4177 (vhdl-activate-customizations)) 4178 :style toggle :selected vhdl-intelligent-tab] 4179 ["Indent Syntax-Based" 4180 (customize-set-variable 'vhdl-indent-syntax-based 4181 (not vhdl-indent-syntax-based)) 4182 :style toggle :selected vhdl-indent-syntax-based] 4183 ["Indent Comments Like Next Code Line" 4184 (customize-set-variable 'vhdl-indent-comment-like-next-code-line 4185 (not vhdl-indent-comment-like-next-code-line)) 4186 :style toggle :selected vhdl-indent-comment-like-next-code-line] 4187 ["Word Completion is Case Sensitive" 4188 (customize-set-variable 'vhdl-word-completion-case-sensitive 4189 (not vhdl-word-completion-case-sensitive)) 4190 :style toggle :selected vhdl-word-completion-case-sensitive] 4191 ["Word Completion in Minibuffer" 4192 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer 4193 (not vhdl-word-completion-in-minibuffer)) 4194 (message "Activate new setting by saving options and restarting Emacs")) 4195 :style toggle :selected vhdl-word-completion-in-minibuffer] 4196 ["Underscore is Part of Word" 4197 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word 4198 (not vhdl-underscore-is-part-of-word)) 4199 (vhdl-activate-customizations)) 4200 :style toggle :selected vhdl-underscore-is-part-of-word] 4201 "--" 4202 ["Customize Group..." (customize-group 'vhdl-misc) t]) 4203 ["Related..." (customize-browse 'vhdl-related) t] 4204 "--" 4205 ["Save Options" customize-save-customized t] 4206 ["Activate Options" vhdl-activate-customizations t] 4207 ["Browse Options..." vhdl-customize t]))) 4208 4209(defvar vhdl-mode-menu-list (vhdl-create-mode-menu) 4210 "VHDL Mode menu.") 4211 4212(defun vhdl-update-mode-menu () 4213 "Update VHDL Mode menu." 4214 (interactive) 4215 (when (featurep 'xemacs) 4216 (easy-menu-remove vhdl-mode-menu-list)) 4217 (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) 4218 (when (featurep 'xemacs) 4219 (easy-menu-add vhdl-mode-menu-list)) 4220 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4221 "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) 4222 4223;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4224;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') 4225 4226(defconst vhdl-imenu-generic-expression 4227 '( 4228 ("Subprogram" 4229 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" 4230 4) 4231 ("Instance" 4232 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" 4233 1) 4234 ("Component" 4235 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4236 2) 4237 ("Procedural" 4238 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" 4239 1) 4240 ("Process" 4241 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" 4242 1) 4243 ("Block" 4244 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" 4245 1) 4246 ("Package" 4247 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4248 3) 4249 ("Configuration" 4250 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4251 2) 4252 ("Architecture" 4253 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4254 2) 4255 ("Entity" 4256 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4257 2) 4258 ("Context" 4259 "^\\s-*\\(context\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4260 2) 4261 ) 4262 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") 4263 4264(defun vhdl-index-menu-init () 4265 "Initialize index menu." 4266 (set (make-local-variable 'imenu-case-fold-search) t) 4267 (set (make-local-variable 'imenu-generic-expression) 4268 vhdl-imenu-generic-expression) 4269 (when (and vhdl-index-menu (fboundp 'imenu)) 4270 (imenu-add-to-menubar "Index"))) 4271 4272;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4273;; Source file menu (using `easy-menu.el') 4274 4275(defvar vhdl-sources-menu nil) 4276 4277(defun vhdl-directory-files (directory &optional full match) 4278 "Call `directory-files' if DIRECTORY exists, otherwise generate error message." 4279 (if (not (file-directory-p directory)) 4280 (vhdl-warning-when-idle "No such directory: \"%s\"" directory) 4281 (let ((dir (directory-files directory full match))) 4282 (setq dir (delete "." dir)) 4283 (setq dir (delete ".." dir)) 4284 dir))) 4285 4286(defun vhdl-get-source-files (&optional full directory) 4287 "Get list of VHDL source files in DIRECTORY or current directory." 4288 (let ((mode-alist auto-mode-alist) 4289 filename-regexp) 4290 ;; create regular expressions for matching file names 4291 (setq filename-regexp "\\`[^.].*\\(") 4292 (while mode-alist 4293 (when (eq (cdar mode-alist) 'vhdl-mode) 4294 (setq filename-regexp 4295 (concat filename-regexp (caar mode-alist) "\\|"))) 4296 (setq mode-alist (cdr mode-alist))) 4297 (setq filename-regexp 4298 (concat (substring filename-regexp 0 4299 (string-match "\\\\|$" filename-regexp)) "\\)")) 4300 ;; find files 4301 (vhdl-directory-files 4302 (or directory default-directory) full filename-regexp))) 4303 4304(defun vhdl-add-source-files-menu () 4305 "Scan directory for all VHDL source files and generate menu. 4306The directory of the current source file is scanned." 4307 (interactive) 4308 (message "Scanning directory for source files ...") 4309 (let ((newmap (current-local-map)) 4310 (file-list (vhdl-get-source-files)) 4311 menu-list found) 4312 ;; Create list for menu 4313 (setq found nil) 4314 (while file-list 4315 (setq found t) 4316 (push (vector (car file-list) (list 'find-file (car file-list)) t) 4317 menu-list) 4318 (setq file-list (cdr file-list))) 4319 (setq menu-list (vhdl-menu-split menu-list "Sources")) 4320 (when found (push "--" menu-list)) 4321 (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) 4322 (push "Sources" menu-list) 4323 ;; Create menu 4324 (when (featurep 'xemacs) 4325 (easy-menu-add menu-list)) 4326 (easy-menu-define vhdl-sources-menu newmap 4327 "VHDL source files menu" menu-list)) 4328 (message "")) 4329 4330 4331;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4332;;; Mode definition 4333;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4334;; performs all buffer local initializations 4335 4336;;;###autoload 4337(define-derived-mode vhdl-mode prog-mode 4338 '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) 4339 (vhdl-electric-mode "e") 4340 (vhdl-stutter-mode "s")) 4341 "Major mode for editing VHDL code. 4342 4343Usage: 4344------ 4345 4346 TEMPLATE INSERTION (electrification): 4347 After typing a VHDL keyword and entering `SPC', you are prompted for 4348 arguments while a template is generated for that VHDL construct. Typing 4349 `RET' or `C-g' at the first (mandatory) prompt aborts the current 4350 template generation. Optional arguments are indicated by square 4351 brackets and removed if the queried string is left empty. Prompts for 4352 mandatory arguments remain in the code if the queried string is left 4353 empty. They can be queried again by `C-c C-t C-q'. Enabled 4354 electrification is indicated by `/e' in the mode line. 4355 4356 Typing `M-SPC' after a keyword inserts a space without calling the 4357 template generator. Automatic template generation (i.e. 4358 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by 4359 setting option `vhdl-electric-mode' (see OPTIONS). 4360 4361 Template generators can be invoked from the VHDL menu, by key 4362 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing 4363 the keyword (i.e. first word of menu entry not in parenthesis) and 4364 `SPC'. The following abbreviations can also be used: arch, attr, cond, 4365 conf, comp, cons, func, inst, pack, sig, var. 4366 4367 Template styles can be customized in customization group 4368 `vhdl-template' (see OPTIONS). 4369 4370 4371 HEADER INSERTION: 4372 A file header can be inserted by `C-c C-t C-h'. A file footer 4373 (template at the end of the file) can be inserted by `C-c C-t C-f'. 4374 See customization group `vhdl-header'. 4375 4376 4377 STUTTERING: 4378 Double striking of some keys inserts cumbersome VHDL syntax elements. 4379 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by 4380 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in 4381 the mode line. The stuttering keys and their effects are: 4382 4383 ;; --> \" : \" [ --> ( -- --> comment 4384 ;;; --> \" := \" [[ --> [ --CR --> comment-out code 4385 .. --> \" => \" ] --> ) --- --> horizontal line 4386 ,, --> \" <= \" ]] --> ] ---- --> display comment 4387 == --> \" == \" \\='\\=' --> \\\" 4388 4389 4390 WORD COMPLETION: 4391 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a 4392 word in the buffer that starts alike, inserts it and adjusts case. 4393 Re-typing `TAB' toggles through alternative word completions. This also 4394 works in the minibuffer (i.e. in template generator prompts). 4395 4396 Typing `TAB' after `(' looks for and inserts complete parenthesized 4397 expressions (e.g. for array index ranges). All keywords as well as 4398 standard types and subprograms of VHDL have predefined abbreviations 4399 (e.g., type \"std\" and `TAB' will toggle through all standard types 4400 beginning with \"std\"). 4401 4402 Typing `TAB' after a non-word character indents the line if at the 4403 beginning of a line (i.e. no preceding non-blank characters), and 4404 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator 4405 stop. 4406 4407 4408 COMMENTS: 4409 `--' puts a single comment. 4410 `---' draws a horizontal line for separating code segments. 4411 `----' inserts a display comment, i.e. two horizontal lines 4412 with a comment in between. 4413 `--CR' comments out code on that line. Re-hitting CR comments 4414 out following lines. 4415 `C-c C-c' comments out a region if not commented out, 4416 uncomments a region if already commented out. Option 4417 `comment-style' defines where the comment characters 4418 should be placed (beginning of line, indent, etc.). 4419 4420 You are prompted for comments after object definitions (i.e. signals, 4421 variables, constants, ports) and after subprogram and process 4422 specifications if option `vhdl-prompt-for-comments' is non-nil. 4423 Comments are automatically inserted as additional labels (e.g. after 4424 begin statements) and as help comments if `vhdl-self-insert-comments' is 4425 non-nil. 4426 4427 Inline comments (i.e. comments after a piece of code on the same line) 4428 are indented at least to `vhdl-inline-comment-column'. Comments go at 4429 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment 4430 will open a new comment line. Typing beyond `vhdl-end-comment-column' 4431 in a comment automatically opens a new comment line. `M-q' re-fills 4432 multi-line comments. 4433 4434 4435 INDENTATION: 4436 `TAB' indents a line if at the beginning of the line. The amount of 4437 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' 4438 always indents the current line (is bound to `TAB' if option 4439 `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents 4440 the entire region. 4441 4442 Indentation can be done for a group of lines (`C-c C-i C-g'), a region 4443 (`M-C-\\') or the entire buffer (menu). Argument and port lists are 4444 indented normally (nil) or relative to the opening parenthesis (non-nil) 4445 according to option `vhdl-argument-list-indent'. 4446 4447 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of 4448 tabs. `\\[tabify]' and `\\[untabify]' allow the conversion of spaces to 4449 tabs and vice versa. 4450 4451 Syntax-based indentation can be very slow in large files. Option 4452 `vhdl-indent-syntax-based' allows you to use faster but simpler indentation. 4453 4454 Option `vhdl-indent-comment-like-next-code-line' controls whether 4455 comment lines are indented like the preceding or like the following code 4456 line. 4457 4458 4459 ALIGNMENT: 4460 The alignment functions align operators, keywords, and inline comments 4461 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines 4462 separated by blank lines, `C-c C-a C-i' a block of lines with same 4463 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by 4464 a pair of parentheses (e.g. port clause/map, argument list), and `C-c 4465 C-a C-d' all lines within the declarative part of a design unit. `C-c 4466 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments 4467 for a group of lines, and `C-c C-a M-c' for a region. 4468 4469 If option `vhdl-align-groups' is non-nil, groups of code lines 4470 separated by special lines (see option `vhdl-align-group-separate') are 4471 aligned individually. If option `vhdl-align-same-indent' is non-nil, 4472 blocks of lines with same indent are aligned separately. Some templates 4473 are automatically aligned after generation if option `vhdl-auto-align' 4474 is non-nil. 4475 4476 Alignment tries to align inline comments at 4477 `vhdl-inline-comment-column' and tries inline comment not to exceed 4478 `vhdl-end-comment-column'. 4479 4480 `C-c C-x M-w' fixes up whitespace in a region. That is, operator 4481 symbols are surrounded by one space, and multiple spaces are eliminated. 4482 4483 4484 CODE FILLING: 4485 Code filling allows you to condense code (e.g. sensitivity lists or port 4486 maps) by removing comments and newlines and re-wrapping so that all 4487 lines are maximally filled (block filling). `C-c C-f C-f' fills a list 4488 enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by 4489 blank lines, `C-c C-f C-i' a block of lines with same indent, and 4490 `C-c C-f M-f' an entire region. 4491 4492 4493 CODE BEAUTIFICATION: 4494 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire 4495 buffer respectively. This includes indentation, alignment, and case 4496 fixing. Code beautification can also be run non-interactively using the 4497 command: 4498 4499 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer 4500 4501 4502 PORT TRANSLATION: 4503 Generic and port clauses from entity or component declarations can be 4504 copied (`C-c C-p C-w') and pasted as entity and component declarations, 4505 as component instantiations and corresponding internal constants and 4506 signals, as a generic map with constants as actual generics, and as 4507 internal signal initializations (menu). 4508 4509 To include formals in component instantiations, see option 4510 `vhdl-association-list-with-formals'. To include comments in pasting, 4511 see options `vhdl-include-...-comments'. 4512 4513 A clause with several generic/port names on the same line can be 4514 flattened (`C-c C-p C-f') so that only one name per line exists. The 4515 direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become 4516 outputs and vice versa, which can be useful in testbenches. (This 4517 reversion is done on the internal data structure and is only reflected 4518 in subsequent paste operations.) 4519 4520 Names for actual ports, instances, testbenches, and 4521 design-under-test instances can be derived from existing names according 4522 to options `vhdl-...-name'. See customization group `vhdl-port'. 4523 4524 4525 SUBPROGRAM TRANSLATION: 4526 Similar functionality exists for copying/pasting the interface of 4527 subprograms (function/procedure). A subprogram interface can be copied 4528 and then pasted as a subprogram declaration, body or call (uses 4529 association list with formals). 4530 4531 4532 TESTBENCH GENERATION: 4533 A copied port can also be pasted as a testbench. The generated 4534 testbench includes an entity, an architecture, and an optional 4535 configuration. The architecture contains the component declaration and 4536 instantiation of the DUT as well as internal constant and signal 4537 declarations. Additional user-defined templates can be inserted. The 4538 names used for entity/architecture/configuration/DUT as well as the file 4539 structure to be generated can be customized. See customization group 4540 `vhdl-testbench'. 4541 4542 4543 KEY BINDINGS: 4544 Key bindings (`C-c ...') exist for most commands (see in menu). 4545 4546 4547 VHDL MENU: 4548 All commands can be found in the VHDL menu including their key bindings. 4549 4550 4551 FILE BROWSER: 4552 The speedbar allows browsing of directories and file contents. It can 4553 be accessed from the VHDL menu and is automatically opened if option 4554 `vhdl-speedbar-auto-open' is non-nil. 4555 4556 In speedbar, open files and directories with `mouse-2' on the name and 4557 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. 4558 4559 4560 DESIGN HIERARCHY BROWSER: 4561 The speedbar can also be used for browsing the hierarchy of design units 4562 contained in the source files of the current directory or the specified 4563 projects (see option `vhdl-project-alist'). 4564 4565 The speedbar can be switched between file, directory hierarchy and 4566 project hierarchy browsing mode in the speedbar menu or by typing `f', 4567 `h' or `H' in speedbar. 4568 4569 In speedbar, open design units with `mouse-2' on the name and browse 4570 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied 4571 from entities and components (in packages). Individual design units and 4572 complete designs can directly be compiled (\"Make\" menu entry). 4573 4574 The hierarchy is automatically updated upon saving a modified source 4575 file when option `vhdl-speedbar-update-on-saving' is non-nil. The 4576 hierarchy is only updated for projects that have been opened once in the 4577 speedbar. The hierarchy is cached between Emacs sessions in a file (see 4578 options in group `vhdl-speedbar'). 4579 4580 Simple design consistency checks are done during scanning, such as 4581 multiple declarations of the same unit or missing primary units that are 4582 required by secondary units. 4583 4584 4585 STRUCTURAL COMPOSITION: 4586 Enables simple structural composition. `C-c C-m C-n' creates a skeleton 4587 for a new component. Subcomponents (i.e. component declaration and 4588 instantiation) can be automatically placed from a previously read port 4589 (`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally, 4590 all subcomponents can be automatically connected using internal signals 4591 and ports (`C-c C-m C-w') following these rules: 4592 - subcomponent actual ports with same name are considered to be 4593 connected by a signal (internal signal or port) 4594 - signals that are only inputs to subcomponents are considered as 4595 inputs to this component -> input port created 4596 - signals that are only outputs from subcomponents are considered as 4597 outputs from this component -> output port created 4598 - signals that are inputs to AND outputs from subcomponents are 4599 considered as internal connections -> internal signal created 4600 4601 Purpose: With appropriate naming conventions it is possible to 4602 create higher design levels with only a few mouse clicks or key 4603 strokes. A new design level can be created by simply generating a new 4604 component, placing the required subcomponents from the hierarchy 4605 browser, and wiring everything automatically. 4606 4607 Note: Automatic wiring only works reliably on templates of new 4608 components and component instantiations that were created by VHDL mode. 4609 4610 Component declarations can be placed in a components package (option 4611 `vhdl-use-components-package') which can be automatically generated for 4612 an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct 4613 component instantiation is also supported (option 4614 `vhdl-use-direct-instantiation'). 4615 4616 Configuration declarations can automatically be generated either from 4617 the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from 4618 the speedbar menu (for the architecture under the cursor). The 4619 configurations can optionally be hierarchical (i.e. include all 4620 component levels of a hierarchical design, option 4621 `vhdl-compose-configuration-hierarchical') or include subconfigurations 4622 (option `vhdl-compose-configuration-use-subconfiguration'). For 4623 subcomponents in hierarchical configurations, the most-recently-analyzed 4624 (mra) architecture is selected. If another architecture is desired, it 4625 can be marked as most-recently-analyzed (speedbar menu) before 4626 generating the configuration. 4627 4628 Note: Configurations of subcomponents (i.e. hierarchical configuration 4629 declarations) are currently not considered when displaying 4630 configurations in speedbar. 4631 4632 See the options group `vhdl-compose' for all relevant user options. 4633 4634 4635 SOURCE FILE COMPILATION: 4636 The syntax of the current buffer can be analyzed by calling a VHDL 4637 compiler (menu, `C-c C-k'). The compiler to be used is specified by 4638 option `vhdl-compiler'. The available compilers are listed in option 4639 `vhdl-compiler-alist' including all required compilation command, 4640 command options, compilation directory, and error message syntax 4641 information. New compilers can be added. 4642 4643 All the source files of an entire design can be compiled by the `make' 4644 command (menu, `C-c M-C-k') if an appropriate Makefile exists. 4645 4646 4647 MAKEFILE GENERATION: 4648 Makefiles can be generated automatically by an internal generation 4649 routine (`C-c M-k'). The library unit dependency information is 4650 obtained from the hierarchy browser. Makefile generation can be 4651 customized for each compiler in option `vhdl-compiler-alist'. 4652 4653 Makefile generation can also be run non-interactively using the 4654 command: 4655 4656 emacs -batch -l ~/.emacs -l vhdl-mode 4657 [-compiler compilername] [-project projectname] 4658 -f vhdl-generate-makefile 4659 4660 The Makefile's default target \"all\" compiles the entire design, the 4661 target \"clean\" removes it and the target \"library\" creates the 4662 library directory if not existent. These target names can be customized 4663 by option `vhdl-makefile-default-targets'. The Makefile also includes a 4664 target for each primary library unit which allows selective compilation 4665 of this unit, its secondary units and its subhierarchy (example: 4666 compilation of a design specified by a configuration). User specific 4667 parts can be inserted into a Makefile with option 4668 `vhdl-makefile-generation-hook'. 4669 4670 Limitations: 4671 - Only library units and dependencies within the current library are 4672 considered. Makefiles for designs that span multiple libraries are 4673 not (yet) supported. 4674 - Only one-level configurations are supported (also hierarchical), 4675 but configurations that go down several levels are not. 4676 - The \"others\" keyword in configurations is not supported. 4677 4678 4679 PROJECTS: 4680 Projects can be defined in option `vhdl-project-alist' and a current 4681 project be selected using option `vhdl-project' (permanently) or from 4682 the menu or speedbar (temporarily). For each project, title and 4683 description strings (for the file headers), source files/directories 4684 (for the hierarchy browser and Makefile generation), library name, and 4685 compiler-dependent options, exceptions and compilation directory can be 4686 specified. Compilation settings overwrite the settings of option 4687 `vhdl-compiler-alist'. 4688 4689 Project setups can be exported (i.e. written to a file) and imported. 4690 Imported setups are not automatically saved in `vhdl-project-alist' but 4691 can be saved afterwards in its customization buffer. When starting 4692 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l 4693 vhdl-mode\") in a directory with an existing project setup file, it is 4694 automatically loaded and its project activated if option 4695 `vhdl-project-autoload' is non-nil. Names/paths of the project setup 4696 files can be specified in option `vhdl-project-file-name'. Multiple 4697 project setups can be automatically loaded from global directories. 4698 This is an alternative to specifying project setups with option 4699 `vhdl-project-alist'. 4700 4701 4702 SPECIAL MENUS: 4703 As an alternative to the speedbar, an index menu can be added (set 4704 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu 4705 (e.g. add \"(global-set-key [S-down-mouse-3] \\='imenu)\" to your start-up 4706 file) for browsing the file contents (is not populated if buffer is 4707 larger than 256000). Also, a source file menu can be 4708 added (set option `vhdl-source-file-menu' to non-nil) for browsing the 4709 current directory for VHDL source files. 4710 4711 4712 VHDL STANDARDS: 4713 The VHDL standards to be used are specified in option `vhdl-standard'. 4714 Available standards are: VHDL'87/'93(02)/'08, VHDL-AMS, and Math Packages. 4715 4716 4717 KEYWORD CASE: 4718 Lower and upper case for keywords and standardized types, attributes, 4719 and enumeration values is supported. If the option 4720 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in 4721 lower case and are converted into upper case automatically (not for 4722 types, attributes, and enumeration values). The case of keywords, 4723 types, attributes,and enumeration values can be fixed for an entire 4724 region (menu) or buffer (`C-c C-x C-c') according to the options 4725 `vhdl-upper-case-{keywords,types,attributes,enum-values}'. 4726 4727 4728 HIGHLIGHTING (fontification): 4729 Keywords and standardized types, attributes, enumeration values, and 4730 function names (controlled by option `vhdl-highlight-keywords'), as well 4731 as comments, strings, and template prompts are highlighted using 4732 different colors. Unit, subprogram, signal, variable, constant, 4733 parameter and generic/port names in declarations as well as labels are 4734 highlighted if option `vhdl-highlight-names' is non-nil. 4735 4736 Additional reserved words or words with a forbidden syntax (e.g. words 4737 that should be avoided) can be specified in option 4738 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in 4739 a warning color (option `vhdl-highlight-forbidden-words'). Verilog 4740 keywords are highlighted as forbidden words if option 4741 `vhdl-highlight-verilog-keywords' is non-nil. 4742 4743 Words with special syntax can be highlighted by specifying their 4744 syntax and color in option `vhdl-special-syntax-alist' and by setting 4745 option `vhdl-highlight-special-words' to non-nil. This allows you to 4746 establish some naming conventions (e.g. to distinguish different kinds 4747 of signals or other objects by using name suffices) and to support them 4748 visually. 4749 4750 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order 4751 to support case-sensitive highlighting. However, keywords are then only 4752 highlighted if written in lower case. 4753 4754 Code between \"translate_off\" and \"translate_on\" pragmas is 4755 highlighted using a different background color if option 4756 `vhdl-highlight-translate-off' is non-nil. 4757 4758 For documentation and customization of the used colors see 4759 customization group `vhdl-highlight-faces' (`\\[customize-group]'). For 4760 highlighting of matching parenthesis, see customization group 4761 `paren-showing'. Automatic buffer highlighting is turned on/off by 4762 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). 4763 4764 4765 USER MODELS: 4766 VHDL models (templates) can be specified by the user and made accessible 4767 in the menu, through key bindings (`C-c C-m ...'), or by keyword 4768 electrification. See option `vhdl-model-alist'. 4769 4770 4771 HIDE/SHOW: 4772 The code of blocks, processes, subprograms, component declarations and 4773 instantiations, generic/port clauses, and configuration declarations can 4774 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within 4775 the code (see customization group `vhdl-menu'). XEmacs: limited 4776 functionality due to old `hideshow.el' package. 4777 4778 4779 CODE UPDATING: 4780 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the 4781 current process, `C-c C-u M-s' of all processes in the current buffer. 4782 Limitations: 4783 - Only declared local signals (ports, signals declared in 4784 architecture and blocks) are automatically inserted. 4785 - Global signals declared in packages are not automatically inserted. 4786 Insert them once manually (will be kept afterwards). 4787 - Out parameters of procedures are considered to be read. 4788 Use option `vhdl-entity-file-name' to specify the entity file name 4789 (used to obtain the port names). 4790 Use option `vhdl-array-index-record-field-in-sensitivity-list' to 4791 specify whether to include array indices and record fields in 4792 sensitivity lists. 4793 4794 4795 CODE FIXING: 4796 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause 4797 (e.g., if the closing parenthesis is on the wrong line or is missing). 4798 4799 4800 PRINTING: 4801 PostScript printing with different faces (an optimized set of faces is 4802 used if `vhdl-print-customize-faces' is non-nil) or colors (if 4803 `ps-print-color-p' is non-nil) is possible using the standard Emacs 4804 PostScript printing commands. Option `vhdl-print-two-column' defines 4805 appropriate default settings for nice landscape two-column printing. 4806 The paper format can be set by option `ps-paper-type'. Do not forget to 4807 switch `ps-print-color-p' to nil for printing on black-and-white 4808 printers. 4809 4810 4811 OPTIONS: 4812 User options allow customization of VHDL Mode. All options are 4813 accessible from the \"Options\" menu entry. Simple options (switches 4814 and choices) can directly be changed, while for complex options a 4815 customization buffer is opened. Changed options can be saved for future 4816 sessions using the \"Save Options\" menu entry. 4817 4818 Options and their detailed descriptions can also be accessed by using 4819 the \"Customize\" menu entry or the command `\\[customize-option]' 4820 (`\\[customize-group]' for groups). Some customizations only take effect 4821 after some action (read the NOTE in the option documentation). 4822 Customization can also be done globally (i.e. site-wide, read the 4823 INSTALL file). 4824 4825 Not all options are described in this documentation, so go and see 4826 what other useful user options there are (`\\[vhdl-customize]' or menu)! 4827 4828 4829 FILE EXTENSIONS: 4830 As default, files with extensions \".vhd\" and \".vhdl\" are 4831 automatically recognized as VHDL source files. To add an extension 4832 \".xxx\", add the following line to your Emacs start-up file (`.emacs'): 4833 4834 (push \\='(\"\\\\.xxx\\\\\\='\" . vhdl-mode) auto-mode-alist) 4835 4836 4837 HINTS: 4838 - To start Emacs with open VHDL hierarchy browser without having to load 4839 a VHDL file first, use the command: 4840 4841 emacs -l vhdl-mode -f speedbar-frame-mode 4842 4843 - Type `C-g C-g' to interrupt long operations or if Emacs hangs. 4844 4845 - Some features only work on properly indented code. 4846 4847 4848 RELEASE NOTES: 4849 See also the release notes (menu) for added features in new releases. 4850 4851 4852Maintenance: 4853------------ 4854 4855To submit a bug report, enter `\\[vhdl-submit-bug-report]' within VHDL Mode. 4856Add a description of the problem and include a reproducible test case. 4857 4858Questions and enhancement requests can be sent to <reto@gnu.org>. 4859 4860The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. 4861The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta 4862releases. You are kindly invited to participate in beta testing. Subscribe 4863to above mailing lists by sending an email to <reto@gnu.org>. 4864 4865VHDL Mode is officially distributed at 4866https://guest.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html 4867where the latest version can be found. 4868 4869 4870Known problems: 4871--------------- 4872 4873- XEmacs: Incorrect start-up when automatically opening speedbar. 4874- XEmacs: Indentation in XEmacs 21.4 (and higher). 4875- Indentation incorrect for new `postponed' VHDL keyword. 4876- Indentation incorrect for `protected body' construct. 4877 4878 4879 The VHDL Mode Authors 4880 Reto Zimmermann and Rod Whitby 4881 4882Key bindings: 4883------------- 4884 4885\\{vhdl-mode-map}" 4886 :abbrev-table vhdl-mode-abbrev-table 4887 4888 ;; set local variables 4889 (set (make-local-variable 'paragraph-start) 4890 "\\s-*\\(--+\\s-*$\\|$\\)") 4891 (set (make-local-variable 'paragraph-separate) paragraph-start) 4892 (set (make-local-variable 'paragraph-ignore-fill-prefix) t) 4893 (set (make-local-variable 'parse-sexp-ignore-comments) t) 4894 (set (make-local-variable 'indent-line-function) #'vhdl-indent-line) 4895 (set (make-local-variable 'comment-start) "--") 4896 (set (make-local-variable 'comment-end) "") 4897 (set (make-local-variable 'comment-column) vhdl-inline-comment-column) 4898 (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) 4899 (set (make-local-variable 'comment-start-skip) "--+\\s-*") 4900 (set (make-local-variable 'comment-multi-line) nil) 4901 (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) 4902 (set (make-local-variable 'hippie-expand-verbose) nil) 4903 4904 ;; setup the comment indent variable in an Emacs version portable way 4905 ;; ignore any byte compiler warnings you might get here 4906 (when (boundp 'comment-indent-function) 4907 (set (make-local-variable 'comment-indent-function) #'vhdl-comment-indent)) 4908 4909 ;; initialize font locking 4910 (set (make-local-variable 'font-lock-defaults) 4911 (list 4912 '(nil vhdl-font-lock-keywords) nil 4913 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) #'beginning-of-line)) 4914 (if (eval-when-compile (fboundp 'syntax-propertize-rules)) 4915 (set (make-local-variable 'syntax-propertize-function) 4916 (syntax-propertize-rules 4917 ;; Mark single quotes as having string quote syntax in 4918 ;; 'c' instances. 4919 ("\\('\\).\\('\\)" (1 "\"'") (2 "\"'")))) 4920 (set (make-local-variable 'font-lock-syntactic-keywords) 4921 vhdl-font-lock-syntactic-keywords)) 4922 (when (featurep 'xemacs) 4923 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) 4924 (set (make-local-variable 'lazy-lock-defer-contextually) nil) 4925 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) 4926 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) 4927 4928 ;; variables for source file compilation 4929 (when vhdl-compile-use-local-error-regexp 4930 (set (make-local-variable 'compilation-error-regexp-alist) nil) 4931 (set (make-local-variable 'compilation-file-regexp-alist) nil)) 4932 4933 ;; add index menu 4934 (vhdl-index-menu-init) 4935 ;; add source file menu 4936 (if vhdl-source-file-menu (vhdl-add-source-files-menu)) 4937 ;; add VHDL menu 4938 (when (featurep 'xemacs) 4939 (easy-menu-add vhdl-mode-menu-list)) 4940 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4941 "Menu keymap for VHDL Mode." vhdl-mode-menu-list) 4942 ;; initialize hideshow and add menu 4943 (vhdl-hideshow-init) 4944 (run-hooks 'menu-bar-update-hook) 4945 4946 ;; miscellaneous 4947 (vhdl-ps-print-init) 4948 (vhdl-write-file-hooks-init) 4949 (message "VHDL Mode %s.%s" vhdl-version 4950 (if noninteractive "" " See menu for documentation and release notes."))) 4951 4952(defun vhdl-activate-customizations () 4953 "Activate all customizations on local variables." 4954 (interactive) 4955 (vhdl-mode-map-init) 4956 (use-local-map vhdl-mode-map) 4957 (set-syntax-table vhdl-mode-syntax-table) 4958 (setq comment-column vhdl-inline-comment-column) 4959 (setq end-comment-column vhdl-end-comment-column) 4960 (vhdl-write-file-hooks-init) 4961 (vhdl-update-mode-menu) 4962 (vhdl-hideshow-init) 4963 (run-hooks 'menu-bar-update-hook)) 4964 4965(defun vhdl-write-file-hooks-init () 4966 "Add/remove hooks when buffer is saved." 4967 (if vhdl-modify-date-on-saving 4968 (add-hook 'write-file-functions #'vhdl-template-modify-noerror nil t) 4969 (remove-hook 'write-file-functions #'vhdl-template-modify-noerror t)) 4970 (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) 4971 (add-hook 'after-save-hook #'vhdl-add-modified-file nil t)) 4972 4973(defun vhdl-process-command-line-option (option) 4974 "Process command line options for VHDL Mode." 4975 (cond 4976 ;; set compiler 4977 ((equal option "-compiler") 4978 (vhdl-set-compiler (car command-line-args-left)) 4979 (setq command-line-args-left (cdr command-line-args-left))) 4980 ;; set project 4981 ((equal option "-project") 4982 (vhdl-set-project (car command-line-args-left)) 4983 (setq command-line-args-left (cdr command-line-args-left))))) 4984 4985;; make Emacs process VHDL Mode options 4986(setq command-switch-alist 4987 (append command-switch-alist 4988 '(("-compiler" . vhdl-process-command-line-option) 4989 ("-project" . vhdl-process-command-line-option)))) 4990 4991 4992;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4993;;; Keywords and standardized words 4994;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4995 4996(defconst vhdl-02-keywords 4997 '( 4998 "abs" "access" "after" "alias" "all" "and" "architecture" "array" 4999 "assert" "attribute" 5000 "begin" "block" "body" "buffer" "bus" 5001 "case" "component" "configuration" "constant" 5002 "disconnect" "downto" 5003 "else" "elsif" "end" "entity" "exit" 5004 "file" "for" "function" 5005 "generate" "generic" "group" "guarded" 5006 "if" "impure" "in" "inertial" "inout" "is" 5007 "label" "library" "linkage" "literal" "loop" 5008 "map" "mod" 5009 "nand" "new" "next" "nor" "not" "null" 5010 "of" "on" "open" "or" "others" "out" 5011 "package" "port" "postponed" "procedure" "process" "protected" "pure" 5012 "range" "record" "register" "reject" "rem" "report" "return" 5013 "rol" "ror" 5014 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" 5015 "then" "to" "transport" "type" 5016 "unaffected" "units" "until" "use" 5017 "variable" 5018 "wait" "when" "while" "with" 5019 "xnor" "xor" 5020 ) 5021 "List of VHDL'02 keywords.") 5022 5023(defconst vhdl-08-keywords 5024 '( 5025 "context" "force" "property" "release" "sequence" 5026 ) 5027 "List of VHDL'08 keywords.") 5028 5029(defconst vhdl-ams-keywords 5030 '( 5031 "across" "break" "limit" "nature" "noise" "procedural" "quantity" 5032 "reference" "spectrum" "subnature" "terminal" "through" 5033 "tolerance" 5034 ) 5035 "List of VHDL-AMS keywords.") 5036 5037(defconst vhdl-verilog-keywords 5038 '( 5039 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" 5040 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" 5041 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" 5042 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" 5043 "endprimitive" "endspecify" "endtable" "endtask" "event" 5044 "for" "force" "forever" "fork" "function" 5045 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" 5046 "macromodule" "makefile" "medium" "module" 5047 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" 5048 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" 5049 "pullup" 5050 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" 5051 "rtranif0" "rtranif1" 5052 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" 5053 "strong1" "supply" "supply0" "supply1" 5054 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" 5055 "triand" "trior" "trireg" 5056 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" 5057 ) 5058 "List of Verilog keywords as candidate for additional reserved words.") 5059 5060(defconst vhdl-02-types 5061 '( 5062 "boolean" "bit" "bit_vector" "character" "severity_level" "integer" 5063 "real" "time" "natural" "positive" "string" "line" "text" "side" 5064 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" 5065 "std_logic" "std_logic_vector" 5066 "std_ulogic" "std_ulogic_vector" 5067 ) 5068 "List of VHDL'02 standardized types.") 5069 5070(defconst vhdl-08-types 5071 '( 5072 "boolean_vector" "integer_vector" "real_vector" "time_vector" 5073 ) 5074 "List of VHDL'08 standardized types.") 5075 5076(defconst vhdl-ams-types 5077 ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004 5078 '( 5079 ;; package `standard' 5080 "domain_type" "real_vector" 5081 ;; package `energy_systems' 5082 "energy" "power" "periodicity" "real_across" "real_through" "unspecified" 5083 "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector" 5084 "real_across_vector" "real_through_vector" 5085 ;; package `electrical_systems' 5086 "voltage" "current" "charge" "resistance" "conductance" "capacitance" 5087 "mmf" "electric_flux" "electric_flux_density" "electric_field_strength" 5088 "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength" 5089 "inductance" "reluctance" "electrical" "electrical_vector" "magnetic" 5090 "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector" 5091 "magnetic_flux_vector" "charge_vector" "resistance_vector" 5092 "conductance_vector" "capacitance_vector" "electric_flux_vector" 5093 "electric_flux_density_vector" "electric_field_strength_vector" 5094 "magnetic_flux_density_vector" "magnetic_field_strength_vector" 5095 "inductance_vector" "reluctance_vector" "ground" 5096 ;; package `mechanical_systems' 5097 "displacement" "force" "velocity" "acceleration" "mass" "stiffness" 5098 "damping" "momentum" "angle" "torque" "angular_velocity" 5099 "angular_acceleration" "moment_inertia" "angular_momentum" 5100 "angular_stiffness" "angular_damping" "translational" 5101 "translational_vector" "translational_velocity" 5102 "translational_velocity_vector" "rotational" "rotational_vector" 5103 "rotational_velocity" "rotational_velocity_vector" "displacement_vector" 5104 "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector" 5105 "torque_vector" "angular_velocity_vector" "torque_velocity_vector" 5106 "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector" 5107 "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector" 5108 "angular_momentum_vector" "angular_stiffness_vector" 5109 "angular_damping_vector" "anchor" "translational_v_ref" 5110 "rotational_v_ref" "translational_v" "rotational_v" 5111 ;; package `radiant_systems' 5112 "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant" 5113 "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector" 5114 "illuminance_vector" "irradiance_vector" 5115 ;; package `thermal_systems' 5116 "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance" 5117 "thermal_conductance" "thermal" "thermal_vector" "temperature_vector" 5118 "heat_flow_vector" "thermal_capacitance_vector" 5119 "thermal_resistance_vector" "thermal_conductance_vector" 5120 ;; package `fluidic_systems' 5121 "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity" 5122 "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance" 5123 "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector" 5124 "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector" 5125 "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector" 5126 "density_vector" "viscosity_vector" "fresistance_vector" 5127 "fconductance_vector" "fcapacitance_vector" "inertance_vector" 5128 "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector" 5129 "cfinertance_vector" 5130 ) 5131 "List of VHDL-AMS standardized types.") 5132 5133(defconst vhdl-math-types 5134 '( 5135 "complex" "complex_polar" "positive_real" "principal_value" 5136 ) 5137 "List of Math Packages standardized types.") 5138 5139(defconst vhdl-02-attributes 5140 '( 5141 "base" "left" "right" "high" "low" "pos" "val" "succ" 5142 "pred" "leftof" "rightof" "range" "reverse_range" 5143 "length" "delayed" "stable" "quiet" "transaction" 5144 "event" "active" "last_event" "last_active" "last_value" 5145 "driving" "driving_value" "ascending" "value" "image" 5146 "simple_name" "instance_name" "path_name" 5147 "foreign" 5148 ) 5149 "List of VHDL'02 standardized attributes.") 5150 5151(defconst vhdl-08-attributes 5152 '( 5153 "instance_name" "path_name" 5154 ) 5155 "List of VHDL'08 standardized attributes.") 5156 5157(defconst vhdl-ams-attributes 5158 '( 5159 "across" "through" 5160 "reference" "contribution" "tolerance" 5161 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" 5162 "ramp" "slew" 5163 ) 5164 "List of VHDL-AMS standardized attributes.") 5165 5166(defconst vhdl-02-enum-values 5167 '( 5168 "true" "false" 5169 "note" "warning" "error" "failure" 5170 "read_mode" "write_mode" "append_mode" 5171 "open_ok" "status_error" "name_error" "mode_error" 5172 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" 5173 "right" "left" 5174 ) 5175 "List of VHDL'02 standardized enumeration values.") 5176 5177(defconst vhdl-ams-enum-values 5178 '( 5179 "quiescent_domain" "time_domain" "frequency_domain" 5180 ;; from `nature_pkg' package 5181 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" 5182 ) 5183 "List of VHDL-AMS standardized enumeration values.") 5184 5185(defconst vhdl-ams-constants 5186 ;; standard: IEEE Std 1076.1.1-2004 5187 '( 5188 ;; package `fundamental_constants' 5189 "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok" 5190 "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto" 5191 "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega" 5192 "giga" "tera" "peta" "exa" "zetta" "yotta" "deca" 5193 ;; package `material_constants' 5194 "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly" 5195 "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2" 5196 "ambient_temperature" "ambient_pressure" "ambient_illuminance" 5197 ) 5198 "List of VHDL-AMS standardized constants.") 5199 5200(defconst vhdl-math-constants 5201 ;; standard: IEEE Std 1076.2-1996 5202 '( 5203 "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi" 5204 "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero" 5205 "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e" 5206 "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2" 5207 "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2" 5208 "math_sqrt_pi" 5209 ) 5210 "List of Math Packages standardized constants.") 5211 5212(defconst vhdl-02-functions 5213 '( 5214 "now" "resolved" "rising_edge" "falling_edge" 5215 "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite" 5216 "endfile" 5217 "resize" "is_X" "std_match" 5218 "shift_left" "shift_right" "rotate_left" "rotate_right" 5219 "to_unsigned" "to_signed" "to_integer" 5220 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" 5221 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" 5222 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" 5223 "shl" "shr" "ext" "sxt" 5224 "deallocate" 5225 ) 5226 "List of VHDL'02 standardized functions.") 5227 5228(defconst vhdl-08-functions 5229 '( 5230 "finish" "flush" "justify" "maximum" "minimum" 5231 "resolution_limit" "rising_edge" "stop" "swrite" 5232 "tee" "to_binarystring" "to_bstring" "to_hexstring" "to_hstring" 5233 "to_octalstring" "to_ostring" "to_string" 5234 ) 5235 "List of VHDL'08 standardized functions.") 5236 5237(defconst vhdl-ams-functions 5238 '( 5239 ;; package `standard' 5240 "frequency" 5241 ) 5242 "List of VHDL-AMS standardized functions.") 5243 5244(defconst vhdl-math-functions 5245 ;; standard: IEEE Std 1076.2-1996 5246 '( 5247 "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg" 5248 "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp" 5249 "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex" 5250 "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt" 5251 "tan" "tanh" "trunc" "uniform" 5252 ) 5253 "List of Math Packages standardized functions.") 5254 5255(defconst vhdl-02-packages 5256 '( 5257 "std_logic_1164" "numeric_std" "numeric_bit" 5258 "standard" "textio" 5259 "std_logic_arith" "std_logic_signed" "std_logic_unsigned" 5260 "std_logic_misc" "std_logic_textio" 5261 "ieee" "std" "work" 5262 ) 5263 "List of VHDL'02 standardized packages and libraries.") 5264 5265(defconst vhdl-08-packages 5266 '( 5267 "env" "numeric_std_signed" "numeric_std_unsigned" 5268 "ieee_bit_context" "ieee_std_context" ;; contexts 5269 ) 5270 "List of VHDL'08 standardized packages and libraries.") 5271 5272(defconst vhdl-ams-packages 5273 '( 5274 "fundamental_constants" "material_constants" "energy_systems" 5275 "electrical_systems" "mechanical_systems" "radiant_systems" 5276 "thermal_systems" "fluidic_systems" 5277 ) 5278 "List of VHDL-AMS standardized packages and libraries.") 5279 5280(defconst vhdl-math-packages 5281 '( 5282 "math_real" "math_complex" 5283 ) 5284 "List of Math Packages standardized packages and libraries.") 5285 5286(defconst vhdl-08-directives 5287 '( 5288 "author" "author_info" "begin" "begin_protected" "comment" 5289 "data_block" "data_keyname" "data_keyowner" "data_method" 5290 "decrypt_license" "digest_block" "digest_key_method" "digest_keyname" 5291 "digest_keyowner" "digest_method" 5292 "encoding" "encrypt_agent" "encrypt_agent_info" "end" "end_protected" 5293 "key_block" "key_keyname" "key_keyowner" "key_method" 5294 "runtime_license" "viewport" 5295 ) 5296 "List of VHDL'08 standardized tool directives.") 5297 5298(defvar vhdl-keywords nil 5299 "List of VHDL keywords.") 5300 5301(defvar vhdl-types nil 5302 "List of VHDL standardized types.") 5303 5304(defvar vhdl-attributes nil 5305 "List of VHDL standardized attributes.") 5306 5307(defvar vhdl-enum-values nil 5308 "List of VHDL standardized enumeration values.") 5309 5310(defvar vhdl-constants nil 5311 "List of VHDL standardized constants.") 5312 5313(defvar vhdl-functions nil 5314 "List of VHDL standardized functions.") 5315 5316(defvar vhdl-packages nil 5317 "List of VHDL standardized packages and libraries.") 5318 5319(defvar vhdl-directives nil 5320 "List of VHDL standardized packages and libraries.") 5321 5322(defvar vhdl-reserved-words nil 5323 "List of additional reserved words.") 5324 5325(defvar vhdl-keywords-regexp nil 5326 "Regexp for VHDL keywords.") 5327 5328(defvar vhdl-types-regexp nil 5329 "Regexp for VHDL standardized types.") 5330 5331(defvar vhdl-attributes-regexp nil 5332 "Regexp for VHDL standardized attributes.") 5333 5334(defvar vhdl-enum-values-regexp nil 5335 "Regexp for VHDL standardized enumeration values.") 5336 5337(defvar vhdl-constants-regexp nil 5338 "Regexp for VHDL standardized constants.") 5339 5340(defvar vhdl-functions-regexp nil 5341 "Regexp for VHDL standardized functions.") 5342 5343(defvar vhdl-packages-regexp nil 5344 "Regexp for VHDL standardized packages and libraries.") 5345 5346(defvar vhdl-reserved-words-regexp nil 5347 "Regexp for additional reserved words.") 5348 5349(defun vhdl-upcase-list (condition list) 5350 "Upcase all elements in LIST based on CONDITION." 5351 (when condition 5352 (let ((tmp-list list)) 5353 (while tmp-list 5354 (setcar tmp-list (upcase (car tmp-list))) 5355 (setq tmp-list (cdr tmp-list))))) 5356 list) 5357 5358(defun vhdl-words-init () 5359 "Initialize reserved words." 5360 (setq vhdl-keywords 5361 (vhdl-upcase-list 5362 (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords) 5363 (append vhdl-02-keywords 5364 (when (vhdl-standard-p '08) vhdl-08-keywords) 5365 (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))) 5366 (setq vhdl-types 5367 (vhdl-upcase-list 5368 (and vhdl-highlight-case-sensitive vhdl-upper-case-types) 5369 (append vhdl-02-types 5370 (when (vhdl-standard-p '08) vhdl-08-types) 5371 (when (vhdl-standard-p 'ams) vhdl-ams-types) 5372 (when (vhdl-standard-p 'math) vhdl-math-types)))) 5373 (setq vhdl-attributes 5374 (vhdl-upcase-list 5375 (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes) 5376 (append vhdl-02-attributes 5377 (when (vhdl-standard-p '08) vhdl-08-attributes) 5378 (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))) 5379 (setq vhdl-enum-values 5380 (vhdl-upcase-list 5381 (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values) 5382 (append vhdl-02-enum-values 5383 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))) 5384 (setq vhdl-constants 5385 (vhdl-upcase-list 5386 (and vhdl-highlight-case-sensitive vhdl-upper-case-constants) 5387 (append (when (vhdl-standard-p 'ams) vhdl-ams-constants) 5388 (when (vhdl-standard-p 'math) vhdl-math-constants) 5389 '("")))) 5390 (setq vhdl-functions 5391 (append vhdl-02-functions 5392 (when (vhdl-standard-p '08) vhdl-08-functions) 5393 (when (vhdl-standard-p 'ams) vhdl-ams-functions) 5394 (when (vhdl-standard-p 'math) vhdl-math-functions))) 5395 (setq vhdl-packages 5396 (append vhdl-02-packages 5397 (when (vhdl-standard-p '08) vhdl-08-packages) 5398 (when (vhdl-standard-p 'ams) vhdl-ams-packages) 5399 (when (vhdl-standard-p 'math) vhdl-math-packages))) 5400 (setq vhdl-directives 5401 (append (when (vhdl-standard-p '08) vhdl-08-directives))) 5402 (setq vhdl-reserved-words 5403 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) 5404 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) 5405 '(""))) 5406 (setq vhdl-keywords-regexp 5407 (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) 5408 (setq vhdl-types-regexp 5409 (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) 5410 (setq vhdl-attributes-regexp 5411 (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) 5412 (setq vhdl-enum-values-regexp 5413 (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) 5414 (setq vhdl-constants-regexp 5415 (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>")) 5416 (setq vhdl-functions-regexp 5417 (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) 5418 (setq vhdl-packages-regexp 5419 (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) 5420 (setq vhdl-reserved-words-regexp 5421 (concat "\\<\\(" 5422 (unless (equal vhdl-forbidden-syntax "") 5423 (concat vhdl-forbidden-syntax "\\|")) 5424 (regexp-opt vhdl-reserved-words) 5425 "\\)\\>")) 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 (lambda (langelem) 5576 (cons (format "%s" (car langelem)) nil)) 5577 vhdl-offsets-alist) 5578 nil (not current-prefix-arg) 5579 ;; initial contents tries to be the last element 5580 ;; on the syntactic analysis list for the current 5581 ;; line 5582 (let* ((syntax (vhdl-get-syntactic-context)) 5583 (len (length syntax)) 5584 (ic (format "%s" (car (nth (1- len) syntax))))) 5585 ic) 5586 ))) 5587 (offset (vhdl-read-offset langelem))) 5588 (list langelem offset current-prefix-arg))) 5589 ;; sanity check offset 5590 (or (eq offset '+) 5591 (eq offset '-) 5592 (eq offset '++) 5593 (eq offset '--) 5594 (integerp offset) 5595 (fboundp offset) 5596 (boundp offset) 5597 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" 5598 offset)) 5599 (let ((entry (assq symbol vhdl-offsets-alist))) 5600 (if entry 5601 (setcdr entry offset) 5602 (if add-p 5603 (setq vhdl-offsets-alist 5604 (cons (cons symbol offset) vhdl-offsets-alist)) 5605 (error "ERROR: %s is not a valid syntactic symbol" symbol)))) 5606 (vhdl-keep-region-active)) 5607 5608(defun vhdl-set-style (style &optional local) 5609 "Set `vhdl-mode' variables to use one of several different indentation styles. 5610STYLE is a string representing the desired style and optional LOCAL is 5611a flag which, if non-nil, means to make the style variables being 5612changed buffer local, instead of the default, which is to set the 5613global variables. Interactively, the flag comes from the prefix 5614argument. The styles are chosen from the `vhdl-style-alist' variable." 5615 (interactive (list (completing-read "Use which VHDL indentation style? " 5616 vhdl-style-alist nil t) 5617 current-prefix-arg)) 5618 (let ((vars (cdr (assoc style vhdl-style-alist)))) 5619 (or vars 5620 (error "ERROR: Invalid VHDL indentation style `%s'" style)) 5621 ;; set all the variables 5622 (mapc 5623 (lambda (varentry) 5624 (let ((var (car varentry)) 5625 (val (cdr varentry))) 5626 ;; special case for vhdl-offsets-alist 5627 (if (not (eq var 'vhdl-offsets-alist)) 5628 (set (if local (make-local-variable var) var) val) 5629 ;; reset vhdl-offsets-alist to the default value first 5630 (set (if local (make-local-variable var) var) 5631 (copy-alist vhdl-offsets-alist-default)) 5632 ;; now set the langelems that are different 5633 (mapcar 5634 (lambda (langentry) 5635 (let ((langelem (car langentry)) 5636 (offset (cdr langentry))) 5637 (vhdl-set-offset langelem offset) 5638 )) 5639 val)) 5640 )) 5641 vars)) 5642 (vhdl-keep-region-active)) 5643 5644(defun vhdl-get-offset (langelem) 5645 "Get offset from LANGELEM which is a cons cell of the form: 5646\(SYMBOL . RELPOS). The symbol is matched against 5647vhdl-offsets-alist and the offset found there is either returned, 5648or added to the indentation at RELPOS. If RELPOS is nil, then 5649the offset is simply returned." 5650 (let* ((symbol (car langelem)) 5651 (relpos (cdr langelem)) 5652 (match (assq symbol vhdl-offsets-alist)) 5653 (offset (cdr-safe match))) 5654 ;; offset can be a number, a function, a variable, or one of the 5655 ;; symbols + or - 5656 (cond 5657 ((not match) 5658 (if vhdl-strict-syntax-p 5659 (error "ERROR: Don't know how to indent a %s" symbol) 5660 (setq offset 0 5661 relpos 0))) 5662 ((eq offset '+) (setq offset vhdl-basic-offset)) 5663 ((eq offset '-) (setq offset (- vhdl-basic-offset))) 5664 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) 5665 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) 5666 ((and (not (numberp offset)) 5667 (fboundp offset)) 5668 (setq offset (funcall offset langelem))) 5669 ((not (numberp offset)) 5670 (setq offset (eval offset))) 5671 ) 5672 (+ (if (and relpos 5673 (< relpos (vhdl-point 'bol))) 5674 (save-excursion 5675 (goto-char relpos) 5676 (current-column)) 5677 0) 5678 offset))) 5679 5680;; Syntactic support functions: 5681 5682(defun vhdl-in-comment-p (&optional pos) 5683 "Check if point is in a comment (include multi-line comments)." 5684 (let ((parse (lambda (p) 5685 (let ((c (char-after p))) 5686 (or (and c (eq (char-syntax c) ?<)) 5687 (nth 4 (parse-partial-sexp 5688 (save-excursion 5689 (beginning-of-defun) 5690 (point)) p))))))) 5691 (save-excursion 5692 (goto-char (or pos (point))) 5693 (or (funcall parse (point)) 5694 ;; `parse-partial-sexp's notion of comments doesn't span lines 5695 (progn 5696 (back-to-indentation) 5697 (unless (eolp) 5698 (forward-char) 5699 (funcall parse (point)))))))) 5700 5701(defun vhdl-in-string-p () 5702 "Check if point is in a string." 5703 (eq (vhdl-in-literal) 'string)) 5704 5705(defun vhdl-in-quote-p () 5706 "Check if point is in a quote ('x')." 5707 (or (and (> (point) (point-min)) 5708 (< (1+ (point)) (point-max)) 5709 (= (char-before (point)) ?\') 5710 (= (char-after (1+ (point))) ?\')) 5711 (and (> (1- (point)) (point-min)) 5712 (< (point) (point-max)) 5713 (= (char-before (1- (point))) ?\') 5714 (= (char-after (point)) ?\')))) 5715 5716(defun vhdl-in-literal () 5717 "Determine if point is in a VHDL literal." 5718 (save-excursion 5719 (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) 5720 (cond 5721 ((nth 3 state) 'string) 5722 ((nth 4 state) 'comment) 5723 ((vhdl-beginning-of-macro) 'pound) 5724 ((vhdl-beginning-of-directive) 'directive) 5725 ;; for multi-line comments 5726 ((and (vhdl-standard-p '08) (vhdl-in-comment-p)) 'comment) 5727 (t nil))))) 5728 5729(defun vhdl-in-extended-identifier-p () 5730 "Determine if point is inside extended identifier (delimited by `\\')." 5731 (save-match-data 5732 (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t)) 5733 (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t))))) 5734 5735(defun vhdl-forward-comment (&optional direction) 5736 "Skip all comments (including whitespace). 5737Skip backwards if DIRECTION is negative, skip forward otherwise." 5738 (interactive "p") 5739 (if (and direction (< direction 0)) 5740 ;; skip backwards 5741 (progn 5742 (skip-chars-backward " \t\n\r\f") 5743 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) 5744 (goto-char (match-beginning 3)) 5745 (skip-chars-backward " \t\n\r\f"))) 5746 ;; skip forwards 5747 (skip-chars-forward " \t\n\r\f") 5748 (while (looking-at "--.*") 5749 (goto-char (match-end 0)) 5750 (skip-chars-forward " \t\n\r\f")))) 5751 5752;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ 5753(unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) 5754 (defalias 'vhdl-forward-comment #'forward-comment)) 5755 5756(defun vhdl-back-to-indentation () 5757 "Move point to the first non-whitespace character on this line." 5758 (interactive) 5759 (beginning-of-line 1) 5760 (skip-syntax-forward " " (vhdl-point 'eol))) 5761 5762;; XEmacs hack: work around old `back-to-indentation' in XEmacs 5763(when (featurep 'xemacs) 5764 (defalias 'back-to-indentation 'vhdl-back-to-indentation)) 5765 5766;; This is the best we can do in Win-Emacs. 5767(defun vhdl-win-il (&optional lim) 5768 "Determine if point is in a VHDL literal." 5769 (save-excursion 5770 (let* ((here (point)) 5771 (state nil) 5772 (match nil) 5773 (lim (or lim (vhdl-point 'bod)))) 5774 (goto-char lim ) 5775 (while (< (point) here) 5776 (setq match 5777 (and (re-search-forward "--\\|[\"']\\|`" 5778 here 'move) 5779 (buffer-substring (match-beginning 0) (match-end 0)))) 5780 (setq state 5781 (cond 5782 ;; no match 5783 ((null match) nil) 5784 ;; looking at the opening of a VHDL style comment 5785 ((string= "--" match) 5786 (if (<= here (progn (end-of-line) (point))) 'comment)) 5787 ;; looking at a directive 5788 ((string= "`" match) 5789 (if (<= here (progn (end-of-line) (point))) 'directive)) 5790 ;; looking at the opening of a double quote string 5791 ((string= "\"" match) 5792 (if (not (save-restriction 5793 ;; this seems to be necessary since the 5794 ;; re-search-forward will not work without it 5795 (narrow-to-region (point) here) 5796 (re-search-forward 5797 ;; this regexp matches a double quote 5798 ;; which is preceded by an even number 5799 ;; of backslashes, including zero 5800 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) 5801 'string)) 5802 ;; looking at the opening of a single quote string 5803 ((string= "'" match) 5804 (if (not (save-restriction 5805 ;; see comments from above 5806 (narrow-to-region (point) here) 5807 (re-search-forward 5808 ;; this matches a single quote which is 5809 ;; preceded by zero or two backslashes. 5810 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" 5811 here 'move))) 5812 'string)) 5813 (t nil))) 5814 ) ; end-while 5815 state))) 5816 5817(and (string-match "Win-Emacs" emacs-version) 5818 (fset 'vhdl-in-literal #'vhdl-win-il)) 5819 5820;; Skipping of "syntactic whitespace". Syntactic whitespace is 5821;; defined as lexical whitespace or comments. Search no farther back 5822;; or forward than optional LIM. If LIM is omitted, (point-min) is 5823;; used for backward skipping, (point-max) is used for forward 5824;; skipping. 5825 5826(defun vhdl-forward-syntactic-ws (&optional lim) 5827 "Forward skip of syntactic whitespace." 5828 (let* ((here (point-max)) 5829 (hugenum (point-max))) 5830 (while (/= here (point)) 5831 (setq here (point)) 5832 (vhdl-forward-comment hugenum) 5833 ;; skip preprocessor directives 5834 (when (and (or (eq (char-after) ?#) (eq (char-after) ?`)) 5835 (= (vhdl-point 'boi) (point))) 5836 (while (and (eq (char-before (vhdl-point 'eol)) ?\\) 5837 (= (forward-line 1) 0))) 5838 (end-of-line))) 5839 (if lim (goto-char (min (point) lim))))) 5840 5841 5842;; This is the best we can do in Win-Emacs. 5843(defun vhdl-win-fsws (&optional lim) 5844 "Forward skip syntactic whitespace for Win-Emacs." 5845 (let ((lim (or lim (point-max))) 5846 stop) 5847 (while (not stop) 5848 (skip-chars-forward " \t\n\r\f" lim) 5849 (cond 5850 ;; vhdl comment 5851 ((looking-at "--") (end-of-line)) 5852 ;; none of the above 5853 (t (setq stop t)))))) 5854 5855(and (string-match "Win-Emacs" emacs-version) 5856 (fset 'vhdl-forward-syntactic-ws #'vhdl-win-fsws)) 5857 5858(defun vhdl-beginning-of-macro (&optional _lim) 5859 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." 5860 (let ((here (point))) 5861 (beginning-of-line) 5862 (while (eq (char-before (1- (point))) ?\\) 5863 (forward-line -1)) 5864 (back-to-indentation) 5865 (if (and (<= (point) here) 5866 (eq (char-after) ?#)) 5867 t 5868 (goto-char here) 5869 nil))) 5870 5871(defun vhdl-beginning-of-directive (&optional _lim) 5872 "Go to the beginning of a directive (nicked from `cc-engine')." 5873 (let ((here (point))) 5874 (beginning-of-line) 5875 (while (eq (char-before (1- (point))) ?\\) 5876 (forward-line -1)) 5877 (back-to-indentation) 5878 (if (and (<= (point) here) 5879 (eq (char-after) ?`)) 5880 t 5881 (goto-char here) 5882 nil))) 5883 5884(defun vhdl-backward-syntactic-ws (&optional lim) 5885 "Backward skip over syntactic whitespace." 5886 (let* ((here (point-min)) 5887 (hugenum (- (point-max)))) 5888 (while (/= here (point)) 5889 (setq here (point)) 5890 (vhdl-forward-comment hugenum) 5891 (vhdl-beginning-of-macro)) 5892 (if lim (goto-char (max (point) lim))))) 5893 5894;; This is the best we can do in Win-Emacs. 5895(defun vhdl-win-bsws (&optional lim) 5896 "Backward skip syntactic whitespace for Win-Emacs." 5897 (let ((lim (or lim (vhdl-point 'bod))) 5898 stop) 5899 (while (not stop) 5900 (skip-chars-backward " \t\n\r\f" lim) 5901 (cond 5902 ;; vhdl comment 5903 ((eq (vhdl-in-literal) 'comment) 5904 (skip-chars-backward "^-" lim) 5905 (skip-chars-backward "-" lim) 5906 (while (not (or (and (= (following-char) ?-) 5907 (= (char-after (1+ (point))) ?-)) 5908 (<= (point) lim))) 5909 (skip-chars-backward "^-" lim) 5910 (skip-chars-backward "-" lim))) 5911 ;; none of the above 5912 (t (setq stop t)))))) 5913 5914(and (string-match "Win-Emacs" emacs-version) 5915 (fset 'vhdl-backward-syntactic-ws #'vhdl-win-bsws)) 5916 5917;; Functions to help finding the correct indentation column: 5918 5919(defun vhdl-first-word (point) 5920 "If the keyword at POINT is at boi, return (current-column) at that point. 5921Otherwise return nil." 5922 (save-excursion 5923 (and (goto-char point) 5924 (eq (point) (vhdl-point 'boi)) 5925 (current-column)))) 5926 5927(defun vhdl-last-word (point) 5928 "If keyword at POINT is at eoi, then return (current-column) at that point. 5929Otherwise, return nil." 5930 (save-excursion 5931 (and (goto-char point) 5932 (save-excursion (or (eq (progn (forward-sexp) (point)) 5933 (vhdl-point 'eoi)) 5934 (looking-at "\\s-*\\(--\\)?"))) 5935 (current-column)))) 5936 5937;; Core syntactic evaluation functions: 5938 5939(defconst vhdl-libunit-re 5940 "\\b\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\b[^_]") 5941 5942(defun vhdl-libunit-p () 5943 (and 5944 (save-excursion 5945 (forward-sexp) 5946 (skip-chars-forward " \t\n\r\f") 5947 (not (looking-at "is\\b[^_]"))) 5948 (save-excursion 5949 (backward-sexp) 5950 (and (not (looking-at "use\\b[^_]")) 5951 (progn 5952 (forward-sexp) 5953 (vhdl-forward-syntactic-ws) 5954 (/= (following-char) ?:)))) 5955 )) 5956 5957(defconst vhdl-defun-re 5958 "\\b\\(architecture\\|block\\|configuration\\|context\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") 5959 5960(defun vhdl-defun-p () 5961 (save-excursion 5962 (if (looking-at "block\\|process\\|procedural") 5963 ;; "block", "process", "procedural": 5964 (save-excursion 5965 (backward-sexp) 5966 (not (looking-at "end\\s-+\\w"))) 5967 ;; "architecture", "configuration", "context", "entity", 5968 ;; "package", "procedure", "function": 5969 t))) 5970 5971(defun vhdl-corresponding-defun () 5972 "If the word at the current position corresponds to a \"defun\" 5973keyword, then return a string that can be used to find the 5974corresponding \"begin\" keyword, else return nil." 5975 (save-excursion 5976 (and (looking-at vhdl-defun-re) 5977 (vhdl-defun-p) 5978 (if (looking-at "block\\|process\\|procedural") 5979 ;; "block", "process". "procedural: 5980 (buffer-substring (match-beginning 0) (match-end 0)) 5981 ;; "architecture", "configuration", "context", "entity", "package", 5982 ;; "procedure", "function": 5983 "is")))) 5984 5985(defconst vhdl-begin-fwd-re 5986 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)" 5987 "Regexp for searching forward that matches all known \"begin\" keywords.") 5988 5989(defconst vhdl-begin-bwd-re 5990 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]" 5991 "Regexp for searching backward that matches all known \"begin\" keywords.") 5992 5993(defun vhdl-begin-p (&optional lim) 5994 "Return t if we are looking at a real \"begin\" keyword. 5995Assumes that the caller will make sure that we are looking at 5996vhdl-begin-fwd-re, and are not inside a literal, and that we are not in 5997the middle of an identifier that just happens to contain a \"begin\" 5998keyword." 5999 (cond 6000 ;; "[architecture|case|configuration|context|entity|package| 6001 ;; procedure|function] ... is": 6002 ((and (looking-at "i") 6003 (save-excursion 6004 ;; Skip backward over first sexp (needed to skip over a 6005 ;; procedure interface list, and is harmless in other 6006 ;; situations). Note that we need "return" in the 6007 ;; following search list so that we don't run into 6008 ;; semicolons in the function interface list. 6009 (backward-sexp) 6010 (skip-chars-forward "(") 6011 (let (foundp) 6012 (while (and (not foundp) 6013 (re-search-backward 6014 ";\\|\\b\\(architecture\\|case\\|configuration\\|context\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" 6015 lim 'move)) 6016 (if (or (= (preceding-char) ?_) 6017 (vhdl-in-literal)) 6018 (backward-char) 6019 (setq foundp t)))) 6020 (and (/= (following-char) ?\;) 6021 (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) 6022 t) 6023 ;; "begin", "then", "use": 6024 ((looking-at "be\\|t\\|use") 6025 t) 6026 ;; "else": 6027 ((and (looking-at "e") 6028 ;; make sure that the "else" isn't inside a 6029 ;; conditional signal assignment. 6030 (save-excursion 6031 (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 6032 (or (eq (following-char) ?\;) 6033 (eq (point) lim)))) 6034 t) 6035 ;; "block", "generate", "loop", "process", "procedural", 6036 ;; "units", "record", "protected body": 6037 ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record") 6038 (save-excursion 6039 (backward-sexp) 6040 (not (looking-at "end\\s-+\\w")))) 6041 t) 6042 ;; "component": 6043 ((and (looking-at "c") 6044 (save-excursion 6045 (backward-sexp) 6046 (not (looking-at "end\\s-+\\w"))) 6047 ;; look out for the dreaded entity class in an attribute 6048 (save-excursion 6049 (vhdl-backward-syntactic-ws lim) 6050 (/= (preceding-char) ?:))) 6051 t) 6052 ;; "for" (inside configuration declaration): 6053 ((and (looking-at "f") 6054 (save-excursion 6055 (backward-sexp) 6056 (not (looking-at "end\\s-+\\w"))) 6057 (vhdl-has-syntax 'configuration)) 6058 t) 6059 )) 6060 6061(defun vhdl-corresponding-mid (&optional _lim) 6062 (cond 6063 ((looking-at "is\\|block\\|generate\\|process\\|procedural") 6064 "begin") 6065 ((looking-at "then\\|use") 6066 "<else>") 6067 (t 6068 "end"))) 6069 6070(defun vhdl-corresponding-end (&optional lim) 6071 "If the word at the current position corresponds to a \"begin\" 6072keyword, then return a vector containing enough information to find 6073the corresponding \"end\" keyword, else return nil. The keyword to 6074search forward for is aref 0. The column in which the keyword must 6075appear is aref 1 or nil if any column is suitable. 6076Assumes that the caller will make sure that we are not in the middle 6077of an identifier that just happens to contain a \"begin\" keyword." 6078 (save-excursion 6079 (and (looking-at vhdl-begin-fwd-re) 6080 (or (not (looking-at "\\<use\\>")) 6081 (save-excursion (back-to-indentation) 6082 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6083 (/= (preceding-char) ?_) 6084 (not (vhdl-in-literal)) 6085 (vhdl-begin-p lim) 6086 (cond 6087 ;; "is", "generate", "loop": 6088 ((looking-at "[igl]") 6089 (vector "end" 6090 (and (vhdl-last-word (point)) 6091 (or (vhdl-first-word (point)) 6092 (save-excursion 6093 (vhdl-beginning-of-statement-1 lim) 6094 (vhdl-backward-skip-label lim) 6095 (vhdl-first-word (point))))))) 6096 ;; "begin", "else", "for": 6097 ((looking-at "be\\|[ef]") 6098 (vector "end" 6099 (and (vhdl-last-word (point)) 6100 (or (vhdl-first-word (point)) 6101 (save-excursion 6102 (vhdl-beginning-of-statement-1 lim) 6103 (vhdl-backward-skip-label lim) 6104 (vhdl-first-word (point))))))) 6105 ;; "component", "units", "record", "protected body": 6106 ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record") 6107 ;; The first end found will close the block 6108 (vector "end" nil)) 6109 ;; "block", "process", "procedural": 6110 ((looking-at "bl\\|p") 6111 (vector "end" 6112 (or (vhdl-first-word (point)) 6113 (save-excursion 6114 (vhdl-beginning-of-statement-1 lim) 6115 (vhdl-backward-skip-label lim) 6116 (vhdl-first-word (point)))))) 6117 ;; "then": 6118 ((looking-at "t\\|use") 6119 (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)" 6120 (and (vhdl-last-word (point)) 6121 (or (vhdl-first-word (point)) 6122 (save-excursion 6123 (vhdl-beginning-of-statement-1 lim) 6124 (vhdl-backward-skip-label lim) 6125 (vhdl-first-word (point))))))) 6126 )))) 6127 6128(defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") 6129 6130(defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") 6131 6132(defun vhdl-end-p (&optional lim) 6133 "Return t if we are looking at a real \"end\" keyword. 6134Assumes that the caller will make sure that we are looking at 6135vhdl-end-fwd-re, and are not inside a literal, and that we are not in 6136the middle of an identifier that just happens to contain an \"end\" 6137keyword." 6138 (or (not (looking-at "else")) 6139 ;; make sure that the "else" isn't inside a conditional signal 6140 ;; assignment. 6141 (save-excursion 6142 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 6143 (or (eq (following-char) ?\;) 6144 (eq (point) lim) 6145 (vhdl-in-literal))))) 6146 6147(defun vhdl-corresponding-begin (&optional lim) 6148 "If the word at the current position corresponds to an \"end\" 6149keyword, then return a vector containing enough information to find 6150the corresponding \"begin\" keyword, else return nil. The keyword to 6151search backward for is aref 0. The column in which the keyword must 6152appear is aref 1 or nil if any column is suitable. The supplementary 6153keyword to search forward for is aref 2 or nil if this is not 6154required. If aref 3 is t, then the \"begin\" keyword may be found in 6155the middle of a statement. 6156Assumes that the caller will make sure that we are not in the middle 6157of an identifier that just happens to contain an \"end\" keyword." 6158 (save-excursion 6159 (let (pos) 6160 (if (and (looking-at vhdl-end-fwd-re) 6161 (not (vhdl-in-literal)) 6162 (vhdl-end-p lim)) 6163 (if (looking-at "el") 6164 ;; "else", "elsif": 6165 (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil) 6166 ;; "end ...": 6167 (setq pos (point)) 6168 (forward-sexp) 6169 (skip-chars-forward " \t\n\r\f") 6170 (cond 6171 ;; "end if": 6172 ((looking-at "if\\b[^_]") 6173 (vector "else\\|elsif\\|if" 6174 (vhdl-first-word pos) 6175 "else\\|then\\|use" nil)) 6176 ;; "end component": 6177 ((looking-at "component\\b[^_]") 6178 (vector (buffer-substring (match-beginning 1) 6179 (match-end 1)) 6180 (vhdl-first-word pos) 6181 nil nil)) 6182 ;; "end units", "end record", "end protected": 6183 ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]") 6184 (vector (buffer-substring (match-beginning 1) 6185 (match-end 1)) 6186 (vhdl-first-word pos) 6187 nil t)) 6188 ;; "end block", "end process", "end procedural": 6189 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") 6190 (vector "begin" (vhdl-first-word pos) nil nil)) 6191 ;; "end case": 6192 ((looking-at "case\\b[^_]") 6193 (vector "case" (vhdl-first-word pos) "is" nil)) 6194 ;; "end generate": 6195 ((looking-at "generate\\b[^_]") 6196 (vector "generate\\|for\\|if" 6197 (vhdl-first-word pos) 6198 "generate" nil)) 6199 ;; "end loop": 6200 ((looking-at "loop\\b[^_]") 6201 (vector "loop\\|while\\|for" 6202 (vhdl-first-word pos) 6203 "loop" nil)) 6204 ;; "end for" (inside configuration declaration): 6205 ((looking-at "for\\b[^_]") 6206 (vector "for" (vhdl-first-word pos) nil nil)) 6207 ;; "end [id]": 6208 (t 6209 (vector "begin\\|architecture\\|configuration\\|context\\|entity\\|package\\|procedure\\|function" 6210 (vhdl-first-word pos) 6211 ;; return an alist of (statement . keyword) mappings 6212 '( 6213 ;; "begin ... end [id]": 6214 ("begin" . nil) 6215 ;; "architecture ... is ... begin ... end [id]": 6216 ("architecture" . "is") 6217 ;; "configuration ... is ... end [id]": 6218 ("configuration" . "is") 6219 ;; "context ... is ... end [id]": 6220 ("context" . "is") 6221 ;; "entity ... is ... end [id]": 6222 ("entity" . "is") 6223 ;; "package ... is ... end [id]": 6224 ("package" . "is") 6225 ;; "procedure ... is ... begin ... end [id]": 6226 ("procedure" . "is") 6227 ;; "function ... is ... begin ... end [id]": 6228 ("function" . "is") 6229 ) 6230 nil)) 6231 ))) ; "end ..." 6232 ))) 6233 6234(defconst vhdl-leader-re 6235 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") 6236 6237(defun vhdl-end-of-leader () 6238 (save-excursion 6239 (cond ((looking-at "block\\|process\\|procedural") 6240 (if (save-excursion 6241 (forward-sexp) 6242 (skip-chars-forward " \t\n\r\f") 6243 (= (following-char) ?\()) 6244 (forward-sexp 2) 6245 (forward-sexp)) 6246 (when (looking-at "[ \t\n\r\f]*is") 6247 (goto-char (match-end 0))) 6248 (point)) 6249 ((looking-at "component") 6250 (forward-sexp 2) 6251 (when (looking-at "[ \t\n\r\f]*is") 6252 (goto-char (match-end 0))) 6253 (point)) 6254 ((looking-at "for") 6255 (forward-sexp 2) 6256 (skip-chars-forward " \t\n\r\f") 6257 (while (looking-at "[,:(]") 6258 (forward-sexp) 6259 (skip-chars-forward " \t\n\r\f")) 6260 (point)) 6261 (t nil) 6262 ))) 6263 6264(defconst vhdl-trailer-re 6265 "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]") 6266 6267(defconst vhdl-statement-fwd-re 6268 "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)" 6269 "Regexp for searching forward that matches all known \"statement\" keywords.") 6270 6271(defconst vhdl-statement-bwd-re 6272 "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]" 6273 "Regexp for searching backward that matches all known \"statement\" keywords.") 6274 6275(defun vhdl-statement-p (&optional _lim) 6276 "Return t if we are looking at a real \"statement\" keyword. 6277Assumes that the caller will make sure that we are looking at 6278vhdl-statement-fwd-re, and are not inside a literal, and that we are not 6279in the middle of an identifier that just happens to contain a 6280\"statement\" keyword." 6281 (cond 6282 ;; "for" ... "generate": 6283 ((and (looking-at "f") 6284 ;; Make sure it's the start of a parameter specification. 6285 (save-excursion 6286 (forward-sexp 2) 6287 (skip-chars-forward " \t\n\r\f") 6288 (looking-at "in\\b[^_]")) 6289 ;; Make sure it's not an "end for". 6290 (save-excursion 6291 (backward-sexp) 6292 (not (looking-at "end\\s-+\\w")))) 6293 t) 6294 ;; "if" ... "then", "if" ... "generate", "if" ... "loop": 6295 ((and (looking-at "i") 6296 ;; Make sure it's not an "end if". 6297 (save-excursion 6298 (backward-sexp) 6299 (not (looking-at "end\\s-+\\w")))) 6300 t) 6301 ;; "while" ... "loop": 6302 ((looking-at "w") 6303 t) 6304 )) 6305 6306(defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>" 6307 "Regexp describing a case statement alternative key.") 6308 6309(defun vhdl-case-alternative-p (&optional lim) 6310 "Return t if we are looking at a real case alternative. 6311Assumes that the caller will make sure that we are looking at 6312vhdl-case-alternative-re, and are not inside a literal, and that 6313we are not in the middle of an identifier that just happens to 6314contain a \"when\" keyword." 6315 (save-excursion 6316 (let (foundp) 6317 (while (and (not foundp) 6318 (re-search-backward ";\\|<=" lim 'move)) 6319 (if (or (= (preceding-char) ?_) 6320 (vhdl-in-literal)) 6321 (backward-char) 6322 (setq foundp t))) 6323 (or (eq (following-char) ?\;) 6324 (eq (point) lim))) 6325 )) 6326 6327;; Core syntactic movement functions: 6328 6329(defconst vhdl-b-t-b-re 6330 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) 6331 6332(defun vhdl-backward-to-block (&optional lim) 6333 "Move backward to the previous \"begin\" or \"end\" keyword." 6334 (let (foundp) 6335 (while (and (not foundp) 6336 (re-search-backward vhdl-b-t-b-re lim 'move)) 6337 (if (or (= (preceding-char) ?_) 6338 (vhdl-in-literal)) 6339 (backward-char) 6340 (cond 6341 ;; "begin" keyword: 6342 ((and (looking-at vhdl-begin-fwd-re) 6343 (or (not (looking-at "\\<use\\>")) 6344 (save-excursion (back-to-indentation) 6345 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6346 (/= (preceding-char) ?_) 6347 (vhdl-begin-p lim)) 6348 (setq foundp 'begin)) 6349 ;; "end" keyword: 6350 ((and (looking-at vhdl-end-fwd-re) 6351 (/= (preceding-char) ?_) 6352 (vhdl-end-p lim)) 6353 (setq foundp 'end)) 6354 )) 6355 ) 6356 foundp 6357 )) 6358 6359(defun vhdl-forward-sexp (&optional count lim) 6360 "Move forward across one balanced expression (sexp). 6361With COUNT, do it that many times." 6362 (interactive "p") 6363 (let ((count (or count 1)) 6364 (case-fold-search t) 6365 end-vec target) 6366 (save-excursion 6367 (while (> count 0) 6368 ;; skip whitespace 6369 (skip-chars-forward " \t\n\r\f") 6370 ;; Check for an unbalanced "end" keyword 6371 (if (and (looking-at vhdl-end-fwd-re) 6372 (/= (preceding-char) ?_) 6373 (not (vhdl-in-literal)) 6374 (vhdl-end-p lim) 6375 (not (looking-at "else"))) 6376 (error 6377 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) 6378 ;; If the current keyword is a "begin" keyword, then find the 6379 ;; corresponding "end" keyword. 6380 (if (setq end-vec (vhdl-corresponding-end lim)) 6381 (let ( 6382 ;; end-re is the statement keyword to search for 6383 (end-re 6384 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) 6385 ;; column is either the statement keyword target column 6386 ;; or nil 6387 (column (aref end-vec 1)) 6388 (eol (vhdl-point 'eol)) 6389 foundp literal placeholder) 6390 ;; Look for the statement keyword. 6391 (while (and (not foundp) 6392 (re-search-forward end-re nil t) 6393 (setq placeholder (match-end 1)) 6394 (goto-char (match-beginning 0))) 6395 ;; If we are in a literal, or not in the right target 6396 ;; column and not on the same line as the begin, then 6397 ;; try again. 6398 (if (or (and column 6399 (/= (current-indentation) column) 6400 (> (point) eol)) 6401 (= (preceding-char) ?_) 6402 (setq literal (vhdl-in-literal))) 6403 (if (eq literal 'comment) 6404 (end-of-line) 6405 (forward-char)) 6406 ;; An "else" keyword corresponds to both the opening brace 6407 ;; of the following sexp and the closing brace of the 6408 ;; previous sexp. 6409 (if (not (looking-at "else")) 6410 (goto-char placeholder)) 6411 (setq foundp t)) 6412 ) 6413 (if (not foundp) 6414 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) 6415 ) 6416 ;; If the current keyword is not a "begin" keyword, then just 6417 ;; perform the normal forward-sexp. 6418 (forward-sexp) 6419 ) 6420 (setq count (1- count)) 6421 ) 6422 (setq target (point))) 6423 (goto-char target) 6424 nil)) 6425 6426(defun vhdl-backward-sexp (&optional count lim) 6427 "Move backward across one balanced expression (sexp). 6428With COUNT, do it that many times. LIM bounds any required backward 6429searches." 6430 (interactive "p") 6431 (let ((count (or count 1)) 6432 (case-fold-search t) 6433 begin-vec target) 6434 (save-excursion 6435 (while (> count 0) 6436 ;; Perform the normal backward-sexp, unless we are looking at 6437 ;; "else" - an "else" keyword corresponds to both the opening brace 6438 ;; of the following sexp and the closing brace of the previous sexp. 6439 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") 6440 (/= (preceding-char) ?_) 6441 (not (vhdl-in-literal))) 6442 nil 6443 (backward-sexp) 6444 (if (and (looking-at vhdl-begin-fwd-re) 6445 (or (not (looking-at "\\<use\\>")) 6446 (save-excursion 6447 (back-to-indentation) 6448 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6449 (/= (preceding-char) ?_) 6450 (not (vhdl-in-literal)) 6451 (vhdl-begin-p lim)) 6452 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) 6453 ;; If the current keyword is an "end" keyword, then find the 6454 ;; corresponding "begin" keyword. 6455 (if (and (setq begin-vec (vhdl-corresponding-begin lim)) 6456 (/= (preceding-char) ?_)) 6457 (let ( 6458 ;; begin-re is the statement keyword to search for 6459 (begin-re 6460 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) 6461 ;; column is either the statement keyword target column 6462 ;; or nil 6463 (column (aref begin-vec 1)) 6464 ;; internal-p controls where the statement keyword can 6465 ;; be found. 6466 (internal-p (aref begin-vec 3)) 6467 (last-backward (point)) ;; last-forward 6468 foundp literal keyword) 6469 ;; Look for the statement keyword. 6470 (while (and (not foundp) 6471 (re-search-backward begin-re lim t) 6472 (setq keyword 6473 (buffer-substring (match-beginning 1) 6474 (match-end 1)))) 6475 ;; If we are in a literal or in the wrong column, 6476 ;; then try again. 6477 (if (or (and column 6478 (and (/= (current-indentation) column) 6479 ;; possibly accept current-column as 6480 ;; well as current-indentation. 6481 (or (not internal-p) 6482 (/= (current-column) column)))) 6483 (= (preceding-char) ?_) 6484 (vhdl-in-literal)) 6485 (backward-char) 6486 ;; If there is a supplementary keyword, then 6487 ;; search forward for it. 6488 (if (and (setq begin-re (aref begin-vec 2)) 6489 (or (not (listp begin-re)) 6490 ;; If begin-re is an alist, then find the 6491 ;; element corresponding to the actual 6492 ;; keyword that we found. 6493 (progn 6494 (setq begin-re 6495 (assoc keyword begin-re)) 6496 (and begin-re 6497 (setq begin-re (cdr begin-re)))))) 6498 (and 6499 (setq begin-re 6500 (concat "\\b\\(" begin-re "\\)\\b[^_]")) 6501 (save-excursion 6502 ;; (setq last-forward (point)) 6503 ;; Look for the supplementary keyword 6504 ;; (bounded by the backward search start 6505 ;; point). 6506 (while (and (not foundp) 6507 (re-search-forward begin-re 6508 last-backward t) 6509 (goto-char (match-beginning 1))) 6510 ;; If we are in a literal, then try again. 6511 (if (or (= (preceding-char) ?_) 6512 (setq literal 6513 (vhdl-in-literal))) 6514 (if (eq literal 'comment) 6515 (goto-char 6516 (min (vhdl-point 'eol) last-backward)) 6517 (forward-char)) 6518 ;; We have found the supplementary keyword. 6519 ;; Save the position of the keyword in foundp. 6520 (setq foundp (point))) 6521 ) 6522 foundp) 6523 ;; If the supplementary keyword was found, then 6524 ;; move point to the supplementary keyword. 6525 (goto-char foundp)) 6526 ;; If there was no supplementary keyword, then 6527 ;; point is already at the statement keyword. 6528 (setq foundp t))) 6529 ) ; end of the search for the statement keyword 6530 (if (not foundp) 6531 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) 6532 )) 6533 (setq count (1- count)) 6534 ) 6535 (setq target (point))) 6536 (goto-char target) 6537 nil)) 6538 6539(defun vhdl-backward-up-list (&optional count limit) 6540 "Move backward out of one level of blocks. 6541With argument, do this that many times." 6542 (interactive "p") 6543 (let ((count (or count 1)) 6544 target) 6545 (save-excursion 6546 (while (> count 0) 6547 (if (looking-at vhdl-defun-re) 6548 (error "ERROR: Unbalanced blocks")) 6549 (vhdl-backward-to-block limit) 6550 (setq count (1- count))) 6551 (setq target (point))) 6552 (goto-char target))) 6553 6554(defun vhdl-end-of-defun (&optional _count) 6555 "Move forward to the end of a VHDL defun." 6556 (interactive) 6557 (let ((case-fold-search t)) 6558 (vhdl-beginning-of-defun) 6559 (if (not (looking-at "block\\|process\\|procedural")) 6560 (re-search-forward "\\bis\\b")) 6561 (vhdl-forward-sexp))) 6562 6563(defun vhdl-mark-defun () 6564 "Put mark at end of this \"defun\", point at beginning." 6565 (interactive) 6566 (let ((case-fold-search t)) 6567 (push-mark) 6568 (vhdl-beginning-of-defun) 6569 (push-mark) 6570 (if (not (looking-at "block\\|process\\|procedural")) 6571 (re-search-forward "\\bis\\b")) 6572 (vhdl-forward-sexp) 6573 (exchange-point-and-mark))) 6574 6575(defun vhdl-beginning-of-libunit () 6576 "Move backward to the beginning of a VHDL library unit. 6577Returns the location of the corresponding begin keyword, unless search 6578stops due to beginning or end of buffer. 6579Note that if point is between the \"libunit\" keyword and the 6580corresponding \"begin\" keyword, then that libunit will not be 6581recognized, and the search will continue backwards. If point is 6582at the \"begin\" keyword, then the defun will be recognized. The 6583returned point is at the first character of the \"libunit\" keyword." 6584 (let ((last-forward (point)) 6585 (last-backward 6586 ;; Just in case we are actually sitting on the "begin" 6587 ;; keyword, allow for the keyword and an extra character, 6588 ;; as this will be used when looking forward for the 6589 ;; "begin" keyword. 6590 (save-excursion (forward-word-strictly 1) (1+ (point)))) 6591 foundp literal placeholder) 6592 ;; Find the "libunit" keyword. 6593 (while (and (not foundp) 6594 (re-search-backward vhdl-libunit-re nil 'move)) 6595 ;; If we are in a literal, or not at a real libunit, then try again. 6596 (if (or (= (preceding-char) ?_) 6597 (vhdl-in-literal) 6598 (not (vhdl-libunit-p))) 6599 (backward-char) 6600 ;; Find the corresponding "begin" keyword. 6601 (setq last-forward (point)) 6602 (while (and (not foundp) 6603 (re-search-forward "\\bis\\b[^_]" last-backward t) 6604 (setq placeholder (match-beginning 0))) 6605 (if (or (= (preceding-char) ?_) 6606 (setq literal (vhdl-in-literal))) 6607 ;; It wasn't a real keyword, so keep searching. 6608 (if (eq literal 'comment) 6609 (goto-char 6610 (min (vhdl-point 'eol) last-backward)) 6611 (forward-char)) 6612 ;; We have found the begin keyword, loop will exit. 6613 (setq foundp placeholder))) 6614 ;; Go back to the libunit keyword 6615 (goto-char last-forward))) 6616 foundp)) 6617 6618(defun vhdl-beginning-of-defun (&optional count) 6619 "Move backward to the beginning of a VHDL defun. 6620With argument, do it that many times. 6621Returns the location of the corresponding begin keyword, unless search 6622stops due to beginning or end of buffer." 6623 ;; Note that if point is between the "defun" keyword and the 6624 ;; corresponding "begin" keyword, then that defun will not be 6625 ;; recognized, and the search will continue backwards. If point is 6626 ;; at the "begin" keyword, then the defun will be recognized. The 6627 ;; returned point is at the first character of the "defun" keyword. 6628 (interactive "p") 6629 (let ((count (or count 1)) 6630 (case-fold-search t) 6631 (last-forward (point)) 6632 foundp) 6633 (while (> count 0) 6634 (setq foundp nil) 6635 (goto-char last-forward) 6636 (let ((last-backward 6637 ;; Just in case we are actually sitting on the "begin" 6638 ;; keyword, allow for the keyword and an extra character, 6639 ;; as this will be used when looking forward for the 6640 ;; "begin" keyword. 6641 (save-excursion (forward-word-strictly 1) (1+ (point)))) 6642 begin-string literal) 6643 (while (and (not foundp) 6644 (re-search-backward vhdl-defun-re nil 'move)) 6645 ;; If we are in a literal, then try again. 6646 (if (or (= (preceding-char) ?_) 6647 (vhdl-in-literal)) 6648 (backward-char) 6649 (if (setq begin-string (vhdl-corresponding-defun)) 6650 ;; This is a real defun keyword. 6651 ;; Find the corresponding "begin" keyword. 6652 ;; Look for the begin keyword. 6653 (progn 6654 ;; Save the search start point. 6655 (setq last-forward (point)) 6656 (while (and (not foundp) 6657 (search-forward begin-string last-backward t)) 6658 (if (or (= (preceding-char) ?_) 6659 (save-match-data 6660 (setq literal (vhdl-in-literal)))) 6661 ;; It wasn't a real keyword, so keep searching. 6662 (if (eq literal 'comment) 6663 (goto-char 6664 (min (vhdl-point 'eol) last-backward)) 6665 (forward-char)) 6666 ;; We have found the begin keyword, loop will exit. 6667 (setq foundp (match-beginning 0))) 6668 ) 6669 ;; Go back to the defun keyword 6670 (goto-char last-forward)) ; end search for begin keyword 6671 )) 6672 ) ; end of the search for the defun keyword 6673 ) 6674 (setq count (1- count)) 6675 ) 6676 (vhdl-keep-region-active) 6677 foundp)) 6678 6679(defun vhdl-beginning-of-statement (&optional count lim interactive) 6680 "Go to the beginning of the innermost VHDL statement. 6681With prefix arg, go back N - 1 statements. If already at the 6682beginning of a statement then go to the beginning of the preceding 6683one. If within a string or comment, or next to a comment (only 6684whitespace between), move by sentences instead of statements. 6685 6686When called from a program, this function takes 3 optional args: the 6687prefix arg, a buffer position limit which is the farthest back to 6688search, and an argument indicating an interactive call." 6689 (interactive "p\np") 6690 (let ((count (or count 1)) 6691 (case-fold-search t) 6692 (lim (or lim (point-min))) 6693 (here (point)) 6694 state) 6695 (save-excursion 6696 (goto-char lim) 6697 (setq state (parse-partial-sexp (point) here nil nil))) 6698 (if (and interactive 6699 (or (nth 3 state) 6700 (nth 4 state) 6701 (looking-at (concat "[ \t]*\\(?:" comment-start-skip "\\)")))) 6702 (forward-sentence (- count)) 6703 (while (> count 0) 6704 (vhdl-beginning-of-statement-1 lim) 6705 (setq count (1- count)))) 6706 ;; its possible we've been left up-buf of lim 6707 (goto-char (max (point) lim)) 6708 ) 6709 (vhdl-keep-region-active)) 6710 6711(defconst vhdl-e-o-s-re 6712 (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) 6713 6714(defun vhdl-end-of-statement () 6715 "Very simple implementation." 6716 (interactive) 6717 (re-search-forward vhdl-e-o-s-re)) 6718 6719(defconst vhdl-b-o-s-re 6720 (concat ";[^_]\\|([^_]\\|)[^_]\\|\\bwhen\\b[^_]\\|" 6721 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) 6722 6723(defun vhdl-beginning-of-statement-1 (&optional lim) 6724 "Move to the start of the current statement. 6725If already at the beginning of a statement, move to the start of 6726the previous statement instead." 6727 (let ((lim (or lim (point-min))) 6728 (here (point)) 6729 (pos (point)) 6730 donep) 6731 ;; go backwards one balanced expression, but be careful of 6732 ;; unbalanced paren being reached 6733 (if (not (vhdl-safe (progn (backward-sexp) t))) 6734 (progn 6735 (backward-up-list 1) 6736 (forward-char) 6737 (vhdl-forward-syntactic-ws here) 6738 (setq donep t))) 6739 (while (and (not donep) 6740 (not (bobp)) 6741 ;; look backwards for a statement boundary 6742 (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move))) 6743 (if (or (= (preceding-char) ?_) 6744 (vhdl-in-literal)) 6745 (backward-char) 6746 (cond 6747 ;; If we are looking at an open paren, then stop after it 6748 ((eq (following-char) ?\() 6749 (forward-char) 6750 (vhdl-forward-syntactic-ws here) 6751 (setq donep t)) 6752 ;; If we are looking at a close paren, then skip it 6753 ((eq (following-char) ?\)) 6754 (forward-char) 6755 (setq pos (point)) 6756 (backward-sexp) 6757 (if (< (point) lim) 6758 (progn (goto-char pos) 6759 (vhdl-forward-syntactic-ws here) 6760 (setq donep t)))) 6761 ;; If we are looking at a semicolon, then stop 6762 ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p))) 6763 (progn 6764 (forward-char) 6765 (vhdl-forward-syntactic-ws here) 6766 (setq donep t))) 6767 ;; If we are looking at a "begin", then stop 6768 ((and (looking-at vhdl-begin-fwd-re) 6769 (or (not (looking-at "\\<use\\>")) 6770 (save-excursion 6771 (back-to-indentation) 6772 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 6773 (/= (preceding-char) ?_) 6774 (vhdl-begin-p nil)) 6775 ;; If it's a leader "begin", then find the 6776 ;; right place 6777 (if (looking-at vhdl-leader-re) 6778 (save-excursion 6779 ;; set a default stop point at the begin 6780 (setq pos (point)) 6781 ;; is the start point inside the leader area ? 6782 (goto-char (vhdl-end-of-leader)) 6783 (vhdl-forward-syntactic-ws here) 6784 (if (< (point) here) 6785 ;; start point was not inside leader area 6786 ;; set stop point at word after leader 6787 (setq pos (point)))) 6788 (unless (looking-at "\\<else\\s-+generate\\>") 6789 (forward-word-strictly 1)) 6790 (vhdl-forward-syntactic-ws here) 6791 (setq pos (point))) 6792 (goto-char pos) 6793 (setq donep t)) 6794 ;; If we are looking at a "statement", then stop 6795 ((and (looking-at vhdl-statement-fwd-re) 6796 (/= (preceding-char) ?_) 6797 (vhdl-statement-p nil)) 6798 (setq donep t)) 6799 ;; If we are looking at a case alternative key, then stop 6800 ((and (looking-at vhdl-case-alternative-re) 6801 (vhdl-case-alternative-p lim)) 6802 (save-excursion 6803 ;; set a default stop point at the when 6804 (setq pos (point)) 6805 ;; is the start point inside the case alternative key ? 6806 (looking-at vhdl-case-alternative-re) 6807 (goto-char (match-end 0)) 6808 (vhdl-forward-syntactic-ws here) 6809 (if (< (point) here) 6810 ;; start point was not inside the case alternative key 6811 ;; set stop point at word after case alternative keyleader 6812 (setq pos (point)))) 6813 (goto-char pos) 6814 (setq donep t)) 6815 ;; Bogus find, continue 6816 (t 6817 (backward-char))))) 6818 )) 6819 6820;; Defuns for calculating the current syntactic state: 6821 6822(defun vhdl-get-library-unit (bod placeholder) 6823 "If there is an enclosing library unit at BOD, with its \"begin\" 6824keyword at PLACEHOLDER, then return the library unit type." 6825 (let ((here (vhdl-point 'bol))) 6826 (if (save-excursion 6827 (goto-char placeholder) 6828 (vhdl-safe (vhdl-forward-sexp 1 bod)) 6829 (<= here (point))) 6830 (save-excursion 6831 (goto-char bod) 6832 (cond 6833 ((looking-at "e") 'entity) 6834 ((looking-at "a") 'architecture) 6835 ((looking-at "conf") 'configuration) 6836 ((looking-at "cont") 'context) 6837 ((looking-at "p") 6838 (save-excursion 6839 (goto-char bod) 6840 (forward-sexp) 6841 (vhdl-forward-syntactic-ws here) 6842 (if (looking-at "body\\b[^_]") 6843 'package-body 'package)))))) 6844 )) 6845 6846(defun vhdl-get-block-state (&optional lim) 6847 "Find and records all the closest opens. 6848LIM is the furthest back we need to search (it should be the 6849previous libunit keyword)." 6850 (let ((here (point)) 6851 (lim (or lim (point-min))) 6852 keyword sexp-start sexp-mid sexp-end 6853 preceding-sexp containing-sexp 6854 containing-begin containing-mid containing-paren) 6855 (save-excursion 6856 ;; Find the containing-paren, and use that as the limit 6857 (if (setq containing-paren 6858 (save-restriction 6859 (narrow-to-region lim (point)) 6860 (vhdl-safe (scan-lists (point) -1 1)))) 6861 (setq lim containing-paren)) 6862 ;; Look backwards for "begin" and "end" keywords. 6863 (while (and (> (point) lim) 6864 (not containing-sexp)) 6865 (setq keyword (vhdl-backward-to-block lim)) 6866 (cond 6867 ((eq keyword 'begin) 6868 ;; Found a "begin" keyword 6869 (setq sexp-start (point)) 6870 (setq sexp-mid (vhdl-corresponding-mid lim)) 6871 (setq sexp-end (vhdl-safe 6872 (save-excursion 6873 (vhdl-forward-sexp 1 lim) (point)))) 6874 (if (and sexp-end (<= sexp-end here)) 6875 ;; we want to record this sexp, but we only want to 6876 ;; record the last-most of any of them before here 6877 (or preceding-sexp 6878 (setq preceding-sexp sexp-start)) 6879 ;; we're contained in this sexp so put sexp-start on 6880 ;; front of list 6881 (setq containing-sexp sexp-start) 6882 (setq containing-mid sexp-mid) 6883 (setq containing-begin t))) 6884 ((eq keyword 'end) 6885 ;; Found an "end" keyword 6886 (forward-sexp) 6887 (setq sexp-end (point)) 6888 (setq sexp-mid nil) 6889 (setq sexp-start 6890 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) 6891 (progn (backward-sexp) (point)))) 6892 ;; we want to record this sexp, but we only want to 6893 ;; record the last-most of any of them before here 6894 (or preceding-sexp 6895 (setq preceding-sexp sexp-start))) 6896 ))) 6897 ;; Check if the containing-paren should be the containing-sexp 6898 (if (and containing-paren 6899 (or (null containing-sexp) 6900 (< containing-sexp containing-paren))) 6901 (setq containing-sexp containing-paren 6902 preceding-sexp nil 6903 containing-begin nil 6904 containing-mid nil)) 6905 (vector containing-sexp preceding-sexp containing-begin containing-mid) 6906 )) 6907 6908 6909(defconst vhdl-s-c-a-re 6910 (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) 6911 6912(defun vhdl-skip-case-alternative (&optional lim) 6913 "Skip forward over case/when bodies, with optional maximal limit. 6914If no next case alternative is found, nil is returned and point 6915is not moved." 6916 (let ((lim (or lim (point-max))) 6917 (here (point)) 6918 donep foundp) 6919 (while (and (< (point) lim) 6920 (not donep)) 6921 (if (and (re-search-forward vhdl-s-c-a-re lim 'move) 6922 (save-match-data 6923 (not (vhdl-in-literal))) 6924 (/= (match-beginning 0) here)) 6925 (progn 6926 (goto-char (match-beginning 0)) 6927 (cond 6928 ((and (looking-at "case") 6929 (re-search-forward "\\bis[^_]" lim t)) 6930 (backward-sexp) 6931 (vhdl-forward-sexp)) 6932 (t 6933 (setq donep t 6934 foundp t)))))) 6935 (if (not foundp) 6936 (goto-char here)) 6937 foundp)) 6938 6939(defun vhdl-backward-skip-label (&optional lim) 6940 "Skip backward over a label, with optional maximal limit. 6941If label is not found, nil is returned and point is not moved." 6942 (let ((lim (or lim (point-min))) 6943 placeholder) 6944 (if (save-excursion 6945 (vhdl-backward-syntactic-ws lim) 6946 (and (eq (preceding-char) ?:) 6947 (progn 6948 (backward-sexp) 6949 (setq placeholder (point)) 6950 (looking-at vhdl-label-key)))) 6951 (goto-char placeholder)) 6952 )) 6953 6954(defun vhdl-forward-skip-label (&optional lim) 6955 "Skip forward over a label, with optional maximal limit. 6956If label is not found, nil is returned and point is not moved." 6957 (let ((lim (or lim (point-max)))) 6958 (if (looking-at vhdl-label-key) 6959 (progn 6960 (goto-char (match-end 0)) 6961 (vhdl-forward-syntactic-ws lim))) 6962 )) 6963 6964(defun vhdl-get-syntactic-context () 6965 "Guess the syntactic description of the current line of VHDL code." 6966 (save-excursion 6967 (save-restriction 6968 (beginning-of-line) 6969 (let* ((indent-point (point)) 6970 (case-fold-search t) 6971 vec literal containing-sexp preceding-sexp 6972 containing-begin containing-mid containing-leader 6973 char-before-ip char-after-ip begin-after-ip end-after-ip 6974 placeholder lim library-unit 6975 ) 6976 6977 ;; Reset the syntactic context 6978 (setq vhdl-syntactic-context nil) 6979 6980 (save-excursion 6981 ;; Move to the start of the previous library unit, and 6982 ;; record the position of the "begin" keyword. 6983 (setq placeholder (vhdl-beginning-of-libunit)) 6984 ;; The position of the "libunit" keyword gives us a gross 6985 ;; limit point. 6986 (setq lim (point)) 6987 ) 6988 6989 ;; If there is a previous library unit, and we are enclosed by 6990 ;; it, then set the syntax accordingly. 6991 (and placeholder 6992 (setq library-unit (vhdl-get-library-unit lim placeholder)) 6993 (vhdl-add-syntax library-unit lim)) 6994 6995 ;; Find the surrounding state. 6996 (if (setq vec (vhdl-get-block-state lim)) 6997 (progn 6998 (setq containing-sexp (aref vec 0)) 6999 (setq preceding-sexp (aref vec 1)) 7000 (setq containing-begin (aref vec 2)) 7001 (setq containing-mid (aref vec 3)) 7002 )) 7003 7004 ;; set the limit on the farthest back we need to search 7005 (setq lim (if containing-sexp 7006 (save-excursion 7007 (goto-char containing-sexp) 7008 ;; set containing-leader if required 7009 (if (looking-at vhdl-leader-re) 7010 (setq containing-leader (vhdl-end-of-leader))) 7011 (vhdl-point 'bol)) 7012 (point-min))) 7013 7014 ;; cache char before and after indent point, and move point to 7015 ;; the most likely position to perform the majority of tests 7016 (goto-char indent-point) 7017 (skip-chars-forward " \t") 7018 (setq literal (vhdl-in-literal)) 7019 (setq char-after-ip (following-char)) 7020 (setq begin-after-ip (and 7021 (not literal) 7022 (looking-at vhdl-begin-fwd-re) 7023 (or (not (looking-at "\\<use\\>")) 7024 (save-excursion 7025 (back-to-indentation) 7026 (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) 7027 (vhdl-begin-p))) 7028 (setq end-after-ip (and 7029 (not literal) 7030 (looking-at vhdl-end-fwd-re) 7031 (vhdl-end-p))) 7032 (vhdl-backward-syntactic-ws lim) 7033 (setq char-before-ip (preceding-char)) 7034 (goto-char indent-point) 7035 (skip-chars-forward " \t") 7036 7037 ;; now figure out syntactic qualities of the current line 7038 (cond 7039 ;; CASE 1: in a string or comment. 7040 ((memq literal '(string comment)) 7041 (vhdl-add-syntax literal (vhdl-point 'bopl))) 7042 ;; CASE 2: Line is at top level. 7043 ((null containing-sexp) 7044 ;; Find the point to which indentation will be relative 7045 (save-excursion 7046 (if (null preceding-sexp) 7047 ;; CASE 2X.1 7048 ;; no preceding-sexp -> use the preceding statement 7049 (vhdl-beginning-of-statement-1 lim) 7050 ;; CASE 2X.2 7051 ;; if there is a preceding-sexp then indent relative to it 7052 (goto-char preceding-sexp) 7053 ;; if not at boi, then the block-opening keyword is 7054 ;; probably following a label, so we need a different 7055 ;; relpos 7056 (if (/= (point) (vhdl-point 'boi)) 7057 ;; CASE 2X.3 7058 (vhdl-beginning-of-statement-1 lim))) 7059 ;; v-b-o-s could have left us at point-min 7060 (and (bobp) 7061 ;; CASE 2X.4 7062 (vhdl-forward-syntactic-ws indent-point)) 7063 (setq placeholder (point))) 7064 (cond 7065 ;; CASE 2A : we are looking at a block-open 7066 (begin-after-ip 7067 (vhdl-add-syntax 'block-open placeholder)) 7068 ;; CASE 2B: we are looking at a block-close 7069 (end-after-ip 7070 (vhdl-add-syntax 'block-close placeholder)) 7071 ;; CASE 2C: we are looking at a top-level statement 7072 ((progn 7073 (vhdl-backward-syntactic-ws lim) 7074 (or (bobp) 7075 (and (= (preceding-char) ?\;) 7076 (not (vhdl-in-quote-p))))) 7077 (vhdl-add-syntax 'statement placeholder)) 7078 ;; CASE 2D: we are looking at a top-level statement-cont 7079 (t 7080 (vhdl-beginning-of-statement-1 lim) 7081 ;; v-b-o-s could have left us at point-min 7082 (and (bobp) 7083 ;; CASE 2D.1 7084 (vhdl-forward-syntactic-ws indent-point)) 7085 (vhdl-add-syntax 'statement-cont (point))) 7086 )) ; end CASE 2 7087 ;; CASE 3: line is inside parentheses. Most likely we are 7088 ;; either in a subprogram argument (interface) list, or a 7089 ;; continued expression containing parentheses. 7090 ((null containing-begin) 7091 (vhdl-backward-syntactic-ws containing-sexp) 7092 (cond 7093 ;; CASE 3A: we are looking at the arglist closing paren 7094 ((eq char-after-ip ?\)) 7095 (goto-char containing-sexp) 7096 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) 7097 ;; CASE 3B: we are looking at the first argument in an empty 7098 ;; argument list. 7099 ((eq char-before-ip ?\() 7100 (goto-char containing-sexp) 7101 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) 7102 ;; CASE 3C: we are looking at an arglist continuation line, 7103 ;; but the preceding argument is on the same line as the 7104 ;; opening paren. This case includes multi-line 7105 ;; expression paren groupings. 7106 ((and (save-excursion 7107 (goto-char (1+ containing-sexp)) 7108 (skip-chars-forward " \t") 7109 (not (eolp)) 7110 (not (looking-at "--\\|`"))) 7111 (save-excursion 7112 (vhdl-beginning-of-statement-1 containing-sexp) 7113 (skip-chars-backward " \t(") 7114 (while (and (= (preceding-char) ?\;) 7115 (not (vhdl-in-quote-p))) 7116 (vhdl-beginning-of-statement-1 containing-sexp) 7117 (skip-chars-backward " \t(")) 7118 (<= (point) containing-sexp))) 7119 (goto-char containing-sexp) 7120 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) 7121 ;; CASE 3D: we are looking at just a normal arglist 7122 ;; continuation line 7123 (t (vhdl-beginning-of-statement-1 containing-sexp) 7124 (vhdl-forward-syntactic-ws indent-point) 7125 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) 7126 )) 7127 ;; CASE 4: A block mid open 7128 ((and begin-after-ip 7129 (looking-at containing-mid)) 7130 (goto-char containing-sexp) 7131 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7132 (if (looking-at vhdl-trailer-re) 7133 ;; CASE 4.1 7134 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7135 (vhdl-backward-skip-label (vhdl-point 'boi)) 7136 (vhdl-add-syntax 'block-open (point))) 7137 ;; CASE 5: block close brace 7138 (end-after-ip 7139 (goto-char containing-sexp) 7140 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7141 (if (looking-at vhdl-trailer-re) 7142 ;; CASE 5.1 7143 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7144 (vhdl-backward-skip-label (vhdl-point 'boi)) 7145 (vhdl-add-syntax 'block-close (point))) 7146 ;; CASE 6: A continued statement 7147 ((and (/= char-before-ip ?\;) 7148 ;; check it's not a trailer begin keyword, or a begin 7149 ;; keyword immediately following a label. 7150 (not (and begin-after-ip 7151 (or (looking-at vhdl-trailer-re) 7152 (save-excursion 7153 (vhdl-backward-skip-label containing-sexp))))) 7154 ;; check it's not a statement keyword 7155 (not (and (looking-at vhdl-statement-fwd-re) 7156 (vhdl-statement-p))) 7157 ;; see if the b-o-s is before the indent point 7158 (> indent-point 7159 (save-excursion 7160 (vhdl-beginning-of-statement-1 containing-sexp) 7161 ;; If we ended up after a leader, then this will 7162 ;; move us forward to the start of the first 7163 ;; statement. Note that a containing sexp here is 7164 ;; always a keyword, not a paren, so this will 7165 ;; have no effect if we hit the containing-sexp. 7166 (vhdl-forward-syntactic-ws indent-point) 7167 (setq placeholder (point)))) 7168 ;; check it's not a block-intro 7169 (/= placeholder containing-sexp) 7170 ;; check it's not a case block-intro 7171 (save-excursion 7172 (goto-char placeholder) 7173 (or (not (looking-at vhdl-case-alternative-re)) 7174 (> (match-end 0) indent-point)))) 7175 ;; Make placeholder skip a label, but only if it puts us 7176 ;; before the indent point at the start of a line. 7177 (let ((new placeholder)) 7178 (if (and (> indent-point 7179 (save-excursion 7180 (goto-char placeholder) 7181 (vhdl-forward-skip-label indent-point) 7182 (setq new (point)))) 7183 (save-excursion 7184 (goto-char new) 7185 (eq new (progn (back-to-indentation) (point))))) 7186 (setq placeholder new))) 7187 (vhdl-add-syntax 'statement-cont placeholder) 7188 (if begin-after-ip 7189 (vhdl-add-syntax 'block-open))) 7190 ;; Statement. But what kind? 7191 ;; CASE 7: A case alternative key 7192 ((and (looking-at vhdl-case-alternative-re) 7193 (vhdl-case-alternative-p containing-sexp)) 7194 ;; for a case alternative key, we set relpos to the first 7195 ;; non-whitespace char on the line containing the "case" 7196 ;; keyword. 7197 (goto-char containing-sexp) 7198 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7199 (if (looking-at vhdl-trailer-re) 7200 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7201 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) 7202 ;; CASE 8: statement catchall 7203 (t 7204 ;; we know its a statement, but we need to find out if it is 7205 ;; the first statement in a block 7206 (if containing-leader 7207 (goto-char containing-leader) 7208 (goto-char containing-sexp) 7209 ;; Note that a containing sexp here is always a keyword, 7210 ;; not a paren, so skip over the keyword. 7211 (forward-sexp)) 7212 ;; move to the start of the first statement 7213 (vhdl-forward-syntactic-ws indent-point) 7214 (setq placeholder (point)) 7215 ;; we want to ignore case alternatives keys when skipping forward 7216 (let (incase-p) 7217 (while (looking-at vhdl-case-alternative-re) 7218 (setq incase-p (point)) 7219 ;; we also want to skip over the body of the 7220 ;; case/when statement if that doesn't put us at 7221 ;; after the indent-point 7222 (while (vhdl-skip-case-alternative indent-point)) 7223 ;; set up the match end 7224 (looking-at vhdl-case-alternative-re) 7225 (goto-char (match-end 0)) 7226 ;; move to the start of the first case alternative statement 7227 (vhdl-forward-syntactic-ws indent-point) 7228 (setq placeholder (point))) 7229 (cond 7230 ;; CASE 8A: we saw a case/when statement so we must be 7231 ;; in a switch statement. find out if we are at the 7232 ;; statement just after a case alternative key 7233 ((and incase-p 7234 (= (point) indent-point)) 7235 ;; relpos is the "when" keyword 7236 (vhdl-add-syntax 'statement-case-intro incase-p)) 7237 ;; CASE 8B: any old statement 7238 ((< (point) indent-point) 7239 ;; relpos is the first statement of the block 7240 (vhdl-add-syntax 'statement placeholder) 7241 (if begin-after-ip 7242 (vhdl-add-syntax 'block-open))) 7243 ;; CASE 8C: first statement in a block 7244 (t 7245 (goto-char containing-sexp) 7246 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 7247 (if (looking-at vhdl-trailer-re) 7248 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 7249 (vhdl-backward-skip-label (vhdl-point 'boi)) 7250 (vhdl-add-syntax 'statement-block-intro (point)) 7251 (if begin-after-ip 7252 (vhdl-add-syntax 'block-open))) 7253 ))) 7254 ) 7255 7256 ;; now we need to look at any modifiers 7257 (goto-char indent-point) 7258 (skip-chars-forward " \t") 7259 (if (or (looking-at "--") (looking-at "/\\*")) 7260 (vhdl-add-syntax 'comment)) 7261 (if (looking-at "`") 7262 (vhdl-add-syntax 'directive)) 7263 (if (eq literal 'pound) 7264 (vhdl-add-syntax 'cpp-macro)) 7265 ;; return the syntax 7266 vhdl-syntactic-context)))) 7267 7268;; Standard indentation line-ups: 7269 7270(defun vhdl-lineup-arglist (langelem) 7271 "Lineup the current arglist line with the arglist appearing just 7272after the containing paren which starts the arglist." 7273 (save-excursion 7274 (let* ((containing-sexp 7275 (save-excursion 7276 ;; arglist-cont-nonempty gives relpos == 7277 ;; to boi of containing-sexp paren. This 7278 ;; is good when offset is +, but bad 7279 ;; when it is vhdl-lineup-arglist, so we 7280 ;; have to special case a kludge here. 7281 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) 7282 (progn 7283 (beginning-of-line) 7284 (backward-up-list 1) 7285 (skip-chars-forward " \t" (vhdl-point 'eol))) 7286 (goto-char (cdr langelem))) 7287 (point))) 7288 (cs-curcol (save-excursion 7289 (goto-char (cdr langelem)) 7290 (current-column)))) 7291 (if (save-excursion 7292 (beginning-of-line) 7293 (looking-at "[ \t]*)")) 7294 (progn (goto-char (match-end 0)) 7295 (backward-sexp) 7296 (forward-char) 7297 (vhdl-forward-syntactic-ws) 7298 (- (current-column) cs-curcol)) 7299 (goto-char containing-sexp) 7300 (or (eolp) 7301 (let ((eol (vhdl-point 'eol)) 7302 (here (progn 7303 (forward-char) 7304 (skip-chars-forward " \t") 7305 (point)))) 7306 (vhdl-forward-syntactic-ws) 7307 (if (< (point) eol) 7308 (goto-char here)))) 7309 (- (current-column) cs-curcol) 7310 )))) 7311 7312(defun vhdl-lineup-arglist-intro (langelem) 7313 "Lineup an arglist-intro line to just after the open paren." 7314 (save-excursion 7315 (let ((cs-curcol (save-excursion 7316 (goto-char (cdr langelem)) 7317 (current-column))) 7318 (ce-curcol (save-excursion 7319 (beginning-of-line) 7320 (backward-up-list 1) 7321 (skip-chars-forward " \t" (vhdl-point 'eol)) 7322 (current-column)))) 7323 (- ce-curcol cs-curcol -1)))) 7324 7325(defun vhdl-lineup-comment (_langelem) 7326 "Support old behavior for comment indentation. 7327We look at `vhdl-comment-only-line-offset' to decide how to 7328indent comment only-lines." 7329 (save-excursion 7330 (back-to-indentation) 7331 ;; at or to the right of comment-column 7332 (if (>= (current-column) comment-column) 7333 (vhdl-comment-indent) 7334 ;; otherwise, indent as specified by vhdl-comment-only-line-offset 7335 (if (not (bolp)) 7336 ;; inside multi-line comment 7337 (if (looking-at "\\*") 7338 1 7339 ;; otherwise 7340 (or (car-safe vhdl-comment-only-line-offset) 7341 vhdl-comment-only-line-offset)) 7342 (or (cdr-safe vhdl-comment-only-line-offset) 7343 (car-safe vhdl-comment-only-line-offset) 7344 -1000 ;jam it against the left side 7345 ))))) 7346 7347(defun vhdl-lineup-statement-cont (langelem) 7348 "Line up statement-cont after the assignment operator." 7349 (save-excursion 7350 (let* ((relpos (cdr langelem)) 7351 (assignp (save-excursion 7352 (goto-char (vhdl-point 'boi)) 7353 (and (re-search-forward "\\(<\\|:\\|=\\)=" 7354 (vhdl-point 'eol) t) 7355 (- (point) (vhdl-point 'boi))))) 7356 (curcol (progn 7357 (goto-char relpos) 7358 (current-column))) 7359 foundp) 7360 (while (and (not foundp) 7361 (< (point) (vhdl-point 'eol))) 7362 (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move) 7363 (if (vhdl-in-literal) 7364 (forward-char) 7365 (if (= (preceding-char) ?\() 7366 ;; skip over any parenthesized expressions 7367 (goto-char (min (vhdl-point 'eol) 7368 (scan-lists (point) 1 1))) 7369 ;; found an assignment operator (not at eol) 7370 (setq foundp (not (looking-at "\\s-*$")))))) 7371 (if (not foundp) 7372 ;; there's no assignment operator on the line 7373 vhdl-basic-offset 7374 ;; calculate indentation column after assign and ws, unless 7375 ;; our line contains an assignment operator 7376 (if (not assignp) 7377 (progn 7378 (forward-char) 7379 (skip-chars-forward " \t") 7380 (setq assignp 0))) 7381 (- (current-column) assignp curcol)) 7382 ))) 7383 7384;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7385;; Progress reporting 7386 7387(defvar vhdl--progress-reporter nil 7388 "Holds the progress reporter data during long running operations.") 7389 7390;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7391;; Indentation commands 7392 7393(defun vhdl-electric-tab (&optional arg) 7394 "If preceding character is part of a word or a paren then hippie-expand, 7395else if right of non whitespace on line then insert tab, 7396else if last command was a tab or return then dedent one step or if a comment 7397toggle between normal indent and inline comment indent, 7398else indent `correctly'." 7399 (interactive "*P") 7400 (vhdl-prepare-search-2 7401 (cond 7402 ;; indent region if region is active 7403 ((and (not (featurep 'xemacs)) (use-region-p)) 7404 (indent-region (region-beginning) (region-end) nil)) 7405 ;; expand word 7406 ((= (char-syntax (preceding-char)) ?w) 7407 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7408 (case-replace nil) 7409 (hippie-expand-only-buffers 7410 (or (and (boundp 'hippie-expand-only-buffers) 7411 hippie-expand-only-buffers) 7412 '(vhdl-mode)))) 7413 (vhdl-expand-abbrev arg))) 7414 ;; expand parenthesis 7415 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 7416 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7417 (case-replace nil)) 7418 (vhdl-expand-paren arg))) 7419 ;; insert tab 7420 ((> (current-column) (current-indentation)) 7421 (insert-tab)) 7422 ;; toggle comment indent 7423 ((and (looking-at "--") 7424 (or (eq last-command 'vhdl-electric-tab) 7425 (eq last-command 'vhdl-electric-return))) 7426 (cond ((= (current-indentation) 0) ; no indent 7427 (indent-to 1) 7428 (indent-according-to-mode)) 7429 ((< (current-indentation) comment-column) ; normal indent 7430 (indent-to comment-column) 7431 (indent-according-to-mode)) 7432 (t ; inline comment indent 7433 (delete-region (line-beginning-position) (point))))) 7434 ;; dedent 7435 ((and (>= (current-indentation) vhdl-basic-offset) 7436 (or (eq last-command 'vhdl-electric-tab) 7437 (eq last-command 'vhdl-electric-return))) 7438 (backward-delete-char-untabify vhdl-basic-offset nil)) 7439 ;; indent line 7440 (t (indent-according-to-mode))) 7441 (setq this-command 'vhdl-electric-tab))) 7442 7443(defun vhdl-electric-return () 7444 "`newline-and-indent' or `indent-new-comment-line' if in comment and preceding 7445character is a space." 7446 (interactive) 7447 (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) 7448 (indent-new-comment-line) 7449 (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z) 7450 (not (vhdl-in-comment-p))) 7451 (vhdl-fix-case-word -1)) 7452 (newline-and-indent))) 7453 7454(defun vhdl-indent-line () 7455 "Indent the current line as VHDL code. 7456Return the amount of indentation change." 7457 (interactive) 7458 (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) 7459 (pos (- (point-max) (point))) 7460 (is-comment nil) 7461 (indent 7462 (if syntax 7463 ;; indent syntax-based 7464 (if (and (eq (caar syntax) 'comment) 7465 (>= (vhdl-get-offset (car syntax)) comment-column)) 7466 ;; special case: comments at or right of comment-column 7467 (vhdl-get-offset (car syntax)) 7468 ;; align comments like following code line 7469 (when vhdl-indent-comment-like-next-code-line 7470 (save-excursion 7471 (while (eq (caar syntax) 'comment) 7472 (setq is-comment t) 7473 (beginning-of-line 2) 7474 (setq syntax (vhdl-get-syntactic-context))))) 7475 (when is-comment 7476 (push (cons 'comment nil) syntax)) 7477 (apply #'+ (mapcar #'vhdl-get-offset syntax))) 7478 ;; indent like previous nonblank line 7479 (save-excursion (beginning-of-line) 7480 (re-search-backward "^[^\n]" nil t) 7481 (current-indentation)))) 7482 (shift-amt (- indent (current-indentation)))) 7483 (and vhdl-echo-syntactic-information-p 7484 (message "syntax: %s, indent= %d" syntax indent)) 7485 (let ((has-formfeed 7486 (save-excursion (beginning-of-line) (looking-at "\\s-*\f")))) 7487 (when (or (not (zerop shift-amt)) has-formfeed) 7488 (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) 7489 (beginning-of-line) 7490 (when has-formfeed (insert "\f")) 7491 (indent-to indent))) 7492 (if (< (point) (vhdl-point 'boi)) 7493 (back-to-indentation) 7494 ;; If initial point was within line's indentation, position after 7495 ;; the indentation. Else stay at same point in text. 7496 (when (> (- (point-max) pos) (point)) 7497 (goto-char (- (point-max) pos)))) 7498 (run-hooks 'vhdl-special-indent-hook) 7499 (when vhdl--progress-reporter 7500 (progress-reporter-update vhdl--progress-reporter (point))) 7501 shift-amt)) 7502 7503(define-obsolete-function-alias 'vhdl-indent-region #'indent-region "28.1") 7504 7505(defun vhdl-indent-buffer () 7506 "Indent whole buffer as VHDL code. 7507Calls `indent-region' for whole buffer and adds progress reporting." 7508 (interactive) 7509 (indent-region (point-min) (point-max))) 7510 7511(defun vhdl-indent-group () 7512 "Indent group of lines between empty lines." 7513 (interactive) 7514 (let ((beg (save-excursion 7515 (if (re-search-backward vhdl-align-group-separate nil t) 7516 (point-marker) 7517 (point-min-marker)))) 7518 (end (save-excursion 7519 (if (re-search-forward vhdl-align-group-separate nil t) 7520 (point-marker) 7521 (point-max-marker))))) 7522 (indent-region beg end))) 7523 7524(defun vhdl-indent-sexp (&optional endpos) 7525 "Indent each line of the list starting just after point. 7526If optional arg ENDPOS is given, indent each line, stopping when 7527ENDPOS is encountered." 7528 (interactive) 7529 (save-excursion 7530 (let ((beg (point)) 7531 (end (progn (vhdl-forward-sexp nil endpos) (point)))) 7532 (indent-region beg end nil)))) 7533 7534;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7535;; Miscellaneous commands 7536 7537(defun vhdl-show-syntactic-information () 7538 "Show syntactic information for current line." 7539 (interactive) 7540 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) 7541 (vhdl-keep-region-active)) 7542 7543;; Verification and regression functions: 7544 7545(defun vhdl-regress-line (&optional arg) 7546 "Check syntactic information for current line." 7547 (interactive "P") 7548 (let ((expected (save-excursion 7549 (end-of-line) 7550 (when (search-backward " -- ((" (vhdl-point 'bol) t) 7551 (forward-char 4) 7552 (read (current-buffer))))) 7553 (actual (vhdl-get-syntactic-context)) 7554 (expurgated)) 7555 ;; remove the library unit symbols 7556 (mapc 7557 (lambda (elt) 7558 (if (memq (car elt) '(entity configuration context package 7559 package-body architecture)) 7560 nil 7561 (setq expurgated (append expurgated (list elt))))) 7562 actual) 7563 (if (and (not arg) expected (listp expected)) 7564 (if (not (equal expected expurgated)) 7565 (error "ERROR: Should be: %s, is: %s" expected expurgated)) 7566 (save-excursion 7567 (beginning-of-line) 7568 (when (not (looking-at "^\\s-*\\(--.*\\)?$")) 7569 (end-of-line) 7570 (if (search-backward " -- ((" (vhdl-point 'bol) t) 7571 (delete-region (point) (line-end-position))) 7572 (insert " -- ") 7573 (insert (format "%s" expurgated)))))) 7574 (vhdl-keep-region-active)) 7575 7576 7577;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7578;;; Alignment, beautifying 7579;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7580 7581(defconst vhdl-align-alist 7582 '( 7583 ;; after some keywords 7584 (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]" 7585 "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2) 7586 ;; before ':' 7587 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") 7588 ;; after direction specifications 7589 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" 7590 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) 7591 ;; before "==", ":=", "=>", and "<=" 7592 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur 7593 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7594 (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur 7595 ;; before some keywords 7596 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) 7597 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) 7598 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) 7599 (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1) 7600 (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1) 7601 ;; before "=>" since "when/else ... =>" can occur 7602 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7603 ) 7604 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). 7605It is searched in order. If REGEXP is found anywhere in the first 7606line of a region to be aligned, ALIGN-PATTERN will be used for that 7607region. ALIGN-PATTERN must include the whitespace to be expanded or 7608contracted. It may also provide regexps for the text surrounding the 7609whitespace. SUBEXP specifies which sub-expression of 7610ALIGN-PATTERN matches the white space to be expanded/contracted.") 7611 7612;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7613;; Align code 7614 7615(defvar vhdl-align-try-all-clauses t 7616 "If REGEXP is not found on the first line of the region that clause is ignored. 7617If this variable is non-nil, then the clause is tried anyway.") 7618 7619(defun vhdl-do-group (function &optional spacing) 7620 "Apply FUNCTION on group of lines between empty lines." 7621 (let 7622 ;; search for group beginning 7623 ((beg (save-excursion 7624 (if (re-search-backward vhdl-align-group-separate nil t) 7625 (progn (beginning-of-line 2) (back-to-indentation) (point)) 7626 (point-min)))) 7627 ;; search for group end 7628 (end (save-excursion 7629 (if (re-search-forward vhdl-align-group-separate nil t) 7630 (progn (beginning-of-line) (point)) 7631 (point-max))))) 7632 ;; run FUNCTION 7633 (funcall function beg end spacing))) 7634 7635(defun vhdl-do-list (function &optional spacing) 7636 "Apply FUNCTION to lines of a list surrounded by a balanced group of parentheses." 7637 (let (beg end) 7638 (save-excursion 7639 ;; search for beginning of balanced group of parentheses 7640 (setq beg (vhdl-re-search-backward "[()]" nil t)) 7641 (while (looking-at ")") 7642 (forward-char) (backward-sexp) 7643 (setq beg (vhdl-re-search-backward "[()]" nil t))) 7644 ;; search for end of balanced group of parentheses 7645 (when beg 7646 (forward-list) 7647 (setq end (point)) 7648 (goto-char (1+ beg)) 7649 (skip-chars-forward " \t\n\r\f") 7650 (setq beg (point)))) 7651 ;; run FUNCTION 7652 (if beg 7653 (funcall function beg end spacing) 7654 (error "ERROR: Not within a list enclosed by a pair of parentheses")))) 7655 7656(defun vhdl-do-same-indent (function &optional spacing) 7657 "Apply FUNCTION to block of lines with same indent." 7658 (let ((indent (current-indentation)) 7659 beg end) 7660 ;; search for first line with same indent 7661 (save-excursion 7662 (while (and (not (bobp)) 7663 (or (looking-at "^\\s-*\\(--.*\\)?$") 7664 (= (current-indentation) indent))) 7665 (unless (looking-at "^\\s-*$") 7666 (back-to-indentation) (setq beg (point))) 7667 (beginning-of-line -0))) 7668 ;; search for last line with same indent 7669 (save-excursion 7670 (while (and (not (eobp)) 7671 (or (looking-at "^\\s-*\\(--.*\\)?$") 7672 (= (current-indentation) indent))) 7673 (if (looking-at "^\\s-*$") 7674 (beginning-of-line 2) 7675 (beginning-of-line 2) 7676 (setq end (point))))) 7677 ;; run FUNCTION 7678 (funcall function beg end spacing))) 7679 7680(defun vhdl-align-region-1 (begin end &optional spacing alignment-list _indent) 7681 "Attempt to align a range of lines based on the content of the lines. 7682The definition of `alignment-list' determines the matching order 7683and the manner in which the lines are aligned. If ALIGNMENT-LIST 7684is not specified `vhdl-align-alist' is used. If INDENT is 7685non-nil, indentation is done before aligning." 7686 (interactive "r\np") 7687 (setq alignment-list (or alignment-list vhdl-align-alist)) 7688 (setq spacing (or spacing 1)) 7689 (save-excursion 7690 (let (bol) ;; indent 7691 (goto-char end) 7692 (setq end (point-marker)) 7693 (goto-char begin) 7694 (setq bol (setq begin (progn (beginning-of-line) (point)))) 7695 ;; FIXME: The `indent' arg is not used, and I think it's because 7696 ;; the let binding commented out above `indent' was hiding it, so 7697 ;; the test below should maybe still test `indent'? 7698 (when nil ;; indent 7699 (indent-region bol end nil)))) 7700 (let ((copy (copy-alist alignment-list))) 7701 (vhdl-prepare-search-2 7702 (while copy 7703 (save-excursion 7704 (goto-char begin) 7705 (let (element 7706 (eol (point-at-eol))) 7707 (setq element (nth 0 copy)) 7708 (when (and (or (and (listp (car element)) 7709 (memq major-mode (car element))) 7710 (eq major-mode (car element))) 7711 (or vhdl-align-try-all-clauses 7712 (re-search-forward (car (cdr element)) eol t))) 7713 (vhdl-align-region-2 begin end (car (cdr (cdr element))) 7714 (car (cdr (cdr (cdr element)))) spacing)) 7715 (setq copy (cdr copy)))))))) 7716 7717(defun vhdl-align-region-2 (begin end match &optional substr spacing) 7718 "Align a range of lines from BEGIN to END. 7719The regular expression MATCH must match exactly one field: the 7720whitespace to be contracted/expanded. The alignment column will 7721equal the rightmost column of the widest whitespace block. 7722SPACING is the amount of extra spaces to add to the calculated 7723maximum required. SPACING defaults to 1 so that at least one 7724space is inserted after the token in MATCH." 7725 (setq spacing (or spacing 1)) 7726 (setq substr (or substr 1)) 7727 (save-excursion 7728 (let (distance (max 0) (lines 0) bol eol width) 7729 ;; Determine the greatest whitespace distance to the alignment 7730 ;; character 7731 (goto-char begin) 7732 (setq eol (point-at-eol) 7733 bol (setq begin (progn (beginning-of-line) (point)))) 7734 (while (< bol end) 7735 (save-excursion 7736 (when (and (vhdl-re-search-forward match eol t) 7737 (save-excursion 7738 (goto-char (match-beginning 0)) 7739 (forward-char) 7740 (and (not (vhdl-in-literal)) 7741 (not (vhdl-in-quote-p)) 7742 (not (vhdl-in-extended-identifier-p)))) 7743 (not (looking-at "\\s-*$"))) 7744 (setq distance (- (match-beginning substr) bol)) 7745 (when (> distance max) 7746 (setq max distance)))) 7747 (forward-line) 7748 (setq bol (point) 7749 eol (point-at-eol)) 7750 (setq lines (1+ lines))) 7751 ;; Now insert enough maxs to push each assignment operator to 7752 ;; the same column. We need to use 'lines' as a counter, since 7753 ;; the location of the mark may change 7754 (goto-char (setq bol begin)) 7755 (setq eol (point-at-eol)) 7756 (while (> lines 0) 7757 (when (and (vhdl-re-search-forward match eol t) 7758 (save-excursion 7759 (goto-char (match-beginning 0)) 7760 (forward-char) 7761 (and (not (vhdl-in-literal)) 7762 (not (vhdl-in-quote-p)) 7763 (not (vhdl-in-extended-identifier-p)))) 7764 (not (looking-at "\\s-*$")) 7765 (> (match-beginning 0) ; not if at boi 7766 (save-excursion (back-to-indentation) (point)))) 7767 (setq width (- (match-end substr) (match-beginning substr))) 7768 (setq distance (- (match-beginning substr) bol)) 7769 (goto-char (match-beginning substr)) 7770 (delete-char width) 7771 (insert-char ? (+ (- max distance) spacing))) 7772 (beginning-of-line) 7773 (forward-line) 7774 (setq bol (point) 7775 eol (point-at-eol)) 7776 (setq lines (1- lines)))))) 7777 7778(defun vhdl-align-region-groups (beg end &optional spacing 7779 no-message no-comments) 7780 "Align region, treat groups of lines separately." 7781 (interactive "r\nP") 7782 (save-excursion 7783 (goto-char beg) 7784 (beginning-of-line) 7785 (setq beg (point)) 7786 (goto-char end) 7787 (setq end (point-marker)) 7788 (untabify beg end) 7789 (let ((orig (copy-marker beg)) 7790 pos 7791 (vhdl--progress-reporter 7792 (if no-message 7793 ;; Preserve a potential progress reporter from 7794 ;; when called from `vhdl-align-region' call. 7795 vhdl--progress-reporter 7796 (when vhdl-progress-interval 7797 (make-progress-reporter "Aligning..." beg (copy-marker end)))))) 7798 (when (nth 0 vhdl-beautify-options) 7799 (vhdl-fixup-whitespace-region beg end t)) 7800 (goto-char beg) 7801 (if (not vhdl-align-groups) 7802 ;; align entire region 7803 (progn (vhdl-align-region-1 beg end spacing) 7804 (unless no-comments 7805 (vhdl-align-inline-comment-region-1 beg end))) 7806 ;; align groups 7807 (while (and (< beg end) 7808 (re-search-forward vhdl-align-group-separate end t)) 7809 (setq pos (point-marker)) 7810 (vhdl-align-region-1 beg pos spacing) 7811 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) 7812 (when vhdl--progress-reporter 7813 (progress-reporter-update vhdl--progress-reporter (point))) 7814 (setq beg (1+ pos)) 7815 (goto-char beg)) 7816 ;; align last group 7817 (when (< beg end) 7818 (vhdl-align-region-1 beg end spacing) 7819 (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) 7820 (when vhdl--progress-reporter 7821 (progress-reporter-update vhdl--progress-reporter (point))))) 7822 (when vhdl-indent-tabs-mode 7823 (tabify orig end)) 7824 (unless no-message 7825 (when vhdl--progress-reporter 7826 (progress-reporter-done vhdl--progress-reporter)))))) 7827 7828(defun vhdl-align-region (beg end &optional spacing) 7829 "Align region, treat blocks with same indent and argument lists separately." 7830 (interactive "r\nP") 7831 (if (not vhdl-align-same-indent) 7832 ;; align entire region 7833 (vhdl-align-region-groups beg end spacing) 7834 ;; align blocks with same indent and argument lists 7835 (save-excursion 7836 (let ((cur-beg beg) 7837 indent cur-end 7838 (vhdl--progress-reporter 7839 (when vhdl-progress-interval 7840 (make-progress-reporter "Aligning..." beg (copy-marker end))))) 7841 (goto-char end) 7842 (setq end (point-marker)) 7843 (goto-char cur-beg) 7844 (while (< (point) end) 7845 ;; is argument list opening? 7846 (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp 7847 (point) (vhdl-point 'eol))))) 7848 ;; determine region for argument list 7849 (progn (goto-char cur-beg) 7850 (forward-sexp) 7851 (setq cur-end (point)) 7852 (beginning-of-line 2)) 7853 ;; determine region with same indent 7854 (setq indent (current-indentation)) 7855 (setq cur-beg (point)) 7856 (setq cur-end (vhdl-point 'bonl)) 7857 (beginning-of-line 2) 7858 (while (and (< (point) end) 7859 (or (looking-at "^\\s-*\\(--.*\\)?$") 7860 (= (current-indentation) indent)) 7861 (<= (save-excursion 7862 (nth 0 (parse-partial-sexp 7863 (point) (vhdl-point 'eol)))) 7864 0)) 7865 (unless (looking-at "^\\s-*$") 7866 (setq cur-end (vhdl-point 'bonl))) 7867 (beginning-of-line 2))) 7868 ;; align region 7869 (vhdl-align-region-groups cur-beg cur-end spacing t t)) 7870 (vhdl-align-inline-comment-region beg end spacing noninteractive) 7871 (when vhdl--progress-reporter 7872 (progress-reporter-done vhdl--progress-reporter)))))) 7873 7874(defun vhdl-align-group (&optional spacing) 7875 "Align group of lines between empty lines." 7876 (interactive) 7877 (vhdl-do-group 'vhdl-align-region spacing)) 7878 7879(defun vhdl-align-list (&optional spacing) 7880 "Align the lines of a list surrounded by a balanced group of parentheses." 7881 (interactive) 7882 (vhdl-do-list 'vhdl-align-region-groups spacing)) 7883 7884(defun vhdl-align-same-indent (&optional spacing) 7885 "Align block of lines with same indent." 7886 (interactive) 7887 (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) 7888 7889(defun vhdl-align-declarations (&optional spacing) 7890 "Align the lines within the declarative part of a design unit." 7891 (interactive) 7892 (let (beg end) 7893 (vhdl-prepare-search-2 7894 (save-excursion 7895 ;; search for declarative part 7896 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|context\\|end\\|entity\\|package\\)\\>" nil t) 7897 (not (member (upcase (match-string 1)) '("BEGIN" "END")))) 7898 (setq beg (point)) 7899 (re-search-forward "^\\(begin\\|end\\)\\>" nil t) 7900 (setq end (point))))) 7901 (if beg 7902 (vhdl-align-region-groups beg end spacing) 7903 (error "ERROR: Not within the declarative part of a design unit")))) 7904 7905(defun vhdl-align-buffer () 7906 "Align buffer." 7907 (interactive) 7908 (vhdl-align-region (point-min) (point-max))) 7909 7910;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7911;; Align inline comments 7912 7913(defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) 7914 "Align inline comments in region." 7915 (save-excursion 7916 (let ((start-max comment-column) 7917 (length-max 0) 7918 comment-list start-list tmp-list start length 7919 cur-start prev-start no-code) 7920 (setq spacing (or spacing 2)) 7921 (vhdl-prepare-search-2 7922 (goto-char beg) 7923 ;; search for comment start positions and lengths 7924 (while (< (point) end) 7925 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7926 (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") 7927 (not (save-excursion (goto-char (match-beginning 2)) 7928 (vhdl-in-literal)))) 7929 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7930 (setq length (- (match-end 2) (match-beginning 2))) 7931 (setq start-max (max start start-max)) 7932 (setq length-max (max length length-max)) 7933 (push (cons start length) comment-list)) 7934 (beginning-of-line 2)) 7935 (setq comment-list 7936 (sort comment-list (lambda (a b) (> (car a) (car b))))) 7937 ;; reduce start positions 7938 (setq start-list (list (caar comment-list))) 7939 (setq comment-list (cdr comment-list)) 7940 (while comment-list 7941 (unless (or (= (caar comment-list) (car start-list)) 7942 (<= (+ (car start-list) (cdar comment-list)) 7943 end-comment-column)) 7944 (push (caar comment-list) start-list)) 7945 (setq comment-list (cdr comment-list))) 7946 ;; align lines as nicely as possible 7947 (goto-char beg) 7948 (while (< (point) end) 7949 (setq cur-start nil) 7950 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7951 (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") 7952 (not (save-excursion 7953 (goto-char (match-beginning 3)) 7954 (vhdl-in-literal)))) 7955 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") 7956 (>= (- (match-end 2) (match-beginning 2)) 7957 comment-column)))) 7958 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7959 (setq length (- (match-end 3) (match-beginning 3))) 7960 (setq no-code (= (match-beginning 1) (match-end 1))) 7961 ;; insert minimum whitespace 7962 (goto-char (match-end 2)) 7963 (delete-region (match-beginning 2) (match-end 2)) 7964 (insert-char ?\ spacing) 7965 (setq tmp-list start-list) 7966 ;; insert additional whitespace to align 7967 (setq cur-start 7968 (cond 7969 ;; align comment-only line to inline comment of previous line 7970 ((and no-code prev-start 7971 (<= length (- end-comment-column prev-start))) 7972 prev-start) 7973 ;; align all comments at `start-max' if this is possible 7974 ((<= (+ start-max length-max) end-comment-column) 7975 start-max) 7976 ;; align at `comment-column' if possible 7977 ((and (<= start comment-column) 7978 (<= length (- end-comment-column comment-column))) 7979 comment-column) 7980 ;; align at left-most possible start position otherwise 7981 (t 7982 (while (and tmp-list (< (car tmp-list) start)) 7983 (setq tmp-list (cdr tmp-list))) 7984 (car tmp-list)))) 7985 (indent-to cur-start)) 7986 (setq prev-start cur-start) 7987 (beginning-of-line 2)))))) 7988 7989(defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) 7990 "Align inline comments within a region. 7991Groups of code lines separated by empty lines are aligned 7992individually, if `vhdl-align-groups' is non-nil." 7993 (interactive "r\nP") 7994 (save-excursion 7995 (let (orig pos) 7996 (goto-char beg) 7997 (beginning-of-line) 7998 (setq orig (point-marker)) 7999 (setq beg (point)) 8000 (goto-char end) 8001 (setq end (point-marker)) 8002 (untabify beg end) 8003 (unless no-message (message "Aligning inline comments...")) 8004 (goto-char beg) 8005 (if (not vhdl-align-groups) 8006 ;; align entire region 8007 (vhdl-align-inline-comment-region-1 beg end spacing) 8008 ;; align groups 8009 (while (and (< beg end) 8010 (re-search-forward vhdl-align-group-separate end t)) 8011 (setq pos (point-marker)) 8012 (vhdl-align-inline-comment-region-1 beg pos spacing) 8013 (setq beg (1+ pos)) 8014 (goto-char beg)) 8015 ;; align last group 8016 (when (< beg end) 8017 (vhdl-align-inline-comment-region-1 beg end spacing))) 8018 (when vhdl-indent-tabs-mode 8019 (tabify orig end)) 8020 (unless no-message (message "Aligning inline comments...done"))))) 8021 8022(defun vhdl-align-inline-comment-group (&optional _spacing) 8023 "Align inline comments within a group of lines between empty lines." 8024 (interactive) 8025 (save-excursion 8026 (let ((start (point)) 8027 beg end) 8028 (setq end (if (re-search-forward vhdl-align-group-separate nil t) 8029 (point-marker) (point-max))) 8030 (goto-char start) 8031 (setq beg (if (re-search-backward vhdl-align-group-separate nil t) 8032 (point) (point-min))) 8033 (untabify beg end) 8034 (message "Aligning inline comments...") 8035 (vhdl-align-inline-comment-region-1 beg end) 8036 (when vhdl-indent-tabs-mode 8037 (tabify beg end)) 8038 (message "Aligning inline comments...done")))) 8039 8040(defun vhdl-align-inline-comment-buffer () 8041 "Align inline comments within buffer. 8042Groups of code lines separated by empty lines are aligned 8043individually, if `vhdl-align-groups' is non-nil." 8044 (interactive) 8045 (vhdl-align-inline-comment-region (point-min) (point-max))) 8046 8047;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8048;; Fixup whitespace 8049 8050(defun vhdl-fixup-whitespace-region (beg end &optional no-message) 8051 "Fixup whitespace in region. 8052Surround operator symbols by one space, eliminate multiple 8053spaces (except at beginning of line), eliminate spaces at end of 8054line, do nothing in comments and strings." 8055 (interactive "r") 8056 (unless no-message (message "Fixing up whitespace...")) 8057 (save-excursion 8058 (goto-char end) 8059 (setq end (point-marker)) 8060 ;; have no space before and one space after `,' and ';' 8061 (goto-char beg) 8062 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) 8063 (if (match-string 1) 8064 (goto-char (match-end 1)) 8065 (replace-match "\\3 " nil nil nil 2))) 8066 ;; have no space after `(' 8067 (goto-char beg) 8068 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t) 8069 (if (match-string 1) 8070 (goto-char (match-end 1)) 8071 (replace-match "\\2"))) 8072 ;; have no space before `)' 8073 (goto-char beg) 8074 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) 8075 (if (match-string 1) 8076 (goto-char (match-end 1)) 8077 (replace-match "\\2"))) 8078 ;; surround operator symbols by one space 8079 (goto-char beg) 8080 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|'.'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) 8081 (if (or (match-string 1) 8082 (<= (match-beginning 0) ; not if at boi 8083 (save-excursion (back-to-indentation) (point)))) 8084 (goto-char (match-end 0)) 8085 (replace-match "\\3 \\4 \\5") 8086 (goto-char (match-end 2)))) 8087 ;; eliminate multiple spaces and spaces at end of line 8088 (goto-char beg) 8089 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) 8090 (and (looking-at "--.*") (re-search-forward "--.*" end t)) 8091 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) 8092 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) 8093 (progn (replace-match "" nil nil) t)) 8094 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) 8095 (progn (replace-match ";" nil nil) t)) 8096 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) 8097 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) 8098 (progn (replace-match " " nil nil) t)) 8099 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) 8100 (progn (replace-match " " nil nil) t)) 8101 (and (looking-at "-") (re-search-forward "-" end t)) 8102 (re-search-forward "[^ \t\"-]+" end t)))) 8103 (unless no-message (message "Fixing up whitespace...done"))) 8104 8105(defun vhdl-fixup-whitespace-buffer () 8106 "Fixup whitespace in buffer. 8107Surround operator symbols by one space, eliminate multiple 8108spaces (except at beginning of line), eliminate spaces at end of 8109line, do nothing in comments." 8110 (interactive) 8111 (vhdl-fixup-whitespace-region (point-min) (point-max))) 8112 8113;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8114;; Case fixing 8115 8116(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) 8117 "Convert all words matching WORD-REGEXP in region to lower or upper case, 8118depending on parameter UPPER-CASE." 8119 (let ((case-replace nil) 8120 (pr (when (and count vhdl-progress-interval (not noninteractive)) 8121 (make-progress-reporter "Fixing case..." beg (copy-marker end))))) 8122 (vhdl-prepare-search-2 8123 (save-excursion 8124 (goto-char end) 8125 (setq end (point-marker)) 8126 (goto-char beg) 8127 (while (re-search-forward word-regexp end t) 8128 (or (vhdl-in-literal) 8129 (if upper-case 8130 (upcase-word -1) 8131 (downcase-word -1))) 8132 (when pr (progress-reporter-update pr (point)))) 8133 (when pr (progress-reporter-done pr)))))) 8134 8135(defun vhdl-fix-case-region (beg end &optional _arg) 8136 "Convert all VHDL words in region to lower or upper case, depending on 8137options vhdl-upper-case-{keywords,types,attributes,enum-values}." 8138 (interactive "r") 8139 (vhdl-fix-case-region-1 8140 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) 8141 (vhdl-fix-case-region-1 8142 beg end vhdl-upper-case-types vhdl-types-regexp 1) 8143 (vhdl-fix-case-region-1 8144 beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) 8145 (vhdl-fix-case-region-1 8146 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) 8147 (vhdl-fix-case-region-1 8148 beg end vhdl-upper-case-constants vhdl-constants-regexp 4) 8149 (when vhdl-progress-interval (message "Fixing case...done"))) 8150 8151(defun vhdl-fix-case-buffer () 8152 "Convert all VHDL words in buffer to lower or upper case, depending on 8153options vhdl-upper-case-{keywords,types,attributes,enum-values}." 8154 (interactive) 8155 (vhdl-fix-case-region (point-min) (point-max))) 8156 8157(defun vhdl-fix-case-word (&optional arg) 8158 "Convert word after cursor to upper case if necessary." 8159 (interactive "p") 8160 (save-excursion 8161 (when arg (backward-word 1)) 8162 (vhdl-prepare-search-1 8163 (when (and vhdl-upper-case-keywords 8164 (looking-at vhdl-keywords-regexp)) 8165 (upcase-word 1)) 8166 (when (and vhdl-upper-case-types 8167 (looking-at vhdl-types-regexp)) 8168 (upcase-word 1)) 8169 (when (and vhdl-upper-case-attributes 8170 (looking-at vhdl-attributes-regexp)) 8171 (upcase-word 1)) 8172 (when (and vhdl-upper-case-enum-values 8173 (looking-at vhdl-enum-values-regexp)) 8174 (upcase-word 1)) 8175 (when (and vhdl-upper-case-constants 8176 (looking-at vhdl-constants-regexp)) 8177 (upcase-word 1))))) 8178 8179;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8180;; Fix statements 8181;; - force each statement to be on a separate line except when on same line 8182;; with 'end' keyword 8183 8184(defun vhdl-fix-statement-region (beg end &optional _arg) 8185 "Force statements in region on separate line except when on same line 8186with `end' keyword (necessary for correct indentation). 8187Currently supported keywords: `begin', `if'." 8188 (interactive "r") 8189 (vhdl-prepare-search-2 8190 (let (point) 8191 (save-excursion 8192 (goto-char end) 8193 (setq end (point-marker)) 8194 (goto-char beg) 8195 ;; `begin' keyword 8196 (while (re-search-forward 8197 "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t) 8198 (goto-char (match-end 0)) 8199 (setq point (point-marker)) 8200 (when (and (match-string 1) 8201 (or (not (match-string 2)) 8202 (save-excursion (goto-char (match-end 2)) 8203 (vhdl-in-literal))) 8204 (not (save-excursion (goto-char (match-beginning 1)) 8205 (vhdl-in-literal)))) 8206 (goto-char (match-beginning 1)) 8207 (insert "\n") 8208 (indent-according-to-mode)) 8209 (goto-char point)) 8210 (goto-char beg) 8211 ;; `for', `if' keywords 8212 (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) 8213 (goto-char (match-end 1)) 8214 (setq point (point-marker)) 8215 ;; exception: in literal or preceded by `end', `wait' or label 8216 (when (and (not (save-excursion (goto-char (match-beginning 1)) 8217 (vhdl-in-literal))) 8218 (save-excursion 8219 (beginning-of-line 1) 8220 (save-match-data 8221 (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" 8222 (match-beginning 1) t) 8223 (not (string-match 8224 "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$" 8225 (match-string 1))))))) 8226 (goto-char (match-beginning 1)) 8227 (insert "\n") 8228 (indent-according-to-mode)) 8229 (goto-char point)))))) 8230 8231(defun vhdl-fix-statement-buffer () 8232 "Force statements in buffer on separate line except when on same line 8233with `end' keyword (necessary for correct indentation)." 8234 (interactive) 8235 (vhdl-fix-statement-region (point-min) (point-max))) 8236 8237;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8238;; Trailing spaces 8239 8240(defun vhdl-remove-trailing-spaces-region (beg end &optional _arg) 8241 "Remove trailing spaces in region." 8242 (interactive "r") 8243 (save-excursion 8244 (goto-char end) 8245 (setq end (point-marker)) 8246 (goto-char beg) 8247 (while (re-search-forward "[ \t]+$" end t) 8248 (unless (vhdl-in-literal) 8249 (replace-match "" nil nil))))) 8250 8251(defun vhdl-remove-trailing-spaces () 8252 "Remove trailing spaces in buffer." 8253 (interactive) 8254 (vhdl-remove-trailing-spaces-region (point-min) (point-max))) 8255 8256;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8257;; Beautify 8258 8259(defun vhdl-beautify-region (beg end) 8260 "Beautify region by applying indentation, whitespace fixup, alignment, and 8261case fixing to a region. Calls functions `vhdl-indent-buffer', 8262`vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and 8263`vhdl-fix-case-buffer'." 8264 (interactive "r") 8265 (setq end (save-excursion (goto-char end) (point-marker))) 8266 (save-excursion ; remove DOS EOL characters in UNIX file 8267 (goto-char beg) 8268 (while (search-forward "\r" nil t) 8269 (replace-match "" nil t))) 8270 (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) 8271 (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) 8272 (when (nth 2 vhdl-beautify-options) (indent-region beg end)) 8273 (when (nth 3 vhdl-beautify-options) 8274 (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) 8275 (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) 8276 (when (nth 0 vhdl-beautify-options) 8277 (vhdl-remove-trailing-spaces-region beg end) 8278 (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end)))) 8279 8280(defun vhdl-beautify-buffer () 8281 "Beautify buffer by applying indentation, whitespace fixup, alignment, and 8282case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire 8283buffer." 8284 (interactive) 8285 (vhdl-beautify-region (point-min) (point-max)) 8286 (when noninteractive (save-buffer))) 8287 8288;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8289;; Code filling 8290 8291(defun vhdl-fill-region (beg end &optional arg) 8292 "Fill lines for a region of code." 8293 (interactive "r\np") 8294 (save-excursion 8295 (goto-char beg) 8296 (let ((margin (if arg (current-indentation) (current-column)))) 8297 (goto-char end) 8298 (setq end (point-marker)) 8299 ;; remove inline comments, newlines and whitespace 8300 (vhdl-comment-kill-region beg end) 8301 (vhdl-comment-kill-inline-region beg end) 8302 (subst-char-in-region beg (1- end) ?\n ?\ ) 8303 (vhdl-fixup-whitespace-region beg end) 8304 ;; wrap and end-comment-column 8305 (goto-char beg) 8306 (while (re-search-forward "\\s-" end t) 8307 (when(> (current-column) vhdl-end-comment-column) 8308 (backward-char) 8309 (when (re-search-backward "\\s-" beg t) 8310 (replace-match "\n") 8311 (indent-to margin))))))) 8312 8313(defun vhdl-fill-group () 8314 "Fill group of lines between empty lines." 8315 (interactive) 8316 (vhdl-do-group 'vhdl-fill-region)) 8317 8318(defun vhdl-fill-list () 8319 "Fill the lines of a list surrounded by a balanced group of parentheses." 8320 (interactive) 8321 (vhdl-do-list 'vhdl-fill-region)) 8322 8323(defun vhdl-fill-same-indent () 8324 "Fill the lines of block of lines with same indent." 8325 (interactive) 8326 (vhdl-do-same-indent 'vhdl-fill-region)) 8327 8328 8329;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8330;;; Code updating/fixing 8331;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8332 8333;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8334;; Sensitivity list update 8335 8336;; Strategy: 8337;; - no sensitivity list is generated for processes with wait statements 8338;; - otherwise, do the following: 8339;; 1. scan for all local signals (ports, signals declared in arch./blocks) 8340;; 2. scan for all signals already in the sensitivity list (in order to catch 8341;; manually entered global signals) 8342;; 3. signals from 1. and 2. form the list of visible signals 8343;; 4. search for if/elsif conditions containing an event (sequential code) 8344;; 5. scan for strings that are within syntactical regions where signals are 8345;; read but not within sequential code, and that correspond to visible 8346;; signals 8347;; 6. replace sensitivity list by list of signals from 5. 8348 8349(defun vhdl-update-sensitivity-list-process () 8350 "Update sensitivity list of current process." 8351 (interactive) 8352 (save-excursion 8353 (vhdl-prepare-search-2 8354 (end-of-line) 8355 ;; look whether in process 8356 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) 8357 (equal (upcase (match-string 2)) "PROCESS") 8358 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) 8359 (error "ERROR: Not within a process") 8360 (message "Updating sensitivity list...") 8361 (vhdl-update-sensitivity-list) 8362 (message "Updating sensitivity list...done"))))) 8363 8364(defun vhdl-update-sensitivity-list-buffer () 8365 "Update sensitivity list of all processes in current buffer." 8366 (interactive) 8367 (save-excursion 8368 (vhdl-prepare-search-2 8369 (goto-char (point-min)) 8370 (message "Updating sensitivity lists...") 8371 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) 8372 (goto-char (match-beginning 0)) 8373 (condition-case nil (vhdl-update-sensitivity-list) (error ""))) 8374 (message "Updating sensitivity lists...done"))) 8375 (when noninteractive (save-buffer))) 8376 8377(defun vhdl-update-sensitivity-list () 8378 "Update sensitivity list." 8379 (let ((proc-beg (point)) 8380 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 8381 (proc-mid (vhdl-re-search-backward 8382 "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t)) 8383 seq-region-list) 8384 (cond 8385 ;; error if 'begin' keyword missing 8386 ((not (match-string 2)) 8387 (error "ERROR: No 'begin' keyword found")) 8388 ;; search for wait statement (no sensitivity list allowed) 8389 ((progn (goto-char proc-mid) 8390 (vhdl-re-search-forward "\\<wait\\>" proc-end t)) 8391 (error "ERROR: Process with wait statement, sensitivity list not generated")) 8392 ;; combinational process (update sensitivity list) 8393 (t 8394 (let 8395 ;; scan for visible signals 8396 ((visible-list (vhdl-get-visible-signals)) 8397 ;; define syntactic regions where signals are read 8398 (scan-regions-list 8399 '(;; right-hand side of signal/variable assignment 8400 ;; (special case: "<=" is relational operator in a condition) 8401 ((vhdl-re-search-forward "[<:]=" proc-end t) 8402 (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) 8403 ;; if condition 8404 ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) 8405 (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8406 ;; elsif condition 8407 ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) 8408 (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8409 ;; while loop condition 8410 ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) 8411 (vhdl-re-search-forward "\\<loop\\>" proc-end t)) 8412 ;; exit/next condition 8413 ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) 8414 (vhdl-re-search-forward ";" proc-end t)) 8415 ;; assert condition 8416 ((vhdl-re-search-forward "\\<assert\\>" proc-end t) 8417 (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) 8418 ;; case expression 8419 ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) 8420 (vhdl-re-search-forward "\\<is\\>" proc-end t)) 8421 ;; parameter list of procedure call, array index 8422 ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) 8423 (1- (point))) 8424 (progn (backward-char) (forward-sexp) 8425 (while (looking-at "(") (forward-sexp)) (point))))) 8426 name field read-list sens-list signal-list tmp-list 8427 sens-beg sens-end beg end margin) 8428 ;; scan for signals in old sensitivity list 8429 (goto-char proc-beg) 8430 (vhdl-re-search-forward "\\<process\\>" proc-mid t) 8431 (if (not (looking-at "[ \t\n\r\f]*(")) 8432 (setq sens-beg (point)) 8433 (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) 8434 (goto-char (match-end 1)) 8435 (forward-sexp) 8436 (setq sens-end (1- (point))) 8437 (goto-char sens-beg) 8438 (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) 8439 (setq sens-list 8440 (cons (downcase (match-string 0)) sens-list)) 8441 (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) 8442 (setq signal-list (append visible-list sens-list)) 8443 ;; search for sequential parts 8444 (goto-char proc-mid) 8445 (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) 8446 (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) 8447 (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) 8448 (goto-char end) 8449 (backward-word-strictly 1) 8450 (vhdl-forward-sexp) 8451 (push (cons end (point)) seq-region-list) 8452 (beginning-of-line))) 8453 ;; scan for signals read in process 8454 (while scan-regions-list 8455 (goto-char proc-mid) 8456 (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) 8457 (setq end (eval (nth 1 (car scan-regions-list))))) 8458 (goto-char beg) 8459 (unless (or (vhdl-in-literal) 8460 (and seq-region-list 8461 (let ((tmp-list seq-region-list)) 8462 (while (and tmp-list 8463 (< (point) (caar tmp-list))) 8464 (setq tmp-list (cdr tmp-list))) 8465 (and tmp-list (< (point) (cdar tmp-list)))))) 8466 (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) 8467 (setq name (match-string 1)) 8468 ;; get array index range 8469 (when vhdl-array-index-record-field-in-sensitivity-list 8470 (setq field (match-string 2)) 8471 ;; not use if it includes a variable name 8472 (save-match-data 8473 (setq tmp-list visible-list) 8474 (while (and field tmp-list) 8475 (when (string-match 8476 (concat "\\<" (car tmp-list) "\\>") field) 8477 (setq field nil)) 8478 (setq tmp-list (cdr tmp-list))))) 8479 (when (and (not (match-string 6)) ; not when formal parameter 8480 (not (and (match-string 5) ; not event attribute 8481 (not (member (downcase (match-string 5)) 8482 '("event" "last_event" "transaction"))))) 8483 (member (downcase name) signal-list)) 8484 ;; not add if name or name+field already exists 8485 (unless 8486 (or (member-ignore-case name read-list) 8487 (member-ignore-case (concat name field) read-list)) 8488 (push (concat name field) read-list)) 8489 (setq tmp-list read-list) 8490 ;; remove existing name+field if name is added 8491 (save-match-data 8492 (while tmp-list 8493 (when (string-match (concat "^" name field "[(.]") 8494 (car tmp-list)) 8495 (setq read-list (delete (car tmp-list) read-list))) 8496 (setq tmp-list (cdr tmp-list))))) 8497 (goto-char (match-end 1))))) 8498 (setq scan-regions-list (cdr scan-regions-list))) 8499 ;; update sensitivity list 8500 (goto-char sens-beg) 8501 (if sens-end 8502 (delete-region sens-beg sens-end) 8503 (when read-list 8504 (insert " ()") (backward-char))) 8505 (setq read-list (sort read-list #'string<)) 8506 (when read-list 8507 (setq margin (current-column)) 8508 (insert (car read-list)) 8509 (setq read-list (cdr read-list)) 8510 (while read-list 8511 (insert ",") 8512 (if (<= (+ (current-column) (length (car read-list)) 2) 8513 end-comment-column) 8514 (insert " ") 8515 (insert "\n") (indent-to margin)) 8516 (insert (car read-list)) 8517 (setq read-list (cdr read-list))))))))) 8518 8519(defun vhdl-get-visible-signals () 8520 "Get all signals visible in the current block." 8521 (let (beg end signal-list entity-name file-name) 8522 (vhdl-prepare-search-2 8523 ;; get entity name 8524 (save-excursion 8525 (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 8526 (not (equal "END" (upcase (match-string 1)))) 8527 (setq entity-name (match-string 2))) 8528 (error "ERROR: Not within an architecture"))) 8529 ;; search for signals declared in entity port clause 8530 (save-excursion 8531 (goto-char (point-min)) 8532 (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) 8533 (setq file-name 8534 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) 8535 "." (file-name-extension (buffer-file-name))))) 8536 (vhdl-visit-file 8537 file-name t 8538 (vhdl-prepare-search-2 8539 (goto-char (point-min)) 8540 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) 8541 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) 8542 (when (setq beg (vhdl-re-search-forward 8543 "\\<port[ \t\n\r\f]*(" 8544 (save-excursion 8545 (re-search-forward "^end\\>" nil t)) 8546 t)) 8547 (setq end (save-excursion 8548 (backward-char) (forward-sexp) (point))) 8549 (vhdl-forward-syntactic-ws) 8550 (while (< (point) end) 8551 (when (looking-at "signal[ \t\n\r\f]+") 8552 (goto-char (match-end 0))) 8553 (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") 8554 (setq signal-list 8555 (cons (downcase (match-string 1)) signal-list)) 8556 (goto-char (match-end 0)) 8557 (vhdl-forward-syntactic-ws)) 8558 (re-search-forward ";" end 1) 8559 (vhdl-forward-syntactic-ws))))))) 8560 ;; search for signals declared in architecture declarative part 8561 (save-excursion 8562 (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) 8563 (not (equal "END" (upcase (match-string 1)))) 8564 (setq end (re-search-forward "^begin\\>" nil t)))) 8565 (error "ERROR: No architecture declarative part found") 8566 ;; scan for all declared signal and alias names 8567 (goto-char beg) 8568 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 8569 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 8570 (if (match-string 2) 8571 ;; scan signal name 8572 (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") 8573 (setq signal-list 8574 (cons (downcase (match-string 1)) signal-list)) 8575 (goto-char (match-end 0))) 8576 ;; scan alias name, check is alias of (declared) signal 8577 (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)") 8578 (member (downcase (match-string 2)) signal-list)) 8579 (setq signal-list 8580 (cons (downcase (match-string 1)) signal-list)) 8581 (goto-char (match-end 0)))) 8582 (setq beg (point)))))) 8583 ;; search for signals declared in surrounding block declarative parts 8584 (save-excursion 8585 (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t)) 8586 (match-string 4)) 8587 (goto-char (match-end 4)) 8588 (vhdl-backward-sexp) 8589 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t)) 8590 beg) 8591 (setq end (re-search-forward "^\\s-*begin\\>" nil t))) 8592 ;; scan for all declared signal names 8593 (goto-char beg) 8594 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 8595 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 8596 (if (match-string 2) 8597 ;; scan signal name 8598 (while (looking-at "[ \t\n,]+\\(\\w+\\)") 8599 (setq signal-list 8600 (cons (downcase (match-string 1)) signal-list)) 8601 (goto-char (match-end 0))) 8602 ;; scan alias name, check is alias of (declared) signal 8603 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") 8604 (member (downcase (match-string 2)) signal-list)) 8605 (setq signal-list 8606 (cons (downcase (match-string 1)) signal-list)) 8607 (goto-char (match-end 0)))))) 8608 (goto-char beg))) 8609 signal-list))) 8610 8611;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8612;; Generic/port clause fixing 8613 8614(defun vhdl-fix-clause-buffer () 8615 "Fix all generic/port clauses in current buffer." 8616 (interactive) 8617 (save-excursion 8618 (vhdl-prepare-search-2 8619 (goto-char (point-min)) 8620 (message "Fixing generic/port clauses...") 8621 (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t) 8622 (goto-char (match-end 0)) 8623 (condition-case nil (vhdl-fix-clause) (error ""))) 8624 (message "Fixing generic/port clauses...done")))) 8625 8626(defun vhdl-fix-clause () 8627 "Fix closing parenthesis within generic/port clause." 8628 (interactive) 8629 (save-excursion 8630 (vhdl-prepare-search-2 8631 (let ((pos (point)) 8632 beg end) 8633 (end-of-line) 8634 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)) 8635 (error "ERROR: Not within a generic/port clause") 8636 ;; search for end of clause 8637 (goto-char (match-end 0)) 8638 (setq beg (1- (point))) 8639 (vhdl-forward-syntactic-ws) 8640 (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;") 8641 (goto-char (1- (match-end 0))) 8642 (setq end (point-marker)) 8643 (forward-char) 8644 (vhdl-forward-syntactic-ws)) 8645 (goto-char end) 8646 (when (> pos (point-at-eol)) 8647 (error "ERROR: Not within a generic/port clause")) 8648 ;; delete closing parenthesis on separate line (not supported style) 8649 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) 8650 (vhdl-line-kill) 8651 (vhdl-backward-syntactic-ws) 8652 (setq end (point-marker)) 8653 (insert ";")) 8654 ;; delete superfluous parentheses 8655 (while (progn (goto-char beg) 8656 (condition-case () (forward-sexp) 8657 (error (goto-char (point-max)))) 8658 (< (point) end)) 8659 (delete-char -1)) 8660 ;; add closing parenthesis 8661 (when (> (point) end) 8662 (goto-char end) 8663 (insert ")"))))))) 8664 8665 8666;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8667;;; Electrification 8668;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8669 8670(defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" 8671 "Syntax of prompt inserted by template generators.") 8672 8673(defvar vhdl-template-invoked-by-hook nil 8674 "Indicates whether a template has been invoked by a hook or by key or menu. 8675Used for undoing after template abortion.") 8676 8677;; correct different behavior of function `unread-command-events' in XEmacs 8678(defun vhdl-character-to-event (_arg) nil) 8679(defalias 'vhdl-character-to-event 8680 (if (fboundp 'character-to-event) #'character-to-event #'identity)) 8681 8682(defun vhdl-work-library () 8683 "Return the working library name of the current project or \"work\" if no 8684project is defined." 8685 (vhdl-resolve-env-variable 8686 (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) 8687 vhdl-default-library))) 8688 8689;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8690;; Enabling/disabling 8691 8692(define-minor-mode vhdl-electric-mode 8693 "Toggle VHDL electric mode." 8694 :global t :group 'vhdl-mode) 8695 8696(define-minor-mode vhdl-stutter-mode 8697 "Toggle VHDL stuttering mode." 8698 :global t :group 'vhdl-mode) 8699 8700;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8701;; Stuttering 8702 8703(defun vhdl-electric-dash (count) 8704 "-- starts a comment, --- draws a horizontal line, 8705---- starts a display comment." 8706 (interactive "p") 8707 (if (and vhdl-stutter-mode (not (vhdl-in-literal))) 8708 (cond 8709 ((and abbrev-start-location (= abbrev-start-location (point))) 8710 (setq abbrev-start-location nil) 8711 (goto-char last-abbrev-location) 8712 (beginning-of-line nil) 8713 (vhdl-comment-display)) 8714 ((/= (preceding-char) ?-) ; standard dash (minus) 8715 (self-insert-command count)) 8716 (t (self-insert-command count) 8717 (message "Enter `-' for horiz. line, RET for commenting-out code, else enter comment") 8718 (let ((next-input (read-char))) 8719 (if (= next-input ?-) ; triple dash 8720 (progn 8721 (vhdl-comment-display-line) 8722 (message 8723 "Enter `-' for display comment, else continue coding") 8724 (let ((next-input (read-char))) 8725 (if (= next-input ?-) ; four dashes 8726 (vhdl-comment-display t) 8727 (push (vhdl-character-to-event next-input) 8728 ; pushback the char 8729 unread-command-events)))) 8730 (push (vhdl-character-to-event next-input) ; pushback the char 8731 unread-command-events) 8732 (vhdl-comment-insert))))) 8733 (self-insert-command count))) 8734 8735(defun vhdl-electric-open-bracket (count) "`[' --> `(', `([' --> `['" 8736 (interactive "p") 8737 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8738 (if (= (preceding-char) ?\() 8739 (progn (delete-char -1) (insert-char ?\[ 1)) 8740 (insert-char ?\( 1)) 8741 (self-insert-command count))) 8742 8743(defun vhdl-electric-close-bracket (count) "`]' --> `)', `)]' --> `]'" 8744 (interactive "p") 8745 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8746 (progn 8747 (if (= (preceding-char) ?\)) 8748 (progn (delete-char -1) (insert-char ?\] 1)) 8749 (insert-char ?\) 1)) 8750 (blink-matching-open)) 8751 (self-insert-command count))) 8752 8753(defun vhdl-electric-quote (count) "\\='\\=' --> \"" 8754 (interactive "p") 8755 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8756 (if (= (preceding-char) vhdl-last-input-event) 8757 (progn (delete-char -1) (insert-char ?\" 1)) 8758 (insert-char ?\' 1)) 8759 (self-insert-command count))) 8760 8761(defun vhdl-electric-semicolon (count) "`;;' --> ` : ', `: ;' --> ` := '" 8762 (interactive "p") 8763 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8764 (cond ((= (preceding-char) vhdl-last-input-event) 8765 (progn (delete-char -1) 8766 (unless (eq (preceding-char) ? ) (insert " ")) 8767 (insert ": ") 8768 (setq this-command 'vhdl-electric-colon))) 8769 ((and 8770 (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) 8771 (progn (delete-char -1) (insert "= "))) 8772 (t (insert-char ?\; 1))) 8773 (self-insert-command count))) 8774 8775(defun vhdl-electric-comma (count) "`,,' --> ` <= '" 8776 (interactive "p") 8777 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8778 (cond ((= (preceding-char) vhdl-last-input-event) 8779 (progn (delete-char -1) 8780 (unless (eq (preceding-char) ? ) (insert " ")) 8781 (insert "<= "))) 8782 (t (insert-char ?\, 1))) 8783 (self-insert-command count))) 8784 8785(defun vhdl-electric-period (count) "`..' --> ` => '" 8786 (interactive "p") 8787 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8788 (cond ((= (preceding-char) vhdl-last-input-event) 8789 (progn (delete-char -1) 8790 (unless (eq (preceding-char) ? ) (insert " ")) 8791 (insert "=> "))) 8792 (t (insert-char ?\. 1))) 8793 (self-insert-command count))) 8794 8795(defun vhdl-electric-equal (count) "`==' --> ` == '" 8796 (interactive "p") 8797 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8798 (cond ((= (preceding-char) vhdl-last-input-event) 8799 (progn (delete-char -1) 8800 (unless (eq (preceding-char) ? ) (insert " ")) 8801 (insert "== "))) 8802 (t (insert-char ?\= 1))) 8803 (self-insert-command count))) 8804 8805;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8806;; VHDL templates 8807 8808(defun vhdl-template-paired-parens () 8809 "Insert a pair of round parentheses, placing point between them." 8810 (interactive) 8811 (insert "()") 8812 (backward-char)) 8813 8814(defun vhdl-template-alias () 8815 "Insert alias declaration." 8816 (interactive) 8817 (let ((start (point))) 8818 (vhdl-insert-keyword "ALIAS ") 8819 (when (vhdl-template-field "name" nil t start (point)) 8820 (insert " : ") 8821 (unless (vhdl-template-field 8822 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") 8823 nil t) 8824 (delete-char -3)) 8825 (vhdl-insert-keyword " IS ") 8826 (vhdl-template-field "name" ";") 8827 (vhdl-comment-insert-inline)))) 8828 8829(defun vhdl-template-architecture () 8830 "Insert architecture." 8831 (interactive) 8832 (let ((margin (current-indentation)) 8833 (start (point)) 8834 arch-name) 8835 (vhdl-insert-keyword "ARCHITECTURE ") 8836 (when (setq arch-name 8837 (vhdl-template-field "name" nil t start (point))) 8838 (vhdl-insert-keyword " OF ") 8839 (if (save-excursion 8840 (vhdl-prepare-search-1 8841 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) 8842 (insert (match-string 1)) 8843 (vhdl-template-field "entity name")) 8844 (vhdl-insert-keyword " IS\n") 8845 (vhdl-template-begin-end 8846 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin 8847 (memq vhdl-insert-empty-lines '(unit all)))))) 8848 8849(defun vhdl-template-array (kind &optional secondary) 8850 "Insert array type definition." 8851 (interactive) 8852 (let ((start (point))) 8853 (vhdl-insert-keyword "ARRAY (") 8854 (when (or (vhdl-template-field "range" nil (not secondary) start (point)) 8855 secondary) 8856 (vhdl-insert-keyword ") OF ") 8857 (vhdl-template-field (if (eq kind 'type) "type" "nature")) 8858 (vhdl-insert-keyword ";")))) 8859 8860(defun vhdl-template-assert () 8861 "Insert an assertion statement." 8862 (interactive) 8863 (let ((start (point))) 8864 (vhdl-insert-keyword "ASSERT ") 8865 (when vhdl-conditions-in-parenthesis (insert "(")) 8866 (when (vhdl-template-field "condition (negated)" nil t start (point)) 8867 (when vhdl-conditions-in-parenthesis (insert ")")) 8868 (setq start (point)) 8869 (vhdl-insert-keyword " REPORT ") 8870 (unless (vhdl-template-field "string expression" nil nil nil nil t) 8871 (delete-region start (point))) 8872 (setq start (point)) 8873 (vhdl-insert-keyword " SEVERITY ") 8874 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 8875 (delete-region start (point))) 8876 (insert ";")))) 8877 8878(defun vhdl-template-attribute () 8879 "Insert an attribute declaration or specification." 8880 (interactive) 8881 (if (eq (vhdl-decision-query 8882 "attribute" "(d)eclaration or (s)pecification?" t) ?s) 8883 (vhdl-template-attribute-spec) 8884 (vhdl-template-attribute-decl))) 8885 8886(defun vhdl-template-attribute-decl () 8887 "Insert an attribute declaration." 8888 (interactive) 8889 (let ((start (point))) 8890 (vhdl-insert-keyword "ATTRIBUTE ") 8891 (when (vhdl-template-field "name" " : " t start (point)) 8892 (vhdl-template-field "type" ";") 8893 (vhdl-comment-insert-inline)))) 8894 8895(defun vhdl-template-attribute-spec () 8896 "Insert an attribute specification." 8897 (interactive) 8898 (let ((start (point))) 8899 (vhdl-insert-keyword "ATTRIBUTE ") 8900 (when (vhdl-template-field "name" nil t start (point)) 8901 (vhdl-insert-keyword " OF ") 8902 (vhdl-template-field "entity names | OTHERS | ALL" " : ") 8903 (vhdl-template-field "entity class") 8904 (vhdl-insert-keyword " IS ") 8905 (vhdl-template-field "expression" ";")))) 8906 8907(defun vhdl-template-block () 8908 "Insert a block." 8909 (interactive) 8910 (let ((margin (current-indentation)) 8911 (start (point)) 8912 label) 8913 (vhdl-insert-keyword ": BLOCK ") 8914 (goto-char start) 8915 (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) 8916 (forward-word-strictly 1) 8917 (forward-char 1) 8918 (insert "(") 8919 (if (vhdl-template-field "[guard expression]" nil t) 8920 (insert ")") 8921 (delete-char -2)) 8922 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 8923 (insert "\n") 8924 (vhdl-template-begin-end "BLOCK" label margin) 8925 (vhdl-comment-block)))) 8926 8927(defun vhdl-template-block-configuration () 8928 "Insert a block configuration statement." 8929 (interactive) 8930 (let ((margin (current-indentation)) 8931 (start (point))) 8932 (vhdl-insert-keyword "FOR ") 8933 (when (vhdl-template-field "block name" nil t start (point)) 8934 (vhdl-insert-keyword "\n\n") 8935 (indent-to margin) 8936 (vhdl-insert-keyword "END FOR;") 8937 (end-of-line 0) 8938 (indent-to (+ margin vhdl-basic-offset))))) 8939 8940(defun vhdl-template-break () 8941 "Insert a break statement." 8942 (interactive) 8943 (let (position) 8944 (vhdl-insert-keyword "BREAK") 8945 (setq position (point)) 8946 (insert " ") 8947 (while (or 8948 (progn (vhdl-insert-keyword "FOR ") 8949 (if (vhdl-template-field "[quantity name]" " USE " t) 8950 (progn (vhdl-template-field "quantity name" " => ") t) 8951 (delete-region (point) 8952 (progn (forward-word-strictly -1) (point))) 8953 nil)) 8954 (vhdl-template-field "[quantity name]" " => " t)) 8955 (vhdl-template-field "expression") 8956 (setq position (point)) 8957 (insert ", ")) 8958 (delete-region position (point)) 8959 (unless (vhdl-sequential-statement-p) 8960 (vhdl-insert-keyword " ON ") 8961 (if (vhdl-template-field "[sensitivity list]" nil t) 8962 (setq position (point)) 8963 (delete-region position (point)))) 8964 (vhdl-insert-keyword " WHEN ") 8965 (when vhdl-conditions-in-parenthesis (insert "(")) 8966 (if (vhdl-template-field "[condition]" nil t) 8967 (when vhdl-conditions-in-parenthesis (insert ")")) 8968 (delete-region position (point))) 8969 (insert ";"))) 8970 8971(defun vhdl-template-case (&optional kind) 8972 "Insert a case statement." 8973 (interactive) 8974 (let ((margin (current-indentation)) 8975 (start (point)) 8976 label) 8977 (unless kind (setq kind (if (or (vhdl-sequential-statement-p) 8978 (not (vhdl-standard-p 'ams))) 'is 'use))) 8979 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 8980 (vhdl-insert-keyword "CASE ") 8981 (vhdl-insert-keyword ": CASE ") 8982 (goto-char start) 8983 (setq label (vhdl-template-field "[label]" nil t)) 8984 (unless label (delete-char 2)) 8985 (forward-word-strictly 1) 8986 (forward-char 1)) 8987 (when (vhdl-template-field "expression" nil t start (point)) 8988 (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) 8989 (indent-to margin) 8990 (vhdl-insert-keyword "END CASE") 8991 (when label (insert " " label)) 8992 (insert ";") 8993 (forward-line -1) 8994 (indent-to (+ margin vhdl-basic-offset)) 8995 (vhdl-insert-keyword "WHEN ") 8996 (let ((position (point))) 8997 (insert " => ;\n") 8998 (indent-to (+ margin vhdl-basic-offset)) 8999 (vhdl-insert-keyword "WHEN OTHERS => null;") 9000 (goto-char position))))) 9001 9002(defun vhdl-template-case-is () 9003 "Insert a sequential case statement." 9004 (interactive) 9005 (vhdl-template-case 'is)) 9006 9007(defun vhdl-template-case-use () 9008 "Insert a simultaneous case statement." 9009 (interactive) 9010 (vhdl-template-case 'use)) 9011 9012(defun vhdl-template-component () 9013 "Insert a component declaration." 9014 (interactive) 9015 (vhdl-template-component-decl)) 9016 9017(defun vhdl-template-component-conf () 9018 "Insert a component configuration (uses `vhdl-template-configuration-spec' 9019since these are almost equivalent)." 9020 (interactive) 9021 (let ((margin (current-indentation)) 9022 (result (vhdl-template-configuration-spec t))) 9023 (when result 9024 (insert "\n") 9025 (indent-to margin) 9026 (vhdl-insert-keyword "END FOR;") 9027 (when (eq result 'no-use) 9028 (end-of-line -0))))) 9029 9030(defun vhdl-template-component-decl () 9031 "Insert a component declaration." 9032 (interactive) 9033 (let ((margin (current-indentation)) 9034 (start (point)) 9035 name end-column) 9036 (vhdl-insert-keyword "COMPONENT ") 9037 (when (setq name (vhdl-template-field "name" nil t start (point))) 9038 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 9039 (insert "\n\n") 9040 (indent-to margin) 9041 (vhdl-insert-keyword "END COMPONENT") 9042 (unless (vhdl-standard-p '87) (insert " " name)) 9043 (insert ";") 9044 (setq end-column (current-column)) 9045 (end-of-line -0) 9046 (indent-to (+ margin vhdl-basic-offset)) 9047 (vhdl-template-generic-list t t) 9048 (insert "\n") 9049 (indent-to (+ margin vhdl-basic-offset)) 9050 (vhdl-template-port-list t) 9051 (beginning-of-line 2) 9052 (forward-char end-column)))) 9053 9054(defun vhdl-template-component-inst () 9055 "Insert a component instantiation statement." 9056 (interactive) 9057 (let ((margin (current-indentation)) 9058 (start (point)) 9059 unit position) 9060 (when (vhdl-template-field "instance label" nil t start (point)) 9061 (insert ": ") 9062 (if (not (vhdl-use-direct-instantiation)) 9063 (vhdl-template-field "component name") 9064 ;; direct instantiation 9065 (setq unit (vhdl-template-field 9066 "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) 9067 (setq unit (upcase (or unit ""))) 9068 (cond ((equal unit "ENTITY") 9069 (let ((begin (point))) 9070 (vhdl-template-field "library name" "." t begin (point) nil 9071 (vhdl-work-library)) 9072 (vhdl-template-field "entity name" "(") 9073 (if (vhdl-template-field "[architecture name]" nil t) 9074 (insert ")") 9075 (delete-char -1)))) 9076 ((equal unit "CONFIGURATION") 9077 (vhdl-template-field "library name" "." nil nil nil nil 9078 (vhdl-work-library)) 9079 (vhdl-template-field "configuration name")) 9080 (t (vhdl-template-field "component name")))) 9081 (insert "\n") 9082 (indent-to (+ margin vhdl-basic-offset)) 9083 (setq position (point)) 9084 (vhdl-insert-keyword "GENERIC ") 9085 (when (vhdl-template-map position t t) 9086 (insert "\n") 9087 (indent-to (+ margin vhdl-basic-offset))) 9088 (setq position (point)) 9089 (vhdl-insert-keyword "PORT ") 9090 (unless (vhdl-template-map position t t) 9091 (delete-region (line-beginning-position) (point)) 9092 (delete-char -1)) 9093 (insert ";")))) 9094 9095(defun vhdl-template-conditional-signal-asst () 9096 "Insert a conditional signal assignment." 9097 (interactive) 9098 (when (vhdl-template-field "target signal") 9099 (insert " <= ") 9100 (let ((margin (current-column)) 9101 (start (point)) 9102 position) 9103 (vhdl-template-field "waveform") 9104 (setq position (point)) 9105 (vhdl-insert-keyword " WHEN ") 9106 (when vhdl-conditions-in-parenthesis (insert "(")) 9107 (while (and (vhdl-template-field "[condition]" nil t) 9108 (progn 9109 (when vhdl-conditions-in-parenthesis (insert ")")) 9110 (setq position (point)) 9111 (vhdl-insert-keyword " ELSE") 9112 (insert "\n") 9113 (indent-to margin) 9114 (vhdl-template-field "[waveform]" nil t))) 9115 (setq position (point)) 9116 (vhdl-insert-keyword " WHEN ") 9117 (when vhdl-conditions-in-parenthesis (insert "("))) 9118 (delete-region position (point)) 9119 (insert ";") 9120 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 9121 9122(defun vhdl-template-configuration () 9123 "Insert a configuration specification if within an architecture, 9124a block or component configuration if within a configuration declaration, 9125a configuration declaration if not within a design unit." 9126 (interactive) 9127 (vhdl-prepare-search-1 9128 (cond 9129 ((and (save-excursion ; architecture body 9130 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) 9131 (equal "ARCHITECTURE" (upcase (match-string 1)))) 9132 (vhdl-template-configuration-spec)) 9133 ((and (save-excursion ; configuration declaration 9134 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9135 (equal "CONFIGURATION" (upcase (match-string 1)))) 9136 (if (eq (vhdl-decision-query 9137 "configuration" "(b)lock or (c)omponent configuration?" t) 9138 ?c) 9139 (vhdl-template-component-conf) 9140 (vhdl-template-block-configuration))) 9141 (t (vhdl-template-configuration-decl))))) ; otherwise 9142 9143(defun vhdl-template-configuration-spec (&optional optional-use) 9144 "Insert a configuration specification." 9145 (interactive) 9146 (let ((margin (current-indentation)) 9147 (start (point)) 9148 aspect position) 9149 (vhdl-insert-keyword "FOR ") 9150 (when (vhdl-template-field "instance names | OTHERS | ALL" " : " 9151 t start (point)) 9152 (vhdl-template-field "component name" "\n") 9153 (indent-to (+ margin vhdl-basic-offset)) 9154 (setq start (point)) 9155 (vhdl-insert-keyword "USE ") 9156 (if (and optional-use 9157 (not (setq aspect (vhdl-template-field 9158 "[ENTITY | CONFIGURATION | OPEN]" " " t)))) 9159 (progn (delete-region start (point)) 'no-use) 9160 (unless optional-use 9161 (setq aspect (vhdl-template-field 9162 "ENTITY | CONFIGURATION | OPEN" " "))) 9163 (setq aspect (upcase (or aspect ""))) 9164 (cond ((equal aspect "ENTITY") 9165 (vhdl-template-field "library name" "." nil nil nil nil 9166 (vhdl-work-library)) 9167 (vhdl-template-field "entity name" "(") 9168 (if (vhdl-template-field "[architecture name]" nil t) 9169 (insert ")") 9170 (delete-char -1)) 9171 (insert "\n") 9172 (indent-to (+ margin (* 2 vhdl-basic-offset))) 9173 (setq position (point)) 9174 (vhdl-insert-keyword "GENERIC ") 9175 (when (vhdl-template-map position t t) 9176 (insert "\n") 9177 (indent-to (+ margin (* 2 vhdl-basic-offset)))) 9178 (setq position (point)) 9179 (vhdl-insert-keyword "PORT ") 9180 (unless (vhdl-template-map position t t) 9181 (delete-region (line-beginning-position) (point)) 9182 (delete-char -1)) 9183 (insert ";") 9184 t) 9185 ((equal aspect "CONFIGURATION") 9186 (vhdl-template-field "library name" "." nil nil nil nil 9187 (vhdl-work-library)) 9188 (vhdl-template-field "configuration name" ";")) 9189 (t (delete-char -1) (insert ";") t)))))) 9190 9191 9192(defun vhdl-template-configuration-decl () 9193 "Insert a configuration declaration." 9194 (interactive) 9195 (let ((margin (current-indentation)) 9196 (start (point)) 9197 entity-exists string name position) 9198 (vhdl-insert-keyword "CONFIGURATION ") 9199 (when (setq name (vhdl-template-field "name" nil t start (point))) 9200 (vhdl-insert-keyword " OF ") 9201 (save-excursion 9202 (vhdl-prepare-search-1 9203 (setq entity-exists (vhdl-re-search-backward 9204 "\\<entity \\(\\w*\\) is\\>" nil t)) 9205 (setq string (match-string 1)))) 9206 (if (and entity-exists (not (equal string ""))) 9207 (insert string) 9208 (vhdl-template-field "entity name")) 9209 (vhdl-insert-keyword " IS\n") 9210 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9211 (indent-to (+ margin vhdl-basic-offset)) 9212 (setq position (point)) 9213 (insert "\n") 9214 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9215 (indent-to margin) 9216 (vhdl-insert-keyword "END ") 9217 (unless (vhdl-standard-p '87) 9218 (vhdl-insert-keyword "CONFIGURATION ")) 9219 (insert name ";") 9220 (goto-char position)))) 9221 9222(defun vhdl-template-constant () 9223 "Insert a constant declaration." 9224 (interactive) 9225 (let ((start (point)) 9226 (in-arglist (vhdl-in-argument-list-p))) 9227 (vhdl-insert-keyword "CONSTANT ") 9228 (when (vhdl-template-field "name" nil t start (point)) 9229 (insert " : ") 9230 (when in-arglist (vhdl-insert-keyword "IN ")) 9231 (vhdl-template-field "type") 9232 (if in-arglist 9233 (progn (insert ";") 9234 (vhdl-comment-insert-inline)) 9235 (let ((position (point))) 9236 (insert " := ") 9237 (unless (vhdl-template-field "[initialization]" nil t) 9238 (delete-region position (point))) 9239 (insert ";") 9240 (vhdl-comment-insert-inline)))))) 9241 9242(defun vhdl-template-context () 9243 "Insert a context declaration." 9244 (interactive) 9245 (let ((margin (current-indentation)) 9246 (start (point)) 9247 name position) ;; entity-exists string 9248 (vhdl-insert-keyword "CONTEXT ") 9249 (when (setq name (vhdl-template-field "name" nil t start (point))) 9250 (vhdl-insert-keyword " IS\n") 9251 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9252 (indent-to (+ margin vhdl-basic-offset)) 9253 (setq position (point)) 9254 (insert "\n") 9255 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9256 (indent-to margin) 9257 (vhdl-insert-keyword "END ") 9258 (unless (vhdl-standard-p '87) 9259 (vhdl-insert-keyword "CONTEXT ")) 9260 (insert name ";") 9261 (goto-char position)))) 9262 9263(defun vhdl-template-default () 9264 "Insert nothing." 9265 (interactive) 9266 (insert " ") 9267 (unexpand-abbrev) 9268 (backward-word-strictly 1) 9269 (vhdl-case-word 1) 9270 (forward-char 1)) 9271 9272(defun vhdl-template-default-indent () 9273 "Insert nothing and indent." 9274 (interactive) 9275 (insert " ") 9276 (unexpand-abbrev) 9277 (backward-word-strictly 1) 9278 (vhdl-case-word 1) 9279 (forward-char 1) 9280 (indent-according-to-mode)) 9281 9282(defun vhdl-template-disconnect () 9283 "Insert a disconnect statement." 9284 (interactive) 9285 (let ((start (point))) 9286 (vhdl-insert-keyword "DISCONNECT ") 9287 (when (vhdl-template-field "signal names | OTHERS | ALL" 9288 " : " t start (point)) 9289 (vhdl-template-field "type") 9290 (vhdl-insert-keyword " AFTER ") 9291 (vhdl-template-field "time expression" ";")))) 9292 9293(defun vhdl-template-else () 9294 "Insert an else statement." 9295 (interactive) 9296 (let (margin) 9297 (vhdl-prepare-search-1 9298 (vhdl-insert-keyword "ELSE") 9299 (if (and (save-excursion (vhdl-re-search-backward "\\(\\(\\<when\\>\\)\\|;\\)" nil t)) 9300 (match-string 2)) 9301 (insert " ") 9302 (unless (vhdl-sequential-statement-p) 9303 (vhdl-insert-keyword " GENERATE")) 9304 (indent-according-to-mode) 9305 (setq margin (current-indentation)) 9306 (insert "\n") 9307 (indent-to (+ margin vhdl-basic-offset)))))) 9308 9309(defun vhdl-template-elsif () 9310 "Insert an elsif statement." 9311 (interactive) 9312 (let ((start (point)) 9313 margin) 9314 (vhdl-insert-keyword "ELSIF ") 9315 (when vhdl-conditions-in-parenthesis (insert "(")) 9316 (when (vhdl-template-field "condition" nil t start (point)) 9317 (when vhdl-conditions-in-parenthesis (insert ")")) 9318 (indent-according-to-mode) 9319 (setq margin (current-indentation)) 9320 (vhdl-insert-keyword 9321 (concat " " (cond ((vhdl-sequential-statement-p) "THEN") 9322 ((vhdl-standard-p 'ams) "USE") 9323 (t "GENERATE")) "\n")) 9324 (indent-to (+ margin vhdl-basic-offset))))) 9325 9326(defun vhdl-template-entity () 9327 "Insert an entity." 9328 (interactive) 9329 (let ((margin (current-indentation)) 9330 (start (point)) 9331 name end-column) 9332 (vhdl-insert-keyword "ENTITY ") 9333 (when (setq name (vhdl-template-field "name" nil t start (point))) 9334 (vhdl-insert-keyword " IS\n\n") 9335 (indent-to margin) 9336 (vhdl-insert-keyword "END ") 9337 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 9338 (insert name ";") 9339 (setq end-column (current-column)) 9340 (end-of-line -0) 9341 (indent-to (+ margin vhdl-basic-offset)) 9342 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9343 (indent-to (+ margin vhdl-basic-offset)) 9344 (when (vhdl-template-generic-list t) 9345 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 9346 (insert "\n") 9347 (indent-to (+ margin vhdl-basic-offset)) 9348 (when (vhdl-template-port-list t) 9349 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 9350 (beginning-of-line 2) 9351 (forward-char end-column)))) 9352 9353(defun vhdl-template-exit () 9354 "Insert an exit statement." 9355 (interactive) 9356 (let ((start (point))) 9357 (vhdl-insert-keyword "EXIT ") 9358 (if (vhdl-template-field "[loop label]" nil t start (point)) 9359 (let ((position (point))) 9360 (vhdl-insert-keyword " WHEN ") 9361 (when vhdl-conditions-in-parenthesis (insert "(")) 9362 (if (vhdl-template-field "[condition]" nil t) 9363 (when vhdl-conditions-in-parenthesis (insert ")")) 9364 (delete-region position (point)))) 9365 (delete-char -1)) 9366 (insert ";"))) 9367 9368(defun vhdl-template-file () 9369 "Insert a file declaration." 9370 (interactive) 9371 (let ((start (point))) 9372 (vhdl-insert-keyword "FILE ") 9373 (when (vhdl-template-field "name" nil t start (point)) 9374 (insert " : ") 9375 (vhdl-template-field "type") 9376 (unless (vhdl-standard-p '87) 9377 (vhdl-insert-keyword " OPEN ") 9378 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" 9379 nil t) 9380 (delete-char -6))) 9381 (vhdl-insert-keyword " IS ") 9382 (when (vhdl-standard-p '87) 9383 (vhdl-template-field "[IN | OUT]" " " t)) 9384 (vhdl-template-field "filename-string" nil nil nil nil t) 9385 (insert ";") 9386 (vhdl-comment-insert-inline)))) 9387 9388(defun vhdl-template-for () 9389 "Insert a block or component configuration if within a configuration 9390declaration, a configuration specification if within an architecture 9391declarative part (and not within a subprogram), a for-loop if within a 9392sequential statement part (subprogram or process), and a for-generate 9393otherwise." 9394 (interactive) 9395 (vhdl-prepare-search-1 9396 (cond 9397 ((vhdl-sequential-statement-p) ; sequential statement 9398 (vhdl-template-for-loop)) 9399 ((and (save-excursion ; configuration declaration 9400 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 9401 (equal "CONFIGURATION" (upcase (match-string 1)))) 9402 (if (eq (vhdl-decision-query 9403 "for" "(b)lock or (c)omponent configuration?" t) 9404 ?c) 9405 (vhdl-template-component-conf) 9406 (vhdl-template-block-configuration))) 9407 ((and (save-excursion 9408 (re-search-backward ; architecture declarative part 9409 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) 9410 (equal "ARCHITECTURE" (upcase (match-string 1)))) 9411 (vhdl-template-configuration-spec)) 9412 (t (vhdl-template-for-generate))))) ; concurrent statement 9413 9414(defun vhdl-template-for-generate () 9415 "Insert a for-generate." 9416 (interactive) 9417 (let ((margin (current-indentation)) 9418 (start (point)) 9419 label position) 9420 (vhdl-insert-keyword ": FOR ") 9421 (setq position (point-marker)) 9422 (goto-char start) 9423 (when (setq label (vhdl-template-field "label" nil t start position)) 9424 (goto-char position) 9425 (vhdl-template-field "loop variable") 9426 (vhdl-insert-keyword " IN ") 9427 (vhdl-template-field "range") 9428 (vhdl-template-generate-body margin label)))) 9429 9430(defun vhdl-template-for-loop () 9431 "Insert a for loop." 9432 (interactive) 9433 (let ((margin (current-indentation)) 9434 (start (point)) 9435 label index) 9436 (if (not (eq vhdl-optional-labels 'all)) 9437 (vhdl-insert-keyword "FOR ") 9438 (vhdl-insert-keyword ": FOR ") 9439 (goto-char start) 9440 (setq label (vhdl-template-field "[label]" nil t)) 9441 (unless label (delete-char 2)) 9442 (forward-word-strictly 1) 9443 (forward-char 1)) 9444 (when (setq index (vhdl-template-field "loop variable" 9445 nil t start (point))) 9446 (vhdl-insert-keyword " IN ") 9447 (vhdl-template-field "range") 9448 (vhdl-insert-keyword " LOOP\n\n") 9449 (indent-to margin) 9450 (vhdl-insert-keyword "END LOOP") 9451 (if label 9452 (insert " " label ";") 9453 (insert ";") 9454 (when vhdl-self-insert-comments (insert " -- " index))) 9455 (forward-line -1) 9456 (indent-to (+ margin vhdl-basic-offset))))) 9457 9458(defun vhdl-template-function (&optional kind) 9459 "Insert a function declaration or body." 9460 (interactive) 9461 (let ((margin (current-indentation)) 9462 (start (point)) 9463 name) 9464 (vhdl-insert-keyword "FUNCTION ") 9465 (when (setq name (vhdl-template-field "name" nil t start (point))) 9466 (vhdl-template-argument-list t) 9467 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9468 (end-of-line) 9469 (insert "\n") 9470 (indent-to (+ margin vhdl-basic-offset)) 9471 (vhdl-insert-keyword "RETURN ") 9472 (vhdl-template-field "type") 9473 (if (if kind (eq kind 'body) 9474 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 9475 (progn (vhdl-insert-keyword " IS\n") 9476 (vhdl-template-begin-end 9477 (unless (vhdl-standard-p '87) "FUNCTION") name margin) 9478 (vhdl-comment-block)) 9479 (insert ";"))))) 9480 9481(defun vhdl-template-function-decl () 9482 "Insert a function declaration." 9483 (interactive) 9484 (vhdl-template-function 'decl)) 9485 9486(defun vhdl-template-function-body () 9487 "Insert a function declaration." 9488 (interactive) 9489 (vhdl-template-function 'body)) 9490 9491(defun vhdl-template-generate () 9492 "Insert a generation scheme." 9493 (interactive) 9494 (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) 9495 (vhdl-template-if-generate) 9496 (vhdl-template-for-generate))) 9497 9498(defun vhdl-template-generic () 9499 "Insert generic declaration, or generic map in instantiation statements." 9500 (interactive) 9501 (let ((start (point))) 9502 (vhdl-prepare-search-1 9503 (cond 9504 ((and (save-excursion ; entity declaration 9505 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 9506 (equal "ENTITY" (upcase (match-string 1)))) 9507 (vhdl-template-generic-list nil)) 9508 ((or (save-excursion 9509 (or (beginning-of-line) 9510 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 9511 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 9512 (vhdl-insert-keyword "GENERIC ") 9513 (vhdl-template-map start)) 9514 (t (vhdl-template-generic-list nil t)))))) 9515 9516(defun vhdl-template-group () 9517 "Insert group or group template declaration." 9518 (interactive) 9519 ;; (let ((start (point))) 9520 (if (eq (vhdl-decision-query 9521 "group" "(d)eclaration or (t)emplate declaration?" t) 9522 ?t) 9523 (vhdl-template-group-template) 9524 (vhdl-template-group-decl))) ;; ) 9525 9526(defun vhdl-template-group-decl () 9527 "Insert group declaration." 9528 (interactive) 9529 (let ((start (point))) 9530 (vhdl-insert-keyword "GROUP ") 9531 (when (vhdl-template-field "name" " : " t start (point)) 9532 (vhdl-template-field "template name" " (") 9533 (vhdl-template-field "constituent list" ");") 9534 (vhdl-comment-insert-inline)))) 9535 9536(defun vhdl-template-group-template () 9537 "Insert group template declaration." 9538 (interactive) 9539 (let ((start (point))) 9540 (vhdl-insert-keyword "GROUP ") 9541 (when (vhdl-template-field "template name" nil t start (point)) 9542 (vhdl-insert-keyword " IS (") 9543 (vhdl-template-field "entity class list" ");") 9544 (vhdl-comment-insert-inline)))) 9545 9546(defun vhdl-template-if () 9547 "Insert a sequential if statement or an if-generate statement." 9548 (interactive) 9549 (if (vhdl-sequential-statement-p) 9550 (vhdl-template-if-then) 9551 (if (and (vhdl-standard-p 'ams) 9552 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) 9553 (vhdl-template-if-use) 9554 (vhdl-template-if-generate)))) 9555 9556(defun vhdl-template-if-generate () 9557 "Insert an if-generate." 9558 (interactive) 9559 (let ((margin (current-indentation)) 9560 (start (point)) 9561 label position) 9562 (vhdl-insert-keyword ": IF ") 9563 (setq position (point-marker)) 9564 (goto-char start) 9565 (when (setq label (vhdl-template-field "label" nil t start position)) 9566 (goto-char position) 9567 (when vhdl-conditions-in-parenthesis (insert "(")) 9568 (vhdl-template-field "condition") 9569 (when vhdl-conditions-in-parenthesis (insert ")")) 9570 (vhdl-template-generate-body margin label)))) 9571 9572(defun vhdl-template-if-then-use (kind) 9573 "Insert a sequential if statement." 9574 (interactive) 9575 (let ((margin (current-indentation)) 9576 (start (point)) 9577 label) 9578 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 9579 (vhdl-insert-keyword "IF ") 9580 (vhdl-insert-keyword ": IF ") 9581 (goto-char start) 9582 (setq label (vhdl-template-field "[label]" nil t)) 9583 (unless label (delete-char 2)) 9584 (forward-word-strictly 1) 9585 (forward-char 1)) 9586 (when vhdl-conditions-in-parenthesis (insert "(")) 9587 (when (vhdl-template-field "condition" nil t start (point)) 9588 (when vhdl-conditions-in-parenthesis (insert ")")) 9589 (vhdl-insert-keyword 9590 (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) 9591 (indent-to margin) 9592 (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE"))) 9593 (when label (insert " " label)) 9594 (insert ";") 9595 (forward-line -1) 9596 (indent-to (+ margin vhdl-basic-offset))))) 9597 9598(defun vhdl-template-if-then () 9599 "Insert a sequential if statement." 9600 (interactive) 9601 (vhdl-template-if-then-use 'then)) 9602 9603(defun vhdl-template-if-use () 9604 "Insert a simultaneous if statement." 9605 (interactive) 9606 (vhdl-template-if-then-use 'use)) 9607 9608(defun vhdl-template-instance () 9609 "Insert a component instantiation statement." 9610 (interactive) 9611 (vhdl-template-component-inst)) 9612 9613(defun vhdl-template-library () 9614 "Insert a library specification." 9615 (interactive) 9616 (let ((margin (current-indentation)) 9617 (start (point)) 9618 name end-pos) 9619 (vhdl-insert-keyword "LIBRARY ") 9620 (when (setq name (vhdl-template-field "names" nil t start (point))) 9621 (insert ";") 9622 (unless (string-match "," name) 9623 (setq end-pos (point)) 9624 (insert "\n") 9625 (indent-to margin) 9626 (vhdl-insert-keyword "USE ") 9627 (insert name) 9628 (vhdl-insert-keyword "..ALL;") 9629 (backward-char 5) 9630 (if (vhdl-template-field "package name") 9631 (forward-char 5) 9632 (delete-region end-pos (+ (point) 5))))))) 9633 9634(defun vhdl-template-limit () 9635 "Insert a limit." 9636 (interactive) 9637 (let ((start (point))) 9638 (vhdl-insert-keyword "LIMIT ") 9639 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " 9640 t start (point)) 9641 (vhdl-template-field "type") 9642 (vhdl-insert-keyword " WITH ") 9643 (vhdl-template-field "real expression" ";")))) 9644 9645(defun vhdl-template-loop () 9646 "Insert a loop." 9647 (interactive) 9648 (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) 9649 (cond ((eq char ?w) 9650 (vhdl-template-while-loop)) 9651 ((eq char ?f) 9652 (vhdl-template-for-loop)) 9653 (t (vhdl-template-bare-loop))))) 9654 9655(defun vhdl-template-bare-loop () 9656 "Insert a loop." 9657 (interactive) 9658 (let ((margin (current-indentation)) 9659 (start (point)) 9660 label) 9661 (if (not (eq vhdl-optional-labels 'all)) 9662 (vhdl-insert-keyword "LOOP ") 9663 (vhdl-insert-keyword ": LOOP ") 9664 (goto-char start) 9665 (setq label (vhdl-template-field "[label]" nil t)) 9666 (unless label (delete-char 2)) 9667 (forward-word-strictly 1) 9668 (delete-char 1)) 9669 (insert "\n\n") 9670 (indent-to margin) 9671 (vhdl-insert-keyword "END LOOP") 9672 (insert (if label (concat " " label ";") ";")) 9673 (forward-line -1) 9674 (indent-to (+ margin vhdl-basic-offset)))) 9675 9676(defun vhdl-template-map (&optional start optional secondary) 9677 "Insert a map specification with association list." 9678 (interactive) 9679 (let ((start (or start (point))) 9680 margin end-pos) 9681 (vhdl-insert-keyword "MAP (") 9682 (if (not vhdl-association-list-with-formals) 9683 (if (vhdl-template-field 9684 (concat (and optional "[") "association list" (and optional "]")) 9685 ")" (or (not secondary) optional) 9686 (and (not secondary) start) (point)) 9687 t 9688 (if (and optional secondary) (delete-region start (point))) 9689 nil) 9690 (if vhdl-argument-list-indent 9691 (setq margin (current-column)) 9692 (setq margin (+ (current-indentation) vhdl-basic-offset)) 9693 (insert "\n") 9694 (indent-to margin)) 9695 (if (vhdl-template-field 9696 (concat (and optional "[") "formal" (and optional "]")) 9697 " => " (or (not secondary) optional) 9698 (and (not secondary) start) (point)) 9699 (progn 9700 (vhdl-template-field "actual" ",") 9701 (setq end-pos (point)) 9702 (insert "\n") 9703 (indent-to margin) 9704 (while (vhdl-template-field "[formal]" " => " t) 9705 (vhdl-template-field "actual" ",") 9706 (setq end-pos (point)) 9707 (insert "\n") 9708 (indent-to margin)) 9709 (delete-region end-pos (point)) 9710 (delete-char -1) 9711 (insert ")") 9712 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9713 t) 9714 (when (and optional secondary) (delete-region start (point))) 9715 nil)))) 9716 9717(defun vhdl-template-modify (&optional noerror) 9718 "Actualize modification date." 9719 (interactive) 9720 (vhdl-prepare-search-2 9721 (save-excursion 9722 (goto-char (point-min)) 9723 (if (re-search-forward vhdl-modify-date-prefix-string nil t) 9724 (progn (delete-region (point) (progn (end-of-line) (point))) 9725 (vhdl-template-insert-date)) 9726 (unless noerror 9727 (error "ERROR: Modification date prefix string \"%s\" not found" 9728 vhdl-modify-date-prefix-string)))))) 9729 9730 9731(defun vhdl-template-modify-noerror () 9732 "Call `vhdl-template-modify' with NOERROR non-nil." 9733 (vhdl-template-modify t)) 9734 9735(defun vhdl-template-nature () 9736 "Insert a nature declaration." 9737 (interactive) 9738 (let ((start (point)) 9739 name mid-pos end-pos) 9740 (vhdl-insert-keyword "NATURE ") 9741 (when (setq name (vhdl-template-field "name" nil t start (point))) 9742 (vhdl-insert-keyword " IS ") 9743 (let ((definition 9744 (upcase 9745 (or (vhdl-template-field 9746 "across type | ARRAY | RECORD") 9747 "")))) 9748 (cond ((equal definition "") 9749 (insert ";")) 9750 ((equal definition "ARRAY") 9751 (delete-region (point) (progn (forward-word-strictly -1) 9752 (point))) 9753 (vhdl-template-array 'nature t)) 9754 ((equal definition "RECORD") 9755 (setq mid-pos (point-marker)) 9756 (delete-region (point) (progn (forward-word-strictly -1) 9757 (point))) 9758 (vhdl-template-record 'nature name t)) 9759 (t 9760 (vhdl-insert-keyword " ACROSS ") 9761 (vhdl-template-field "through type") 9762 (vhdl-insert-keyword " THROUGH ") 9763 (vhdl-template-field "reference name") 9764 (vhdl-insert-keyword " REFERENCE;"))) 9765 (when mid-pos 9766 (setq end-pos (point-marker)) 9767 (goto-char mid-pos) 9768 (end-of-line)) 9769 (vhdl-comment-insert-inline) 9770 (when end-pos (goto-char end-pos)))))) 9771 9772(defun vhdl-template-next () 9773 "Insert a next statement." 9774 (interactive) 9775 (let ((start (point))) 9776 (vhdl-insert-keyword "NEXT ") 9777 (if (vhdl-template-field "[loop label]" nil t start (point)) 9778 (let ((position (point))) 9779 (vhdl-insert-keyword " WHEN ") 9780 (when vhdl-conditions-in-parenthesis (insert "(")) 9781 (if (vhdl-template-field "[condition]" nil t) 9782 (when vhdl-conditions-in-parenthesis (insert ")")) 9783 (delete-region position (point)))) 9784 (delete-char -1)) 9785 (insert ";"))) 9786 9787(defun vhdl-template-others () 9788 "Insert an others aggregate." 9789 (interactive) 9790 (let ((start (point))) 9791 (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) 9792 (progn (unless vhdl-template-invoked-by-hook (insert "(")) 9793 (vhdl-insert-keyword "OTHERS => '") 9794 (when (vhdl-template-field "value" nil t start (point)) 9795 (insert "')"))) 9796 (vhdl-insert-keyword "OTHERS ")))) 9797 9798(defun vhdl-template-package (&optional kind) 9799 "Insert a package specification or body." 9800 (interactive) 9801 (let ((margin (current-indentation)) 9802 (start (point)) 9803 name body position) 9804 (vhdl-insert-keyword "PACKAGE ") 9805 (setq body (if kind (eq kind 'body) 9806 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) 9807 (when body 9808 (vhdl-insert-keyword "BODY ") 9809 (when (save-excursion 9810 (vhdl-prepare-search-1 9811 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) 9812 (insert (setq name (match-string 1))))) 9813 (when (or name 9814 (setq name (vhdl-template-field "name" nil t start (point)))) 9815 (vhdl-insert-keyword " IS\n") 9816 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9817 (indent-to (+ margin vhdl-basic-offset)) 9818 (setq position (point)) 9819 (insert "\n") 9820 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9821 (indent-to margin) 9822 (vhdl-insert-keyword "END ") 9823 (unless (vhdl-standard-p '87) 9824 (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) 9825 (insert (or name "") ";") 9826 (goto-char position)))) 9827 9828(defun vhdl-template-package-decl () 9829 "Insert a package specification." 9830 (interactive) 9831 (vhdl-template-package 'decl)) 9832 9833(defun vhdl-template-package-body () 9834 "Insert a package body." 9835 (interactive) 9836 (vhdl-template-package 'body)) 9837 9838(defun vhdl-template-port () 9839 "Insert a port declaration, or port map in instantiation statements." 9840 (interactive) 9841 (let ((start (point))) 9842 (vhdl-prepare-search-1 9843 (cond 9844 ((and (save-excursion ; entity declaration 9845 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 9846 (equal "ENTITY" (upcase (match-string 1)))) 9847 (vhdl-template-port-list nil)) 9848 ((or (save-excursion 9849 (or (beginning-of-line) 9850 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 9851 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 9852 (vhdl-insert-keyword "PORT ") 9853 (vhdl-template-map start)) 9854 (t (vhdl-template-port-list nil)))))) 9855 9856(defun vhdl-template-procedural () 9857 "Insert a procedural." 9858 (interactive) 9859 (let ((margin (current-indentation)) 9860 (start (point)) 9861 (case-fold-search t) 9862 label) 9863 (vhdl-insert-keyword "PROCEDURAL ") 9864 (when (memq vhdl-optional-labels '(process all)) 9865 (goto-char start) 9866 (insert ": ") 9867 (goto-char start) 9868 (setq label (vhdl-template-field "[label]" nil t)) 9869 (unless label (delete-char 2)) 9870 (forward-word-strictly 1) 9871 (forward-char 1)) 9872 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) 9873 (insert "\n") 9874 (vhdl-template-begin-end "PROCEDURAL" label margin) 9875 (vhdl-comment-block))) 9876 9877(defun vhdl-template-procedure (&optional kind) 9878 "Insert a procedure declaration or body." 9879 (interactive) 9880 (let ((margin (current-indentation)) 9881 (start (point)) 9882 name) 9883 (vhdl-insert-keyword "PROCEDURE ") 9884 (when (setq name (vhdl-template-field "name" nil t start (point))) 9885 (vhdl-template-argument-list) 9886 (if (if kind (eq kind 'body) 9887 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 9888 (progn (vhdl-insert-keyword " IS") 9889 (when vhdl-auto-align 9890 (vhdl-align-region-groups start (point) 1)) 9891 (end-of-line) (insert "\n") 9892 (vhdl-template-begin-end 9893 (unless (vhdl-standard-p '87) "PROCEDURE") 9894 name margin) 9895 (vhdl-comment-block)) 9896 (insert ";") 9897 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9898 (end-of-line))))) 9899 9900(defun vhdl-template-procedure-decl () 9901 "Insert a procedure declaration." 9902 (interactive) 9903 (vhdl-template-procedure 'decl)) 9904 9905(defun vhdl-template-procedure-body () 9906 "Insert a procedure body." 9907 (interactive) 9908 (vhdl-template-procedure 'body)) 9909 9910(defun vhdl-template-process (&optional kind) 9911 "Insert a process." 9912 (interactive) 9913 (let ((margin (current-indentation)) 9914 (start (point)) 9915 (reset-kind vhdl-reset-kind) 9916 label seq input-signals clock reset final-pos) 9917 (setq seq (if kind (eq kind 'seq) 9918 (eq (vhdl-decision-query 9919 "process" "(c)ombinational or (s)equential?" t) ?s))) 9920 (vhdl-insert-keyword "PROCESS ") 9921 (when (memq vhdl-optional-labels '(process all)) 9922 (goto-char start) 9923 (insert ": ") 9924 (goto-char start) 9925 (setq label (vhdl-template-field "[label]" nil t)) 9926 (unless label (delete-char 2)) 9927 (forward-word-strictly 1) 9928 (forward-char 1)) 9929 (insert "(") 9930 (if (not seq) 9931 (unless (or (and (vhdl-standard-p '08) vhdl-sensitivity-list-all 9932 (progn (insert "all)") (setq input-signals "all"))) 9933 (setq input-signals 9934 (vhdl-template-field "[sensitivity list]" ")" t))) 9935 (setq input-signals "") 9936 (delete-char -2)) 9937 (setq clock (or (and (not (equal "" vhdl-clock-name)) 9938 (progn (insert vhdl-clock-name) vhdl-clock-name)) 9939 (vhdl-template-field "clock name") "<clock>")) 9940 (when (eq reset-kind 'query) 9941 (setq reset-kind 9942 (if (eq (vhdl-decision-query 9943 "" "(a)synchronous or (s)ynchronous reset?" t) ?a) 9944 'async 9945 'sync))) 9946 (when (eq reset-kind 'async) 9947 (insert ", ") 9948 (setq reset (or (and (not (equal "" vhdl-reset-name)) 9949 (progn (insert vhdl-reset-name) vhdl-reset-name)) 9950 (vhdl-template-field "reset name") "<reset>"))) 9951 (insert ")")) 9952 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 9953 (insert "\n") 9954 (vhdl-template-begin-end "PROCESS" label margin) 9955 (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind))) 9956 (when vhdl-prompt-for-comments 9957 (setq final-pos (point-marker)) 9958 (vhdl-prepare-search-2 9959 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) 9960 (vhdl-re-search-backward "\\<process\\>" nil t)) 9961 (end-of-line -0) 9962 (if (bobp) 9963 (progn (insert "\n") (forward-line -1)) 9964 (insert "\n")) 9965 (indent-to margin) 9966 (insert "-- purpose: ") 9967 (if (not (vhdl-template-field "[description]" nil t)) 9968 (vhdl-line-kill-entire) 9969 (insert "\n") 9970 (indent-to margin) 9971 (insert "-- type : ") 9972 (insert (if seq "sequential" "combinational") "\n") 9973 (indent-to margin) 9974 (insert "-- inputs : ") 9975 (if (not seq) 9976 (insert input-signals) 9977 (insert clock ", ") 9978 (when reset (insert reset ", ")) 9979 (unless (vhdl-template-field "[signal names]" nil t) 9980 (delete-char -2))) 9981 (insert "\n") 9982 (indent-to margin) 9983 (insert "-- outputs: ") 9984 (vhdl-template-field "[signal names]" nil t)))) 9985 (goto-char final-pos)))) 9986 9987(defun vhdl-template-process-comb () 9988 "Insert a combinational process." 9989 (interactive) 9990 (vhdl-template-process 'comb)) 9991 9992(defun vhdl-template-process-seq () 9993 "Insert a sequential process." 9994 (interactive) 9995 (vhdl-template-process 'seq)) 9996 9997(defun vhdl-template-quantity () 9998 "Insert a quantity declaration." 9999 (interactive) 10000 (if (vhdl-in-argument-list-p) 10001 (let ((start (point))) 10002 (vhdl-insert-keyword "QUANTITY ") 10003 (when (vhdl-template-field "names" nil t start (point)) 10004 (insert " : ") 10005 (vhdl-template-field "[IN | OUT]" " " t) 10006 (vhdl-template-field "type") 10007 (insert ";") 10008 (vhdl-comment-insert-inline))) 10009 (let ((char (vhdl-decision-query 10010 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) 10011 (cond ((eq char ?f) (vhdl-template-quantity-free)) 10012 ((eq char ?b) (vhdl-template-quantity-branch)) 10013 ((eq char ?s) (vhdl-template-quantity-source)) 10014 (t (vhdl-template-undo (point) (point))))))) 10015 10016(defun vhdl-template-quantity-free () 10017 "Insert a free quantity declaration." 10018 (interactive) 10019 (vhdl-insert-keyword "QUANTITY ") 10020 (vhdl-template-field "names") 10021 (insert " : ") 10022 (vhdl-template-field "type") 10023 (let ((position (point))) 10024 (insert " := ") 10025 (unless (vhdl-template-field "[initialization]" nil t) 10026 (delete-region position (point))) 10027 (insert ";") 10028 (vhdl-comment-insert-inline))) 10029 10030(defun vhdl-template-quantity-branch () 10031 "Insert a branch quantity declaration." 10032 (interactive) 10033 (let (position) 10034 (vhdl-insert-keyword "QUANTITY ") 10035 (when (vhdl-template-field "[across names]" " " t) 10036 (vhdl-insert-keyword "ACROSS ")) 10037 (when (vhdl-template-field "[through names]" " " t) 10038 (vhdl-insert-keyword "THROUGH ")) 10039 (vhdl-template-field "plus terminal name") 10040 (setq position (point)) 10041 (vhdl-insert-keyword " TO ") 10042 (unless (vhdl-template-field "[minus terminal name]" nil t) 10043 (delete-region position (point))) 10044 (insert ";") 10045 (vhdl-comment-insert-inline))) 10046 10047(defun vhdl-template-quantity-source () 10048 "Insert a source quantity declaration." 10049 (interactive) 10050 (vhdl-insert-keyword "QUANTITY ") 10051 (vhdl-template-field "names") 10052 (insert " : ") 10053 (vhdl-template-field "type" " ") 10054 (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) 10055 (progn (vhdl-insert-keyword "NOISE ") 10056 (vhdl-template-field "power expression")) 10057 (vhdl-insert-keyword "SPECTRUM ") 10058 (vhdl-template-field "magnitude expression" ", ") 10059 (vhdl-template-field "phase expression")) 10060 (insert ";") 10061 (vhdl-comment-insert-inline)) 10062 10063(defun vhdl-template-record (kind &optional name secondary) 10064 "Insert a record type declaration." 10065 (interactive) 10066 (let ((margin (current-indentation)) 10067 (start (point)) 10068 (first t)) 10069 (vhdl-insert-keyword "RECORD\n") 10070 (indent-to (+ margin vhdl-basic-offset)) 10071 (when (or (vhdl-template-field "element names" 10072 nil (not secondary) start (point)) 10073 secondary) 10074 (while (or first (vhdl-template-field "[element names]" nil t)) 10075 (insert " : ") 10076 (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") 10077 (vhdl-comment-insert-inline) 10078 (insert "\n") 10079 (indent-to (+ margin vhdl-basic-offset)) 10080 (setq first nil)) 10081 (delete-region (line-beginning-position) (point)) 10082 (indent-to margin) 10083 (vhdl-insert-keyword "END RECORD") 10084 (unless (vhdl-standard-p '87) (and name (insert " " name))) 10085 (insert ";") 10086 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 10087 10088(defun vhdl-template-report () 10089 "Insert a report statement." 10090 (interactive) 10091 (let ((start (point))) 10092 (vhdl-insert-keyword "REPORT ") 10093 (if (equal "\"\"" (vhdl-template-field 10094 "string expression" nil t start (point) t)) 10095 (delete-char -2) 10096 (setq start (point)) 10097 (vhdl-insert-keyword " SEVERITY ") 10098 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 10099 (delete-region start (point))) 10100 (insert ";")))) 10101 10102(defun vhdl-template-return () 10103 "Insert a return statement." 10104 (interactive) 10105 (let ((start (point))) 10106 (vhdl-insert-keyword "RETURN ") 10107 (unless (vhdl-template-field "[expression]" nil t start (point)) 10108 (delete-char -1)) 10109 (insert ";"))) 10110 10111(defun vhdl-template-selected-signal-asst () 10112 "Insert a selected signal assignment." 10113 (interactive) 10114 (let ((margin (current-indentation)) 10115 (start (point)) 10116 (choices t)) 10117 (let ((position (point))) 10118 (vhdl-insert-keyword " SELECT ") 10119 (goto-char position)) 10120 (vhdl-insert-keyword "WITH ") 10121 (when (vhdl-template-field "selector expression" 10122 nil t start (+ (point) 7)) 10123 (forward-word-strictly 1) 10124 (delete-char 1) 10125 (insert "\n") 10126 (indent-to (+ margin vhdl-basic-offset)) 10127 (vhdl-template-field "target signal" " <= ") 10128 (insert "\n") 10129 (indent-to (+ margin vhdl-basic-offset)) 10130 (vhdl-template-field "waveform") 10131 (vhdl-insert-keyword " WHEN ") 10132 (vhdl-template-field "choices" ",") 10133 (insert "\n") 10134 (indent-to (+ margin vhdl-basic-offset)) 10135 (while (and choices (vhdl-template-field "[waveform]" nil t)) 10136 (vhdl-insert-keyword " WHEN ") 10137 (if (setq choices (vhdl-template-field "[choices]" "," t)) 10138 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 10139 (vhdl-insert-keyword "OTHERS"))) 10140 (when choices 10141 (fixup-whitespace) 10142 (delete-char -2)) 10143 (insert ";") 10144 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 10145 10146(defun vhdl-template-signal () 10147 "Insert a signal declaration." 10148 (interactive) 10149 (let ((start (point)) 10150 (in-arglist (vhdl-in-argument-list-p))) 10151 (vhdl-insert-keyword "SIGNAL ") 10152 (when (vhdl-template-field "names" nil t start (point)) 10153 (insert " : ") 10154 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 10155 (vhdl-template-field "type") 10156 (if in-arglist 10157 (progn (insert ";") 10158 (vhdl-comment-insert-inline)) 10159 (let ((position (point))) 10160 (insert " := ") 10161 (unless (vhdl-template-field "[initialization]" nil t) 10162 (delete-region position (point))) 10163 (insert ";") 10164 (vhdl-comment-insert-inline)))))) 10165 10166(defun vhdl-template-subnature () 10167 "Insert a subnature declaration." 10168 (interactive) 10169 (let ((start (point)) 10170 position) 10171 (vhdl-insert-keyword "SUBNATURE ") 10172 (when (vhdl-template-field "name" nil t start (point)) 10173 (vhdl-insert-keyword " IS ") 10174 (vhdl-template-field "nature" " (") 10175 (if (vhdl-template-field "[index range]" nil t) 10176 (insert ")") 10177 (delete-char -2)) 10178 (setq position (point)) 10179 (vhdl-insert-keyword " TOLERANCE ") 10180 (if (equal "\"\"" (vhdl-template-field "[string expression]" 10181 nil t nil nil t)) 10182 (delete-region position (point)) 10183 (vhdl-insert-keyword " ACROSS ") 10184 (vhdl-template-field "string expression" nil nil nil nil t) 10185 (vhdl-insert-keyword " THROUGH")) 10186 (insert ";") 10187 (vhdl-comment-insert-inline)))) 10188 10189(defun vhdl-template-subprogram-body () 10190 "Insert a subprogram body." 10191 (interactive) 10192 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 10193 (vhdl-template-function-body) 10194 (vhdl-template-procedure-body))) 10195 10196(defun vhdl-template-subprogram-decl () 10197 "Insert a subprogram declaration." 10198 (interactive) 10199 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 10200 (vhdl-template-function-decl) 10201 (vhdl-template-procedure-decl))) 10202 10203(defun vhdl-template-subtype () 10204 "Insert a subtype declaration." 10205 (interactive) 10206 (let ((start (point))) 10207 (vhdl-insert-keyword "SUBTYPE ") 10208 (when (vhdl-template-field "name" nil t start (point)) 10209 (vhdl-insert-keyword " IS ") 10210 (vhdl-template-field "type" " ") 10211 (unless 10212 (vhdl-template-field "[RANGE value range | ( index range )]" nil t) 10213 (delete-char -1)) 10214 (insert ";") 10215 (vhdl-comment-insert-inline)))) 10216 10217(defun vhdl-template-terminal () 10218 "Insert a terminal declaration." 10219 (interactive) 10220 (let ((start (point))) 10221 (vhdl-insert-keyword "TERMINAL ") 10222 (when (vhdl-template-field "names" nil t start (point)) 10223 (insert " : ") 10224 (vhdl-template-field "nature") 10225 (insert ";") 10226 (vhdl-comment-insert-inline)))) 10227 10228(defun vhdl-template-type () 10229 "Insert a type declaration." 10230 (interactive) 10231 (let ((start (point)) 10232 name mid-pos end-pos) 10233 (vhdl-insert-keyword "TYPE ") 10234 (when (setq name (vhdl-template-field "name" nil t start (point))) 10235 (vhdl-insert-keyword " IS ") 10236 (let ((definition 10237 (upcase 10238 (or (vhdl-template-field 10239 "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) 10240 "")))) 10241 (cond ((equal definition "") 10242 (delete-char -4) 10243 (insert ";")) 10244 ((equal definition "ARRAY") 10245 (delete-region (point) (progn (forward-word-strictly -1) 10246 (point))) 10247 (vhdl-template-array 'type t)) 10248 ((equal definition "RECORD") 10249 (setq mid-pos (point-marker)) 10250 (delete-region (point) (progn (forward-word-strictly -1) 10251 (point))) 10252 (vhdl-template-record 'type name t)) 10253 ((equal definition "ACCESS") 10254 (insert " ") 10255 (vhdl-template-field "type" ";")) 10256 ((equal definition "FILE") 10257 (vhdl-insert-keyword " OF ") 10258 (vhdl-template-field "type" ";")) 10259 ((equal definition "ENUM") 10260 (kill-word -1) 10261 (insert "(") 10262 (setq end-pos (point-marker)) 10263 (insert ");")) 10264 (t (insert ";"))) 10265 (when mid-pos 10266 (setq end-pos (point-marker)) 10267 (goto-char mid-pos) 10268 (end-of-line)) 10269 (vhdl-comment-insert-inline) 10270 (when end-pos (goto-char end-pos)))))) 10271 10272(defun vhdl-template-use () 10273 "Insert a use clause." 10274 (interactive) 10275 (let ((start (point))) 10276 (vhdl-prepare-search-1 10277 (vhdl-insert-keyword "USE ") 10278 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) 10279 (vhdl-insert-keyword "..ALL;") 10280 (backward-char 6) 10281 (when (vhdl-template-field "library name" nil t start (+ (point) 6)) 10282 (forward-char 1) 10283 (vhdl-template-field "package name") 10284 (forward-char 5)))))) 10285 10286(defun vhdl-template-variable () 10287 "Insert a variable declaration." 10288 (interactive) 10289 (let ((start (point)) 10290 (in-arglist (vhdl-in-argument-list-p))) 10291 (vhdl-prepare-search-2 10292 (if (or (save-excursion 10293 (progn (vhdl-beginning-of-block) 10294 (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>"))) 10295 (save-excursion (backward-word-strictly 1) 10296 (looking-at "\\<shared\\>"))) 10297 (vhdl-insert-keyword "VARIABLE ") 10298 (if (vhdl-standard-p '87) 10299 (error "ERROR: Not within sequential block") 10300 (vhdl-insert-keyword "SHARED VARIABLE ")))) 10301 (when (vhdl-template-field "names" nil t start (point)) 10302 (insert " : ") 10303 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 10304 (vhdl-template-field "type") 10305 (if in-arglist 10306 (progn (insert ";") 10307 (vhdl-comment-insert-inline)) 10308 (let ((position (point))) 10309 (insert " := ") 10310 (unless (vhdl-template-field "[initialization]" nil t) 10311 (delete-region position (point))) 10312 (insert ";") 10313 (vhdl-comment-insert-inline)))))) 10314 10315(defun vhdl-template-wait () 10316 "Insert a wait statement." 10317 (interactive) 10318 (vhdl-insert-keyword "WAIT ") 10319 (unless (vhdl-template-field 10320 "[ON sensitivity list] [UNTIL condition] [FOR time expression]" 10321 nil t) 10322 (delete-char -1)) 10323 (insert ";")) 10324 10325(defun vhdl-template-when () 10326 "Indent correctly if within a case statement." 10327 (interactive) 10328 (let ((position (point)) 10329 margin) 10330 (vhdl-prepare-search-2 10331 (if (and (= (current-column) (current-indentation)) 10332 (vhdl-re-search-forward "\\<end\\>" nil t) 10333 (looking-at "\\s-*\\<case\\>")) 10334 (progn 10335 (setq margin (current-indentation)) 10336 (goto-char position) 10337 (delete-horizontal-space) 10338 (indent-to (+ margin vhdl-basic-offset))) 10339 (goto-char position))) 10340 (vhdl-insert-keyword "WHEN "))) 10341 10342(defun vhdl-template-while-loop () 10343 "Insert a while loop." 10344 (interactive) 10345 (let* ((margin (current-indentation)) 10346 (start (point)) 10347 label) 10348 (if (not (eq vhdl-optional-labels 'all)) 10349 (vhdl-insert-keyword "WHILE ") 10350 (vhdl-insert-keyword ": WHILE ") 10351 (goto-char start) 10352 (setq label (vhdl-template-field "[label]" nil t)) 10353 (unless label (delete-char 2)) 10354 (forward-word-strictly 1) 10355 (forward-char 1)) 10356 (when vhdl-conditions-in-parenthesis (insert "(")) 10357 (when (vhdl-template-field "condition" nil t start (point)) 10358 (when vhdl-conditions-in-parenthesis (insert ")")) 10359 (vhdl-insert-keyword " LOOP\n\n") 10360 (indent-to margin) 10361 (vhdl-insert-keyword "END LOOP") 10362 (insert (if label (concat " " label ";") ";")) 10363 (forward-line -1) 10364 (indent-to (+ margin vhdl-basic-offset))))) 10365 10366(defun vhdl-template-with () 10367 "Insert a with statement (i.e. selected signal assignment)." 10368 (interactive) 10369 (vhdl-prepare-search-1 10370 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) 10371 (equal ";" (match-string 1))) 10372 (vhdl-template-selected-signal-asst) 10373 (vhdl-insert-keyword "WITH ")))) 10374 10375;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10376;; Special templates 10377 10378(defun vhdl-template-clocked-wait () 10379 "Insert a wait statement for rising/falling clock edge." 10380 (interactive) 10381 (let ((start (point)) 10382 clock) 10383 (vhdl-insert-keyword "WAIT UNTIL ") 10384 (when (setq clock 10385 (or (and (not (equal "" vhdl-clock-name)) 10386 (progn (insert vhdl-clock-name) vhdl-clock-name)) 10387 (vhdl-template-field "clock name" nil t start (point)))) 10388 (insert "'event") 10389 (vhdl-insert-keyword " AND ") 10390 (insert clock) 10391 (insert 10392 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") 10393 (vhdl-comment-insert-inline 10394 (concat (if vhdl-clock-rising-edge "rising" "falling") 10395 " clock edge"))))) 10396 10397(defun vhdl-template-seq-process (clock reset reset-kind) 10398 "Insert a template for the body of a sequential process." 10399 (let ((margin (current-indentation)) 10400 position) 10401 (vhdl-insert-keyword "IF ") 10402 (when vhdl-conditions-in-parenthesis (insert "(")) 10403 (when (eq reset-kind 'async) 10404 (insert reset " = " 10405 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 10406 (when vhdl-conditions-in-parenthesis (insert ")")) 10407 (vhdl-insert-keyword " THEN") 10408 (vhdl-comment-insert-inline 10409 (concat "asynchronous reset (active " 10410 (if vhdl-reset-active-high "high" "low") ")")) 10411 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10412 (setq position (point)) 10413 (insert "\n") (indent-to margin) 10414 (vhdl-insert-keyword "ELSIF ") 10415 (when vhdl-conditions-in-parenthesis (insert "("))) 10416 (if (eq vhdl-clock-edge-condition 'function) 10417 (insert (if vhdl-clock-rising-edge "rising" "falling") 10418 "_edge(" clock ")") 10419 (insert clock "'event") 10420 (vhdl-insert-keyword " AND ") 10421 (insert clock " = " 10422 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) 10423 (when vhdl-conditions-in-parenthesis (insert ")")) 10424 (vhdl-insert-keyword " THEN") 10425 (vhdl-comment-insert-inline 10426 (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) 10427 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10428 (when (eq reset-kind 'sync) 10429 (vhdl-insert-keyword "IF ") 10430 (when vhdl-conditions-in-parenthesis (insert "(")) 10431 (setq reset (or (and (not (equal "" vhdl-reset-name)) 10432 (progn (insert vhdl-reset-name) vhdl-reset-name)) 10433 (vhdl-template-field "reset name") "<reset>")) 10434 (insert " = " 10435 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 10436 (when vhdl-conditions-in-parenthesis (insert ")")) 10437 (vhdl-insert-keyword " THEN") 10438 (vhdl-comment-insert-inline 10439 (concat "synchronous reset (active " 10440 (if vhdl-reset-active-high "high" "low") ")")) 10441 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 10442 (setq position (point)) 10443 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10444 (vhdl-insert-keyword "ELSE") 10445 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 10446 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 10447 (vhdl-insert-keyword "END IF;")) 10448 (when (eq reset-kind 'none) 10449 (setq position (point))) 10450 (insert "\n") (indent-to margin) 10451 (vhdl-insert-keyword "END IF;") 10452 (goto-char position) 10453 reset)) 10454 10455(defun vhdl-template-standard-package (library package) 10456 "Insert specification of a standard package. 10457Include a library specification, if not already there." 10458 (let ((margin (current-indentation))) 10459 (unless (equal library "std") 10460 (unless (or (save-excursion 10461 (vhdl-prepare-search-1 10462 (and (not (bobp)) 10463 (re-search-backward 10464 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" 10465 library "\\|end\\)\\>") 10466 nil t) 10467 (match-string 2)))) 10468 (equal (downcase library) "work")) 10469 (vhdl-insert-keyword "LIBRARY ") 10470 (insert library ";") 10471 (when package 10472 (insert "\n") 10473 (indent-to margin)))) 10474 (when package 10475 (vhdl-insert-keyword "USE ") 10476 (insert library "." package) 10477 (vhdl-insert-keyword ".ALL;")))) 10478 10479(defun vhdl-template-package-numeric-bit () 10480 "Insert specification of `numeric_bit' package." 10481 (interactive) 10482 (vhdl-template-standard-package "ieee" "numeric_bit")) 10483 10484(defun vhdl-template-package-numeric-std () 10485 "Insert specification of `numeric_std' package." 10486 (interactive) 10487 (vhdl-template-standard-package "ieee" "numeric_std")) 10488 10489(defun vhdl-template-package-std-logic-1164 () 10490 "Insert specification of `std_logic_1164' package." 10491 (interactive) 10492 (vhdl-template-standard-package "ieee" "std_logic_1164")) 10493 10494(defun vhdl-template-package-std-logic-arith () 10495 "Insert specification of `std_logic_arith' package." 10496 (interactive) 10497 (vhdl-template-standard-package "ieee" "std_logic_arith")) 10498 10499(defun vhdl-template-package-std-logic-misc () 10500 "Insert specification of `std_logic_misc' package." 10501 (interactive) 10502 (vhdl-template-standard-package "ieee" "std_logic_misc")) 10503 10504(defun vhdl-template-package-std-logic-signed () 10505 "Insert specification of `std_logic_signed' package." 10506 (interactive) 10507 (vhdl-template-standard-package "ieee" "std_logic_signed")) 10508 10509(defun vhdl-template-package-std-logic-textio () 10510 "Insert specification of `std_logic_textio' package." 10511 (interactive) 10512 (vhdl-template-standard-package "ieee" "std_logic_textio")) 10513 10514(defun vhdl-template-package-std-logic-unsigned () 10515 "Insert specification of `std_logic_unsigned' package." 10516 (interactive) 10517 (vhdl-template-standard-package "ieee" "std_logic_unsigned")) 10518 10519(defun vhdl-template-package-textio () 10520 "Insert specification of `textio' package." 10521 (interactive) 10522 (vhdl-template-standard-package "std" "textio")) 10523 10524(defun vhdl-template-package-fundamental-constants () 10525 "Insert specification of `fundamental_constants' package." 10526 (interactive) 10527 (vhdl-template-standard-package "ieee" "fundamental_constants")) 10528 10529(defun vhdl-template-package-material-constants () 10530 "Insert specification of `material_constants' package." 10531 (interactive) 10532 (vhdl-template-standard-package "ieee" "material_constants")) 10533 10534(defun vhdl-template-package-energy-systems () 10535 "Insert specification of `energy_systems' package." 10536 (interactive) 10537 (vhdl-template-standard-package "ieee" "energy_systems")) 10538 10539(defun vhdl-template-package-electrical-systems () 10540 "Insert specification of `electrical_systems' package." 10541 (interactive) 10542 (vhdl-template-standard-package "ieee" "electrical_systems")) 10543 10544(defun vhdl-template-package-mechanical-systems () 10545 "Insert specification of `mechanical_systems' package." 10546 (interactive) 10547 (vhdl-template-standard-package "ieee" "mechanical_systems")) 10548 10549(defun vhdl-template-package-radiant-systems () 10550 "Insert specification of `radiant_systems' package." 10551 (interactive) 10552 (vhdl-template-standard-package "ieee" "radiant_systems")) 10553 10554(defun vhdl-template-package-thermal-systems () 10555 "Insert specification of `thermal_systems' package." 10556 (interactive) 10557 (vhdl-template-standard-package "ieee" "thermal_systems")) 10558 10559(defun vhdl-template-package-fluidic-systems () 10560 "Insert specification of `fluidic_systems' package." 10561 (interactive) 10562 (vhdl-template-standard-package "ieee" "fluidic_systems")) 10563 10564(defun vhdl-template-package-math-complex () 10565 "Insert specification of `math_complex' package." 10566 (interactive) 10567 (vhdl-template-standard-package "ieee" "math_complex")) 10568 10569(defun vhdl-template-package-math-real () 10570 "Insert specification of `math_real' package." 10571 (interactive) 10572 (vhdl-template-standard-package "ieee" "math_real")) 10573 10574(defun vhdl-template-directive (directive) 10575 "Insert directive." 10576 (unless (= (current-indentation) (current-column)) 10577 (delete-horizontal-space) 10578 (insert " ")) 10579 (insert "-- pragma " directive)) 10580 10581(defun vhdl-template-directive-translate-on () 10582 "Insert directive `translate_on'." 10583 (interactive) 10584 (vhdl-template-directive "translate_on")) 10585 10586(defun vhdl-template-directive-translate-off () 10587 "Insert directive `translate_off'." 10588 (interactive) 10589 (vhdl-template-directive "translate_off")) 10590 10591(defun vhdl-template-directive-synthesis-on () 10592 "Insert directive `synthesis_on'." 10593 (interactive) 10594 (vhdl-template-directive "synthesis_on")) 10595 10596(defun vhdl-template-directive-synthesis-off () 10597 "Insert directive `synthesis_off'." 10598 (interactive) 10599 (vhdl-template-directive "synthesis_off")) 10600 10601;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10602;; Header and footer templates 10603 10604(defun vhdl-template-header (&optional file-title) 10605 "Insert a VHDL file header." 10606 (interactive) 10607 (unless (equal vhdl-file-header "") 10608 (let (pos) 10609 (save-excursion 10610 (goto-char (point-min)) 10611 (vhdl-insert-string-or-file vhdl-file-header) 10612 (setq pos (point-marker))) 10613 (vhdl-template-replace-header-keywords 10614 (point-min-marker) pos file-title)))) 10615 10616(defun vhdl-template-footer () 10617 "Insert a VHDL file footer." 10618 (interactive) 10619 (unless (equal vhdl-file-footer "") 10620 (let (pos) 10621 (save-excursion 10622 (goto-char (point-max)) 10623 (setq pos (point-marker)) 10624 (vhdl-insert-string-or-file vhdl-file-footer) 10625 (unless (= (preceding-char) ?\n) 10626 (insert "\n"))) 10627 (vhdl-template-replace-header-keywords pos (point-max-marker))))) 10628 10629(defun vhdl-template-replace-header-keywords (beg end &optional file-title 10630 is-model) 10631 "Replace keywords in header and footer." 10632 (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project)) 10633 "")) 10634 (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project)) 10635 "")) 10636 pos) 10637 (vhdl-prepare-search-2 10638 (save-excursion 10639 (goto-char beg) 10640 (while (search-forward "<projectdesc>" end t) 10641 (replace-match project-desc t t)) 10642 (goto-char beg) 10643 (while (search-forward "<filename>" end t) 10644 (replace-match (buffer-name) t t)) 10645 (goto-char beg) 10646 (while (search-forward "<copyright>" end t) 10647 (replace-match vhdl-copyright-string t t)) 10648 (goto-char beg) 10649 (while (search-forward "<author>" end t) 10650 (replace-match "" t t) 10651 (insert (user-full-name)) 10652 (when user-mail-address (insert " <" user-mail-address ">"))) 10653 (goto-char beg) 10654 (while (search-forward "<authorfull>" end t) 10655 (replace-match (user-full-name) t t)) 10656 (goto-char beg) 10657 (while (search-forward "<login>" end t) 10658 (replace-match (user-login-name) t t)) 10659 (goto-char beg) 10660 (while (search-forward "<project>" end t) 10661 (replace-match project-title t t)) 10662 (goto-char beg) 10663 (while (search-forward "<company>" end t) 10664 (replace-match vhdl-company-name t t)) 10665 (goto-char beg) 10666 (while (search-forward "<platform>" end t) 10667 (replace-match vhdl-platform-spec t t)) 10668 (goto-char beg) 10669 (while (search-forward "<standard>" end t) 10670 (replace-match 10671 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") 10672 ((vhdl-standard-p '93) "'93/02") 10673 ((vhdl-standard-p '08) "'08")) 10674 (when (vhdl-standard-p 'ams) ", VHDL-AMS") 10675 (when (vhdl-standard-p 'math) ", Math Packages")) t t)) 10676 (goto-char beg) 10677 ;; Replace <RCS> with $, so that RCS for the source is 10678 ;; not over-enthusiastic with replacements 10679 (while (search-forward "<RCS>" end t) 10680 (replace-match "$" nil t)) 10681 (goto-char beg) 10682 (while (search-forward "<date>" end t) 10683 (replace-match "" t t) 10684 (vhdl-template-insert-date)) 10685 (goto-char beg) 10686 (let ((year (format-time-string "%Y"))) 10687 (while (search-forward "<year>" end t) 10688 (replace-match year t t))) 10689 (goto-char beg) 10690 (when file-title 10691 (while (search-forward "<title string>" end t) 10692 (replace-match file-title t t)) 10693 (goto-char beg)) 10694 (let (string) 10695 (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) 10696 (save-match-data 10697 (setq string (read-string (concat (match-string 1) ": ")))) 10698 (replace-match string t t))) 10699 (goto-char beg) 10700 (when (and (not is-model) (search-forward "<cursor>" end t)) 10701 (replace-match "" t t) 10702 (setq pos (point)))) 10703 (when pos (goto-char pos)) 10704 (unless is-model 10705 (when (or (not project-title) (equal project-title "")) 10706 (message "You can specify a project title in user option `vhdl-project-alist'")) 10707 (when (or (not project-desc) (equal project-desc "")) 10708 (message "You can specify a project description in user option `vhdl-project-alist'")) 10709 (when (equal vhdl-platform-spec "") 10710 (message "You can specify a platform in user option `vhdl-platform-spec'")) 10711 (when (equal vhdl-company-name "") 10712 (message "You can specify a company name in user option `vhdl-company-name'")))))) 10713 10714;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10715;; Comment templates and functions 10716 10717(defun vhdl-comment-indent () 10718 "Indent comments." 10719 (let* ((position (point)) 10720 (col 10721 (progn 10722 (forward-line -1) 10723 (if (re-search-forward "--" position t) 10724 (- (current-column) 2) ; existing comment at bol stays there 10725 (goto-char position) 10726 (skip-chars-backward " \t") 10727 (max comment-column ; else indent to comment column 10728 (1+ (current-column))))))) ; except leave at least one space 10729 (goto-char position) 10730 col)) 10731 10732(defun vhdl-comment-insert () 10733 "Start a comment at the end of the line. 10734If on line with code, indent at least `comment-column'. 10735If starting after end-comment-column, start a new line." 10736 (interactive) 10737 (when (> (current-column) end-comment-column) (newline-and-indent)) 10738 (if (or (looking-at "\\s-*$") ; end of line 10739 (and (not unread-command-events) ; called with key binding or menu 10740 (not (end-of-line)))) 10741 (let (margin) 10742 (while (= (preceding-char) ?-) (delete-char -1)) 10743 (setq margin (current-column)) 10744 (delete-horizontal-space) 10745 (if (bolp) 10746 (progn (indent-to margin) (insert "--")) 10747 (insert " ") 10748 (indent-to comment-column) 10749 (insert "--")) 10750 (if (not unread-command-events) (insert " "))) 10751 ;; else code following current point implies commenting out code 10752 (let (next-input code) 10753 (while (= (preceding-char) ?-) (delete-char -2)) 10754 (while (= (setq next-input (read-char)) 13) ; CR 10755 (insert "--") ; or have a space after it? 10756 (forward-char -2) 10757 (forward-line 1) 10758 (message "Enter CR if commenting out a line of code.") 10759 (setq code t)) 10760 (unless code 10761 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? 10762 (push (vhdl-character-to-event next-input) ; pushback the char 10763 unread-command-events)))) 10764 10765(defun vhdl-comment-display (&optional line-exists) 10766 "Add 2 comment lines at the current indent, making a display comment." 10767 (interactive) 10768 (let ((margin (current-indentation))) 10769 (unless line-exists (vhdl-comment-display-line)) 10770 (insert "\n") (indent-to margin) 10771 (insert "\n") (indent-to margin) 10772 (vhdl-comment-display-line) 10773 (end-of-line -0) 10774 (insert "-- "))) 10775 10776(defun vhdl-comment-display-line () 10777 "Displays one line of dashes." 10778 (interactive) 10779 (while (= (preceding-char) ?-) (delete-char -2)) 10780 (insert "--") 10781 (let* ((col (current-column)) 10782 (len (- end-comment-column col))) 10783 (insert-char vhdl-comment-display-line-char len))) 10784 10785(defun vhdl-comment-append-inline () 10786 "Append empty inline comment to current line." 10787 (interactive) 10788 (end-of-line) 10789 (delete-horizontal-space) 10790 (insert " ") 10791 (indent-to comment-column) 10792 (insert "-- ")) 10793 10794(defun vhdl-comment-insert-inline (&optional string always-insert) 10795 "Insert inline comment." 10796 (when (or (and string (or vhdl-self-insert-comments always-insert)) 10797 (and (not string) vhdl-prompt-for-comments)) 10798 (let ((position (point))) 10799 (insert " ") 10800 (indent-to comment-column) 10801 (insert "-- ") 10802 (if (not (or (and string (progn (insert string) t)) 10803 (vhdl-template-field "[comment]" nil t))) 10804 (delete-region position (point)) 10805 (while (= (preceding-char) ?\ ) (delete-char -1)))))) 10806 10807(defun vhdl-comment-block () 10808 "Insert comment for code block." 10809 (when vhdl-prompt-for-comments 10810 (let ((final-pos (point-marker))) 10811 (vhdl-prepare-search-2 10812 (when (and (re-search-backward "^\\s-*begin\\>" nil t) 10813 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) 10814 (let (margin) 10815 (back-to-indentation) 10816 (setq margin (current-column)) 10817 (end-of-line -0) 10818 (if (bobp) 10819 (progn (insert "\n") (forward-line -1)) 10820 (insert "\n")) 10821 (indent-to margin) 10822 (insert "-- purpose: ") 10823 (unless (vhdl-template-field "[description]" nil t) 10824 (vhdl-line-kill-entire))))) 10825 (goto-char final-pos)))) 10826 10827(defun vhdl-comment-uncomment-region (beg end &optional _arg) 10828 "Comment out region if not commented out, uncomment otherwise." 10829 (interactive "r") 10830 (save-excursion 10831 (goto-char (1- end)) 10832 (end-of-line) 10833 (setq end (point-marker)) 10834 (goto-char beg) 10835 (beginning-of-line) 10836 (setq beg (point)) 10837 (if (looking-at (concat "\\s-*" comment-start)) 10838 (comment-region beg end '(4)) 10839 (comment-region beg end)))) 10840 10841(defun vhdl-comment-uncomment-line (&optional arg) 10842 "Comment out line if not commented out, uncomment otherwise." 10843 (interactive "p") 10844 (save-excursion 10845 (beginning-of-line) 10846 (let ((position (point))) 10847 (forward-line (or arg 1)) 10848 (vhdl-comment-uncomment-region position (point))))) 10849 10850(defun vhdl-comment-kill-region (beg end) 10851 "Kill comments in region." 10852 (interactive "r") 10853 (save-excursion 10854 (goto-char end) 10855 (setq end (point-marker)) 10856 (goto-char beg) 10857 (beginning-of-line) 10858 (while (< (point) end) 10859 (if (looking-at "^\\(\\s-*--.*\n\\)") 10860 (progn (delete-region (match-beginning 1) (match-end 1))) 10861 (beginning-of-line 2))))) 10862 10863(defun vhdl-comment-kill-inline-region (beg end) 10864 "Kill inline comments in region." 10865 (interactive "r") 10866 (save-excursion 10867 (goto-char end) 10868 (setq end (point-marker)) 10869 (goto-char beg) 10870 (beginning-of-line) 10871 (while (< (point) end) 10872 (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$") 10873 (delete-region (match-beginning 1) (match-end 1))) 10874 (beginning-of-line 2)))) 10875 10876;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10877;; Subtemplates 10878 10879(defun vhdl-template-begin-end (construct name margin &optional empty-lines) 10880 "Insert a begin ... end pair with optional name after the end. 10881Point is left between them." 10882 (let (position) 10883 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10884 (indent-to margin) 10885 (vhdl-insert-keyword "BEGIN") 10886 (when (and (or construct name) vhdl-self-insert-comments) 10887 (insert " --") 10888 (when construct (insert " ") (vhdl-insert-keyword construct)) 10889 (when name (insert " " name))) 10890 (insert "\n") 10891 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10892 (indent-to (+ margin vhdl-basic-offset)) 10893 (setq position (point)) 10894 (insert "\n") 10895 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10896 (indent-to margin) 10897 (vhdl-insert-keyword "END") 10898 (when construct (insert " ") (vhdl-insert-keyword construct)) 10899 (insert (if name (concat " " name) "") ";") 10900 (goto-char position))) 10901 10902(defun vhdl-template-argument-list (&optional is-function) 10903 "Read from user a procedure or function argument list." 10904 (insert " (") 10905 (let ((margin (current-column)) 10906 ;; (start (point)) 10907 (end-pos (point)) 10908 not-empty interface semicolon-pos) 10909 (unless vhdl-argument-list-indent 10910 (setq margin (+ (current-indentation) vhdl-basic-offset)) 10911 (insert "\n") 10912 (indent-to margin)) 10913 (setq interface (vhdl-template-field 10914 (concat "[CONSTANT | SIGNAL" 10915 (unless is-function " | VARIABLE") "]") 10916 " " t)) 10917 (while (vhdl-template-field "[names]" nil t) 10918 (setq not-empty t) 10919 (insert " : ") 10920 (unless is-function 10921 (if (and interface (equal (upcase interface) "CONSTANT")) 10922 (vhdl-insert-keyword "IN ") 10923 (vhdl-template-field "[IN | OUT | INOUT]" " " t))) 10924 (vhdl-template-field "type") 10925 (setq semicolon-pos (point)) 10926 (insert ";") 10927 (vhdl-comment-insert-inline) 10928 (setq end-pos (point)) 10929 (insert "\n") 10930 (indent-to margin) 10931 (setq interface (vhdl-template-field 10932 (concat "[CONSTANT | SIGNAL" 10933 (unless is-function " | VARIABLE") "]") 10934 " " t))) 10935 (delete-region end-pos (point)) 10936 (when semicolon-pos (goto-char semicolon-pos)) 10937 (if not-empty 10938 (progn (delete-char 1) (insert ")")) 10939 (delete-char -2)))) 10940 10941(defun vhdl-template-generic-list (optional &optional no-value) 10942 "Read from user a generic spec argument list." 10943 (let (margin 10944 (start (point))) 10945 (vhdl-insert-keyword "GENERIC (") 10946 (setq margin (current-column)) 10947 (unless vhdl-argument-list-indent 10948 (let ((position (point))) 10949 (back-to-indentation) 10950 (setq margin (+ (current-column) vhdl-basic-offset)) 10951 (goto-char position) 10952 (insert "\n") 10953 (indent-to margin))) 10954 (let ((vhdl-generics (vhdl-template-field 10955 (concat (and optional "[") "name" 10956 (and no-value "s") (and optional "]")) 10957 nil optional))) 10958 (if (not vhdl-generics) 10959 (if optional 10960 (progn (vhdl-line-kill-entire) (end-of-line -0) 10961 (unless vhdl-argument-list-indent 10962 (vhdl-line-kill-entire) (end-of-line -0))) 10963 (vhdl-template-undo start (point)) 10964 nil ) 10965 (insert " : ") 10966 (let (semicolon-pos end-pos) 10967 (while vhdl-generics 10968 (vhdl-template-field "type") 10969 (if no-value 10970 (progn (setq semicolon-pos (point)) 10971 (insert ";")) 10972 (insert " := ") 10973 (unless (vhdl-template-field "[value]" nil t) 10974 (delete-char -4)) 10975 (setq semicolon-pos (point)) 10976 (insert ";")) 10977 (vhdl-comment-insert-inline) 10978 (setq end-pos (point)) 10979 (insert "\n") 10980 (indent-to margin) 10981 (setq vhdl-generics (vhdl-template-field 10982 (concat "[name" (and no-value "s") "]") 10983 " : " t))) 10984 (delete-region end-pos (point)) 10985 (goto-char semicolon-pos) 10986 (insert ")") 10987 (end-of-line) 10988 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 10989 t))))) 10990 10991(defun vhdl-template-port-list (optional) 10992 "Read from user a port spec argument list." 10993 (let ((start (point)) 10994 margin vhdl-ports object) 10995 (vhdl-insert-keyword "PORT (") 10996 (setq margin (current-column)) 10997 (unless vhdl-argument-list-indent 10998 (let ((position (point))) 10999 (back-to-indentation) 11000 (setq margin (+ (current-column) vhdl-basic-offset)) 11001 (goto-char position) 11002 (insert "\n") 11003 (indent-to margin))) 11004 (when (vhdl-standard-p 'ams) 11005 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 11006 " " t))) 11007 (setq vhdl-ports (vhdl-template-field 11008 (concat (and optional "[") "names" (and optional "]")) 11009 nil optional)) 11010 (if (not vhdl-ports) 11011 (if optional 11012 (progn (vhdl-line-kill-entire) (end-of-line -0) 11013 (unless vhdl-argument-list-indent 11014 (vhdl-line-kill-entire) (end-of-line -0))) 11015 (vhdl-template-undo start (point)) 11016 nil) 11017 (insert " : ") 11018 (let (semicolon-pos end-pos) 11019 (while vhdl-ports 11020 (cond ((or (null object) (equal "SIGNAL" (upcase object))) 11021 (vhdl-template-field "IN | OUT | INOUT" " ")) 11022 ((equal "QUANTITY" (upcase object)) 11023 (vhdl-template-field "[IN | OUT]" " " t))) 11024 (vhdl-template-field 11025 (if (and object (equal "TERMINAL" (upcase object))) 11026 "nature" "type")) 11027 (setq semicolon-pos (point)) 11028 (insert ";") 11029 (vhdl-comment-insert-inline) 11030 (setq end-pos (point)) 11031 (insert "\n") 11032 (indent-to margin) 11033 (when (vhdl-standard-p 'ams) 11034 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 11035 " " t))) 11036 (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) 11037 (delete-region end-pos (point)) 11038 (goto-char semicolon-pos) 11039 (insert ")") 11040 (end-of-line) 11041 (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) 11042 t)))) 11043 11044(defun vhdl-template-generate-body (margin label) 11045 "Insert body for generate template." 11046 (vhdl-insert-keyword " GENERATE") 11047 (insert "\n\n") 11048 (indent-to margin) 11049 (vhdl-insert-keyword "END GENERATE ") 11050 (insert label ";") 11051 (end-of-line 0) 11052 (indent-to (+ margin vhdl-basic-offset))) 11053 11054(defun vhdl-template-insert-date () 11055 "Insert date in appropriate format." 11056 (interactive) 11057 (insert 11058 (cond 11059 ;; 'american, 'european, 'scientific kept for backward compatibility 11060 ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) 11061 ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) 11062 ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) 11063 (t (format-time-string vhdl-date-format nil))))) 11064 11065;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11066;; Help functions 11067 11068(defun vhdl-electric-space (count) 11069 "Expand abbreviations and self-insert space(s), do `indent-new-comment-line' 11070if in comment and past end-comment-column." 11071 (interactive "p") 11072 (cond ((vhdl-in-comment-p) 11073 (self-insert-command count) 11074 (cond ((>= (current-column) (+ 2 end-comment-column)) 11075 (backward-char 1) 11076 (skip-chars-backward "^ \t\n\r\f") 11077 (indent-new-comment-line) 11078 (skip-chars-forward "^ \t\n\r\f") 11079 (forward-char 1)) 11080 ((>= (current-column) end-comment-column) 11081 (indent-new-comment-line)) 11082 (t nil))) 11083 ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) 11084 (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) 11085 (vhdl-prepare-search-1 11086 (or (expand-abbrev) (vhdl-fix-case-word -1))) 11087 (self-insert-command count)) 11088 (t (self-insert-command count)))) 11089 11090(defun vhdl-template-field (prompt &optional follow-string optional 11091 begin end is-string default) 11092 "Prompt for string and insert it in buffer with optional FOLLOW-STRING. 11093If OPTIONAL is nil, the prompt is left if an empty string is inserted. If 11094an empty string is inserted, return nil and call `vhdl-template-undo' for 11095the region between BEGIN and END. IS-STRING indicates whether a string 11096with double-quotes is to be inserted. DEFAULT specifies a default string." 11097 (let ((position (point)) 11098 string) 11099 (insert "<" prompt ">") 11100 (setq string 11101 (condition-case () 11102 (read-from-minibuffer (concat prompt ": ") 11103 (or (and is-string '("\"\"" . 2)) default) 11104 vhdl-minibuffer-local-map) 11105 (quit (if (and optional begin end) 11106 (progn (beep) "") 11107 (keyboard-quit))))) 11108 (when (or (not (equal string "")) optional) 11109 (delete-region position (point))) 11110 (when (and (equal string "") optional begin end) 11111 (vhdl-template-undo begin end) 11112 (message "Template aborted")) 11113 (unless (equal string "") 11114 (insert string) 11115 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords 11116 vhdl-keywords-regexp) 11117 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types 11118 vhdl-types-regexp) 11119 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes 11120 (concat "'" vhdl-attributes-regexp)) 11121 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values 11122 vhdl-enum-values-regexp) 11123 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants 11124 vhdl-constants-regexp)) 11125 (when (or (not (equal string "")) (not optional)) 11126 (insert (or follow-string ""))) 11127 (if (equal string "") nil string))) 11128 11129(defun vhdl-decision-query (string prompt &optional optional) 11130 "Query a decision from the user." 11131 (let ((start (point))) 11132 (when string (vhdl-insert-keyword (concat string " "))) 11133 (message "%s" (or prompt "")) 11134 (let ((char (read-char))) 11135 (delete-region start (point)) 11136 (if (and optional (eq char ?\r)) 11137 (progn (insert " ") 11138 (unexpand-abbrev) 11139 (throw 'abort "ERROR: Template aborted")) 11140 char)))) 11141 11142(defun vhdl-insert-keyword (keyword) 11143 "Insert KEYWORD and adjust case." 11144 (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) 11145 11146(defun vhdl-case-keyword (keyword) 11147 "Adjust case of KEYWORD." 11148 (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) 11149 11150(defun vhdl-case-word (num) 11151 "Adjust case of following NUM words." 11152 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) 11153 11154(defun vhdl-minibuffer-tab (&optional arg) 11155 "If preceding character is part of a word or a paren then hippie-expand, 11156else insert tab (used for word completion in VHDL minibuffer)." 11157 (interactive "P") 11158 (cond 11159 ;; expand word 11160 ((= (char-syntax (preceding-char)) ?w) 11161 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 11162 (case-replace nil) 11163 (hippie-expand-only-buffers 11164 (or (and (boundp 'hippie-expand-only-buffers) 11165 hippie-expand-only-buffers) 11166 '(vhdl-mode)))) 11167 (vhdl-expand-abbrev arg))) 11168 ;; expand parenthesis 11169 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 11170 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 11171 (case-replace nil)) 11172 (vhdl-expand-paren arg))) 11173 ;; insert tab 11174 (t (insert-tab)))) 11175 11176(defun vhdl-template-search-prompt () 11177 "Search for left out template prompts and query again." 11178 (interactive) 11179 (vhdl-prepare-search-2 11180 (when (or (re-search-forward 11181 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) 11182 (re-search-backward 11183 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) 11184 (let ((string (match-string 1))) 11185 (replace-match "") 11186 (vhdl-template-field string))))) 11187 11188(defun vhdl-template-undo (begin end) 11189 "Undo aborted template by deleting region and unexpanding the keyword." 11190 (cond (vhdl-template-invoked-by-hook 11191 (goto-char end) 11192 (insert " ") 11193 (delete-region begin end) 11194 (unexpand-abbrev)) 11195 (t (delete-region begin end)))) 11196 11197(defun vhdl-insert-string-or-file (string) 11198 "Insert STRING or file contents if STRING is an existing file name." 11199 (unless (equal string "") 11200 (let ((file-name 11201 (progn (string-match "^\\([^\n]+\\)" string) 11202 (vhdl-resolve-env-variable (match-string 1 string))))) 11203 (if (file-exists-p file-name) 11204 (forward-char (cadr (insert-file-contents file-name))) 11205 (insert string))))) 11206 11207(defun vhdl-beginning-of-block () 11208 "Move cursor to the beginning of the enclosing block." 11209 (let (pos) 11210 (vhdl-prepare-search-2 11211 (save-excursion 11212 (beginning-of-line) 11213 ;; search backward for block beginning or end 11214 (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)) 11215 ;; not consider subprogram declarations 11216 (or (and (match-string 5) 11217 (save-match-data 11218 (save-excursion 11219 (goto-char (match-end 5)) 11220 (forward-word-strictly 1) 11221 (vhdl-forward-syntactic-ws) 11222 (when (looking-at "(") 11223 (forward-sexp)) 11224 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 11225 (match-string 1))) 11226 ;; not consider configuration specifications 11227 (and (match-string 6) 11228 (save-match-data 11229 (save-excursion 11230 (vhdl-end-of-block) 11231 (beginning-of-line) 11232 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 11233 (match-string 2)) 11234 ;; skip subblock if block end found 11235 (vhdl-beginning-of-block)))) 11236 (when pos (goto-char pos)))) 11237 11238(defun vhdl-end-of-block () 11239 "Move cursor to the end of the enclosing block." 11240 (let (pos) 11241 (vhdl-prepare-search-2 11242 (save-excursion 11243 (end-of-line) 11244 ;; search forward for block beginning or end 11245 (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)) 11246 ;; not consider subprogram declarations 11247 (or (and (match-string 5) 11248 (save-match-data 11249 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 11250 (match-string 1))) 11251 ;; not consider configuration specifications 11252 (and (match-string 6) 11253 (save-match-data 11254 (save-excursion 11255 (vhdl-end-of-block) 11256 (beginning-of-line) 11257 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 11258 (not (match-string 2))) 11259 ;; skip subblock if block beginning found 11260 (vhdl-end-of-block)))) 11261 (when pos (goto-char pos)))) 11262 11263(defun vhdl-sequential-statement-p () 11264 "Check if point is within sequential statement part." 11265 (let ((start (point))) 11266 (save-excursion 11267 (vhdl-prepare-search-2 11268 ;; is sequential statement if ... 11269 (and (re-search-backward "^\\s-*begin\\>" nil t) 11270 ;; ... point is between "begin" and "end" of ... 11271 (progn (vhdl-end-of-block) 11272 (< start (point))) 11273 ;; ... a sequential block 11274 (progn (vhdl-beginning-of-block) 11275 (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\\)\\)\\>"))))))) 11276 11277(defun vhdl-in-argument-list-p () 11278 "Check if within an argument list." 11279 (save-excursion 11280 (vhdl-prepare-search-2 11281 (or (string-match "arglist" 11282 (format "%s" (caar (vhdl-get-syntactic-context)))) 11283 (progn (beginning-of-line) 11284 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) 11285 11286;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11287;; Abbrev hooks 11288 11289(defun vhdl-hooked-abbrev (func) 11290 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, 11291but not if inside a comment or quote." 11292 (if (or (vhdl-in-literal) 11293 (save-excursion 11294 (forward-word-strictly -1) 11295 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) 11296 (progn 11297 (insert " ") 11298 (unexpand-abbrev) 11299 (backward-word-strictly 1) 11300 (vhdl-case-word 1) 11301 (delete-char 1)) 11302 (if (not vhdl-electric-mode) 11303 (progn 11304 (insert " ") 11305 (unexpand-abbrev) 11306 (backward-word-strictly 1) 11307 (vhdl-case-word 1) 11308 (delete-char 1)) 11309 (let ((invoke-char vhdl-last-input-event) 11310 (abbrev-mode -1) 11311 (vhdl-template-invoked-by-hook t)) 11312 (let ((caught (catch 'abort 11313 (funcall func)))) 11314 (when (stringp caught) (message "%s" caught))) 11315 (when (= invoke-char ?-) (setq abbrev-start-location (point))) 11316 ;; delete CR which is still in event queue 11317 (if (fboundp 'enqueue-eval-event) 11318 (enqueue-eval-event 'delete-char -1) 11319 (push (vhdl-character-to-event ?\177) ; push back a delete char 11320 unread-command-events)))))) 11321 11322(defun vhdl-template-alias-hook () 11323 (vhdl-hooked-abbrev 'vhdl-template-alias)) 11324(defun vhdl-template-architecture-hook () 11325 (vhdl-hooked-abbrev 'vhdl-template-architecture)) 11326(defun vhdl-template-assert-hook () 11327 (vhdl-hooked-abbrev 'vhdl-template-assert)) 11328(defun vhdl-template-attribute-hook () 11329 (vhdl-hooked-abbrev 'vhdl-template-attribute)) 11330(defun vhdl-template-block-hook () 11331 (vhdl-hooked-abbrev 'vhdl-template-block)) 11332(defun vhdl-template-break-hook () 11333 (vhdl-hooked-abbrev 'vhdl-template-break)) 11334(defun vhdl-template-case-hook () 11335 (vhdl-hooked-abbrev 'vhdl-template-case)) 11336(defun vhdl-template-component-hook () 11337 (vhdl-hooked-abbrev 'vhdl-template-component)) 11338(defun vhdl-template-instance-hook () 11339 (vhdl-hooked-abbrev 'vhdl-template-instance)) 11340(defun vhdl-template-conditional-signal-asst-hook () 11341 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) 11342(defun vhdl-template-configuration-hook () 11343 (vhdl-hooked-abbrev 'vhdl-template-configuration)) 11344(defun vhdl-template-constant-hook () 11345 (vhdl-hooked-abbrev 'vhdl-template-constant)) 11346(defun vhdl-template-context-hook () 11347 (vhdl-hooked-abbrev 'vhdl-template-context)) 11348(defun vhdl-template-disconnect-hook () 11349 (vhdl-hooked-abbrev 'vhdl-template-disconnect)) 11350(defun vhdl-template-display-comment-hook () 11351 (vhdl-hooked-abbrev 'vhdl-comment-display)) 11352(defun vhdl-template-else-hook () 11353 (vhdl-hooked-abbrev 'vhdl-template-else)) 11354(defun vhdl-template-elsif-hook () 11355 (vhdl-hooked-abbrev 'vhdl-template-elsif)) 11356(defun vhdl-template-entity-hook () 11357 (vhdl-hooked-abbrev 'vhdl-template-entity)) 11358(defun vhdl-template-exit-hook () 11359 (vhdl-hooked-abbrev 'vhdl-template-exit)) 11360(defun vhdl-template-file-hook () 11361 (vhdl-hooked-abbrev 'vhdl-template-file)) 11362(defun vhdl-template-for-hook () 11363 (vhdl-hooked-abbrev 'vhdl-template-for)) 11364(defun vhdl-template-function-hook () 11365 (vhdl-hooked-abbrev 'vhdl-template-function)) 11366(defun vhdl-template-generic-hook () 11367 (vhdl-hooked-abbrev 'vhdl-template-generic)) 11368(defun vhdl-template-group-hook () 11369 (vhdl-hooked-abbrev 'vhdl-template-group)) 11370(defun vhdl-template-library-hook () 11371 (vhdl-hooked-abbrev 'vhdl-template-library)) 11372(defun vhdl-template-limit-hook () 11373 (vhdl-hooked-abbrev 'vhdl-template-limit)) 11374(defun vhdl-template-if-hook () 11375 (vhdl-hooked-abbrev 'vhdl-template-if)) 11376(defun vhdl-template-bare-loop-hook () 11377 (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) 11378(defun vhdl-template-map-hook () 11379 (vhdl-hooked-abbrev 'vhdl-template-map)) 11380(defun vhdl-template-nature-hook () 11381 (vhdl-hooked-abbrev 'vhdl-template-nature)) 11382(defun vhdl-template-next-hook () 11383 (vhdl-hooked-abbrev 'vhdl-template-next)) 11384(defun vhdl-template-others-hook () 11385 (vhdl-hooked-abbrev 'vhdl-template-others)) 11386(defun vhdl-template-package-hook () 11387 (vhdl-hooked-abbrev 'vhdl-template-package)) 11388(defun vhdl-template-port-hook () 11389 (vhdl-hooked-abbrev 'vhdl-template-port)) 11390(defun vhdl-template-procedural-hook () 11391 (vhdl-hooked-abbrev 'vhdl-template-procedural)) 11392(defun vhdl-template-procedure-hook () 11393 (vhdl-hooked-abbrev 'vhdl-template-procedure)) 11394(defun vhdl-template-process-hook () 11395 (vhdl-hooked-abbrev 'vhdl-template-process)) 11396(defun vhdl-template-quantity-hook () 11397 (vhdl-hooked-abbrev 'vhdl-template-quantity)) 11398(defun vhdl-template-report-hook () 11399 (vhdl-hooked-abbrev 'vhdl-template-report)) 11400(defun vhdl-template-return-hook () 11401 (vhdl-hooked-abbrev 'vhdl-template-return)) 11402(defun vhdl-template-selected-signal-asst-hook () 11403 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) 11404(defun vhdl-template-signal-hook () 11405 (vhdl-hooked-abbrev 'vhdl-template-signal)) 11406(defun vhdl-template-subnature-hook () 11407 (vhdl-hooked-abbrev 'vhdl-template-subnature)) 11408(defun vhdl-template-subtype-hook () 11409 (vhdl-hooked-abbrev 'vhdl-template-subtype)) 11410(defun vhdl-template-terminal-hook () 11411 (vhdl-hooked-abbrev 'vhdl-template-terminal)) 11412(defun vhdl-template-type-hook () 11413 (vhdl-hooked-abbrev 'vhdl-template-type)) 11414(defun vhdl-template-use-hook () 11415 (vhdl-hooked-abbrev 'vhdl-template-use)) 11416(defun vhdl-template-variable-hook () 11417 (vhdl-hooked-abbrev 'vhdl-template-variable)) 11418(defun vhdl-template-wait-hook () 11419 (vhdl-hooked-abbrev 'vhdl-template-wait)) 11420(defun vhdl-template-when-hook () 11421 (vhdl-hooked-abbrev 'vhdl-template-when)) 11422(defun vhdl-template-while-loop-hook () 11423 (vhdl-hooked-abbrev 'vhdl-template-while-loop)) 11424(defun vhdl-template-with-hook () 11425 (vhdl-hooked-abbrev 'vhdl-template-with)) 11426(defun vhdl-template-and-hook () 11427 (vhdl-hooked-abbrev 'vhdl-template-and)) 11428(defun vhdl-template-or-hook () 11429 (vhdl-hooked-abbrev 'vhdl-template-or)) 11430(defun vhdl-template-nand-hook () 11431 (vhdl-hooked-abbrev 'vhdl-template-nand)) 11432(defun vhdl-template-nor-hook () 11433 (vhdl-hooked-abbrev 'vhdl-template-nor)) 11434(defun vhdl-template-xor-hook () 11435 (vhdl-hooked-abbrev 'vhdl-template-xor)) 11436(defun vhdl-template-xnor-hook () 11437 (vhdl-hooked-abbrev 'vhdl-template-xnor)) 11438(defun vhdl-template-not-hook () 11439 (vhdl-hooked-abbrev 'vhdl-template-not)) 11440 11441(defun vhdl-template-default-hook () 11442 (vhdl-hooked-abbrev 'vhdl-template-default)) 11443(defun vhdl-template-default-indent-hook () 11444 (vhdl-hooked-abbrev 'vhdl-template-default-indent)) 11445 11446;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11447;; Template insertion from completion list 11448 11449(defun vhdl-template-insert-construct (name) 11450 "Insert the built-in construct template with NAME." 11451 (interactive 11452 (list (let ((completion-ignore-case t)) 11453 (completing-read "Construct name: " 11454 vhdl-template-construct-alist nil t)))) 11455 (vhdl-template-insert-fun 11456 (cadr (assoc name vhdl-template-construct-alist)))) 11457 11458(defun vhdl-template-insert-package (name) 11459 "Insert the built-in package template with NAME." 11460 (interactive 11461 (list (let ((completion-ignore-case t)) 11462 (completing-read "Package name: " 11463 vhdl-template-package-alist nil t)))) 11464 (vhdl-template-insert-fun 11465 (cadr (assoc name vhdl-template-package-alist)))) 11466 11467(defun vhdl-template-insert-directive (name) 11468 "Insert the built-in directive template with NAME." 11469 (interactive 11470 (list (let ((completion-ignore-case t)) 11471 (completing-read "Directive name: " 11472 vhdl-template-directive-alist nil t)))) 11473 (vhdl-template-insert-fun 11474 (cadr (assoc name vhdl-template-directive-alist)))) 11475 11476(defun vhdl-template-insert-fun (fun) 11477 "Call FUN to insert a built-in template." 11478 (let ((caught (catch 'abort (when fun (funcall fun))))) 11479 (when (stringp caught) (message "%s" caught)))) 11480 11481 11482;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11483;;; Models 11484;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11485 11486(defun vhdl-model-insert (model-name) 11487 "Insert the user model with name MODEL-NAME." 11488 (interactive 11489 (let ((completion-ignore-case t)) 11490 (list (completing-read "Model name: " vhdl-model-alist)))) 11491 (indent-according-to-mode) 11492 (let ((start (point-marker)) 11493 (margin (current-indentation)) 11494 model position prompt string end) 11495 (vhdl-prepare-search-2 11496 (when (setq model (assoc model-name vhdl-model-alist)) 11497 ;; insert model 11498 (beginning-of-line) 11499 (delete-horizontal-space) 11500 (goto-char start) 11501 (vhdl-insert-string-or-file (nth 1 model)) 11502 (setq end (point-marker)) 11503 ;; indent code 11504 (goto-char start) 11505 (beginning-of-line) 11506 (while (< (point) end) 11507 (unless (looking-at "^$") 11508 (insert-char ? margin)) 11509 (beginning-of-line 2)) 11510 (goto-char start) 11511 ;; insert clock 11512 (unless (equal "" vhdl-clock-name) 11513 (while (re-search-forward "<clock>" end t) 11514 (replace-match vhdl-clock-name))) 11515 (goto-char start) 11516 ;; insert reset 11517 (unless (equal "" vhdl-reset-name) 11518 (while (re-search-forward "<reset>" end t) 11519 (replace-match vhdl-reset-name))) 11520 ;; replace header prompts 11521 (vhdl-template-replace-header-keywords start end nil t) 11522 (goto-char start) 11523 ;; query other prompts 11524 (while (re-search-forward 11525 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) 11526 (unless (equal "cursor" (match-string 1)) 11527 (setq position (match-beginning 1)) 11528 (setq prompt (match-string 1)) 11529 (replace-match "") 11530 (setq string (vhdl-template-field prompt nil t)) 11531 ;; replace occurrences of same prompt 11532 (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) 11533 (replace-match (or string ""))) 11534 (goto-char position))) 11535 (goto-char start) 11536 ;; goto final position 11537 (if (re-search-forward "<cursor>" end t) 11538 (replace-match "") 11539 (goto-char end)))))) 11540 11541(defun vhdl-model-defun () 11542 "Define help and hook functions for user models." 11543 (let ((model-alist vhdl-model-alist) 11544 model-name model-keyword) 11545 (while model-alist 11546 ;; define functions for user models that can be invoked from menu and key 11547 ;; bindings and which themselves call `vhdl-model-insert' with the model 11548 ;; name as argument 11549 (setq model-name (nth 0 (car model-alist))) 11550 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () 11551 ,(concat "Insert model for \"" model-name "\".") 11552 (interactive) 11553 (vhdl-model-insert ,model-name))) 11554 ;; define hooks for user models that are invoked from keyword abbrevs 11555 (setq model-keyword (nth 3 (car model-alist))) 11556 (unless (equal model-keyword "") 11557 (eval `(defun 11558 ,(vhdl-function-name 11559 "vhdl-model" model-name "hook") 11560 () 11561 (vhdl-hooked-abbrev 11562 ',(vhdl-function-name "vhdl-model" model-name))))) 11563 (setq model-alist (cdr model-alist))))) 11564 11565(vhdl-model-defun) 11566 11567 11568;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11569;;; Port translation 11570;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11571 11572(defvar vhdl-port-list nil 11573 "Variable to hold last port map parsed.") 11574;; structure: (parenthesized expression means list of such entries) 11575;; (ent-name 11576;; ((generic-names) generic-type generic-init generic-comment group-comment) 11577;; ((port-names) port-object port-direct port-type port-comment group-comment) 11578;; (lib-name pack-key)) 11579 11580(defun vhdl-parse-string (string &optional optional) 11581 "Check that the text following point matches the regexp in STRING." 11582 (if (looking-at string) 11583 (progn (goto-char (match-end 0)) 11584 (when (vhdl-in-literal) 11585 (end-of-line)) 11586 (point)) 11587 (unless optional 11588 (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" 11589 (vhdl-current-line) string))) 11590 nil)) 11591 11592(defun vhdl-replace-string (regexp-cons string &optional adjust-case) 11593 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." 11594 (vhdl-prepare-search-1 11595 (if (string-match (car regexp-cons) string) 11596 (if adjust-case 11597 (funcall vhdl-file-name-case 11598 (replace-match (cdr regexp-cons) t nil string)) 11599 (replace-match (cdr regexp-cons) t nil string)) 11600 string))) 11601 11602(defun vhdl-parse-group-comment () 11603 "Parse comment and empty lines between groups of lines." 11604 (let ((start (point)) 11605 string) 11606 (vhdl-forward-comment (point-max)) 11607 (setq string (buffer-substring-no-properties start (point))) 11608 (vhdl-forward-syntactic-ws) 11609 ;; strip off leading blanks and first newline 11610 (while (string-match "^\\(\\s-+\\)" string) 11611 (setq string (concat (substring string 0 (match-beginning 1)) 11612 (substring string (match-end 1))))) 11613 (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) 11614 (substring string 1) 11615 string))) 11616 11617(defun vhdl-paste-group-comment (string indent) 11618 "Paste comment and empty lines from STRING between groups of lines with INDENT." 11619 (let ((pos (point-marker))) 11620 (when (> indent 0) 11621 (while (string-match "^\\(--\\)" string) 11622 (setq string (concat (substring string 0 (match-beginning 1)) 11623 (make-string indent ? ) 11624 (substring string (match-beginning 1)))))) 11625 (beginning-of-line) 11626 (insert string) 11627 (goto-char pos))) 11628 11629(defvar vhdl-port-flattened nil 11630 "Indicates whether a port has been flattened.") 11631 11632(defun vhdl-port-flatten (&optional as-alist) 11633 "Flatten port list so that only one generic/port exists per line. 11634This operation is performed on an internally stored port and is only 11635reflected in a subsequent paste operation." 11636 (interactive) 11637 (if (not vhdl-port-list) 11638 (error "ERROR: No port has been read") 11639 (message "Flattening port for next paste...") 11640 (let ((new-vhdl-port-list (list (car vhdl-port-list))) 11641 (old-vhdl-port-list (cdr vhdl-port-list)) 11642 old-port-list new-port-list old-port new-port names) 11643 ;; traverse port list and flatten entries 11644 (while (cdr old-vhdl-port-list) 11645 (setq old-port-list (car old-vhdl-port-list)) 11646 (setq new-port-list nil) 11647 (while old-port-list 11648 (setq old-port (car old-port-list)) 11649 (setq names (car old-port)) 11650 (while names 11651 (setq new-port (cons (if as-alist (car names) (list (car names))) 11652 (cdr old-port))) 11653 (setq new-port-list (append new-port-list (list new-port))) 11654 (setq names (cdr names))) 11655 (setq old-port-list (cdr old-port-list))) 11656 (setq old-vhdl-port-list (cdr old-vhdl-port-list)) 11657 (setq new-vhdl-port-list (append new-vhdl-port-list 11658 (list new-port-list)))) 11659 (setq vhdl-port-list 11660 (append new-vhdl-port-list (list old-vhdl-port-list)) 11661 vhdl-port-flattened t) 11662 (message "Flattening port for next paste...done")))) 11663 11664(defvar vhdl-port-reversed-direction nil 11665 "Indicates whether port directions are reversed.") 11666 11667(defun vhdl-port-reverse-direction () 11668 "Reverse direction for all ports (useful in testbenches). 11669This operation is performed on an internally stored port and is only 11670reflected in a subsequent paste operation." 11671 (interactive) 11672 (if (not vhdl-port-list) 11673 (error "ERROR: No port has been read") 11674 (message "Reversing port directions for next paste...") 11675 (let ((port-list (nth 2 vhdl-port-list)) 11676 port-dir-car port-dir) 11677 ;; traverse port list and reverse directions 11678 (while port-list 11679 (setq port-dir-car (cddr (car port-list)) 11680 port-dir (car port-dir-car)) 11681 (setcar port-dir-car 11682 (cond ((equal port-dir "in") "out") 11683 ((equal port-dir "IN") "OUT") 11684 ((equal port-dir "out") "in") 11685 ((equal port-dir "OUT") "IN") 11686 (t port-dir))) 11687 (setq port-list (cdr port-list))) 11688 (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) 11689 (message "Reversing port directions for next paste...done")))) 11690 11691(defun vhdl-port-copy () 11692 "Get generic and port information from an entity or component declaration." 11693 (interactive) 11694 (save-excursion 11695 (let (parse-error end-of-list 11696 decl-type name generic-list port-list context-clause 11697 object names direct type init comment group-comment) 11698 (vhdl-prepare-search-2 11699 (setq 11700 parse-error 11701 (catch 'parse 11702 ;; check if within entity or component declaration 11703 (end-of-line) 11704 (when (or (not (re-search-backward 11705 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) 11706 (equal "END" (upcase (match-string 1)))) 11707 (throw 'parse "ERROR: Not within an entity or component declaration")) 11708 (setq decl-type (downcase (match-string-no-properties 1))) 11709 (forward-word-strictly 1) 11710 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") 11711 (setq name (match-string-no-properties 1)) 11712 (message "Reading port of %s \"%s\"..." decl-type name) 11713 (vhdl-forward-syntactic-ws) 11714 ;; parse generic clause 11715 (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t) 11716 ;; parse group comment and spacing 11717 (setq group-comment (vhdl-parse-group-comment)) 11718 (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) 11719 (while (not end-of-list) 11720 ;; parse names (accept extended identifiers) 11721 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 11722 (setq names (list (match-string-no-properties 1))) 11723 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 11724 (setq names 11725 (append names (list (match-string-no-properties 1))))) 11726 ;; parse type 11727 (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)") 11728 (setq type (match-string-no-properties 1)) 11729 (when (vhdl-in-comment-p) ; if stuck in comment 11730 (setq type (concat type (and (vhdl-parse-string ".*") 11731 (match-string-no-properties 0))))) 11732 (setq comment nil) 11733 (while (looking-at "(") 11734 (setq type 11735 (concat type 11736 (buffer-substring-no-properties 11737 (point) (progn (forward-sexp) (point))) 11738 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 11739 (match-string-no-properties 1))))) 11740 ;; special case: closing parenthesis is on separate line 11741 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11742 (setq comment (substring type (match-beginning 2))) 11743 (setq type (substring type 0 (match-beginning 1)))) 11744 ;; strip of trailing group-comment 11745 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11746 (setq type (substring type 0 (match-end 1))) 11747 ;; parse initialization expression 11748 (setq init nil) 11749 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) 11750 (vhdl-parse-string "\\([^();\n]*\\)") 11751 (setq init (match-string-no-properties 1)) 11752 (while (looking-at "(") 11753 (setq init 11754 (concat init 11755 (buffer-substring-no-properties 11756 (point) (progn (forward-sexp) (point))) 11757 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11758 (match-string-no-properties 1)))))) 11759 ;; special case: closing parenthesis is on separate line 11760 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 11761 (setq comment (substring init (match-beginning 2))) 11762 (setq init (substring init 0 (match-beginning 1))) 11763 (vhdl-forward-syntactic-ws)) 11764 (skip-chars-forward " \t") 11765 ;; parse inline comment, special case: as above, no initial. 11766 (unless comment 11767 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11768 (match-string-no-properties 1)))) 11769 (vhdl-forward-syntactic-ws) 11770 (setq end-of-list (vhdl-parse-string ")" t)) 11771 (vhdl-parse-string "\\s-*;\\s-*") 11772 ;; parse inline comment 11773 (unless comment 11774 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11775 (match-string-no-properties 1)))) 11776 ;; save everything in list 11777 (setq generic-list (append generic-list 11778 (list (list names type init 11779 comment group-comment)))) 11780 ;; parse group comment and spacing 11781 (setq group-comment (vhdl-parse-group-comment)))) 11782 ;; parse port clause 11783 (when (vhdl-parse-string "port[ \t\n\r\f]*(" t) 11784 ;; parse group comment and spacing 11785 (setq group-comment (vhdl-parse-group-comment)) 11786 (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) 11787 (while (not end-of-list) 11788 ;; parse object 11789 (setq object 11790 (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t) 11791 (match-string-no-properties 1))) 11792 ;; parse names (accept extended identifiers) 11793 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 11794 (setq names (list (match-string-no-properties 1))) 11795 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 11796 (setq names (append names (list (match-string-no-properties 1))))) 11797 ;; parse direction 11798 (vhdl-parse-string ":[ \t\n\r\f]*") 11799 (setq direct 11800 (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t) 11801 (match-string-no-properties 1))) 11802 ;; parse type 11803 (vhdl-parse-string "\\([^();\n]+\\)") 11804 (setq type (match-string-no-properties 1)) 11805 (when (vhdl-in-comment-p) ; if stuck in comment 11806 (setq type (concat type (and (vhdl-parse-string ".*") 11807 (match-string-no-properties 0))))) 11808 (setq comment nil) 11809 (while (looking-at "(") 11810 (setq type (concat type 11811 (buffer-substring-no-properties 11812 (point) (progn (forward-sexp) (point))) 11813 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11814 (match-string-no-properties 1))))) 11815 ;; special case: closing parenthesis is on separate line 11816 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11817 (setq comment (substring type (match-beginning 2))) 11818 (setq type (substring type 0 (match-beginning 1)))) 11819 ;; strip of trailing group-comment 11820 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11821 (setq type (substring type 0 (match-end 1))) 11822 (vhdl-forward-syntactic-ws) 11823 (setq end-of-list (vhdl-parse-string ")" t)) 11824 (vhdl-parse-string "\\s-*;\\s-*") 11825 ;; parse inline comment 11826 (unless comment 11827 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11828 (match-string-no-properties 1)))) 11829 ;; save everything in list 11830 (setq port-list (append port-list 11831 (list (list names object direct type 11832 comment group-comment)))) 11833 ;; parse group comment and spacing 11834 (setq group-comment (vhdl-parse-group-comment)))) 11835 ;; parse context clause 11836 (setq context-clause (vhdl-scan-context-clause)) 11837; ;; add surrounding package to context clause 11838; (when (and (equal decl-type "component") 11839; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) 11840; (setq context-clause 11841; (append context-clause 11842; (list (cons (vhdl-work-library) 11843; (match-string-no-properties 1)))))) 11844 (message "Reading port of %s \"%s\"...done" decl-type name) 11845 nil))) 11846 ;; finish parsing 11847 (if parse-error 11848 (error parse-error) 11849 (setq vhdl-port-list (list name generic-list port-list context-clause) 11850 vhdl-port-reversed-direction nil 11851 vhdl-port-flattened nil))))) 11852 11853(defun vhdl-port-paste-context-clause (&optional exclude-pack-name) 11854 "Paste a context clause." 11855 (let (;; (margin (current-indentation)) 11856 (clause-list (nth 3 vhdl-port-list)) 11857 clause) 11858 (while clause-list 11859 (setq clause (car clause-list)) 11860 (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) 11861 (downcase exclude-pack-name))) 11862 (save-excursion 11863 (re-search-backward 11864 (concat "^\\s-*use\\s-+" (car clause) 11865 "." (cdr clause) "\\>") 11866 nil t))) 11867 (vhdl-template-standard-package (car clause) (cdr clause)) 11868 (insert "\n")) 11869 (setq clause-list (cdr clause-list))))) 11870 11871(defun vhdl-port-paste-generic (&optional no-init) 11872 "Paste a generic clause." 11873 (let ((margin (current-indentation)) 11874 (generic-list (nth 1 vhdl-port-list)) 11875 list-margin start names generic) 11876 ;; paste generic clause 11877 (when generic-list 11878 (setq start (point)) 11879 (vhdl-insert-keyword "GENERIC (") 11880 (unless vhdl-argument-list-indent 11881 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11882 (setq list-margin (current-column)) 11883 (while generic-list 11884 (setq generic (car generic-list)) 11885 ;; paste group comment and spacing 11886 (when (memq vhdl-include-group-comments '(decl always)) 11887 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 11888 ;; paste names 11889 (setq names (nth 0 generic)) 11890 (while names 11891 (insert (car names)) 11892 (setq names (cdr names)) 11893 (when names (insert ", "))) 11894 ;; paste type 11895 (insert " : " (nth 1 generic)) 11896 ;; paste initialization 11897 (when (and (not no-init) (nth 2 generic)) 11898 (insert " := " (nth 2 generic))) 11899 (unless (cdr generic-list) (insert ")")) 11900 (insert ";") 11901 ;; paste comment 11902 (when (and vhdl-include-port-comments (nth 3 generic)) 11903 (vhdl-comment-insert-inline (nth 3 generic) t)) 11904 (setq generic-list (cdr generic-list)) 11905 (when generic-list (insert "\n") (indent-to list-margin))) 11906 ;; align generic clause 11907 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) 11908 11909(defun vhdl-port-paste-port () 11910 "Paste a port clause." 11911 (let ((margin (current-indentation)) 11912 (port-list (nth 2 vhdl-port-list)) 11913 list-margin start names port) 11914 ;; paste port clause 11915 (when port-list 11916 (setq start (point)) 11917 (vhdl-insert-keyword "PORT (") 11918 (unless vhdl-argument-list-indent 11919 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11920 (setq list-margin (current-column)) 11921 (while port-list 11922 (setq port (car port-list)) 11923 ;; paste group comment and spacing 11924 (when (memq vhdl-include-group-comments '(decl always)) 11925 (vhdl-paste-group-comment (nth 5 port) list-margin)) 11926 ;; paste object 11927 (when (nth 1 port) (insert (nth 1 port) " ")) 11928 ;; paste names 11929 (setq names (nth 0 port)) 11930 (while names 11931 (insert (car names)) 11932 (setq names (cdr names)) 11933 (when names (insert ", "))) 11934 ;; paste direction 11935 (insert " : ") 11936 (when (nth 2 port) (insert (nth 2 port) " ")) 11937 ;; paste type 11938 (insert (nth 3 port)) 11939 (unless (cdr port-list) (insert ")")) 11940 (insert ";") 11941 ;; paste comment 11942 (when (and vhdl-include-port-comments (nth 4 port)) 11943 (vhdl-comment-insert-inline (nth 4 port) t)) 11944 (setq port-list (cdr port-list)) 11945 (when port-list (insert "\n") (indent-to list-margin))) 11946 ;; align port clause 11947 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 11948 11949(defun vhdl-port-paste-declaration (kind &optional no-indent) 11950 "Paste as an entity or component declaration." 11951 (unless no-indent (indent-according-to-mode)) 11952 (let ((margin (current-indentation)) 11953 (name (nth 0 vhdl-port-list))) 11954 (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) 11955 (insert name) 11956 (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) 11957 (vhdl-insert-keyword " IS")) 11958 ;; paste generic and port clause 11959 (when (nth 1 vhdl-port-list) 11960 (insert "\n") 11961 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11962 (insert "\n")) 11963 (indent-to (+ margin vhdl-basic-offset)) 11964 (vhdl-port-paste-generic (eq kind 'component))) 11965 (when (nth 2 vhdl-port-list) 11966 (insert "\n") 11967 (when (and (memq vhdl-insert-empty-lines '(unit all)) 11968 (eq kind 'entity)) 11969 (insert "\n")) 11970 (indent-to (+ margin vhdl-basic-offset))) 11971 (vhdl-port-paste-port) 11972 (insert "\n") 11973 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11974 (insert "\n")) 11975 (indent-to margin) 11976 (vhdl-insert-keyword "END") 11977 (if (eq kind 'entity) 11978 (progn 11979 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) 11980 (insert " " name)) 11981 (vhdl-insert-keyword " COMPONENT") 11982 (unless (vhdl-standard-p '87) (insert " " name))) 11983 (insert ";"))) 11984 11985(defun vhdl-port-paste-entity (&optional no-indent) 11986 "Paste as an entity declaration." 11987 (interactive) 11988 (if (not vhdl-port-list) 11989 (error "ERROR: No port read") 11990 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) 11991 (vhdl-port-paste-declaration 'entity no-indent) 11992 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) 11993 11994(defun vhdl-port-paste-component (&optional no-indent) 11995 "Paste as a component declaration." 11996 (interactive) 11997 (if (not vhdl-port-list) 11998 (error "ERROR: No port read") 11999 (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) 12000 (vhdl-port-paste-declaration 'component no-indent) 12001 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) 12002 12003(defun vhdl-port-paste-generic-map (&optional secondary no-constants) 12004 "Paste as a generic map." 12005 (interactive) 12006 (unless secondary (indent-according-to-mode)) 12007 (let ((margin (current-indentation)) 12008 list-margin start generic 12009 (generic-list (nth 1 vhdl-port-list))) 12010 (when generic-list 12011 (setq start (point)) 12012 (vhdl-insert-keyword "GENERIC MAP (") 12013 (if (not vhdl-association-list-with-formals) 12014 ;; paste list of actual generics 12015 (while generic-list 12016 (insert (if no-constants 12017 (car (nth 0 (car generic-list))) 12018 (or (nth 2 (car generic-list)) " "))) 12019 (setq generic-list (cdr generic-list)) 12020 (insert (if generic-list ", " ")")) 12021 (when (and (not generic-list) secondary 12022 (null (nth 2 vhdl-port-list))) 12023 (insert ";"))) 12024 (unless vhdl-argument-list-indent 12025 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12026 (setq list-margin (current-column)) 12027 (while generic-list 12028 (setq generic (car generic-list)) 12029 ;; paste group comment and spacing 12030 (when (eq vhdl-include-group-comments 'always) 12031 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 12032 ;; paste formal and actual generic 12033 (insert (car (nth 0 generic)) " => " 12034 (if no-constants 12035 (vhdl-replace-string vhdl-actual-generic-name 12036 (car (nth 0 generic))) 12037 (or (nth 2 generic) ""))) 12038 (setq generic-list (cdr generic-list)) 12039 (insert (if generic-list "," ")")) 12040 (when (and (not generic-list) secondary 12041 (null (nth 2 vhdl-port-list))) 12042 (insert ";")) 12043 ;; paste comment 12044 (when (or vhdl-include-type-comments 12045 (and vhdl-include-port-comments (nth 3 generic))) 12046 (vhdl-comment-insert-inline 12047 (concat 12048 (when vhdl-include-type-comments 12049 (concat "[" (nth 1 generic) "] ")) 12050 (when vhdl-include-port-comments (nth 3 generic))) t)) 12051 (when generic-list (insert "\n") (indent-to list-margin))) 12052 ;; align generic map 12053 (when vhdl-auto-align 12054 (vhdl-align-region-groups start (point) 1 t)))))) 12055 12056(defun vhdl-port-paste-port-map () 12057 "Paste as a port map." 12058 (let ((margin (current-indentation)) 12059 list-margin start port 12060 (port-list (nth 2 vhdl-port-list))) 12061 (when port-list 12062 (setq start (point)) 12063 (vhdl-insert-keyword "PORT MAP (") 12064 (if (not vhdl-association-list-with-formals) 12065 ;; paste list of actual ports 12066 (while port-list 12067 (insert (vhdl-replace-string vhdl-actual-port-name 12068 (car (nth 0 (car port-list))))) 12069 (setq port-list (cdr port-list)) 12070 (insert (if port-list ", " ")"))) 12071 (unless vhdl-argument-list-indent 12072 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12073 (setq list-margin (current-column)) 12074 (while port-list 12075 (setq port (car port-list)) 12076 ;; paste group comment and spacing 12077 (when (eq vhdl-include-group-comments 'always) 12078 (vhdl-paste-group-comment (nth 5 port) list-margin)) 12079 ;; paste formal and actual port 12080 (insert (car (nth 0 port)) " => ") 12081 (insert (vhdl-replace-string vhdl-actual-port-name 12082 (car (nth 0 port)))) 12083 (setq port-list (cdr port-list)) 12084 (insert (if port-list "," ");")) 12085 ;; paste comment 12086 (when (or (and vhdl-include-direction-comments (nth 2 port)) 12087 vhdl-include-type-comments 12088 (and vhdl-include-port-comments (nth 4 port))) 12089 (vhdl-comment-insert-inline 12090 (concat 12091 (cond ((and vhdl-include-direction-comments 12092 vhdl-include-type-comments) 12093 (concat "[" (format "%-4s" (concat (nth 2 port) " ")) 12094 (nth 3 port) "] ")) 12095 ((and vhdl-include-direction-comments (nth 2 port)) 12096 (format "%-6s" (concat "[" (nth 2 port) "] "))) 12097 (vhdl-include-direction-comments " ") 12098 (vhdl-include-type-comments 12099 (concat "[" (nth 3 port) "] "))) 12100 (when vhdl-include-port-comments (nth 4 port))) t)) 12101 (when port-list (insert "\n") (indent-to list-margin))) 12102 ;; align port clause 12103 (when vhdl-auto-align 12104 (vhdl-align-region-groups start (point) 1)))))) 12105 12106(defun vhdl-port-paste-instance (&optional name no-indent title) 12107 "Paste as an instantiation." 12108 (interactive) 12109 (if (not vhdl-port-list) 12110 (error "ERROR: No port read") 12111 (let ((orig-vhdl-port-list vhdl-port-list)) 12112 ;; flatten local copy of port list (must be flat for port mapping) 12113 (vhdl-port-flatten) 12114 (unless no-indent (indent-according-to-mode)) 12115 (let ((margin (current-indentation))) 12116 ;; paste instantiation 12117 (cond (name 12118 (insert name)) 12119 ((equal (cdr vhdl-instance-name) "") 12120 (setq name (vhdl-template-field "instance name"))) 12121 ((string-match "%d" (cdr vhdl-instance-name)) 12122 (let ((n 1)) 12123 (while (save-excursion 12124 (setq name (format (vhdl-replace-string 12125 vhdl-instance-name 12126 (nth 0 vhdl-port-list)) n)) 12127 (goto-char (point-min)) 12128 (vhdl-re-search-forward name nil t)) 12129 (setq n (1+ n))) 12130 (insert name))) 12131 (t (insert (vhdl-replace-string vhdl-instance-name 12132 (nth 0 vhdl-port-list))))) 12133 (message "Pasting port as instantiation \"%s\"..." name) 12134 (insert ": ") 12135 (when title 12136 (save-excursion 12137 (beginning-of-line) 12138 (indent-to vhdl-basic-offset) 12139 (insert "-- instance \"" name "\"\n"))) 12140 (if (not (vhdl-use-direct-instantiation)) 12141 (insert (nth 0 vhdl-port-list)) 12142 (vhdl-insert-keyword "ENTITY ") 12143 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) 12144 (when (nth 1 vhdl-port-list) 12145 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 12146 (vhdl-port-paste-generic-map t t)) 12147 (when (nth 2 vhdl-port-list) 12148 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 12149 (vhdl-port-paste-port-map)) 12150 (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) 12151 (insert ";")) 12152 (message "Pasting port as instantiation \"%s\"...done" name)) 12153 (setq vhdl-port-list orig-vhdl-port-list)))) 12154 12155(defun vhdl-port-paste-constants (&optional no-indent) 12156 "Paste generics as constants." 12157 (interactive) 12158 (if (not vhdl-port-list) 12159 (error "ERROR: No port read") 12160 (let ((orig-vhdl-port-list vhdl-port-list)) 12161 (message "Pasting port as constants...") 12162 ;; flatten local copy of port list (must be flat for constant initial.) 12163 (vhdl-port-flatten) 12164 (unless no-indent (indent-according-to-mode)) 12165 (let ((margin (current-indentation)) 12166 start generic name 12167 (generic-list (nth 1 vhdl-port-list))) 12168 (when generic-list 12169 (setq start (point)) 12170 (while generic-list 12171 (setq generic (car generic-list)) 12172 ;; paste group comment and spacing 12173 (when (memq vhdl-include-group-comments '(decl always)) 12174 (vhdl-paste-group-comment (nth 4 generic) margin)) 12175 (vhdl-insert-keyword "CONSTANT ") 12176 ;; paste generic constants 12177 (setq name (nth 0 generic)) 12178 (when name 12179 (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) 12180 ;; paste type 12181 (insert " : " (nth 1 generic)) 12182 ;; paste initialization 12183 (when (nth 2 generic) 12184 (insert " := " (nth 2 generic))) 12185 (insert ";") 12186 ;; paste comment 12187 (when (and vhdl-include-port-comments (nth 3 generic)) 12188 (vhdl-comment-insert-inline (nth 3 generic) t)) 12189 (setq generic-list (cdr generic-list)) 12190 (when generic-list (insert "\n") (indent-to margin)))) 12191 ;; align signal list 12192 (when vhdl-auto-align 12193 (vhdl-align-region-groups start (point) 1)))) 12194 (message "Pasting port as constants...done") 12195 (setq vhdl-port-list orig-vhdl-port-list)))) 12196 12197(defun vhdl-port-paste-signals (&optional initialize no-indent) 12198 "Paste ports as internal signals." 12199 (interactive) 12200 (if (not vhdl-port-list) 12201 (error "ERROR: No port read") 12202 (message "Pasting port as signals...") 12203 (unless no-indent (indent-according-to-mode)) 12204 (let ((margin (current-indentation)) 12205 start port names type generic-list port-name constant-name pos 12206 (port-list (nth 2 vhdl-port-list))) 12207 (when port-list 12208 (setq start (point)) 12209 (while port-list 12210 (setq port (car port-list)) 12211 ;; paste group comment and spacing 12212 (when (memq vhdl-include-group-comments '(decl always)) 12213 (vhdl-paste-group-comment (nth 5 port) margin)) 12214 ;; paste object 12215 (if (nth 1 port) 12216 (insert (nth 1 port) " ") 12217 (vhdl-insert-keyword "SIGNAL ")) 12218 ;; paste actual port signals 12219 (setq names (nth 0 port)) 12220 (while names 12221 (insert (vhdl-replace-string vhdl-actual-port-name (car names))) 12222 (setq names (cdr names)) 12223 (when names (insert ", "))) 12224 ;; paste type 12225 (setq type (nth 3 port)) 12226 (setq generic-list (nth 1 vhdl-port-list)) 12227 (vhdl-prepare-search-1 12228 (setq pos 0) 12229 ;; replace formal by actual generics 12230 (while generic-list 12231 (setq port-name (car (nth 0 (car generic-list)))) 12232 (while (string-match (concat "\\<" port-name "\\>") type pos) 12233 (setq constant-name 12234 (save-match-data (vhdl-replace-string 12235 vhdl-actual-generic-name port-name))) 12236 (setq type (replace-match constant-name t nil type)) 12237 (setq pos (match-end 0))) 12238 (setq generic-list (cdr generic-list)))) 12239 (insert " : " type) 12240 ;; paste initialization (inputs only) 12241 (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) 12242 (insert " := " 12243 (cond ((string-match "integer" (nth 3 port)) "0") 12244 ((string-match "natural" (nth 3 port)) "0") 12245 ((string-match "positive" (nth 3 port)) "0") 12246 ((string-match "real" (nth 3 port)) "0.0") 12247 ((string-match "(.+)" (nth 3 port)) "(others => '0')") 12248 (t "'0'")))) 12249 (insert ";") 12250 ;; paste comment 12251 (when (or (and vhdl-include-direction-comments (nth 2 port)) 12252 (and vhdl-include-port-comments (nth 4 port))) 12253 (vhdl-comment-insert-inline 12254 (concat 12255 (cond ((and vhdl-include-direction-comments (nth 2 port)) 12256 (format "%-6s" (concat "[" (nth 2 port) "] "))) 12257 (vhdl-include-direction-comments " ")) 12258 (when vhdl-include-port-comments (nth 4 port))) 12259 t)) 12260 (setq port-list (cdr port-list)) 12261 (when port-list (insert "\n") (indent-to margin))) 12262 ;; align signal list 12263 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 12264 (message "Pasting port as signals...done"))) 12265 12266(defun vhdl-port-paste-initializations (&optional no-indent) 12267 "Paste ports as signal initializations." 12268 (interactive) 12269 (if (not vhdl-port-list) 12270 (error "ERROR: No port read") 12271 (let ((orig-vhdl-port-list vhdl-port-list)) 12272 (message "Pasting port as initializations...") 12273 ;; flatten local copy of port list (must be flat for signal initial.) 12274 (vhdl-port-flatten) 12275 (unless no-indent (indent-according-to-mode)) 12276 (let ((margin (current-indentation)) 12277 start port name 12278 (port-list (nth 2 vhdl-port-list))) 12279 (when port-list 12280 (setq start (point)) 12281 (while port-list 12282 (setq port (car port-list)) 12283 ;; paste actual port signal (inputs only) 12284 (when (equal "IN" (upcase (nth 2 port))) 12285 (setq name (car (nth 0 port))) 12286 (insert (vhdl-replace-string vhdl-actual-port-name name)) 12287 ;; paste initialization 12288 (insert " <= " 12289 (cond ((string-match "integer" (nth 3 port)) "0") 12290 ((string-match "natural" (nth 3 port)) "0") 12291 ((string-match "positive" (nth 3 port)) "0") 12292 ((string-match "real" (nth 3 port)) "0.0") 12293 ((string-match "(.+)" (nth 3 port)) "(others => '0')") 12294 (t "'0'")) 12295 ";")) 12296 (setq port-list (cdr port-list)) 12297 (when (and port-list 12298 (equal "IN" (upcase (nth 2 (car port-list))))) 12299 (insert "\n") (indent-to margin))) 12300 ;; align signal list 12301 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 12302 (message "Pasting port as initializations...done") 12303 (setq vhdl-port-list orig-vhdl-port-list)))) 12304 12305(defun vhdl-port-paste-testbench () 12306 "Paste as a bare-bones testbench." 12307 (interactive) 12308 (if (not vhdl-port-list) 12309 (error "ERROR: No port read") 12310 (let ((case-fold-search t) 12311 (ent-name (vhdl-replace-string vhdl-testbench-entity-name 12312 (nth 0 vhdl-port-list))) 12313 ;; (source-buffer (current-buffer)) 12314 arch-name config-name ent-file-name arch-file-name 12315 ent-buffer arch-buffer position) 12316 ;; open entity file 12317 (unless (eq vhdl-testbench-create-files 'none) 12318 (setq ent-file-name 12319 (concat (vhdl-replace-string vhdl-testbench-entity-file-name 12320 ent-name t) 12321 "." (file-name-extension (buffer-file-name)))) 12322 (if (file-exists-p ent-file-name) 12323 (if (y-or-n-p 12324 (concat "File \"" ent-file-name "\" exists; overwrite? ")) 12325 (progn (find-file ent-file-name) 12326 (erase-buffer) 12327 (set-buffer-modified-p nil)) 12328 (if (eq vhdl-testbench-create-files 'separate) 12329 (setq ent-file-name nil) 12330 (error "ERROR: Pasting port as testbench...aborted"))) 12331 (find-file ent-file-name))) 12332 (unless (and (eq vhdl-testbench-create-files 'separate) 12333 (null ent-file-name)) 12334 ;; paste entity header 12335 (if vhdl-testbench-include-header 12336 (progn (vhdl-template-header 12337 (concat "Testbench for design \"" 12338 (nth 0 vhdl-port-list) "\"")) 12339 (goto-char (point-max))) 12340 (vhdl-comment-display-line) (insert "\n\n")) 12341 ;; paste std_logic_1164 package 12342 (when vhdl-testbench-include-library 12343 (vhdl-template-package-std-logic-1164) 12344 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) 12345 ;; paste entity declaration 12346 (vhdl-insert-keyword "ENTITY ") 12347 (insert ent-name) 12348 (vhdl-insert-keyword " IS") 12349 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 12350 (insert "\n") 12351 (vhdl-insert-keyword "END ") 12352 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 12353 (insert ent-name ";") 12354 (insert "\n\n") 12355 (vhdl-comment-display-line) (insert "\n")) 12356 ;; get architecture name 12357 (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") 12358 (read-from-minibuffer "architecture name: " 12359 nil vhdl-minibuffer-local-map) 12360 (vhdl-replace-string vhdl-testbench-architecture-name 12361 (nth 0 vhdl-port-list)))) 12362 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) 12363 ;; open architecture file 12364 (if (not (eq vhdl-testbench-create-files 'separate)) 12365 (insert "\n") 12366 (setq ent-buffer (current-buffer)) 12367 (setq arch-file-name 12368 (concat (vhdl-replace-string vhdl-testbench-architecture-file-name 12369 (concat ent-name " " arch-name) t) 12370 "." (file-name-extension (buffer-file-name)))) 12371 (when (and (file-exists-p arch-file-name) 12372 (not (y-or-n-p (concat "File \"" arch-file-name 12373 "\" exists; overwrite? ")))) 12374 (error "ERROR: Pasting port as testbench...aborted")) 12375 (find-file arch-file-name) 12376 (erase-buffer) 12377 (set-buffer-modified-p nil) 12378 ;; paste architecture header 12379 (if vhdl-testbench-include-header 12380 (progn (vhdl-template-header 12381 (concat "Testbench architecture for design \"" 12382 (nth 0 vhdl-port-list) "\"")) 12383 (goto-char (point-max))) 12384 (vhdl-comment-display-line) (insert "\n\n"))) 12385 ;; paste architecture body 12386 (vhdl-insert-keyword "ARCHITECTURE ") 12387 (insert arch-name) 12388 (vhdl-insert-keyword " OF ") 12389 (insert ent-name) 12390 (vhdl-insert-keyword " IS") 12391 (insert "\n\n") (indent-to vhdl-basic-offset) 12392 ;; paste component declaration 12393 (unless (vhdl-use-direct-instantiation) 12394 (vhdl-port-paste-component t) 12395 (insert "\n\n") (indent-to vhdl-basic-offset)) 12396 ;; paste constants 12397 (when (nth 1 vhdl-port-list) 12398 (insert "-- component generics\n") (indent-to vhdl-basic-offset) 12399 (vhdl-port-paste-constants t) 12400 (insert "\n\n") (indent-to vhdl-basic-offset)) 12401 ;; paste internal signals 12402 (insert "-- component ports\n") (indent-to vhdl-basic-offset) 12403 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) 12404 (insert "\n") 12405 ;; paste custom declarations 12406 (unless (equal "" vhdl-testbench-declarations) 12407 (insert "\n") 12408 (setq position (point)) 12409 (vhdl-insert-string-or-file vhdl-testbench-declarations) 12410 (indent-region position (point))) 12411 (setq position (point)) 12412 (insert "\n\n") 12413 (vhdl-comment-display-line) (insert "\n") 12414 (when vhdl-testbench-include-configuration 12415 (setq config-name (vhdl-replace-string 12416 vhdl-testbench-configuration-name 12417 (concat ent-name " " arch-name))) 12418 (insert "\n") 12419 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) 12420 (vhdl-insert-keyword " OF ") (insert ent-name) 12421 (vhdl-insert-keyword " IS\n") 12422 (indent-to vhdl-basic-offset) 12423 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 12424 (indent-to vhdl-basic-offset) 12425 (vhdl-insert-keyword "END FOR;\n") 12426 (vhdl-insert-keyword "END ") (insert config-name ";\n\n") 12427 (vhdl-comment-display-line) (insert "\n")) 12428 (goto-char position) 12429 (vhdl-template-begin-end 12430 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) 12431 ;; paste instantiation 12432 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) 12433 (vhdl-port-paste-instance 12434 (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) 12435 (insert "\n") 12436 ;; paste custom statements 12437 (unless (equal "" vhdl-testbench-statements) 12438 (insert "\n") 12439 (setq position (point)) 12440 (vhdl-insert-string-or-file vhdl-testbench-statements) 12441 (indent-region position (point))) 12442 (insert "\n") 12443 (indent-to vhdl-basic-offset) 12444 (unless (eq vhdl-testbench-create-files 'none) 12445 (setq arch-buffer (current-buffer)) 12446 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 12447 (set-buffer arch-buffer) (save-buffer)) 12448 (message "%s" 12449 (concat (format "Pasting port as testbench \"%s(%s)\"...done" 12450 ent-name arch-name) 12451 (and ent-file-name 12452 (format "\n File created: \"%s\"" ent-file-name)) 12453 (and arch-file-name 12454 (format "\n File created: \"%s\"" arch-file-name))))))) 12455 12456 12457;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12458;;; Subprogram interface translation 12459;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12460 12461(defvar vhdl-subprog-list nil 12462 "Variable to hold last subprogram interface parsed.") 12463;; structure: (parenthesized expression means list of such entries) 12464;; (subprog-name kind 12465;; ((names) object direct type init comment group-comment) 12466;; return-type return-comment group-comment) 12467 12468(defvar vhdl-subprog-flattened nil 12469 "Indicates whether an subprogram interface has been flattened.") 12470 12471(defun vhdl-subprog-flatten () 12472 "Flatten interface list so that only one parameter exists per line." 12473 (interactive) 12474 (if (not vhdl-subprog-list) 12475 (error "ERROR: No subprogram interface has been read") 12476 (message "Flattening subprogram interface...") 12477 (let ((old-subprog-list (nth 2 vhdl-subprog-list)) 12478 new-subprog-list old-subprog new-subprog names) 12479 ;; traverse parameter list and flatten entries 12480 (while old-subprog-list 12481 (setq old-subprog (car old-subprog-list)) 12482 (setq names (car old-subprog)) 12483 (while names 12484 (setq new-subprog (cons (list (car names)) (cdr old-subprog))) 12485 (setq new-subprog-list (append new-subprog-list (list new-subprog))) 12486 (setq names (cdr names))) 12487 (setq old-subprog-list (cdr old-subprog-list))) 12488 (setq vhdl-subprog-list 12489 (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) 12490 new-subprog-list (nth 3 vhdl-subprog-list) 12491 (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) 12492 vhdl-subprog-flattened t) 12493 (message "Flattening subprogram interface...done")))) 12494 12495(defun vhdl-subprog-copy () 12496 "Get interface information from a subprogram specification." 12497 (interactive) 12498 (save-excursion 12499 (let (parse-error pos end-of-list 12500 name kind param-list object names direct type init 12501 comment group-comment 12502 return-type return-comment return-group-comment) 12503 (vhdl-prepare-search-2 12504 (setq 12505 parse-error 12506 (catch 'parse 12507 ;; check if within function declaration 12508 (setq pos (point)) 12509 (end-of-line) 12510 (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) 12511 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) 12512 (goto-char (match-end 0)) 12513 (save-excursion (backward-char) 12514 (forward-sexp) 12515 (<= pos (point)))) 12516 (throw 'parse "ERROR: Not within a subprogram specification")) 12517 (setq name (match-string-no-properties 5)) 12518 (setq kind (if (match-string 2) 'procedure 'function)) 12519 (setq end-of-list (not (match-string 7))) 12520 (message "Reading interface of subprogram \"%s\"..." name) 12521 ;; parse parameter list 12522 (setq group-comment (vhdl-parse-group-comment)) 12523 (setq end-of-list (or end-of-list 12524 (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) 12525 (while (not end-of-list) 12526 ;; parse object 12527 (setq object 12528 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t) 12529 (match-string-no-properties 1))) 12530 ;; parse names (accept extended identifiers) 12531 (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") 12532 (setq names (list (match-string-no-properties 1))) 12533 (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) 12534 (setq names (append names (list (match-string-no-properties 1))))) 12535 ;; parse direction 12536 (vhdl-parse-string ":[ \t\n\r\f]*") 12537 (setq direct 12538 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t) 12539 (match-string-no-properties 1))) 12540 ;; parse type 12541 (vhdl-parse-string "\\([^():;\n]+\\)") 12542 (setq type (match-string-no-properties 1)) 12543 (setq comment nil) 12544 (while (looking-at "(") 12545 (setq type 12546 (concat type 12547 (buffer-substring-no-properties 12548 (point) (progn (forward-sexp) (point))) 12549 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 12550 (match-string-no-properties 1))))) 12551 ;; special case: closing parenthesis is on separate line 12552 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 12553 (setq comment (substring type (match-beginning 2))) 12554 (setq type (substring type 0 (match-beginning 1)))) 12555 ;; strip off trailing group-comment 12556 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 12557 (setq type (substring type 0 (match-end 1))) 12558 ;; parse initialization expression 12559 (setq init nil) 12560 (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) 12561 (vhdl-parse-string "\\([^();\n]*\\)") 12562 (setq init (match-string-no-properties 1)) 12563 (while (looking-at "(") 12564 (setq init 12565 (concat init 12566 (buffer-substring-no-properties 12567 (point) (progn (forward-sexp) (point))) 12568 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 12569 (match-string-no-properties 1)))))) 12570 ;; special case: closing parenthesis is on separate line 12571 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 12572 (setq comment (substring init (match-beginning 2))) 12573 (setq init (substring init 0 (match-beginning 1))) 12574 (vhdl-forward-syntactic-ws)) 12575 (skip-chars-forward " \t") 12576 ;; parse inline comment, special case: as above, no initial. 12577 (unless comment 12578 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12579 (match-string-no-properties 1)))) 12580 (vhdl-forward-syntactic-ws) 12581 (setq end-of-list (vhdl-parse-string ")\\s-*" t)) 12582 ;; parse inline comment 12583 (unless comment 12584 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12585 (match-string-no-properties 1)))) 12586 (setq return-group-comment (vhdl-parse-group-comment)) 12587 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") 12588 ;; parse return type 12589 (when (match-string 3) 12590 (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*") 12591 (setq return-type (match-string-no-properties 1)) 12592 (when (and return-type 12593 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) 12594 (setq return-comment (substring return-type (match-beginning 2))) 12595 (setq return-type (substring return-type 0 (match-beginning 1)))) 12596 ;; strip of trailing group-comment 12597 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) 12598 (setq return-type (substring return-type 0 (match-end 1))) 12599 ;; parse return comment 12600 (unless return-comment 12601 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12602 (match-string-no-properties 1))))) 12603 ;; parse inline comment 12604 (unless comment 12605 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 12606 (match-string-no-properties 1)))) 12607 ;; save everything in list 12608 (setq param-list (append param-list 12609 (list (list names object direct type init 12610 comment group-comment)))) 12611 ;; parse group comment and spacing 12612 (setq group-comment (vhdl-parse-group-comment))) 12613 (message "Reading interface of subprogram \"%s\"...done" name) 12614 nil))) 12615 ;; finish parsing 12616 (if parse-error 12617 (error parse-error) 12618 (setq vhdl-subprog-list 12619 (list name kind param-list return-type return-comment 12620 return-group-comment) 12621 vhdl-subprog-flattened nil))))) 12622 12623(defun vhdl-subprog-paste-specification (kind) 12624 "Paste as a subprogram specification." 12625 (indent-according-to-mode) 12626 (let ((margin (current-column)) 12627 (param-list (nth 2 vhdl-subprog-list)) 12628 list-margin start names param) 12629 ;; paste keyword and name 12630 (vhdl-insert-keyword 12631 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) 12632 (insert (nth 0 vhdl-subprog-list)) 12633 (if (not param-list) 12634 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 12635 (setq start (point)) 12636 ;; paste parameter list 12637 (insert " (") 12638 (unless vhdl-argument-list-indent 12639 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12640 (setq list-margin (current-column)) 12641 (while param-list 12642 (setq param (car param-list)) 12643 ;; paste group comment and spacing 12644 (when (memq vhdl-include-group-comments (list kind 'always)) 12645 (vhdl-paste-group-comment (nth 6 param) list-margin)) 12646 ;; paste object 12647 (when (nth 1 param) (insert (nth 1 param) " ")) 12648 ;; paste names 12649 (setq names (nth 0 param)) 12650 (while names 12651 (insert (car names)) 12652 (setq names (cdr names)) 12653 (when names (insert ", "))) 12654 ;; paste direction 12655 (insert " : ") 12656 (when (nth 2 param) (insert (nth 2 param) " ")) 12657 ;; paste type 12658 (insert (nth 3 param)) 12659 ;; paste initialization 12660 (when (nth 4 param) (insert " := " (nth 4 param))) 12661 ;; terminate line 12662 (if (cdr param-list) 12663 (insert ";") 12664 (insert ")") 12665 (when (null (nth 3 vhdl-subprog-list)) 12666 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) 12667 ;; paste comment 12668 (when (and vhdl-include-port-comments (nth 5 param)) 12669 (vhdl-comment-insert-inline (nth 5 param) t)) 12670 (setq param-list (cdr param-list)) 12671 (when param-list (insert "\n") (indent-to list-margin))) 12672 (when (nth 3 vhdl-subprog-list) 12673 (insert "\n") (indent-to list-margin) 12674 ;; paste group comment and spacing 12675 (when (memq vhdl-include-group-comments (list kind 'always)) 12676 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) 12677 ;; paste return type 12678 (insert "return " (nth 3 vhdl-subprog-list)) 12679 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 12680 (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) 12681 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) 12682 ;; align parameter list 12683 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) 12684 ;; paste body 12685 (when (eq kind 'body) 12686 (insert "\n") 12687 (vhdl-template-begin-end 12688 (unless (vhdl-standard-p '87) 12689 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) 12690 (nth 0 vhdl-subprog-list) margin)))) 12691 12692(defun vhdl-subprog-paste-declaration () 12693 "Paste as a subprogram declaration." 12694 (interactive) 12695 (if (not vhdl-subprog-list) 12696 (error "ERROR: No subprogram interface read") 12697 (message "Pasting interface as subprogram declaration \"%s\"..." 12698 (car vhdl-subprog-list)) 12699 ;; paste specification 12700 (vhdl-subprog-paste-specification 'decl) 12701 (message "Pasting interface as subprogram declaration \"%s\"...done" 12702 (car vhdl-subprog-list)))) 12703 12704(defun vhdl-subprog-paste-body () 12705 "Paste as a subprogram body." 12706 (interactive) 12707 (if (not vhdl-subprog-list) 12708 (error "ERROR: No subprogram interface read") 12709 (message "Pasting interface as subprogram body \"%s\"..." 12710 (car vhdl-subprog-list)) 12711 ;; paste specification and body 12712 (vhdl-subprog-paste-specification 'body) 12713 (message "Pasting interface as subprogram body \"%s\"...done" 12714 (car vhdl-subprog-list)))) 12715 12716(defun vhdl-subprog-paste-call () 12717 "Paste as a subprogram call." 12718 (interactive) 12719 (if (not vhdl-subprog-list) 12720 (error "ERROR: No subprogram interface read") 12721 (let ((orig-vhdl-subprog-list vhdl-subprog-list) 12722 param-list margin list-margin param start) 12723 ;; flatten local copy of interface list (must be flat for parameter mapping) 12724 (vhdl-subprog-flatten) 12725 (setq param-list (nth 2 vhdl-subprog-list)) 12726 (indent-according-to-mode) 12727 (setq margin (current-indentation)) 12728 (message "Pasting interface as subprogram call \"%s\"..." 12729 (car vhdl-subprog-list)) 12730 ;; paste name 12731 (insert (nth 0 vhdl-subprog-list)) 12732 (if (not param-list) 12733 (insert ";") 12734 (setq start (point)) 12735 ;; paste parameter list 12736 (insert " (") 12737 (unless vhdl-argument-list-indent 12738 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 12739 (setq list-margin (current-column)) 12740 (while param-list 12741 (setq param (car param-list)) 12742 ;; paste group comment and spacing 12743 (when (eq vhdl-include-group-comments 'always) 12744 (vhdl-paste-group-comment (nth 6 param) list-margin)) 12745 ;; paste formal port 12746 (insert (car (nth 0 param)) " => ") 12747 (setq param-list (cdr param-list)) 12748 (insert (if param-list "," ");")) 12749 ;; paste comment 12750 (when (and vhdl-include-port-comments (nth 5 param)) 12751 (vhdl-comment-insert-inline (nth 5 param))) 12752 (when param-list (insert "\n") (indent-to list-margin))) 12753 ;; align parameter list 12754 (when vhdl-auto-align 12755 (vhdl-align-region-groups start (point) 1))) 12756 (message "Pasting interface as subprogram call \"%s\"...done" 12757 (car vhdl-subprog-list)) 12758 (setq vhdl-subprog-list orig-vhdl-subprog-list)))) 12759 12760 12761;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12762;;; Miscellaneous 12763;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12764 12765;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12766;; Hippie expand customization 12767 12768(defvar vhdl-expand-upper-case nil) 12769 12770(defun vhdl-try-expand-abbrev (old) 12771 "Try expanding abbreviations from `vhdl-abbrev-list'." 12772 (unless old 12773 (he-init-string (he-dabbrev-beg) (point)) 12774 (setq he-expand-list 12775 (let ((abbrev-list vhdl-abbrev-list) 12776 (sel-abbrev-list '())) 12777 (while abbrev-list 12778 (when (or (not (stringp (car abbrev-list))) 12779 (string-match 12780 (concat "^" he-search-string) (car abbrev-list))) 12781 (setq sel-abbrev-list 12782 (cons (car abbrev-list) sel-abbrev-list))) 12783 (setq abbrev-list (cdr abbrev-list))) 12784 (nreverse sel-abbrev-list)))) 12785 (while (and he-expand-list 12786 (or (not (stringp (car he-expand-list))) 12787 (he-string-member (car he-expand-list) he-tried-table t))) 12788 (unless (stringp (car he-expand-list)) 12789 (setq vhdl-expand-upper-case (car he-expand-list))) 12790 (setq he-expand-list (cdr he-expand-list))) 12791 (if (null he-expand-list) 12792 (progn (when old (he-reset-string)) 12793 nil) 12794 (he-substitute-string 12795 (if vhdl-expand-upper-case 12796 (upcase (car he-expand-list)) 12797 (car he-expand-list)) 12798 t) 12799 (setq he-expand-list (cdr he-expand-list)) 12800 t)) 12801 12802(defun vhdl-he-list-beg () 12803 "Also looks at the word before `(' in order to better match parenthesized 12804expressions (e.g. for index ranges of types and signals)." 12805 (save-excursion 12806 (condition-case () 12807 (progn (backward-up-list 1) 12808 (skip-syntax-backward "w_")) ; crashes in `viper-mode' 12809 (error ())) 12810 (point))) 12811 12812;; override `he-list-beg' from `hippie-exp' 12813(unless (and (boundp 'viper-mode) viper-mode) 12814 (defalias 'he-list-beg #'vhdl-he-list-beg)) 12815 12816;; function for expanding abbrevs and dabbrevs 12817(defalias 'vhdl-expand-abbrev (make-hippie-expand-function 12818 '(try-expand-dabbrev 12819 try-expand-dabbrev-all-buffers 12820 vhdl-try-expand-abbrev))) 12821 12822;; function for expanding parenthesis 12823(defalias 'vhdl-expand-paren (make-hippie-expand-function 12824 '(try-expand-list 12825 try-expand-list-all-buffers))) 12826 12827;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12828;; Line handling functions 12829 12830(defun vhdl-current-line () 12831 "Return the line number of the line containing point." 12832 (save-restriction 12833 (widen) 12834 (1+ (count-lines (point-min) (point-at-bol))))) 12835 12836(defun vhdl-line-kill-entire (&optional arg) 12837 "Delete entire line." 12838 (interactive "p") 12839 (beginning-of-line) 12840 (kill-line (or arg 1))) 12841 12842(defun vhdl-line-kill (&optional arg) 12843 "Kill current line." 12844 (interactive "p") 12845 (vhdl-line-kill-entire arg)) 12846 12847(defun vhdl-line-copy (&optional arg) 12848 "Copy current line." 12849 (interactive "p") 12850 (save-excursion 12851 (let ((position (point-at-bol))) 12852 (forward-line (or arg 1)) 12853 (copy-region-as-kill position (point))))) 12854 12855(defun vhdl-line-yank () 12856 "Yank entire line." 12857 (interactive) 12858 (beginning-of-line) 12859 (yank)) 12860 12861(defun vhdl-line-expand (&optional arg) 12862 "Hippie-expand current line." 12863 (interactive "P") 12864 (require 'hippie-exp) 12865 (let ((case-fold-search t) (case-replace nil) 12866 (hippie-expand-try-functions-list 12867 '(try-expand-line try-expand-line-all-buffers))) 12868 (hippie-expand arg))) 12869 12870(defun vhdl-line-transpose-next (&optional arg) 12871 "Interchange this line with next line." 12872 (interactive "p") 12873 (forward-line 1) 12874 (transpose-lines (or arg 1)) 12875 (forward-line -1)) 12876 12877(defun vhdl-line-transpose-previous (&optional arg) 12878 "Interchange this line with previous line." 12879 (interactive "p") 12880 (forward-line 1) 12881 (transpose-lines (- 0 (or arg 0))) 12882 (forward-line -1)) 12883 12884(defun vhdl-line-open () 12885 "Open a new line and indent." 12886 (interactive) 12887 (end-of-line -0) 12888 (newline-and-indent)) 12889 12890(defun vhdl-delete-indentation () 12891 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that 12892it works within comments too." 12893 (interactive) 12894 (let ((fill-prefix "-- ")) 12895 (delete-indentation))) 12896 12897;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12898;; Move functions 12899 12900(defun vhdl-forward-same-indent () 12901 "Move forward to next line with same indent." 12902 (interactive) 12903 (let ((pos (point)) 12904 (indent (current-indentation))) 12905 (beginning-of-line 2) 12906 (while (and (not (eobp)) 12907 (or (looking-at "^\\s-*\\(--.*\\)?$") 12908 (> (current-indentation) indent))) 12909 (beginning-of-line 2)) 12910 (if (= (current-indentation) indent) 12911 (back-to-indentation) 12912 (message "No following line with same indent found in this block") 12913 (goto-char pos) 12914 nil))) 12915 12916(defun vhdl-backward-same-indent () 12917 "Move backward to previous line with same indent." 12918 (interactive) 12919 (let ((pos (point)) 12920 (indent (current-indentation))) 12921 (beginning-of-line -0) 12922 (while (and (not (bobp)) 12923 (or (looking-at "^\\s-*\\(--.*\\)?$") 12924 (> (current-indentation) indent))) 12925 (beginning-of-line -0)) 12926 (if (= (current-indentation) indent) 12927 (back-to-indentation) 12928 (message "No preceding line with same indent found in this block") 12929 (goto-char pos) 12930 nil))) 12931 12932;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12933;; Statistics 12934 12935(defun vhdl-statistics-buffer () 12936 "Get some file statistics." 12937 (interactive) 12938 (let ((no-stats 0) 12939 (no-code-lines 0) 12940 (no-empty-lines 0) 12941 (no-comm-lines 0) 12942 (no-comments 0) 12943 (no-lines (count-lines (point-min) (point-max)))) 12944 (save-excursion 12945 ;; count statements 12946 (goto-char (point-min)) 12947 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) 12948 (if (match-string 1) 12949 (goto-char (match-end 1)) 12950 (setq no-stats (1+ no-stats)))) 12951 ;; count code lines 12952 (goto-char (point-min)) 12953 (while (not (eobp)) 12954 (unless (looking-at "^\\s-*\\(--.*\\)?$") 12955 (setq no-code-lines (1+ no-code-lines))) 12956 (beginning-of-line 2)) 12957 ;; count empty lines 12958 (goto-char (point-min)) 12959 (while (and (re-search-forward "^\\s-*$" nil t) 12960 (not (eq (point) (point-max)))) 12961 (if (match-string 1) 12962 (goto-char (match-end 1)) 12963 (setq no-empty-lines (1+ no-empty-lines)) 12964 (unless (eq (point) (point-max)) 12965 (forward-char)))) 12966 ;; count comment-only lines 12967 (goto-char (point-min)) 12968 (while (re-search-forward "^\\s-*--.*" nil t) 12969 (if (match-string 1) 12970 (goto-char (match-end 1)) 12971 (setq no-comm-lines (1+ no-comm-lines)))) 12972 ;; count comments 12973 (goto-char (point-min)) 12974 (while (re-search-forward "--.*" nil t) 12975 (if (match-string 1) 12976 (goto-char (match-end 1)) 12977 (setq no-comments (1+ no-comments))))) 12978 ;; print results 12979 (message "\n\ 12980File statistics: \"%s\"\n\ 12981-----------------------\n\ 12982# statements : %5d\n\ 12983# code lines : %5d\n\ 12984# empty lines : %5d\n\ 12985# comment lines : %5d\n\ 12986# comments : %5d\n\ 12987# total lines : %5d\n" 12988 (buffer-file-name) no-stats no-code-lines no-empty-lines 12989 no-comm-lines no-comments no-lines) 12990 (when (featurep 'xemacs) (vhdl-show-messages)))) 12991 12992;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12993;; Help functions 12994 12995(defun vhdl-re-search-forward (regexp &optional bound noerror count) 12996 "Like `re-search-forward', but does not match within literals." 12997 (let (pos) 12998 (save-excursion 12999 (while (and (setq pos (re-search-forward regexp bound noerror count)) 13000 (save-match-data (vhdl-in-literal))))) 13001 (when pos (goto-char pos)) 13002 pos)) 13003 13004(defun vhdl-re-search-backward (regexp &optional bound noerror count) 13005 "Like `re-search-backward', but does not match within literals." 13006 (let (pos) 13007 (save-excursion 13008 (while (and (setq pos (re-search-backward regexp bound noerror count)) 13009 (save-match-data (vhdl-in-literal))))) 13010 (when pos (goto-char pos)) 13011 pos)) 13012 13013 13014;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13015;;; Project 13016;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13017 13018(defun vhdl-set-project (name) 13019 "Set current project to NAME." 13020 (interactive 13021 (list (let ((completion-ignore-case t)) 13022 (completing-read "Project name: " vhdl-project-alist nil t)))) 13023 (cond ((equal name "") 13024 (setq vhdl-project nil) 13025 (message "Current VHDL project: None")) 13026 ((assoc name vhdl-project-alist) 13027 (setq vhdl-project name) 13028 (message "Current VHDL project: \"%s\"" name)) 13029 (t 13030 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) 13031 (vhdl-speedbar-update-current-project)) 13032 13033(defun vhdl-set-default-project () 13034 "Set current project as default on startup." 13035 (interactive) 13036 (customize-set-variable 'vhdl-project vhdl-project) 13037 (customize-save-customized)) 13038 13039(defun vhdl-toggle-project (name _token _indent) 13040 "Set current project to NAME or unset if NAME is current project." 13041 (vhdl-set-project (if (equal name vhdl-project) "" name))) 13042 13043(defun vhdl-export-project (file-name) 13044 "Write project setup for current project." 13045 (interactive 13046 (let ((name (vhdl-resolve-env-variable 13047 (vhdl-replace-string 13048 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 13049 (concat (subst-char-in-string 13050 ? ?_ (or (vhdl-project-p) 13051 (error "ERROR: No current project"))) 13052 " " (user-login-name)))))) 13053 (list (read-file-name 13054 "Write project file: " 13055 (when (file-name-absolute-p name) "") nil nil name)))) 13056 (setq file-name (abbreviate-file-name file-name)) 13057 (let ((orig-buffer (current-buffer))) 13058 (unless (file-exists-p (file-name-directory file-name)) 13059 (make-directory (file-name-directory file-name) t)) 13060 (if (not (file-writable-p file-name)) 13061 (error "ERROR: File not writable: \"%s\"" file-name) 13062 (set-buffer (find-file-noselect file-name t t)) 13063 (erase-buffer) 13064 (insert ";; -*- Emacs-Lisp -*-\n\n" 13065 ";;; " (file-name-nondirectory file-name) 13066 " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" 13067 ";; Project : " vhdl-project "\n" 13068 ";; Saved : " (format-time-string "%Y-%m-%d %T ") 13069 (user-login-name) "\n\n\n" 13070 ";; project name\n" 13071 "(setq vhdl-project \"" vhdl-project "\")\n\n" 13072 ";; project setup\n" 13073 "(vhdl-aput 'vhdl-project-alist vhdl-project\n'") 13074 (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer)) 13075 (insert ")\n") 13076 (save-buffer) 13077 (kill-buffer (current-buffer)) 13078 (set-buffer orig-buffer)))) 13079 13080(defun vhdl-import-project (file-name &optional auto not-make-current) 13081 "Read project setup and set current project." 13082 (interactive 13083 (let ((name (vhdl-resolve-env-variable 13084 (vhdl-replace-string 13085 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 13086 (concat "" " " (user-login-name)))))) 13087 (list (read-file-name 13088 "Read project file: " (when (file-name-absolute-p name) "") nil t 13089 (file-name-directory name))))) 13090 (when (file-exists-p file-name) 13091 (condition-case () 13092 (let ((current-project vhdl-project)) 13093 (load-file file-name) 13094 (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project)) 10) 13095 (vhdl-adelete 'vhdl-project-alist vhdl-project) 13096 (error "")) 13097 (if not-make-current 13098 (setq vhdl-project current-project) 13099 (setq vhdl-compiler 13100 (caar (nth 4 (vhdl-aget vhdl-project-alist vhdl-project))))) 13101 (vhdl-update-mode-menu) 13102 (vhdl-speedbar-refresh) 13103 (unless not-make-current 13104 (message "Current VHDL project: \"%s\"; compiler: \"%s\"%s" 13105 vhdl-project vhdl-compiler (if auto " (auto-loaded)" "")))) 13106 (error (vhdl-warning 13107 (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) 13108 13109(defun vhdl-duplicate-project () 13110 "Duplicate setup of current project." 13111 (interactive) 13112 (let ((new-name (read-from-minibuffer "New project name: ")) 13113 (project-entry (vhdl-aget vhdl-project-alist vhdl-project))) 13114 (setq vhdl-project-alist 13115 (append vhdl-project-alist 13116 (list (cons new-name project-entry)))) 13117 (vhdl-update-mode-menu))) 13118 13119(defun vhdl-autoload-project () 13120 "Automatically load project setup at startup." 13121 (let ((file-name-list vhdl-project-file-name) 13122 file-list list-length) 13123 (while file-name-list 13124 (setq file-list 13125 (append file-list 13126 (file-expand-wildcards 13127 (vhdl-resolve-env-variable 13128 (vhdl-replace-string 13129 (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) 13130 (concat "* " (user-login-name))))))) 13131 (setq list-length (or list-length (length file-list))) 13132 (setq file-name-list (cdr file-name-list))) 13133 (while file-list 13134 (vhdl-import-project (expand-file-name (car file-list)) t 13135 (not (> list-length 0))) 13136 (setq list-length (1- list-length)) 13137 (setq file-list (cdr file-list))))) 13138(define-obsolete-function-alias 'vhdl-auto-load-project 13139 #'vhdl-autoload-project "27.1") 13140 13141;; automatically load project setup when idle after startup 13142(when (memq 'startup vhdl-project-autoload) 13143 (if noninteractive 13144 (vhdl-autoload-project) 13145 (vhdl-run-when-idle .1 nil 'vhdl-autoload-project))) 13146 13147 13148;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13149;;; Hideshow 13150;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13151;; (using `hideshow.el') 13152 13153(defconst vhdl-hs-start-regexp 13154 (concat 13155 "\\(^\\)\\s-*\\(" 13156 ;; generic/port clause 13157 "\\(generic\\|port\\)[ \t\n\r\f]*(\\|" 13158 ;; component 13159 "component\\>\\|" 13160 ;; component instantiation 13161 "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*" 13162 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" 13163 "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*" 13164 "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|" 13165 ;; subprogram 13166 "\\(function\\|procedure\\)\\>\\|" 13167 ;; process, block 13168 "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|" 13169 ;; configuration declaration 13170 "configuration\\>" 13171 "\\)") 13172 "Regexp to match start of construct to hide.") 13173 13174(defun vhdl-hs-forward-sexp-func (count) 13175 "Find end of construct to hide (for hideshow). Only search forward." 13176 (let ((pos (point))) 13177 (vhdl-prepare-search-2 13178 (beginning-of-line) 13179 (cond 13180 ;; generic/port clause 13181 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(") 13182 (goto-char (match-end 0)) 13183 (backward-char) 13184 (forward-sexp)) 13185 ;; component declaration 13186 ((looking-at "^\\s-*component\\>") 13187 (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) 13188 ;; component instantiation 13189 ((looking-at 13190 (concat 13191 "^\\s-*\\w+\\s-*:[ \t\n\r\f]*" 13192 "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" 13193 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*" 13194 "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*(")) 13195 (goto-char (match-end 0)) 13196 (backward-char) 13197 (forward-sexp) 13198 (setq pos (point)) 13199 (vhdl-forward-syntactic-ws) 13200 (when (looking-at "port\\s-+map[ \t\n\r\f]*(") 13201 (goto-char (match-end 0)) 13202 (backward-char) 13203 (forward-sexp) 13204 (setq pos (point))) 13205 (goto-char pos)) 13206 ;; subprogram declaration/body 13207 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") 13208 (goto-char (match-end 0)) 13209 (vhdl-forward-syntactic-ws) 13210 (when (looking-at "(") 13211 (forward-sexp)) 13212 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) 13213 (vhdl-in-literal))) 13214 ;; subprogram body 13215 (when (match-string 2) 13216 (re-search-forward "^\\s-*\\<begin\\>" nil t) 13217 (backward-word-strictly 1) 13218 (vhdl-forward-sexp))) 13219 ;; block (recursive) 13220 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") 13221 (goto-char (match-end 0)) 13222 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) 13223 (match-beginning 2)) 13224 (vhdl-hs-forward-sexp-func count))) 13225 ;; process 13226 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") 13227 (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 13228 ;; configuration declaration 13229 ((looking-at "^\\s-*configuration\\>") 13230 (forward-word-strictly 4) 13231 (vhdl-forward-sexp)) 13232 (t (goto-char pos)))))) 13233 13234(defun vhdl-hideshow-init () 13235 "Initialize `hideshow'." 13236 (when vhdl-hideshow-menu 13237 (vhdl-hs-minor-mode 1))) 13238 13239(defun vhdl-hs-minor-mode (&optional arg) 13240 "Toggle hideshow minor mode and update menu bar." 13241 (interactive "P") 13242 (require 'hideshow) 13243 (declare-function hs-hide-all "hideshow" ()) 13244 ;; check for hideshow version 5.x 13245 (if (not (boundp 'hs-block-start-mdata-select)) 13246 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") 13247 ;; initialize hideshow 13248 (unless (assoc 'vhdl-mode hs-special-modes-alist) 13249 (setq hs-special-modes-alist 13250 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" 13251 'vhdl-hs-forward-sexp-func nil) 13252 hs-special-modes-alist))) 13253 (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) 13254 (if vhdl-hide-all-init 13255 (add-hook 'hs-minor-mode-hook #'hs-hide-all nil t) 13256 (remove-hook 'hs-minor-mode-hook #'hs-hide-all t)) 13257 (hs-minor-mode arg) 13258 (force-mode-line-update))) ; hack to update menu bar 13259 13260 13261;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13262;;; Font locking 13263;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13264;; (using `font-lock.el') 13265 13266;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13267;; Help functions 13268 13269(defun vhdl-within-translate-off () 13270 "Return point if within translate-off region, else nil." 13271 (and (save-excursion 13272 (re-search-backward 13273 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) 13274 (equal "off" (match-string 1)) 13275 (point))) 13276 13277(defun vhdl-start-translate-off (limit) 13278 "Return point before translate-off pragma if before LIMIT, else nil." 13279 (when (re-search-forward 13280 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) 13281 (match-beginning 0))) 13282 13283(defun vhdl-end-translate-off (limit) 13284 "Return point after translate-on pragma if before LIMIT, else nil." 13285 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) 13286 13287(defun vhdl-match-translate-off (limit) 13288 "Match a translate-off block, setting match-data and returning t, else nil." 13289 (when (< (point) limit) 13290 (let ((start (or (vhdl-within-translate-off) 13291 (vhdl-start-translate-off limit))) 13292 (case-fold-search t)) 13293 (when start 13294 (let ((end (or (vhdl-end-translate-off limit) limit))) 13295 (set-match-data (list start end)) 13296 (goto-char end)))))) 13297 13298(defun vhdl-font-lock-match-item (limit) 13299 "Match, and move over, any declaration item after point. 13300Adapted from 13301`font-lock-match-c-style-declaration-item-and-skip-to-next'." 13302 (condition-case nil 13303 (save-restriction 13304 (narrow-to-region (point-min) limit) 13305 ;; match item 13306 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") 13307 (save-match-data 13308 (goto-char (match-end 1)) 13309 ;; move to next item 13310 (if (looking-at "\\(\\s-*,\\)") 13311 (goto-char (match-end 1)) 13312 (end-of-line) t)))) 13313 (error t))) 13314 13315;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13316;; Syntax definitions 13317 13318(defconst vhdl-font-lock-syntactic-keywords 13319 '(("\\('\\).\\('\\)" (1 (7 . ?\')) (2 (7 . ?\')))) 13320 "Mark single quotes as having string quote syntax in `c' instances.") 13321 13322(defvar vhdl-font-lock-keywords nil 13323 "Regular expressions to highlight in VHDL Mode.") 13324 13325(defvar vhdl-font-lock-keywords-0 nil 13326 ;; set in `vhdl-font-lock-init' because dependent on user options 13327 "For consideration as a value of `vhdl-font-lock-keywords'. 13328This does highlighting of template prompts and directives (pragmas).") 13329 13330(defvar vhdl-font-lock-keywords-1 nil 13331 ;; set in `vhdl-font-lock-init' because dependent on user options 13332 "For consideration as a value of `vhdl-font-lock-keywords'. 13333This does highlighting of keywords and standard identifiers.") 13334 13335(defconst vhdl-font-lock-keywords-2 13336 (list 13337 ;; highlight names of units, subprograms, and components when declared 13338 (list 13339 (concat 13340 "^\\s-*\\(" 13341 "architecture\\|configuration\\|context\\|entity\\|package" 13342 "\\(\\s-+body\\)?\\|" 13343 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" 13344 "\\)\\s-+\\(\\w+\\)") 13345 5 'font-lock-function-name-face) 13346 13347 ;; highlight entity names of architectures and configurations 13348 (list 13349 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" 13350 2 'font-lock-function-name-face) 13351 13352 ;; highlight labels of common constructs 13353 (list 13354 (concat 13355 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\(" 13356 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" 13357 "postponed\\|process\\|" 13358 (when (vhdl-standard-p 'ams) "procedural\\|") 13359 "with\\|while" 13360 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") 13361 1 'font-lock-function-name-face) 13362 13363 ;; highlight label and component name of component instantiations 13364 (list 13365 (concat 13366 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*" 13367 "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>") 13368 '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) 13369 13370 ;; highlight label and instantiated unit of component instantiations 13371 (list 13372 (concat 13373 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*" 13374 "\\(component\\|configuration\\|entity\\)\\s-+" 13375 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") 13376 '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) 13377 '(5 font-lock-function-name-face nil t) 13378 '(7 font-lock-function-name-face nil t)) 13379 13380 ;; highlight names and labels at end of constructs 13381 (list 13382 (concat 13383 "^\\s-*end\\s-+\\(\\(" 13384 "architecture\\|block\\|case\\|component\\|configuration\\|context\\|" 13385 "entity\\|for\\|function\\|generate\\|if\\|loop\\|package" 13386 "\\(\\s-+body\\)?\\|procedure\\|\\(postponed\\s-+\\)?process\\|" 13387 (when (vhdl-standard-p 'ams) "procedural\\|") 13388 "units" 13389 "\\)\\s-+\\)?\\(\\w*\\)") 13390 5 'font-lock-function-name-face) 13391 13392 ;; highlight labels in exit and next statements 13393 (list 13394 (concat 13395 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") 13396 3 'font-lock-function-name-face) 13397 13398 ;; highlight entity name in attribute specifications 13399 (list 13400 (concat 13401 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") 13402 1 'font-lock-function-name-face) 13403 13404 ;; highlight labels in block and component specifications 13405 (list 13406 (concat 13407 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" 13408 "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)") 13409 '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) 13410 13411 ;; highlight names in library clauses 13412 (list "^\\s-*library\\>" 13413 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) 13414 13415 ;; highlight names in use clauses 13416 (list 13417 (concat 13418 "\\<\\(context\\|use\\)\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" 13419 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") 13420 '(4 font-lock-function-name-face) '(6 font-lock-function-name-face nil t) 13421 '(8 font-lock-function-name-face nil t)) 13422 13423 ;; highlight attribute name in attribute declarations/specifications 13424 (list 13425 (concat 13426 "^\\s-*attribute\\s-+\\(\\w+\\)") 13427 1 'vhdl-font-lock-attribute-face) 13428 13429 ;; highlight type/nature name in (sub)type/(sub)nature declarations 13430 (list 13431 (concat 13432 "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)") 13433 5 'font-lock-type-face) 13434 13435 ;; highlight signal/variable/constant declaration names 13436 (list "\\(:[^=]\\)" 13437 '(vhdl-font-lock-match-item 13438 (progn (goto-char (match-beginning 1)) 13439 (skip-syntax-backward " ") 13440 (skip-syntax-backward "w_") 13441 (skip-syntax-backward " ") 13442 (while (= (preceding-char) ?,) 13443 (backward-char 1) 13444 (skip-syntax-backward " ") 13445 (skip-syntax-backward "w_") 13446 (skip-syntax-backward " "))) 13447 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 13448 13449 ;; highlight formal parameters in component instantiations and subprogram 13450 ;; calls 13451 (list "\\(=>\\)" 13452 '(vhdl-font-lock-match-item 13453 (progn (goto-char (match-beginning 1)) 13454 (skip-syntax-backward " ") 13455 (while (= (preceding-char) ?\)) (backward-sexp)) 13456 (skip-syntax-backward "w_") 13457 (skip-syntax-backward " ") 13458 (when (memq (preceding-char) '(?n ?N ?|)) 13459 (goto-char (point-max)))) 13460 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 13461 13462 ;; highlight alias/group/quantity declaration names and for-loop/-generate 13463 ;; variables 13464 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" 13465 '(vhdl-font-lock-match-item 13466 (progn (goto-char (match-end 1)) (match-beginning 2)) 13467 nil (1 font-lock-variable-name-face))) 13468 13469 ;; highlight tool directives 13470 (list 13471 (concat 13472 "^\\s-*\\(`\\w+\\)") 13473 1 'font-lock-preprocessor-face) 13474 ) 13475 "For consideration as a value of `vhdl-font-lock-keywords'. 13476This does context sensitive highlighting of names and labels.") 13477 13478(defvar vhdl-font-lock-keywords-3 nil 13479 ;; set in `vhdl-font-lock-init' because dependent on user options 13480 "For consideration as a value of `vhdl-font-lock-keywords'. 13481This does highlighting of words with special syntax.") 13482 13483(defvar vhdl-font-lock-keywords-4 nil 13484 ;; set in `vhdl-font-lock-init' because dependent on user options 13485 "For consideration as a value of `vhdl-font-lock-keywords'. 13486This does highlighting of additional reserved words.") 13487 13488(defconst vhdl-font-lock-keywords-5 13489 ;; background highlight translate-off regions 13490 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) 13491 "For consideration as a value of `vhdl-font-lock-keywords'. 13492This does background highlighting of translate-off regions.") 13493 13494;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13495;; Font and color definitions 13496 13497(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face 13498 "Face name to use for prompts.") 13499 13500(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face 13501 "Face name to use for standardized attributes.") 13502 13503(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face 13504 "Face name to use for standardized enumeration values.") 13505 13506(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face 13507 "Face name to use for standardized functions and packages.") 13508 13509(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face 13510 "Face name to use for directives.") 13511 13512(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face 13513 "Face name to use for additional reserved words.") 13514 13515(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face 13516 "Face name to use for translate-off regions.") 13517 13518;; face names to use for words with special syntax. 13519(let ((syntax-alist vhdl-special-syntax-alist) 13520 name) 13521 (while syntax-alist 13522 (setq name (vhdl-function-name 13523 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 13524 ;; FIXME: This `defvar' shouldn't be needed: just quote the face 13525 ;; name when you use it. 13526 (eval `(defvar ,name ',name 13527 ,(concat "Face name to use for " 13528 (nth 0 (car syntax-alist)) "."))) 13529 (setq syntax-alist (cdr syntax-alist)))) 13530 13531(defgroup vhdl-highlight-faces nil 13532 "Faces for highlighting." 13533 :group 'vhdl-highlight) 13534 13535;; add faces used from `font-lock' 13536(custom-add-to-group 13537 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) 13538(custom-add-to-group 13539 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) 13540(custom-add-to-group 13541 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) 13542(custom-add-to-group 13543 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) 13544(custom-add-to-group 13545 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) 13546(custom-add-to-group 13547 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) 13548 13549(defface vhdl-font-lock-prompt-face 13550 '((((min-colors 88) (class color) (background light)) 13551 (:foreground "Red1" :bold t)) 13552 (((class color) (background light)) (:foreground "Red" :bold t)) 13553 (((class color) (background dark)) (:foreground "Pink" :bold t)) 13554 (t (:inverse-video t))) 13555 "Font lock mode face used to highlight prompts." 13556 :group 'vhdl-highlight-faces) 13557 13558(defface vhdl-font-lock-attribute-face 13559 '((((class color) (background light)) (:foreground "Orchid")) 13560 (((class color) (background dark)) (:foreground "LightSteelBlue")) 13561 (t (:italic t :bold t))) 13562 "Font lock mode face used to highlight standardized attributes." 13563 :group 'vhdl-highlight-faces) 13564 13565(defface vhdl-font-lock-enumvalue-face 13566 '((((class color) (background light)) (:foreground "SaddleBrown")) 13567 (((class color) (background dark)) (:foreground "BurlyWood")) 13568 (t (:italic t :bold t))) 13569 "Font lock mode face used to highlight standardized enumeration values." 13570 :group 'vhdl-highlight-faces) 13571 13572(defface vhdl-font-lock-function-face 13573 '((((class color) (background light)) (:foreground "Cyan4")) 13574 (((class color) (background dark)) (:foreground "Orchid1")) 13575 (t (:italic t :bold t))) 13576 "Font lock mode face used to highlight standardized functions and packages." 13577 :group 'vhdl-highlight-faces) 13578 13579(defface vhdl-font-lock-directive-face 13580 '((((class color) (background light)) (:foreground "CadetBlue")) 13581 (((class color) (background dark)) (:foreground "Aquamarine")) 13582 (t (:italic t :bold t))) 13583 "Font lock mode face used to highlight directives." 13584 :group 'vhdl-highlight-faces) 13585 13586(defface vhdl-font-lock-reserved-words-face 13587 '((((class color) (background light)) (:foreground "Orange" :bold t)) 13588 (((min-colors 88) (class color) (background dark)) 13589 (:foreground "Yellow1" :bold t)) 13590 (((class color) (background dark)) (:foreground "Yellow" :bold t)) 13591 (t ())) 13592 "Font lock mode face used to highlight additional reserved words." 13593 :group 'vhdl-highlight-faces) 13594 13595(defface vhdl-font-lock-translate-off-face 13596 '((((class color) (background light)) (:background "LightGray")) 13597 (((class color) (background dark)) (:background "DimGray")) 13598 (t ())) 13599 "Font lock mode face used to background highlight translate-off regions." 13600 :group 'vhdl-highlight-faces) 13601 13602;; font lock mode faces used to highlight words with special syntax. 13603(let ((syntax-alist vhdl-special-syntax-alist)) 13604 (while syntax-alist 13605 (eval `(defface ,(vhdl-function-name 13606 "vhdl-font-lock" (caar syntax-alist) "face") 13607 '((((class color) (background light)) 13608 (:foreground ,(nth 2 (car syntax-alist)))) 13609 (((class color) (background dark)) 13610 (:foreground ,(nth 3 (car syntax-alist)))) 13611 (t ())) 13612 ,(concat "Font lock mode face used to highlight " 13613 (nth 0 (car syntax-alist)) ".") 13614 :group 'vhdl-highlight-faces)) 13615 (setq syntax-alist (cdr syntax-alist)))) 13616 13617;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13618;; Font lock initialization 13619 13620(defun vhdl-font-lock-init () 13621 "Initialize fontification." 13622 ;; highlight template prompts and directives 13623 (setq vhdl-font-lock-keywords-0 13624 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" 13625 vhdl-template-prompt-syntax ">\\)") 13626 2 'vhdl-font-lock-prompt-face t) 13627 (list (concat "--\\s-*" 13628 "\\<" 13629 (regexp-opt vhdl-directive-keywords t) 13630 "\\>" 13631 "\\s-+\\(.*\\)$") 13632 2 'vhdl-font-lock-directive-face t) 13633 ;; highlight c-preprocessor directives 13634 (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" 13635 '(1 font-lock-builtin-face) 13636 '(3 font-lock-variable-name-face nil t)))) 13637 ;; highlight keywords and standardized types, attributes, enumeration 13638 ;; values, and subprograms 13639 (setq vhdl-font-lock-keywords-1 13640 (list 13641 (list (concat "'" vhdl-attributes-regexp) 13642 1 'vhdl-font-lock-attribute-face) 13643 (list vhdl-types-regexp 1 'font-lock-type-face) 13644 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) 13645 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) 13646 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) 13647 (list vhdl-constants-regexp 1 'font-lock-constant-face) 13648 (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) 13649 ;; highlight words with special syntax. 13650 (setq vhdl-font-lock-keywords-3 13651 (let ((syntax-alist vhdl-special-syntax-alist) 13652 keywords) 13653 (while syntax-alist 13654 (setq keywords 13655 (cons 13656 (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1 13657 (vhdl-function-name 13658 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face") 13659 (nth 4 (car syntax-alist))) 13660 keywords)) 13661 (setq syntax-alist (cdr syntax-alist))) 13662 keywords)) 13663 ;; highlight additional reserved words 13664 (setq vhdl-font-lock-keywords-4 13665 (list (list vhdl-reserved-words-regexp 1 13666 'vhdl-font-lock-reserved-words-face))) 13667 ;; highlight everything together 13668 (setq vhdl-font-lock-keywords 13669 (append 13670 vhdl-font-lock-keywords-0 13671 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) 13672 (when (or vhdl-highlight-forbidden-words 13673 vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) 13674 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) 13675 (when vhdl-highlight-names vhdl-font-lock-keywords-2) 13676 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) 13677 13678;; initialize fontification for VHDL Mode 13679(vhdl-font-lock-init) 13680 13681(defun vhdl-fontify-buffer () 13682 "Re-initialize fontification and fontify buffer." 13683 (interactive) 13684 (setq font-lock-defaults 13685 `(vhdl-font-lock-keywords 13686 nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) 13687 beginning-of-line)) 13688 (when (fboundp 'font-lock-unset-defaults) 13689 (font-lock-unset-defaults)) ; not implemented in XEmacs 13690 (font-lock-set-defaults) 13691 (font-lock-mode nil) 13692 (font-lock-mode t)) 13693 13694;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13695;; Initialization for PostScript printing 13696 13697(defun vhdl-ps-print-settings () 13698 "Initialize custom face and page settings for PostScript printing." 13699 ;; define custom face settings 13700 (unless (or (not vhdl-print-customize-faces) 13701 ps-print-color-p) 13702 (set (make-local-variable 'ps-bold-faces) 13703 '(font-lock-keyword-face 13704 font-lock-type-face 13705 vhdl-font-lock-attribute-face 13706 vhdl-font-lock-enumvalue-face 13707 vhdl-font-lock-directive-face)) 13708 (set (make-local-variable 'ps-italic-faces) 13709 '(font-lock-comment-face 13710 font-lock-function-name-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-underlined-faces) 13716 '(font-lock-string-face)) 13717 (setq ps-always-build-face-reference t)) 13718 ;; define page settings, so that a line containing 79 characters (default) 13719 ;; fits into one column 13720 (when vhdl-print-two-column 13721 (set (make-local-variable 'ps-landscape-mode) t) 13722 (set (make-local-variable 'ps-number-of-columns) 2) 13723 (set (make-local-variable 'ps-font-size) 7.0) 13724 (set (make-local-variable 'ps-header-title-font-size) 10.0) 13725 (set (make-local-variable 'ps-header-font-size) 9.0) 13726 (set (make-local-variable 'ps-header-offset) 12.0) 13727 (when (eq ps-paper-type 'letter) 13728 (set (make-local-variable 'ps-inter-column) 40.0) 13729 (set (make-local-variable 'ps-left-margin) 40.0) 13730 (set (make-local-variable 'ps-right-margin) 40.0)))) 13731 13732(defun vhdl-ps-print-init () 13733 "Initialize PostScript printing." 13734 (if (featurep 'xemacs) 13735 (when (boundp 'ps-print-color-p) 13736 (vhdl-ps-print-settings)) 13737 (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) 13738 (add-hook 'ps-print-hook #'vhdl-ps-print-settings nil t))) 13739 13740 13741;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13742;;; Hierarchy browser (using `speedbar.el') 13743;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13744;; Allows displaying the hierarchy of all VHDL design units contained in a 13745;; directory by using the speedbar. 13746 13747;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13748;; Variables 13749 13750(defvar vhdl-entity-alist nil 13751 "Cache with entities and corresponding architectures for each project/directory.") 13752;; structure: (parenthesized expression means list of such entries) 13753;; (cache-key 13754;; (ent-key ent-name ent-file ent-line 13755;; (arch-key arch-name arch-file arch-line 13756;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key 13757;; inst-arch-key inst-conf-key inst-lib-key inst-path) 13758;; (lib-name pack-key)) 13759;; mra-key (lib-name pack-key)) 13760 13761(defvar vhdl-config-alist nil 13762 "Cache with configurations for each project/directory.") 13763;; structure: (parenthesized expression means list of such entries) 13764;; (cache-key 13765;; (conf-key conf-name conf-file conf-line ent-key arch-key 13766;; (inst-key inst-comp-name inst-ent-key inst-arch-key 13767;; inst-conf-key inst-lib-key) 13768;; (lib-name pack-key))) 13769 13770(defvar vhdl-package-alist nil 13771 "Cache with packages for each project/directory.") 13772;; structure: (parenthesized expression means list of such entries) 13773;; (cache-key 13774;; (pack-key pack-name pack-file pack-line 13775;; (comp-key comp-name comp-file comp-line) 13776;; (func-key func-name func-file func-line) 13777;; (lib-name pack-key) 13778;; pack-body-file pack-body-line 13779;; (func-key func-name func-body-file func-body-line) 13780;; (lib-name pack-key))) 13781 13782(defvar vhdl-ent-inst-alist nil 13783 "Cache with instantiated entities for each project/directory.") 13784;; structure: (parenthesized expression means list of such entries) 13785;; (cache-key (inst-ent-key)) 13786 13787(defvar vhdl-file-alist nil 13788 "Cache with design units in each file for each project/directory.") 13789;; structure: (parenthesized expression means list of such entries) 13790;; (cache-key 13791;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) 13792;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) 13793 13794(defvar vhdl-directory-alist nil 13795 "Cache with source directories for each project.") 13796;; structure: (parenthesized expression means list of such entries) 13797;; (cache-key (directory)) 13798 13799(defvar vhdl-speedbar-shown-unit-alist nil 13800 "Alist of design units simultaneously open in the current speedbar for each 13801directory and project.") 13802 13803(defvar vhdl-speedbar-shown-project-list nil 13804 "List of projects simultaneously open in the current speedbar.") 13805 13806(defvar vhdl-updated-project-list nil 13807 "List of projects and directories with updated files.") 13808 13809(defvar vhdl-modified-file-list nil 13810 "List of modified files to be rescanned for hierarchy updating.") 13811 13812(defvar vhdl-speedbar-hierarchy-depth 0 13813 "Depth of instantiation hierarchy to display.") 13814 13815(defvar vhdl-speedbar-show-projects nil 13816 "Non-nil means project hierarchy is displayed in speedbar, directory 13817hierarchy otherwise.") 13818 13819(defun vhdl-get-end-of-unit () 13820 "Return position of end of current unit." 13821 (let ((pos (point))) 13822 (save-excursion 13823 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil 1) 13824 (save-excursion 13825 (goto-char (match-beginning 0)) 13826 (vhdl-backward-syntactic-ws) 13827 (and (/= (preceding-char) ?\;) (not (bobp)))))) 13828 (re-search-backward "^[ \t]*end\\>" pos 1) 13829 (point)))) 13830 13831(defun vhdl-match-string-downcase (num &optional string) 13832 "Like `match-string-no-properties' with down-casing." 13833 (let ((match (match-string-no-properties num string))) 13834 (and match (downcase match)))) 13835 13836 13837;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13838;; Scan functions 13839 13840(defun vhdl-scan-context-clause () 13841 "Scan the context clause that precedes a design unit." 13842 (let (lib-alist) 13843 (save-excursion 13844 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|context\\|entity\\|package\\)\\>" nil t) 13845 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) 13846 (equal "USE" (upcase (match-string 1)))) 13847 (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") 13848 (push (cons (match-string-no-properties 1) 13849 (vhdl-match-string-downcase 2)) 13850 lib-alist))))) 13851 lib-alist)) 13852 13853(defun vhdl-scan-directory-contents (name &optional project update num-string 13854 non-final) 13855 "Scan contents of VHDL files in directory or file pattern NAME." 13856 (string-match "\\(.*[/\\]\\)\\(.*\\)" name) 13857 (let* ((dir-name (match-string 1 name)) 13858 (file-pattern (match-string 2 name)) 13859 (is-directory (= 0 (length file-pattern))) 13860 (file-list 13861 (if update 13862 (list name) 13863 (if is-directory 13864 (vhdl-get-source-files t dir-name) 13865 (vhdl-directory-files 13866 dir-name t (wildcard-to-regexp file-pattern))))) 13867 (key (or project dir-name)) 13868 (file-exclude-regexp 13869 (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) 13870 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) 13871 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) 13872 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) 13873 ent-alist conf-alist pack-alist ent-inst-list file-alist 13874 tmp-list tmp-entry no-files files-exist big-files) 13875 (when (or project update) 13876 (setq ent-alist (vhdl-aget vhdl-entity-alist key) 13877 conf-alist (vhdl-aget vhdl-config-alist key) 13878 pack-alist (vhdl-aget vhdl-package-alist key) 13879 ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key)) 13880 file-alist (vhdl-aget vhdl-file-alist key))) 13881 (when (and (not is-directory) (null file-list)) 13882 (message "No such file: \"%s\"" name)) 13883 (setq files-exist file-list) 13884 (when file-list 13885 (setq no-files (length file-list)) 13886 (message "Scanning %s %s\"%s\"..." 13887 (if is-directory "directory" "files") (or num-string "") name) 13888 ;; exclude files 13889 (unless (equal file-exclude-regexp "") 13890 (let ((case-fold-search nil) 13891 file-tmp-list) 13892 (while file-list 13893 (unless (string-match file-exclude-regexp (car file-list)) 13894 (push (car file-list) file-tmp-list)) 13895 (setq file-list (cdr file-list))) 13896 (setq file-list (nreverse file-tmp-list)))) 13897 ;; do for all files 13898 (while file-list 13899 (unless noninteractive 13900 (message "Scanning %s %s\"%s\"... (%2d%%)" 13901 (if is-directory "directory" "files") 13902 (or num-string "") name 13903 (floor (* 100.0 (- no-files (length file-list))) no-files))) 13904 (let ((file-name (abbreviate-file-name (car file-list))) 13905 ent-list arch-list arch-ent-list conf-list 13906 pack-list pack-body-list inst-list inst-ent-list) 13907 ;; scan file 13908 (vhdl-visit-file 13909 file-name nil 13910 (vhdl-prepare-search-2 13911 (save-excursion 13912 ;; scan for design units 13913 (if (and limit-design-file-size 13914 (< limit-design-file-size (buffer-size))) 13915 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) 13916 (setq big-files t)) 13917 ;; scan for entities 13918 (goto-char (point-min)) 13919 (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 13920 (let* ((ent-name (match-string-no-properties 1)) 13921 (ent-key (downcase ent-name)) 13922 (ent-entry (vhdl-aget ent-alist ent-key)) 13923 (lib-alist (vhdl-scan-context-clause))) 13924 (if (nth 1 ent-entry) 13925 (vhdl-warning-when-idle 13926 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13927 ent-name (nth 1 ent-entry) (nth 2 ent-entry) 13928 file-name (vhdl-current-line)) 13929 (push ent-key ent-list) 13930 (vhdl-aput 'ent-alist ent-key 13931 (list ent-name file-name (vhdl-current-line) 13932 (nth 3 ent-entry) (nth 4 ent-entry) 13933 lib-alist))))) 13934 ;; scan for architectures 13935 (goto-char (point-min)) 13936 (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) 13937 (let* ((arch-name (match-string-no-properties 1)) 13938 (arch-key (downcase arch-name)) 13939 (ent-name (match-string-no-properties 2)) 13940 (ent-key (downcase ent-name)) 13941 (ent-entry (vhdl-aget ent-alist ent-key)) 13942 (arch-alist (nth 3 ent-entry)) 13943 (arch-entry (vhdl-aget arch-alist arch-key)) 13944 (lib-arch-alist (vhdl-scan-context-clause))) 13945 (if arch-entry 13946 (vhdl-warning-when-idle 13947 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13948 arch-name ent-name (nth 1 arch-entry) 13949 (nth 2 arch-entry) file-name (vhdl-current-line)) 13950 (setq arch-list (cons arch-key arch-list) 13951 arch-ent-list (cons ent-key arch-ent-list)) 13952 (vhdl-aput 'arch-alist arch-key 13953 (list arch-name file-name (vhdl-current-line) 13954 nil lib-arch-alist)) 13955 (vhdl-aput 'ent-alist ent-key 13956 (list (or (nth 0 ent-entry) ent-name) 13957 (nth 1 ent-entry) (nth 2 ent-entry) 13958 (vhdl-sort-alist arch-alist) 13959 arch-key (nth 5 ent-entry)))))) 13960 ;; scan for configurations 13961 (goto-char (point-min)) 13962 (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) 13963 (let* ((conf-name (match-string-no-properties 1)) 13964 (conf-key (downcase conf-name)) 13965 (conf-entry (vhdl-aget conf-alist conf-key)) 13966 (ent-name (match-string-no-properties 2)) 13967 (ent-key (downcase ent-name)) 13968 (lib-alist (vhdl-scan-context-clause)) 13969 (conf-line (vhdl-current-line)) 13970 (end-of-unit (vhdl-get-end-of-unit)) 13971 arch-key comp-conf-list inst-key-list 13972 inst-comp-key inst-ent-key inst-arch-key 13973 inst-conf-key inst-lib-key) 13974 (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)") 13975 (setq arch-key (vhdl-match-string-downcase 1))) 13976 (if conf-entry 13977 (vhdl-warning-when-idle 13978 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13979 conf-name ent-name (nth 1 conf-entry) 13980 (nth 2 conf-entry) file-name conf-line) 13981 (push conf-key conf-list) 13982 ;; scan for subconfigurations and subentities 13983 (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) 13984 (setq inst-comp-key (vhdl-match-string-downcase 3) 13985 inst-key-list (split-string 13986 (vhdl-match-string-downcase 1) 13987 "[ \t\n\r\f]*,[ \t\n\r\f]*")) 13988 (vhdl-forward-syntactic-ws) 13989 (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?") 13990 (setq 13991 inst-lib-key (vhdl-match-string-downcase 3) 13992 inst-ent-key (and (match-string 2) 13993 (vhdl-match-string-downcase 4)) 13994 inst-arch-key (and (match-string 2) 13995 (vhdl-match-string-downcase 6)) 13996 inst-conf-key (and (not (match-string 2)) 13997 (vhdl-match-string-downcase 4))) 13998 (while inst-key-list 13999 (setq comp-conf-list 14000 (cons (list (car inst-key-list) 14001 inst-comp-key inst-ent-key 14002 inst-arch-key inst-conf-key 14003 inst-lib-key) 14004 comp-conf-list)) 14005 (setq inst-key-list (cdr inst-key-list))))) 14006 (vhdl-aput 'conf-alist conf-key 14007 (list conf-name file-name conf-line ent-key 14008 arch-key comp-conf-list lib-alist))))) 14009 ;; scan for packages 14010 (goto-char (point-min)) 14011 (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) 14012 (let* ((pack-name (match-string-no-properties 2)) 14013 (pack-key (downcase pack-name)) 14014 (is-body (match-string-no-properties 1)) 14015 (pack-entry (vhdl-aget pack-alist pack-key)) 14016 (pack-line (vhdl-current-line)) 14017 (end-of-unit (vhdl-get-end-of-unit)) 14018 comp-name func-name comp-alist func-alist lib-alist) 14019 (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 14020 (vhdl-warning-when-idle 14021 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 14022 (if is-body " body" "") pack-name 14023 (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 14024 (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) 14025 file-name (vhdl-current-line)) 14026 ;; scan for context clauses 14027 (setq lib-alist (vhdl-scan-context-clause)) 14028 ;; scan for component and subprogram declarations/bodies 14029 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t) 14030 (if (equal (upcase (match-string 1)) "COMPONENT") 14031 (setq comp-name (match-string-no-properties 2) 14032 comp-alist 14033 (cons (list (downcase comp-name) comp-name 14034 file-name (vhdl-current-line)) 14035 comp-alist)) 14036 (setq func-name (match-string-no-properties 2) 14037 func-alist 14038 (cons (list (downcase func-name) func-name 14039 file-name (vhdl-current-line)) 14040 func-alist)))) 14041 (setq func-alist (nreverse func-alist)) 14042 (setq comp-alist (nreverse comp-alist)) 14043 (if is-body 14044 (push pack-key pack-body-list) 14045 (push pack-key pack-list)) 14046 (vhdl-aput 14047 'pack-alist pack-key 14048 (if is-body 14049 (list (or (nth 0 pack-entry) pack-name) 14050 (nth 1 pack-entry) (nth 2 pack-entry) 14051 (nth 3 pack-entry) (nth 4 pack-entry) 14052 (nth 5 pack-entry) 14053 file-name pack-line func-alist lib-alist) 14054 (list pack-name file-name pack-line 14055 comp-alist func-alist lib-alist 14056 (nth 6 pack-entry) (nth 7 pack-entry) 14057 (nth 8 pack-entry) (nth 9 pack-entry)))))))) 14058 ;; scan for hierarchy 14059 (if (and limit-hier-file-size 14060 (< limit-hier-file-size (buffer-size))) 14061 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) 14062 (setq big-files t)) 14063 ;; scan for architectures 14064 (goto-char (point-min)) 14065 (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) 14066 (let* ((ent-name (match-string-no-properties 2)) 14067 (ent-key (downcase ent-name)) 14068 (arch-name (match-string-no-properties 1)) 14069 (arch-key (downcase arch-name)) 14070 (ent-entry (vhdl-aget ent-alist ent-key)) 14071 (arch-alist (nth 3 ent-entry)) 14072 (arch-entry (vhdl-aget arch-alist arch-key)) 14073 (beg-of-unit (point)) 14074 (end-of-unit (vhdl-get-end-of-unit)) 14075 (inst-no 0) 14076 inst-alist inst-path) 14077 ;; scan for contained instantiations 14078 (while (and (re-search-forward 14079 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" 14080 "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|" 14081 "component[ \t\n\r\f]+\\(\\w+\\)\\|" 14082 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" 14083 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" 14084 "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") 14085 end-of-unit t) 14086 (or (not limit-hier-inst-no) 14087 (<= (if (or (match-string 14) 14088 (match-string 16)) 14089 inst-no 14090 (setq inst-no (1+ inst-no))) 14091 limit-hier-inst-no))) 14092 (cond 14093 ;; block/generate beginning found 14094 ((match-string 14) 14095 (setq inst-path 14096 (cons (match-string-no-properties 1) inst-path))) 14097 ;; block/generate end found 14098 ((match-string 16) 14099 (setq inst-path (cdr inst-path))) 14100 ;; instantiation found 14101 (t 14102 (let* ((inst-name (match-string-no-properties 1)) 14103 (inst-key (downcase inst-name)) 14104 (inst-comp-name 14105 (or (match-string-no-properties 3) 14106 (match-string-no-properties 6))) 14107 (inst-ent-key 14108 (or (and (match-string 8) 14109 (vhdl-match-string-downcase 11)) 14110 (and inst-comp-name 14111 (downcase inst-comp-name)))) 14112 (inst-arch-key (vhdl-match-string-downcase 13)) 14113 (inst-conf-key 14114 (and (not (match-string 8)) 14115 (vhdl-match-string-downcase 11))) 14116 (inst-lib-key (vhdl-match-string-downcase 10))) 14117 (goto-char (match-end 1)) 14118 (setq inst-list (cons inst-key inst-list) 14119 inst-ent-list 14120 (cons inst-ent-key inst-ent-list)) 14121 (setq inst-alist 14122 (append 14123 inst-alist 14124 (list (list inst-key inst-name file-name 14125 (vhdl-current-line) inst-comp-name 14126 inst-ent-key inst-arch-key 14127 inst-conf-key inst-lib-key 14128 (reverse inst-path))))))))) 14129 ;; scan for contained configuration specifications 14130 (goto-char beg-of-unit) 14131 (while (re-search-forward 14132 (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]*\\)*" 14133 "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t) 14134 (let* ((inst-comp-name (match-string-no-properties 3)) 14135 (inst-ent-key 14136 (and (match-string 6) 14137 (vhdl-match-string-downcase 9))) 14138 (inst-arch-key (vhdl-match-string-downcase 11)) 14139 (inst-conf-key 14140 (and (not (match-string 6)) 14141 (vhdl-match-string-downcase 9))) 14142 (inst-lib-key (vhdl-match-string-downcase 8)) 14143 (inst-key-list 14144 (split-string (vhdl-match-string-downcase 1) 14145 "[ \t\n\r\f]*,[ \t\n\r\f]*")) 14146 (tmp-inst-alist inst-alist) 14147 inst-entry) 14148 (while tmp-inst-alist 14149 (when (and (or (equal "all" (car inst-key-list)) 14150 (member (nth 0 (car tmp-inst-alist)) 14151 inst-key-list)) 14152 (equal 14153 (downcase 14154 (or (nth 4 (car tmp-inst-alist)) "")) 14155 (downcase inst-comp-name))) 14156 (setq inst-entry (car tmp-inst-alist)) 14157 (setq inst-ent-list 14158 (cons (or inst-ent-key (nth 5 inst-entry)) 14159 (vhdl-delete 14160 (nth 5 inst-entry) inst-ent-list))) 14161 (setq inst-entry 14162 (list (nth 0 inst-entry) (nth 1 inst-entry) 14163 (nth 2 inst-entry) (nth 3 inst-entry) 14164 (nth 4 inst-entry) 14165 (or inst-ent-key (nth 5 inst-entry)) 14166 (or inst-arch-key (nth 6 inst-entry)) 14167 inst-conf-key inst-lib-key)) 14168 (setcar tmp-inst-alist inst-entry)) 14169 (setq tmp-inst-alist (cdr tmp-inst-alist))))) 14170 ;; save in cache 14171 (vhdl-aput 'arch-alist arch-key 14172 (list (nth 0 arch-entry) (nth 1 arch-entry) 14173 (nth 2 arch-entry) inst-alist 14174 (nth 4 arch-entry))) 14175 (vhdl-aput 'ent-alist ent-key 14176 (list (nth 0 ent-entry) (nth 1 ent-entry) 14177 (nth 2 ent-entry) 14178 (vhdl-sort-alist arch-alist) 14179 (nth 4 ent-entry) (nth 5 ent-entry))) 14180 (when (and limit-hier-inst-no 14181 (> inst-no limit-hier-inst-no)) 14182 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) 14183 (setq big-files t)) 14184 (goto-char end-of-unit)))) 14185 ;; remember design units for this file 14186 (vhdl-aput 'file-alist file-name 14187 (list ent-list arch-list arch-ent-list conf-list 14188 pack-list pack-body-list 14189 inst-list inst-ent-list)) 14190 (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) 14191 (setq file-list (cdr file-list)))) 14192 (when (or (and (not project) files-exist) 14193 (and project (not non-final))) 14194 ;; consistency checks: 14195 ;; check whether each architecture has a corresponding entity 14196 (setq tmp-list ent-alist) 14197 (while tmp-list 14198 (when (null (nth 2 (car tmp-list))) 14199 (setq tmp-entry (car (nth 4 (car tmp-list)))) 14200 (vhdl-warning-when-idle 14201 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 14202 (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) 14203 (nth 3 tmp-entry))) 14204 (setq tmp-list (cdr tmp-list))) 14205 ;; check whether configuration has a corresponding entity/architecture 14206 (setq tmp-list conf-alist) 14207 (while tmp-list 14208 (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)))) 14209 (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list))) 14210 (setq tmp-entry (car tmp-list)) 14211 (vhdl-warning-when-idle 14212 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" 14213 (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) 14214 (nth 2 tmp-entry) (nth 3 tmp-entry))) 14215 (setq tmp-entry (car tmp-list)) 14216 (vhdl-warning-when-idle 14217 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 14218 (nth 1 tmp-entry) (nth 4 tmp-entry) 14219 (nth 2 tmp-entry) (nth 3 tmp-entry))) 14220 (setq tmp-list (cdr tmp-list))) 14221 ;; check whether each package body has a package declaration 14222 (setq tmp-list pack-alist) 14223 (while tmp-list 14224 (when (null (nth 2 (car tmp-list))) 14225 (setq tmp-entry (car tmp-list)) 14226 (vhdl-warning-when-idle 14227 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" 14228 (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) 14229 (setq tmp-list (cdr tmp-list))) 14230 ;; sort lists 14231 (setq ent-alist (vhdl-sort-alist ent-alist)) 14232 (setq conf-alist (vhdl-sort-alist conf-alist)) 14233 (setq pack-alist (vhdl-sort-alist pack-alist)) 14234 ;; remember updated directory/project 14235 (add-to-list 'vhdl-updated-project-list (or project dir-name))) 14236 ;; clear directory alists 14237 (unless project 14238 (vhdl-adelete 'vhdl-entity-alist key) 14239 (vhdl-adelete 'vhdl-config-alist key) 14240 (vhdl-adelete 'vhdl-package-alist key) 14241 (vhdl-adelete 'vhdl-ent-inst-alist key) 14242 (vhdl-adelete 'vhdl-file-alist key)) 14243 ;; put directory contents into cache 14244 (vhdl-aput 'vhdl-entity-alist key ent-alist) 14245 (vhdl-aput 'vhdl-config-alist key conf-alist) 14246 (vhdl-aput 'vhdl-package-alist key pack-alist) 14247 (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list)) 14248 (vhdl-aput 'vhdl-file-alist key file-alist) 14249 ;; final messages 14250 (message "Scanning %s %s\"%s\"...done" 14251 (if is-directory "directory" "files") (or num-string "") name) 14252 (unless project (message "Scanning directory...done")) 14253 (when big-files 14254 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) 14255 ;; save cache when scanned non-interactively 14256 (when (or (not project) (not non-final)) 14257 (when (and noninteractive vhdl-speedbar-save-cache) 14258 (vhdl-save-cache key))) 14259 t)) 14260 14261(defun vhdl-scan-project-contents (project) 14262 "Scan the contents of all VHDL files found in the directories and files 14263of PROJECT." 14264 (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '(""))) 14265 (default-dir (vhdl-resolve-env-variable 14266 (nth 1 (vhdl-aget vhdl-project-alist project)))) 14267 (file-exclude-regexp 14268 (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) 14269 dir-list-tmp dir dir-name num-dir act-dir recursive) 14270 ;; clear project alists 14271 (vhdl-adelete 'vhdl-entity-alist project) 14272 (vhdl-adelete 'vhdl-config-alist project) 14273 (vhdl-adelete 'vhdl-package-alist project) 14274 (vhdl-adelete 'vhdl-ent-inst-alist project) 14275 (vhdl-adelete 'vhdl-file-alist project) 14276 ;; expand directory names by default-directory 14277 (message "Collecting source files...") 14278 (while dir-list 14279 (setq dir (vhdl-resolve-env-variable (car dir-list))) 14280 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) 14281 (setq recursive (match-string 1 dir) 14282 dir-name (match-string 3 dir)) 14283 (setq dir-list-tmp 14284 (cons (concat recursive 14285 (if (file-name-absolute-p dir-name) "" default-dir) 14286 dir-name) 14287 dir-list-tmp)) 14288 (setq dir-list (cdr dir-list))) 14289 ;; resolve path wildcards 14290 (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) 14291 ;; expand directories 14292 (while dir-list-tmp 14293 (setq dir (car dir-list-tmp)) 14294 ;; get subdirectories 14295 (if (string-match "-r \\(.*[/\\]\\)" dir) 14296 (setq dir-list (append dir-list (vhdl-get-subdirs 14297 (match-string 1 dir)))) 14298 (setq dir-list (append dir-list (list dir)))) 14299 (setq dir-list-tmp (cdr dir-list-tmp))) 14300 ;; exclude files 14301 (unless (equal file-exclude-regexp "") 14302 (let ((case-fold-search nil)) 14303 (while dir-list 14304 (unless (string-match file-exclude-regexp (car dir-list)) 14305 (push (car dir-list) dir-list-tmp)) 14306 (setq dir-list (cdr dir-list))) 14307 (setq dir-list (nreverse dir-list-tmp)))) 14308 (message "Collecting source files...done") 14309 ;; scan for design units for each directory in DIR-LIST 14310 (setq dir-list-tmp nil 14311 num-dir (length dir-list) 14312 act-dir 1) 14313 (while dir-list 14314 (setq dir-name (abbreviate-file-name 14315 (expand-file-name (car dir-list)))) 14316 (vhdl-scan-directory-contents dir-name project nil 14317 (format "(%s/%s) " act-dir num-dir) 14318 (cdr dir-list)) 14319 (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) 14320 (setq dir-list (cdr dir-list) 14321 act-dir (1+ act-dir))) 14322 (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) 14323 (message "Scanning project \"%s\"...done" project))) 14324 14325(defun vhdl-update-file-contents (file-name) 14326 "Update hierarchy information by contents of current buffer." 14327 (setq file-name (abbreviate-file-name file-name)) 14328 (let* ((dir-name (file-name-directory file-name)) 14329 (directory-alist vhdl-directory-alist) 14330 updated) 14331 (while directory-alist 14332 (when (member dir-name (nth 1 (car directory-alist))) 14333 (let* ((vhdl-project (nth 0 (car directory-alist))) 14334 (project (vhdl-project-p)) 14335 (ent-alist (vhdl-aget vhdl-entity-alist 14336 (or project dir-name))) 14337 (conf-alist (vhdl-aget vhdl-config-alist 14338 (or project dir-name))) 14339 (pack-alist (vhdl-aget vhdl-package-alist 14340 (or project dir-name))) 14341 (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist 14342 (or project dir-name)))) 14343 (file-alist (vhdl-aget vhdl-file-alist (or project dir-name))) 14344 (file-entry (vhdl-aget file-alist file-name)) 14345 (ent-list (nth 0 file-entry)) 14346 (arch-list (nth 1 file-entry)) 14347 (arch-ent-list (nth 2 file-entry)) 14348 (conf-list (nth 3 file-entry)) 14349 (pack-list (nth 4 file-entry)) 14350 (pack-body-list (nth 5 file-entry)) 14351 (inst-ent-list (nth 7 file-entry)) 14352 (cache-key (or project dir-name)) 14353 arch-alist key ent-key entry) 14354 ;; delete design units previously contained in this file: 14355 ;; entities 14356 (while ent-list 14357 (setq key (car ent-list) 14358 entry (vhdl-aget ent-alist key)) 14359 (when (equal file-name (nth 1 entry)) 14360 (if (nth 3 entry) 14361 (vhdl-aput 'ent-alist key 14362 (list (nth 0 entry) nil nil (nth 3 entry) nil)) 14363 (vhdl-adelete 'ent-alist key))) 14364 (setq ent-list (cdr ent-list))) 14365 ;; architectures 14366 (while arch-list 14367 (setq key (car arch-list) 14368 ent-key (car arch-ent-list) 14369 entry (vhdl-aget ent-alist ent-key) 14370 arch-alist (nth 3 entry)) 14371 (when (equal file-name (nth 1 (vhdl-aget arch-alist key))) 14372 (vhdl-adelete 'arch-alist key) 14373 (if (or (nth 1 entry) arch-alist) 14374 (vhdl-aput 'ent-alist ent-key 14375 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 14376 arch-alist (nth 4 entry) (nth 5 entry))) 14377 (vhdl-adelete 'ent-alist ent-key))) 14378 (setq arch-list (cdr arch-list) 14379 arch-ent-list (cdr arch-ent-list))) 14380 ;; configurations 14381 (while conf-list 14382 (setq key (car conf-list)) 14383 (when (equal file-name (nth 1 (vhdl-aget conf-alist key))) 14384 (vhdl-adelete 'conf-alist key)) 14385 (setq conf-list (cdr conf-list))) 14386 ;; package declarations 14387 (while pack-list 14388 (setq key (car pack-list) 14389 entry (vhdl-aget pack-alist key)) 14390 (when (equal file-name (nth 1 entry)) 14391 (if (nth 6 entry) 14392 (vhdl-aput 'pack-alist key 14393 (list (nth 0 entry) nil nil nil nil nil 14394 (nth 6 entry) (nth 7 entry) (nth 8 entry) 14395 (nth 9 entry))) 14396 (vhdl-adelete 'pack-alist key))) 14397 (setq pack-list (cdr pack-list))) 14398 ;; package bodies 14399 (while pack-body-list 14400 (setq key (car pack-body-list) 14401 entry (vhdl-aget pack-alist key)) 14402 (when (equal file-name (nth 6 entry)) 14403 (if (nth 1 entry) 14404 (vhdl-aput 'pack-alist key 14405 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 14406 (nth 3 entry) (nth 4 entry) (nth 5 entry) 14407 nil nil nil nil)) 14408 (vhdl-adelete 'pack-alist key))) 14409 (setq pack-body-list (cdr pack-body-list))) 14410 ;; instantiated entities 14411 (while inst-ent-list 14412 (setq ent-inst-list 14413 (vhdl-delete (car inst-ent-list) ent-inst-list)) 14414 (setq inst-ent-list (cdr inst-ent-list))) 14415 ;; update caches 14416 (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist) 14417 (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist) 14418 (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist) 14419 (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) 14420 ;; scan file 14421 (vhdl-scan-directory-contents file-name project t) 14422 (when (or (and vhdl-speedbar-show-projects project) 14423 (and (not vhdl-speedbar-show-projects) (not project))) 14424 (vhdl-speedbar-refresh project)) 14425 (setq updated t))) 14426 (setq directory-alist (cdr directory-alist))) 14427 updated)) 14428 14429(defun vhdl-update-hierarchy () 14430 "Update directory and hierarchy information in speedbar." 14431 (let ((file-list (reverse vhdl-modified-file-list)) 14432 updated) 14433 (when (and vhdl-speedbar-update-on-saving file-list) 14434 (while file-list 14435 (setq updated 14436 (or (vhdl-update-file-contents (car file-list)) 14437 updated)) 14438 (setq file-list (cdr file-list))) 14439 (setq vhdl-modified-file-list nil) 14440 (vhdl-speedbar-update-current-unit) 14441 (when updated (message "Updating hierarchy...done"))))) 14442 14443;; structure (parenthesized expression means list of such entries) 14444;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker 14445;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker 14446;; comp-lib-name level) 14447(defun vhdl-get-hierarchy ( ent-alist-arg conf-alist-arg ent-key arch-key 14448 conf-key-arg conf-inst-alist level indent 14449 &optional include-top ent-hier) 14450 "Get instantiation hierarchy beginning in architecture ARCH-KEY of 14451entity ENT-KEY." 14452 (let* ((ent-alist ent-alist-arg) 14453 (conf-alist conf-alist-arg) 14454 (conf-key conf-key-arg) 14455 (ent-entry (vhdl-aget ent-alist ent-key)) 14456 (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key) 14457 (cdar (last (nth 3 ent-entry))))) 14458 (inst-alist (nth 3 arch-entry)) 14459 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry 14460 hier-list subcomp-list tmp-list inst-key inst-comp-name 14461 inst-ent-key inst-arch-key inst-conf-key inst-lib-key) 14462 (when (= level 0) (message "Extract design hierarchy...")) 14463 (when include-top 14464 (setq level (1+ level))) 14465 (when (member ent-key ent-hier) 14466 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) 14467 ;; process all instances 14468 (while inst-alist 14469 (setq inst-entry (car inst-alist) 14470 inst-key (nth 0 inst-entry) 14471 inst-comp-name (nth 4 inst-entry) 14472 inst-conf-key (nth 7 inst-entry)) 14473 ;; search entry in configuration's instantiations list 14474 (setq tmp-list conf-inst-alist) 14475 (while (and tmp-list 14476 (not (and (member (nth 0 (car tmp-list)) 14477 (list "all" inst-key)) 14478 (equal (nth 1 (car tmp-list)) 14479 (downcase (or inst-comp-name "")))))) 14480 (setq tmp-list (cdr tmp-list))) 14481 (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) 14482 (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key)) 14483 (when (and inst-conf-key (not inst-conf-entry)) 14484 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) 14485 ;; determine entity 14486 (setq inst-ent-key 14487 (or (nth 2 (car tmp-list)) ; from configuration 14488 (nth 3 inst-conf-entry) ; from subconfiguration 14489 (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry))) 14490 ; from configuration spec. 14491 (nth 5 inst-entry))) ; from direct instantiation 14492 (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key)) 14493 ;; determine architecture 14494 (setq inst-arch-key 14495 (or (nth 3 (car tmp-list)) ; from configuration 14496 (nth 4 inst-conf-entry) ; from subconfiguration 14497 (nth 6 inst-entry) ; from direct instantiation 14498 (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry))) 14499 ; from configuration spec. 14500 (nth 4 inst-ent-entry) ; MRA 14501 (caar (nth 3 inst-ent-entry)))) ; first alphabetically 14502 (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key)) 14503 ;; set library 14504 (setq inst-lib-key 14505 (or (nth 5 (car tmp-list)) ; from configuration 14506 (nth 8 inst-entry))) ; from direct instantiation 14507 ;; gather information for this instance 14508 (setq comp-entry 14509 (list (nth 1 inst-entry) 14510 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 14511 (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) 14512 (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) 14513 (or (nth 0 inst-arch-entry) inst-arch-key) 14514 (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) 14515 (or (nth 0 inst-conf-entry) inst-conf-key) 14516 (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) 14517 inst-lib-key level)) 14518 ;; get subcomponent hierarchy 14519 (setq subcomp-list (vhdl-get-hierarchy 14520 ent-alist conf-alist 14521 inst-ent-key inst-arch-key inst-conf-key 14522 (nth 5 inst-conf-entry) 14523 (1+ level) indent nil (cons ent-key ent-hier))) 14524 ;; add to list 14525 (setq hier-list (append hier-list (list comp-entry) subcomp-list)) 14526 (setq inst-alist (cdr inst-alist))) 14527 (when include-top 14528 (setq hier-list 14529 (cons (list nil nil (nth 0 ent-entry) 14530 (cons (nth 1 ent-entry) (nth 2 ent-entry)) 14531 (nth 0 arch-entry) 14532 (cons (nth 1 arch-entry) (nth 2 arch-entry)) 14533 nil nil 14534 nil (1- level)) 14535 hier-list))) 14536 (when (or (= level 0) (and include-top (= level 1))) (message "")) 14537 hier-list)) 14538 14539(defun vhdl-get-instantiations (ent-key indent) 14540 "Get all instantiations of entity ENT-KEY." 14541 (let ((ent-alist (vhdl-aget vhdl-entity-alist 14542 (vhdl-speedbar-line-key indent))) 14543 arch-alist inst-alist ent-inst-list 14544 ent-entry arch-entry inst-entry) 14545 (while ent-alist 14546 (setq ent-entry (car ent-alist)) 14547 (setq arch-alist (nth 4 ent-entry)) 14548 (while arch-alist 14549 (setq arch-entry (car arch-alist)) 14550 (setq inst-alist (nth 4 arch-entry)) 14551 (while inst-alist 14552 (setq inst-entry (car inst-alist)) 14553 (when (equal ent-key (nth 5 inst-entry)) 14554 (setq ent-inst-list 14555 (cons (list (nth 1 inst-entry) 14556 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 14557 (nth 1 ent-entry) 14558 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 14559 (nth 1 arch-entry) 14560 (cons (nth 2 arch-entry) (nth 3 arch-entry))) 14561 ent-inst-list))) 14562 (setq inst-alist (cdr inst-alist))) 14563 (setq arch-alist (cdr arch-alist))) 14564 (setq ent-alist (cdr ent-alist))) 14565 (nreverse ent-inst-list))) 14566 14567;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14568;; Caching in file 14569 14570(defun vhdl-save-caches () 14571 "Save all updated hierarchy caches to file." 14572 (interactive) 14573 (condition-case nil 14574 (when vhdl-speedbar-save-cache 14575 ;; update hierarchy 14576 (vhdl-update-hierarchy) 14577 (let ((project-list vhdl-updated-project-list)) 14578 (message "Saving hierarchy caches...") 14579 ;; write updated project caches 14580 (while project-list 14581 (vhdl-save-cache (car project-list)) 14582 (setq project-list (cdr project-list))) 14583 (message "Saving hierarchy caches...done"))) 14584 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") 14585 (sit-for 2))))) 14586 14587(defvar vhdl-cache-version) 14588 14589(defun vhdl-save-cache (key) 14590 "Save current hierarchy cache to file." 14591 (let* ((orig-buffer (current-buffer)) 14592 (vhdl-project key) 14593 (project (vhdl-project-p)) 14594 (default-directory key) 14595 (directory (abbreviate-file-name (vhdl-default-directory))) 14596 (file-name (vhdl-resolve-env-variable 14597 (vhdl-replace-string 14598 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 14599 (concat 14600 (subst-char-in-string ? ?_ (or project "dir")) 14601 " " (user-login-name))))) 14602 (file-dir-name (expand-file-name file-name directory)) 14603 (cache-key (or project directory)) 14604 (key (if project "project" "directory"))) 14605 (unless (file-exists-p (file-name-directory file-dir-name)) 14606 (make-directory (file-name-directory file-dir-name) t)) 14607 (if (not (file-writable-p file-dir-name)) 14608 (progn (vhdl-warning (format "File not writable: \"%s\"" 14609 (abbreviate-file-name file-dir-name))) 14610 (sit-for 2)) 14611 (message "Saving cache: \"%s\"" file-dir-name) 14612 (set-buffer (find-file-noselect file-dir-name t t)) 14613 (erase-buffer) 14614 (insert ";; -*- Emacs-Lisp -*-\n\n" 14615 ";;; " (file-name-nondirectory file-name) 14616 " - design hierarchy cache file for Emacs VHDL Mode " 14617 vhdl-version "\n") 14618 (insert "\n;; " (if project "Project " "Directory") " : ") 14619 (if project (insert project) (prin1 directory (current-buffer))) 14620 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") 14621 (user-login-name) "\n\n" 14622 "\n;; version number\n" 14623 "(setq vhdl-cache-version \"" vhdl-version "\")\n" 14624 "\n;; " (if project "project" "directory") " name" 14625 "\n(setq " key " ") 14626 (prin1 (or project directory) (current-buffer)) 14627 (insert ")\n") 14628 (when (member 'hierarchy vhdl-speedbar-save-cache) 14629 (insert "\n;; entity and architecture cache\n" 14630 "(vhdl-aput 'vhdl-entity-alist " key " '") 14631 (print (vhdl-aget vhdl-entity-alist cache-key) (current-buffer)) 14632 (insert ")\n\n;; configuration cache\n" 14633 "(vhdl-aput 'vhdl-config-alist " key " '") 14634 (print (vhdl-aget vhdl-config-alist cache-key) (current-buffer)) 14635 (insert ")\n\n;; package cache\n" 14636 "(vhdl-aput 'vhdl-package-alist " key " '") 14637 (print (vhdl-aget vhdl-package-alist cache-key) (current-buffer)) 14638 (insert ")\n\n;; instantiated entities cache\n" 14639 "(vhdl-aput 'vhdl-ent-inst-alist " key " '") 14640 (print (vhdl-aget vhdl-ent-inst-alist cache-key) (current-buffer)) 14641 (insert ")\n\n;; design units per file cache\n" 14642 "(vhdl-aput 'vhdl-file-alist " key " '") 14643 (print (vhdl-aget vhdl-file-alist cache-key) (current-buffer)) 14644 (when project 14645 (insert ")\n\n;; source directories in project cache\n" 14646 "(vhdl-aput 'vhdl-directory-alist " key " '") 14647 (print (vhdl-aget vhdl-directory-alist cache-key) (current-buffer))) 14648 (insert ")\n")) 14649 (when (member 'display vhdl-speedbar-save-cache) 14650 (insert "\n;; shown design units cache\n" 14651 "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") 14652 (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key) 14653 (current-buffer)) 14654 (insert ")\n")) 14655 (setq vhdl-updated-project-list 14656 (delete cache-key vhdl-updated-project-list)) 14657 (save-buffer) 14658 (kill-buffer (current-buffer)) 14659 (set-buffer orig-buffer)))) 14660 14661(defun vhdl-load-cache (key) 14662 "Load hierarchy cache information from file." 14663 (let* ((vhdl-project key) 14664 (default-directory key) 14665 (directory (vhdl-default-directory)) 14666 (file-name (vhdl-resolve-env-variable 14667 (vhdl-replace-string 14668 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 14669 (concat 14670 (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) 14671 " " (user-login-name))))) 14672 (file-dir-name (expand-file-name file-name directory)) 14673 vhdl-cache-version) 14674 (unless (memq 'vhdl-save-caches kill-emacs-hook) 14675 (add-hook 'kill-emacs-hook #'vhdl-save-caches)) 14676 (when (file-exists-p file-dir-name) 14677 (condition-case () 14678 (progn (load-file file-dir-name) 14679 (string< (mapconcat 14680 (lambda (a) (format "%3d" (string-to-number a))) 14681 (split-string "3.33" "\\.") "") 14682 (mapconcat 14683 (lambda (a) (format "%3d" (string-to-number a))) 14684 (split-string vhdl-cache-version "\\.") ""))) 14685 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) 14686 nil)))))) 14687 14688(defun vhdl-require-hierarchy-info () 14689 "Make sure that hierarchy information is available. Load cache or scan files 14690if required." 14691 (if (vhdl-project-p) 14692 (unless (or (assoc vhdl-project vhdl-file-alist) 14693 (vhdl-load-cache vhdl-project)) 14694 (vhdl-scan-project-contents vhdl-project)) 14695 (let ((directory (abbreviate-file-name default-directory))) 14696 (unless (or (assoc directory vhdl-file-alist) 14697 (vhdl-load-cache directory)) 14698 (vhdl-scan-directory-contents directory))))) 14699 14700;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14701;; Add hierarchy browser functionality to speedbar 14702 14703(defvar vhdl-speedbar-mode-map nil 14704 "Keymap used when in the VHDL hierarchy browser mode.") 14705 14706(defvar vhdl-speedbar-menu-items nil 14707 "Additional menu-items to add to speedbar frame.") 14708 14709(declare-function speedbar-add-supported-extension "speedbar" (extension)) 14710(declare-function speedbar-add-mode-functions-list "speedbar" (new-list)) 14711(declare-function speedbar-make-specialized-keymap "speedbar" ()) 14712(declare-function speedbar-change-initial-expansion-list "speedbar" 14713 (new-default)) 14714(declare-function speedbar-add-expansion-list "speedbar" (new-list)) 14715(declare-function speedbar-expand-line "speedbar" (&optional arg)) 14716(declare-function speedbar-edit-line "speedbar" ()) 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;; (declare (indent 0) (debug t)) 14845;; (list 'let '((inhibit-read-only t)) 14846;; (cons 'progn forms))) 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(defvar vhdl-speedbar-update-current-unit) 14890 14891(defun vhdl-speedbar-insert-projects () 14892 "Insert all projects in speedbar." 14893 (vhdl-speedbar-make-title-line "Projects:") 14894 (let ((project-alist (if vhdl-project-sort 14895 (vhdl-sort-alist (copy-alist vhdl-project-alist)) 14896 vhdl-project-alist)) 14897 (vhdl-speedbar-update-current-unit nil)) 14898 ;; insert projects 14899 (while project-alist 14900 (speedbar-make-tag-line 14901 'angle ?+ #'vhdl-speedbar-expand-project 14902 (caar project-alist) (caar project-alist) 14903 #'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) 14904 (setq project-alist (cdr project-alist))) 14905 (setq project-alist vhdl-project-alist) 14906 ;; expand projects 14907 (while project-alist 14908 (when (member (caar project-alist) vhdl-speedbar-shown-project-list) 14909 (goto-char (point-min)) 14910 (when (re-search-forward 14911 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) 14912 (goto-char (match-end 1)) 14913 (speedbar-do-function-pointer))) 14914 (setq project-alist (cdr project-alist))))) 14915 14916(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) 14917 "Insert hierarchy of PROJECT. 14918Rescan directories if optional argument RESCAN is non-nil, 14919otherwise use cached data." 14920 (when (or rescan (and (not (assoc project vhdl-file-alist)) 14921 (not (vhdl-load-cache project)))) 14922 (vhdl-scan-project-contents project)) 14923 ;; insert design hierarchy 14924 (vhdl-speedbar-insert-hierarchy 14925 (vhdl-aget vhdl-entity-alist project) 14926 (vhdl-aget vhdl-config-alist project) 14927 (vhdl-aget vhdl-package-alist project) 14928 (car (vhdl-aget vhdl-ent-inst-alist project)) indent) 14929 (insert (int-to-string indent) ":\n") 14930 (put-text-property (- (point) 3) (1- (point)) 'invisible t) 14931 (put-text-property (1- (point)) (point) 'invisible nil) 14932 ;; expand design units 14933 (vhdl-speedbar-expand-units project)) 14934 14935(defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) 14936 "Insert hierarchy of DIRECTORY. 14937Rescan directory if optional argument RESCAN is non-nil, 14938otherwise use cached data." 14939 (when (or rescan (and (not (assoc directory vhdl-file-alist)) 14940 (not (vhdl-load-cache directory)))) 14941 (vhdl-scan-directory-contents directory)) 14942 ;; insert design hierarchy 14943 (vhdl-speedbar-insert-hierarchy 14944 (vhdl-aget vhdl-entity-alist directory) 14945 (vhdl-aget vhdl-config-alist directory) 14946 (vhdl-aget vhdl-package-alist directory) 14947 (car (vhdl-aget vhdl-ent-inst-alist directory)) depth) 14948 ;; expand design units 14949 (vhdl-speedbar-expand-units directory) 14950 (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) 14951 14952(defun vhdl-speedbar-insert-hierarchy ( ent-alist-arg conf-alist-arg pack-alist 14953 ent-inst-list depth) 14954 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." 14955 (if (not (or ent-alist conf-alist pack-alist)) 14956 (vhdl-speedbar-make-title-line "No VHDL design units!" depth) 14957 (let ((ent-alist ent-alist-arg) 14958 (conf-alist conf-alist-arg) 14959 ent-entry conf-entry pack-entry) 14960 ;; insert entities 14961 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) 14962 (while ent-alist 14963 (setq ent-entry (car ent-alist)) 14964 (speedbar-make-tag-line 14965 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) 14966 (nth 1 ent-entry) 'vhdl-speedbar-find-file 14967 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 14968 'vhdl-speedbar-entity-face depth) 14969 (unless (nth 2 ent-entry) 14970 (end-of-line 0) (insert "!") (forward-char 1)) 14971 (unless (member (nth 0 ent-entry) ent-inst-list) 14972 (end-of-line 0) (insert " (top)") (forward-char 1)) 14973 (setq ent-alist (cdr ent-alist))) 14974 ;; insert configurations 14975 (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) 14976 (while conf-alist 14977 (setq conf-entry (car conf-alist)) 14978 (speedbar-make-tag-line 14979 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) 14980 (nth 1 conf-entry) 'vhdl-speedbar-find-file 14981 (cons (nth 2 conf-entry) (nth 3 conf-entry)) 14982 'vhdl-speedbar-configuration-face depth) 14983 (setq conf-alist (cdr conf-alist))) 14984 ;; insert packages 14985 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) 14986 (while pack-alist 14987 (setq pack-entry (car pack-alist)) 14988 (vhdl-speedbar-make-pack-line 14989 (nth 0 pack-entry) (nth 1 pack-entry) 14990 (cons (nth 2 pack-entry) (nth 3 pack-entry)) 14991 (cons (nth 7 pack-entry) (nth 8 pack-entry)) 14992 depth) 14993 (setq pack-alist (cdr pack-alist)))))) 14994 14995(declare-function speedbar-line-directory "speedbar" (&optional depth)) 14996 14997(defun vhdl-speedbar-rescan-hierarchy () 14998 "Rescan hierarchy for the directory or project under the cursor." 14999 (interactive) 15000 (let (key path) 15001 (cond 15002 ;; current project 15003 (vhdl-speedbar-show-projects 15004 (setq key (vhdl-speedbar-line-project)) 15005 (vhdl-scan-project-contents key)) 15006 ;; top-level directory 15007 ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) 15008 (re-search-forward "[0-9]+:" nil t) 15009 (vhdl-scan-directory-contents 15010 (abbreviate-file-name (speedbar-line-directory)))) 15011 ;; current directory 15012 (t (setq path (speedbar-line-directory)) 15013 (string-match "^\\(.+[/\\]\\)" path) 15014 (vhdl-scan-directory-contents 15015 (abbreviate-file-name (match-string 1 path))))) 15016 (vhdl-speedbar-refresh key))) 15017 15018(declare-function speedbar-goto-this-file "speedbar" (file)) 15019 15020(defun vhdl-speedbar-expand-dirs (_directory) 15021 "Expand subdirectories in DIRECTORY according to `speedbar-shown-directories'." 15022 ;; (nicked from `speedbar-default-directory-list') 15023 (let ((sf (cdr (reverse speedbar-shown-directories))) 15024 (vhdl-speedbar-update-current-unit nil)) 15025 (setq speedbar-shown-directories 15026 (list (expand-file-name default-directory))) 15027 (while sf 15028 (when (speedbar-goto-this-file (car sf)) 15029 (beginning-of-line) 15030 (when (looking-at "[0-9]+:\\s-*<") 15031 (goto-char (match-end 0)) 15032 (speedbar-do-function-pointer))) 15033 (setq sf (cdr sf)))) 15034 (vhdl-speedbar-update-current-unit nil t)) 15035 15036(defun vhdl-speedbar-expand-units (key) 15037 "Expand design units in directory/project KEY according to 15038`vhdl-speedbar-shown-unit-alist'." 15039 (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15040 (vhdl-speedbar-update-current-unit nil) 15041 vhdl-updated-project-list) 15042 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) 15043 (vhdl-prepare-search-1 15044 (while unit-alist ; expand units 15045 (vhdl-speedbar-goto-this-unit key (caar unit-alist)) 15046 (beginning-of-line) 15047 (let ((arch-alist (nth 1 (car unit-alist))) 15048 position) 15049 (when (looking-at "^[0-9]+:\\s-*\\[") 15050 (goto-char (match-end 0)) 15051 (setq position (point)) 15052 (speedbar-do-function-pointer) 15053 (select-frame speedbar-frame) 15054 (while arch-alist ; expand architectures 15055 (goto-char position) 15056 (when (re-search-forward 15057 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" 15058 (car arch-alist) "\\>\\)") 15059 nil t) 15060 (beginning-of-line) 15061 (when (looking-at "^[0-9]+:\\s-*{") 15062 (goto-char (match-end 0)) 15063 (speedbar-do-function-pointer) 15064 (select-frame speedbar-frame))) 15065 (setq arch-alist (cdr arch-alist)))) 15066 (setq unit-alist (cdr unit-alist)))))) 15067 (vhdl-speedbar-update-current-unit nil t)) 15068 15069(declare-function speedbar-center-buffer-smartly "speedbar" ()) 15070 15071(defun vhdl-speedbar-contract-level () 15072 "Contract current level in current directory/project." 15073 (interactive) 15074 (when (or (save-excursion 15075 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) 15076 (and (save-excursion 15077 (beginning-of-line) (looking-at "^\\([0-9]+\\):")) 15078 (re-search-backward 15079 (format "^[0-%d]:\\s-*[[{<]-" 15080 (max (1- (string-to-number (match-string 1))) 0)) nil t))) 15081 (goto-char (match-end 0)) 15082 (speedbar-do-function-pointer) 15083 (speedbar-center-buffer-smartly))) 15084 15085(defun vhdl-speedbar-contract-all () 15086 "Contract all expanded design units in current directory/project." 15087 (interactive) 15088 (if (and vhdl-speedbar-show-projects 15089 (save-excursion (beginning-of-line) (looking-at "^0:"))) 15090 (progn (setq vhdl-speedbar-shown-project-list nil) 15091 (vhdl-speedbar-refresh)) 15092 (let ((key (vhdl-speedbar-line-key))) 15093 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) 15094 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) 15095 (when (memq 'display vhdl-speedbar-save-cache) 15096 (add-to-list 'vhdl-updated-project-list key))))) 15097 15098(defun vhdl-speedbar-expand-all () 15099 "Expand all design units in current directory/project." 15100 (interactive) 15101 (let* ((key (vhdl-speedbar-line-key)) 15102 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15103 (conf-alist (vhdl-aget vhdl-config-alist key)) 15104 (pack-alist (vhdl-aget vhdl-package-alist key)) 15105 arch-alist unit-alist subunit-alist) 15106 (add-to-list 'vhdl-speedbar-shown-project-list key) 15107 (while ent-alist 15108 (setq arch-alist (nth 4 (car ent-alist))) 15109 (setq subunit-alist nil) 15110 (while arch-alist 15111 (push (caar arch-alist) subunit-alist) 15112 (setq arch-alist (cdr arch-alist))) 15113 (push (list (caar ent-alist) subunit-alist) unit-alist) 15114 (setq ent-alist (cdr ent-alist))) 15115 (while conf-alist 15116 (push (list (caar conf-alist)) unit-alist) 15117 (setq conf-alist (cdr conf-alist))) 15118 (while pack-alist 15119 (push (list (caar pack-alist)) unit-alist) 15120 (setq pack-alist (cdr pack-alist))) 15121 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15122 (vhdl-speedbar-refresh) 15123 (when (memq 'display vhdl-speedbar-save-cache) 15124 (add-to-list 'vhdl-updated-project-list key)))) 15125 15126(declare-function speedbar-change-expand-button-char "speedbar" (char)) 15127(declare-function speedbar-delete-subblock "speedbar" (indent)) 15128 15129(defun vhdl-speedbar-expand-project (text token indent) 15130 "Expand/contract the project under the cursor." 15131 (cond 15132 ((string-match "\\+" text) ; expand project 15133 (speedbar-change-expand-button-char ?-) 15134 (unless (member token vhdl-speedbar-shown-project-list) 15135 (setq vhdl-speedbar-shown-project-list 15136 (cons token vhdl-speedbar-shown-project-list))) 15137 (speedbar-with-writable 15138 (save-excursion 15139 (end-of-line) (forward-char 1) 15140 (vhdl-speedbar-insert-project-hierarchy token (1+ indent) 15141 speedbar-power-click)))) 15142 ((string-match "-" text) ; contract project 15143 (speedbar-change-expand-button-char ?+) 15144 (setq vhdl-speedbar-shown-project-list 15145 (delete token vhdl-speedbar-shown-project-list)) 15146 (speedbar-delete-subblock indent)) 15147 (t (error "Nothing to display"))) 15148 (when (equal (selected-frame) speedbar-frame) 15149 (speedbar-center-buffer-smartly))) 15150 15151(defun vhdl-speedbar-expand-entity (text token indent) 15152 "Expand/contract the entity under the cursor." 15153 (cond 15154 ((string-match "\\+" text) ; expand entity 15155 (let* ((key (vhdl-speedbar-line-key indent)) 15156 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15157 (ent-entry (vhdl-aget ent-alist token)) 15158 (arch-alist (nth 3 ent-entry)) 15159 (inst-alist (vhdl-get-instantiations token indent)) 15160 (subpack-alist (nth 5 ent-entry)) 15161 (multiple-arch (> (length arch-alist) 1)) 15162 arch-entry inst-entry) 15163 (if (not (or arch-alist inst-alist subpack-alist)) 15164 (speedbar-change-expand-button-char ??) 15165 (speedbar-change-expand-button-char ?-) 15166 ;; add entity to `vhdl-speedbar-shown-unit-alist' 15167 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15168 (vhdl-aput 'unit-alist token nil) 15169 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15170 (speedbar-with-writable 15171 (save-excursion 15172 (end-of-line) (forward-char 1) 15173 ;; insert architectures 15174 (when arch-alist 15175 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) 15176 (while arch-alist 15177 (setq arch-entry (car arch-alist)) 15178 (speedbar-make-tag-line 15179 'curly ?+ 'vhdl-speedbar-expand-architecture 15180 (cons token (nth 0 arch-entry)) 15181 (nth 1 arch-entry) 'vhdl-speedbar-find-file 15182 (cons (nth 2 arch-entry) (nth 3 arch-entry)) 15183 'vhdl-speedbar-architecture-face (1+ indent)) 15184 (when (and multiple-arch 15185 (equal (nth 0 arch-entry) (nth 4 ent-entry))) 15186 (end-of-line 0) (insert " (mra)") (forward-char 1)) 15187 (setq arch-alist (cdr arch-alist))) 15188 ;; insert instantiations 15189 (when inst-alist 15190 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) 15191 (while inst-alist 15192 (setq inst-entry (car inst-alist)) 15193 (vhdl-speedbar-make-inst-line 15194 (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) 15195 (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) 15196 nil nil nil (1+ indent) 0 " in ") 15197 (setq inst-alist (cdr inst-alist))) 15198 ;; insert required packages 15199 (vhdl-speedbar-insert-subpackages 15200 subpack-alist (1+ indent) indent))) 15201 (when (memq 'display vhdl-speedbar-save-cache) 15202 (add-to-list 'vhdl-updated-project-list key)) 15203 (vhdl-speedbar-update-current-unit t t)))) 15204 ((string-match "-" text) ; contract entity 15205 (speedbar-change-expand-button-char ?+) 15206 ;; remove entity from `vhdl-speedbar-shown-unit-alist' 15207 (let* ((key (vhdl-speedbar-line-key indent)) 15208 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15209 (vhdl-adelete 'unit-alist token) 15210 (if unit-alist 15211 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15212 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15213 (speedbar-delete-subblock indent) 15214 (when (memq 'display vhdl-speedbar-save-cache) 15215 (add-to-list 'vhdl-updated-project-list key)))) 15216 (t (error "Nothing to display"))) 15217 (when (equal (selected-frame) speedbar-frame) 15218 (speedbar-center-buffer-smartly))) 15219 15220(defun vhdl-speedbar-expand-architecture (text token indent) 15221 "Expand/contract the architecture under the cursor." 15222 (cond 15223 ((string-match "\\+" text) ; expand architecture 15224 (let* ((key (vhdl-speedbar-line-key (1- indent))) 15225 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15226 (conf-alist (vhdl-aget vhdl-config-alist key)) 15227 (hier-alist (vhdl-get-hierarchy 15228 ent-alist conf-alist (car token) (cdr token) nil nil 15229 0 (1- indent))) 15230 (ent-entry (vhdl-aget ent-alist (car token))) 15231 (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token))) 15232 (subpack-alist (nth 4 arch-entry)) 15233 entry) 15234 (if (not (or hier-alist subpack-alist)) 15235 (speedbar-change-expand-button-char ??) 15236 (speedbar-change-expand-button-char ?-) 15237 ;; add architecture to `vhdl-speedbar-shown-unit-alist' 15238 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15239 (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) 15240 (vhdl-aput 'unit-alist (car token) 15241 (list (cons (cdr token) arch-alist))) 15242 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15243 (speedbar-with-writable 15244 (save-excursion 15245 (end-of-line) (forward-char 1) 15246 ;; insert instance hierarchy 15247 (when hier-alist 15248 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" 15249 (1+ indent))) 15250 (while hier-alist 15251 (setq entry (car hier-alist)) 15252 (when (or (= vhdl-speedbar-hierarchy-depth 0) 15253 (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 15254 (vhdl-speedbar-make-inst-line 15255 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 15256 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 15257 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) 15258 (setq hier-alist (cdr hier-alist))) 15259 ;; insert required packages 15260 (vhdl-speedbar-insert-subpackages 15261 subpack-alist (1+ indent) (1- indent)))) 15262 (when (memq 'display vhdl-speedbar-save-cache) 15263 (add-to-list 'vhdl-updated-project-list key)) 15264 (vhdl-speedbar-update-current-unit t t)))) 15265 ((string-match "-" text) ; contract architecture 15266 (speedbar-change-expand-button-char ?+) 15267 ;; remove architecture from `vhdl-speedbar-shown-unit-alist' 15268 (let* ((key (vhdl-speedbar-line-key (1- indent))) 15269 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key)) 15270 (arch-alist (nth 0 (vhdl-aget unit-alist (car token))))) 15271 (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) 15272 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15273 (speedbar-delete-subblock indent) 15274 (when (memq 'display vhdl-speedbar-save-cache) 15275 (add-to-list 'vhdl-updated-project-list key)))) 15276 (t (error "Nothing to display"))) 15277 (when (equal (selected-frame) speedbar-frame) 15278 (speedbar-center-buffer-smartly))) 15279 15280(defun vhdl-speedbar-expand-config (text token indent) 15281 "Expand/contract the configuration under the cursor." 15282 (cond 15283 ((string-match "\\+" text) ; expand configuration 15284 (let* ((key (vhdl-speedbar-line-key indent)) 15285 (conf-alist (vhdl-aget vhdl-config-alist key)) 15286 (conf-entry (vhdl-aget conf-alist token)) 15287 (ent-alist (vhdl-aget vhdl-entity-alist key)) 15288 (hier-alist (vhdl-get-hierarchy 15289 ent-alist conf-alist (nth 3 conf-entry) 15290 (nth 4 conf-entry) token (nth 5 conf-entry) 15291 0 indent t)) 15292 (subpack-alist (nth 6 conf-entry)) 15293 entry) 15294 (if (not (or hier-alist subpack-alist)) 15295 (speedbar-change-expand-button-char ??) 15296 (speedbar-change-expand-button-char ?-) 15297 ;; add configuration to `vhdl-speedbar-shown-unit-alist' 15298 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15299 (vhdl-aput 'unit-alist token nil) 15300 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15301 (speedbar-with-writable 15302 (save-excursion 15303 (end-of-line) (forward-char 1) 15304 ;; insert instance hierarchy 15305 (when hier-alist 15306 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) 15307 (while hier-alist 15308 (setq entry (car hier-alist)) 15309 (when (or (= vhdl-speedbar-hierarchy-depth 0) 15310 (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 15311 (vhdl-speedbar-make-inst-line 15312 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 15313 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 15314 (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) 15315 (setq hier-alist (cdr hier-alist))) 15316 ;; insert required packages 15317 (vhdl-speedbar-insert-subpackages 15318 subpack-alist (1+ indent) indent))) 15319 (when (memq 'display vhdl-speedbar-save-cache) 15320 (add-to-list 'vhdl-updated-project-list key)) 15321 (vhdl-speedbar-update-current-unit t t)))) 15322 ((string-match "-" text) ; contract configuration 15323 (speedbar-change-expand-button-char ?+) 15324 ;; remove configuration from `vhdl-speedbar-shown-unit-alist' 15325 (let* ((key (vhdl-speedbar-line-key indent)) 15326 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15327 (vhdl-adelete 'unit-alist token) 15328 (if unit-alist 15329 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15330 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15331 (speedbar-delete-subblock indent) 15332 (when (memq 'display vhdl-speedbar-save-cache) 15333 (add-to-list 'vhdl-updated-project-list key)))) 15334 (t (error "Nothing to display"))) 15335 (when (equal (selected-frame) speedbar-frame) 15336 (speedbar-center-buffer-smartly))) 15337 15338(defun vhdl-speedbar-expand-package (text token indent) 15339 "Expand/contract the package under the cursor." 15340 (cond 15341 ((string-match "\\+" text) ; expand package 15342 (let* ((key (vhdl-speedbar-line-key indent)) 15343 (pack-alist (vhdl-aget vhdl-package-alist key)) 15344 (pack-entry (vhdl-aget pack-alist token)) 15345 (comp-alist (nth 3 pack-entry)) 15346 (func-alist (nth 4 pack-entry)) 15347 (func-body-alist (nth 8 pack-entry)) 15348 (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) 15349 comp-entry func-entry func-body-entry) 15350 (if (not (or comp-alist func-alist subpack-alist)) 15351 (speedbar-change-expand-button-char ??) 15352 (speedbar-change-expand-button-char ?-) 15353 ;; add package to `vhdl-speedbar-shown-unit-alist' 15354 (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15355 (vhdl-aput 'unit-alist token nil) 15356 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 15357 (speedbar-with-writable 15358 (save-excursion 15359 (end-of-line) (forward-char 1) 15360 ;; insert components 15361 (when comp-alist 15362 (vhdl-speedbar-make-title-line "Components:" (1+ indent))) 15363 (while comp-alist 15364 (setq comp-entry (car comp-alist)) 15365 (speedbar-make-tag-line 15366 nil nil nil 15367 (cons token (nth 0 comp-entry)) 15368 (nth 1 comp-entry) 'vhdl-speedbar-find-file 15369 (cons (nth 2 comp-entry) (nth 3 comp-entry)) 15370 'vhdl-speedbar-entity-face (1+ indent)) 15371 (setq comp-alist (cdr comp-alist))) 15372 ;; insert subprograms 15373 (when func-alist 15374 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) 15375 (while func-alist 15376 (setq func-entry (car func-alist) 15377 func-body-entry (vhdl-aget func-body-alist 15378 (car func-entry))) 15379 (when (nth 2 func-entry) 15380 (vhdl-speedbar-make-subprogram-line 15381 (nth 1 func-entry) 15382 (cons (nth 2 func-entry) (nth 3 func-entry)) 15383 (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) 15384 (1+ indent))) 15385 (setq func-alist (cdr func-alist))) 15386 ;; insert required packages 15387 (vhdl-speedbar-insert-subpackages 15388 subpack-alist (1+ indent) indent))) 15389 (when (memq 'display vhdl-speedbar-save-cache) 15390 (add-to-list 'vhdl-updated-project-list key)) 15391 (vhdl-speedbar-update-current-unit t t)))) 15392 ((string-match "-" text) ; contract package 15393 (speedbar-change-expand-button-char ?+) 15394 ;; remove package from `vhdl-speedbar-shown-unit-alist' 15395 (let* ((key (vhdl-speedbar-line-key indent)) 15396 (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key))) 15397 (vhdl-adelete 'unit-alist token) 15398 (if unit-alist 15399 (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 15400 (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) 15401 (speedbar-delete-subblock indent) 15402 (when (memq 'display vhdl-speedbar-save-cache) 15403 (add-to-list 'vhdl-updated-project-list key)))) 15404 (t (error "Nothing to display"))) 15405 (when (equal (selected-frame) speedbar-frame) 15406 (speedbar-center-buffer-smartly))) 15407 15408(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) 15409 "Insert required packages." 15410 (let* ((pack-alist (vhdl-aget vhdl-package-alist 15411 (vhdl-speedbar-line-key dir-indent))) 15412 pack-key lib-name pack-entry) 15413 (when subpack-alist 15414 (vhdl-speedbar-make-title-line "Packages Used:" indent)) 15415 (while subpack-alist 15416 (setq pack-key (cdar subpack-alist) 15417 lib-name (caar subpack-alist)) 15418 (setq pack-entry (vhdl-aget pack-alist pack-key)) 15419 (vhdl-speedbar-make-subpack-line 15420 (or (nth 0 pack-entry) pack-key) lib-name 15421 (cons (nth 1 pack-entry) (nth 2 pack-entry)) 15422 (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) 15423 (setq subpack-alist (cdr subpack-alist))))) 15424 15425;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15426;; Display help functions 15427 15428;; FIXME: This `defvar' should be moved before its first use. 15429(defvar vhdl-speedbar-update-current-unit t 15430 "Non-nil means to run `vhdl-speedbar-update-current-unit'.") 15431 15432(defun vhdl-speedbar-update-current-project () 15433 "Highlight project that is currently active." 15434 (when (and vhdl-speedbar-show-projects 15435 (not (equal vhdl-speedbar-last-selected-project vhdl-project)) 15436 (and (boundp 'speedbar-frame) 15437 (frame-live-p speedbar-frame))) 15438 (let ((last-frame (selected-frame)) 15439 (project-alist vhdl-project-alist) 15440 pos) 15441 (select-frame speedbar-frame) 15442 (speedbar-with-writable 15443 (save-excursion 15444 (while project-alist 15445 (goto-char (point-min)) 15446 (when (re-search-forward 15447 (concat "<.> \\(" (caar project-alist) "\\)$") nil t) 15448 (put-text-property (match-beginning 1) (match-end 1) 'face 15449 (if (equal (caar project-alist) vhdl-project) 15450 'speedbar-selected-face 15451 'speedbar-directory-face)) 15452 (when (equal (caar project-alist) vhdl-project) 15453 (setq pos (1- (match-beginning 1))))) 15454 (setq project-alist (cdr project-alist)))) 15455 (when pos (goto-char pos))) 15456 (select-frame last-frame) 15457 (setq vhdl-speedbar-last-selected-project vhdl-project))) 15458 t) 15459 15460(declare-function speedbar-position-cursor-on-line "speedbar" ()) 15461 15462(defun vhdl-speedbar-update-current-unit (&optional no-position always) 15463 "Highlight all design units that are contained in the current file. 15464NO-POSITION non-nil means do not re-position cursor." 15465 (let ((last-frame (selected-frame)) 15466 (project-list vhdl-speedbar-shown-project-list) 15467 file-alist pos file-name) 15468 ;; get current file name 15469 (if (fboundp 'speedbar-select-attached-frame) 15470 (speedbar-select-attached-frame) 15471 (select-frame speedbar-attached-frame)) 15472 (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) 15473 (when (and vhdl-speedbar-update-current-unit 15474 (or always (not (equal file-name speedbar-last-selected-file)))) 15475 (if vhdl-speedbar-show-projects 15476 (while project-list 15477 (setq file-alist (append file-alist 15478 (vhdl-aget vhdl-file-alist 15479 (car project-list)))) 15480 (setq project-list (cdr project-list))) 15481 (setq file-alist 15482 (vhdl-aget vhdl-file-alist 15483 (abbreviate-file-name default-directory)))) 15484 (select-frame speedbar-frame) 15485 (set-buffer speedbar-buffer) 15486 (speedbar-with-writable 15487 (vhdl-prepare-search-1 15488 (save-excursion 15489 ;; unhighlight last units 15490 (let* ((file-entry (vhdl-aget file-alist 15491 speedbar-last-selected-file))) 15492 (vhdl-speedbar-update-units 15493 "\\[.] " (nth 0 file-entry) 15494 speedbar-last-selected-file 'vhdl-speedbar-entity-face) 15495 (vhdl-speedbar-update-units 15496 "{.} " (nth 1 file-entry) 15497 speedbar-last-selected-file 'vhdl-speedbar-architecture-face) 15498 (vhdl-speedbar-update-units 15499 "\\[.] " (nth 3 file-entry) 15500 speedbar-last-selected-file 'vhdl-speedbar-configuration-face) 15501 (vhdl-speedbar-update-units 15502 "[]>] " (nth 4 file-entry) 15503 speedbar-last-selected-file 'vhdl-speedbar-package-face) 15504 (vhdl-speedbar-update-units 15505 "\\[.].+(" '("body") 15506 speedbar-last-selected-file 'vhdl-speedbar-package-face) 15507 (vhdl-speedbar-update-units 15508 "> " (nth 6 file-entry) 15509 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) 15510 ;; highlight current units 15511 (let* ((file-entry (vhdl-aget file-alist file-name))) 15512 (setq 15513 pos (vhdl-speedbar-update-units 15514 "\\[.] " (nth 0 file-entry) 15515 file-name 'vhdl-speedbar-entity-selected-face pos) 15516 pos (vhdl-speedbar-update-units 15517 "{.} " (nth 1 file-entry) 15518 file-name 'vhdl-speedbar-architecture-selected-face pos) 15519 pos (vhdl-speedbar-update-units 15520 "\\[.] " (nth 3 file-entry) 15521 file-name 'vhdl-speedbar-configuration-selected-face pos) 15522 pos (vhdl-speedbar-update-units 15523 "[]>] " (nth 4 file-entry) 15524 file-name 'vhdl-speedbar-package-selected-face pos) 15525 pos (vhdl-speedbar-update-units 15526 "\\[.].+(" '("body") 15527 file-name 'vhdl-speedbar-package-selected-face pos) 15528 pos (vhdl-speedbar-update-units 15529 "> " (nth 6 file-entry) 15530 file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) 15531 ;; move speedbar so the first highlighted unit is visible 15532 (when (and pos (not no-position)) 15533 (goto-char pos) 15534 (speedbar-center-buffer-smartly) 15535 (speedbar-position-cursor-on-line)) 15536 (setq speedbar-last-selected-file file-name)) 15537 (select-frame last-frame) 15538 t)) 15539 15540(defun vhdl-speedbar-update-units (text unit-list file-name face 15541 &optional pos) 15542 "Help function to highlight design units." 15543 (while unit-list 15544 (goto-char (point-min)) 15545 (while (re-search-forward 15546 (concat text "\\(" (car unit-list) "\\)\\>") nil t) 15547 (when (equal file-name (car (get-text-property 15548 (match-beginning 1) 'speedbar-token))) 15549 (setq pos (or pos (point-marker))) 15550 (put-text-property (match-beginning 1) (match-end 1) 'face face))) 15551 (setq unit-list (cdr unit-list))) 15552 pos) 15553 15554(declare-function speedbar-make-button "speedbar" 15555 (start end face mouse function &optional token)) 15556 15557(defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker 15558 ent-name ent-file-marker 15559 arch-name arch-file-marker 15560 conf-name conf-file-marker 15561 lib-name depth offset delimiter) 15562 "Insert instantiation entry." 15563 (let ((start (point)) 15564 visible-start) 15565 (insert (int-to-string depth) ":") 15566 (put-text-property start (point) 'invisible t) 15567 (setq visible-start (point)) 15568 (insert-char ? (* depth speedbar-indentation-width)) 15569 (while (> offset 0) 15570 (insert "|") 15571 (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) 15572 (setq offset (1- offset))) 15573 (put-text-property visible-start (point) 'invisible nil) 15574 (setq start (point)) 15575 (insert ">") 15576 (speedbar-make-button start (point) nil nil nil) 15577 (setq visible-start (point)) 15578 (insert " ") 15579 (setq start (point)) 15580 (if (not inst-name) 15581 (insert "(top)") 15582 (insert inst-name) 15583 (speedbar-make-button 15584 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face 15585 'vhdl-speedbar-find-file inst-file-marker)) 15586 (insert delimiter) 15587 (when ent-name 15588 (setq start (point)) 15589 (insert ent-name) 15590 (speedbar-make-button 15591 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face 15592 'vhdl-speedbar-find-file ent-file-marker) 15593 (when arch-name 15594 (insert " (") 15595 (setq start (point)) 15596 (insert arch-name) 15597 (speedbar-make-button 15598 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face 15599 'vhdl-speedbar-find-file arch-file-marker) 15600 (insert ")")) 15601 (when conf-name 15602 (insert " (") 15603 (setq start (point)) 15604 (insert conf-name) 15605 (speedbar-make-button 15606 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face 15607 'vhdl-speedbar-find-file conf-file-marker) 15608 (insert ")"))) 15609 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) 15610 (setq start (point)) 15611 (insert " (" lib-name ")") 15612 (put-text-property (+ 2 start) (1- (point)) 'face 15613 'vhdl-speedbar-library-face)) 15614 (insert-char ?\n 1) 15615 (put-text-property visible-start (point) 'invisible nil))) 15616 15617(defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker 15618 body-file-marker depth) 15619 "Insert package entry." 15620 (let ((start (point)) 15621 visible-start) 15622 (insert (int-to-string depth) ":") 15623 (put-text-property start (point) 'invisible t) 15624 (setq visible-start (point)) 15625 (insert-char ? (* depth speedbar-indentation-width)) 15626 (put-text-property visible-start (point) 'invisible nil) 15627 (setq start (point)) 15628 (insert "[+]") 15629 (speedbar-make-button 15630 start (point) 'speedbar-button-face 'speedbar-highlight-face 15631 'vhdl-speedbar-expand-package pack-key) 15632 (setq visible-start (point)) 15633 (insert-char ? 1 nil) 15634 (setq start (point)) 15635 (insert pack-name) 15636 (speedbar-make-button 15637 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15638 'vhdl-speedbar-find-file pack-file-marker) 15639 (unless (car pack-file-marker) 15640 (insert "!")) 15641 (when (car body-file-marker) 15642 (insert " (") 15643 (setq start (point)) 15644 (insert "body") 15645 (speedbar-make-button 15646 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15647 'vhdl-speedbar-find-file body-file-marker) 15648 (insert ")")) 15649 (insert-char ?\n 1) 15650 (put-text-property visible-start (point) 'invisible nil))) 15651 15652(defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker 15653 pack-body-file-marker depth) 15654 "Insert used package entry." 15655 (let ((start (point)) 15656 visible-start) 15657 (insert (int-to-string depth) ":") 15658 (put-text-property start (point) 'invisible t) 15659 (setq visible-start (point)) 15660 (insert-char ? (* depth speedbar-indentation-width)) 15661 (put-text-property visible-start (point) 'invisible nil) 15662 (setq start (point)) 15663 (insert ">") 15664 (speedbar-make-button start (point) nil nil nil) 15665 (setq visible-start (point)) 15666 (insert " ") 15667 (setq start (point)) 15668 (insert pack-name) 15669 (speedbar-make-button 15670 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15671 'vhdl-speedbar-find-file pack-file-marker) 15672 (when (car pack-body-file-marker) 15673 (insert " (") 15674 (setq start (point)) 15675 (insert "body") 15676 (speedbar-make-button 15677 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 15678 'vhdl-speedbar-find-file pack-body-file-marker) 15679 (insert ")")) 15680 (setq start (point)) 15681 (insert " (" lib-name ")") 15682 (put-text-property (+ 2 start) (1- (point)) 'face 15683 'vhdl-speedbar-library-face) 15684 (insert-char ?\n 1) 15685 (put-text-property visible-start (point) 'invisible nil))) 15686 15687(defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker 15688 func-body-file-marker 15689 depth) 15690 "Insert subprogram entry." 15691 (let ((start (point)) 15692 visible-start) 15693 (insert (int-to-string depth) ":") 15694 (put-text-property start (point) 'invisible t) 15695 (setq visible-start (point)) 15696 (insert-char ? (* depth speedbar-indentation-width)) 15697 (put-text-property visible-start (point) 'invisible nil) 15698 (setq start (point)) 15699 (insert ">") 15700 (speedbar-make-button start (point) nil nil nil) 15701 (setq visible-start (point)) 15702 (insert " ") 15703 (setq start (point)) 15704 (insert func-name) 15705 (speedbar-make-button 15706 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 15707 'vhdl-speedbar-find-file func-file-marker) 15708 (when (car func-body-file-marker) 15709 (insert " (") 15710 (setq start (point)) 15711 (insert "body") 15712 (speedbar-make-button 15713 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 15714 'vhdl-speedbar-find-file func-body-file-marker) 15715 (insert ")")) 15716 (insert-char ?\n 1) 15717 (put-text-property visible-start (point) 'invisible nil))) 15718 15719(defun vhdl-speedbar-make-title-line (text &optional depth) 15720 "Insert design unit title entry." 15721 (let ((start (point)) 15722 visible-start) 15723 (when depth 15724 (insert (int-to-string depth) ":") 15725 (put-text-property start (point) 'invisible t)) 15726 (setq visible-start (point)) 15727 (insert-char ? (* (or depth 0) speedbar-indentation-width)) 15728 (setq start (point)) 15729 (insert text) 15730 (speedbar-make-button start (point) nil nil nil nil) 15731 (insert-char ?\n 1) 15732 (put-text-property visible-start (point) 'invisible nil))) 15733 15734(defun vhdl-speedbar-insert-dirs (files level) 15735 "Insert subdirectories." 15736 (let ((dirs (car files))) 15737 (while dirs 15738 (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) 15739 (car dirs) 'speedbar-dir-follow nil 15740 'speedbar-directory-face level) 15741 (setq dirs (cdr dirs))))) 15742 15743(declare-function speedbar-reset-scanners "speedbar" ()) 15744 15745(defun vhdl-speedbar-dired (text token indent) 15746 "Speedbar click handler for directory expand button in hierarchy mode." 15747 (cond ((string-match "\\+" text) ; we have to expand this dir 15748 (setq speedbar-shown-directories 15749 (cons (expand-file-name 15750 (concat (speedbar-line-directory indent) token "/")) 15751 speedbar-shown-directories)) 15752 (speedbar-change-expand-button-char ?-) 15753 (speedbar-reset-scanners) 15754 (speedbar-with-writable 15755 (save-excursion 15756 (end-of-line) (forward-char 1) 15757 (vhdl-speedbar-insert-dirs 15758 (speedbar-file-lists 15759 (concat (speedbar-line-directory indent) token "/")) 15760 (1+ indent)) 15761 (speedbar-reset-scanners) 15762 (vhdl-speedbar-insert-dir-hierarchy 15763 (abbreviate-file-name 15764 (concat (speedbar-line-directory indent) token "/")) 15765 (1+ indent) speedbar-power-click))) 15766 (vhdl-speedbar-update-current-unit t t)) 15767 ((string-match "-" text) ; we have to contract this node 15768 (speedbar-reset-scanners) 15769 (let ((oldl speedbar-shown-directories) 15770 (newl nil) 15771 (td (expand-file-name 15772 (concat (speedbar-line-directory indent) token)))) 15773 (while oldl 15774 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) 15775 (push (car oldl) newl)) 15776 (setq oldl (cdr oldl))) 15777 (setq speedbar-shown-directories (nreverse newl))) 15778 (speedbar-change-expand-button-char ?+) 15779 (speedbar-delete-subblock indent)) 15780 (t (error "Nothing to display"))) 15781 (when (equal (selected-frame) speedbar-frame) 15782 (speedbar-center-buffer-smartly))) 15783 15784(declare-function speedbar-files-item-info "speedbar" ()) 15785 15786(defun vhdl-speedbar-item-info () 15787 "Derive and display information about this line item." 15788 (save-excursion 15789 (beginning-of-line) 15790 ;; skip invisible number info 15791 (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) 15792 (cond 15793 ;; project/directory entry 15794 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") 15795 (if vhdl-speedbar-show-projects 15796 (message "Project \"%s\"" (match-string-no-properties 1)) 15797 (speedbar-files-item-info))) 15798 ;; design unit entry 15799 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") 15800 (goto-char (match-end 1)) 15801 (let ((face (get-text-property (point) 'face))) 15802 (message 15803 "%s \"%s\" in \"%s\"" 15804 ;; design unit kind 15805 (cond ((or (eq face 'vhdl-speedbar-entity-face) 15806 (eq face 'vhdl-speedbar-entity-selected-face)) 15807 (if (equal (match-string 2) ">") "Component" "Entity")) 15808 ((or (eq face 'vhdl-speedbar-architecture-face) 15809 (eq face 'vhdl-speedbar-architecture-selected-face)) 15810 "Architecture") 15811 ((or (eq face 'vhdl-speedbar-configuration-face) 15812 (eq face 'vhdl-speedbar-configuration-selected-face)) 15813 "Configuration") 15814 ((or (eq face 'vhdl-speedbar-package-face) 15815 (eq face 'vhdl-speedbar-package-selected-face)) 15816 "Package") 15817 ((or (eq face 'vhdl-speedbar-instantiation-face) 15818 (eq face 'vhdl-speedbar-instantiation-selected-face)) 15819 "Instantiation") 15820 ((eq face 'vhdl-speedbar-subprogram-face) 15821 "Subprogram") 15822 (t "")) 15823 ;; design unit name 15824 (buffer-substring-no-properties 15825 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) 15826 (match-end 1)) 15827 ;; file name 15828 (file-relative-name 15829 (or (car (get-text-property (point) 'speedbar-token)) 15830 "?") 15831 (vhdl-default-directory))))) 15832 (t (message ""))))) 15833 15834(declare-function speedbar-line-text "speedbar" (&optional p)) 15835 15836(defun vhdl-speedbar-line-text () 15837 "Call `speedbar-line-text' and remove text properties." 15838 (let ((string (speedbar-line-text))) 15839 (set-text-properties 0 (length string) nil string) 15840 string)) 15841 15842(defun vhdl-speedbar-higher-text () 15843 "Get speedbar-line-text of higher level." 15844 (let (depth string) 15845 (save-excursion 15846 (beginning-of-line) 15847 (looking-at "^\\([0-9]+\\):") 15848 (setq depth (string-to-number (match-string 1))) 15849 (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) 15850 (setq string (match-string 1)) 15851 (set-text-properties 0 (length string) nil string) 15852 string)))) 15853 15854;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15855;; Help functions 15856 15857(defun vhdl-speedbar-line-key (&optional indent) 15858 "Get currently displayed directory of project name." 15859 (if vhdl-speedbar-show-projects 15860 (vhdl-speedbar-line-project) 15861 (abbreviate-file-name 15862 (file-name-as-directory (speedbar-line-directory indent))))) 15863 15864(defun vhdl-speedbar-line-project (&optional _indent) 15865 "Get currently displayed project name." 15866 (and vhdl-speedbar-show-projects 15867 (save-excursion 15868 (end-of-line) 15869 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) 15870 (match-string-no-properties 1)))) 15871 15872(defun vhdl-add-modified-file () 15873 "Add file to `vhdl-modified-file-list'." 15874 (when vhdl-file-alist 15875 (add-to-list 'vhdl-modified-file-list (buffer-file-name))) 15876 nil) 15877 15878(defun vhdl-resolve-paths (path-list) 15879 "Resolve path wildcards in PATH-LIST." 15880 (let (path-list-1 path-list-2 path-beg path-end dir) 15881 ;; eliminate non-existent directories 15882 (while path-list 15883 (setq dir (car path-list)) 15884 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) 15885 (if (file-directory-p (match-string 2 dir)) 15886 (push dir path-list-1) 15887 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) 15888 (setq path-list (cdr path-list))) 15889 ;; resolve path wildcards 15890 (while path-list-1 15891 (setq dir (car path-list-1)) 15892 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) 15893 (progn 15894 (setq path-beg (match-string 1 dir) 15895 path-end (match-string 5 dir)) 15896 (setq path-list-1 15897 (append 15898 (mapcar 15899 (lambda (var) (concat path-beg var path-end)) 15900 (let ((all-list (vhdl-directory-files 15901 (match-string 2 dir) t 15902 (concat "\\<" (wildcard-to-regexp 15903 (match-string 4 dir))))) 15904 dir-list) 15905 (while all-list 15906 (when (file-directory-p (car all-list)) 15907 (push (car all-list) dir-list)) 15908 (setq all-list (cdr all-list))) 15909 dir-list)) 15910 (cdr path-list-1)))) 15911 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) 15912 (when (file-directory-p (match-string 2 dir)) 15913 (push dir path-list-2)) 15914 (setq path-list-1 (cdr path-list-1)))) 15915 (nreverse path-list-2))) 15916 15917(defun vhdl-speedbar-goto-this-unit (directory unit) 15918 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." 15919 (let ((dest (point))) 15920 (if (and (if vhdl-speedbar-show-projects 15921 (progn (goto-char (point-min)) t) 15922 (speedbar-goto-this-file directory)) 15923 (re-search-forward (concat "[]}] " unit "\\>") nil t)) 15924 (progn (speedbar-position-cursor-on-line) 15925 t) 15926 (goto-char dest) 15927 nil))) 15928 15929(declare-function speedbar-find-file-in-frame "speedbar" (file)) 15930(declare-function speedbar-set-timer "speedbar" (timeout)) 15931;; speedbar loads dframe at runtime. 15932(declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) 15933 15934(defun vhdl-speedbar-find-file (_text token _indent) 15935 "When user clicks on TEXT, load file with name and position in TOKEN. 15936Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file 15937is already shown in a buffer." 15938 (if (not (car token)) 15939 (error "ERROR: File cannot be found") 15940 (let ((buffer (get-file-buffer (car token)))) 15941 (speedbar-find-file-in-frame (car token)) 15942 (when (or vhdl-speedbar-jump-to-unit buffer) 15943 (goto-char (point-min)) 15944 (forward-line (1- (cdr token))) 15945 (recenter)) 15946 (vhdl-speedbar-update-current-unit t t) 15947 (speedbar-set-timer dframe-update-speed) 15948 (dframe-maybee-jump-to-attached-frame)))) 15949 15950(defun vhdl-speedbar-port-copy () 15951 "Copy the port of the entity/component or subprogram under the cursor." 15952 (interactive) 15953 (let ((is-entity (vhdl-speedbar-check-unit 'entity))) 15954 (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) 15955 (error "ERROR: No entity/component or subprogram under cursor") 15956 (beginning-of-line) 15957 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") 15958 (condition-case info 15959 (let ((token (get-text-property 15960 (match-beginning 3) 'speedbar-token))) 15961 (vhdl-visit-file (car token) t 15962 (goto-char (point-min)) 15963 (forward-line (1- (cdr token))) 15964 (end-of-line) 15965 (if is-entity 15966 (vhdl-port-copy) 15967 (vhdl-subprog-copy)))) 15968 (error (error "ERROR: %s not scanned successfully\n (%s)" 15969 (if is-entity "Port" "Interface") (cadr info)))) 15970 (error "ERROR: No entity/component or subprogram on current line"))))) 15971 15972(defun vhdl-speedbar-place-component () 15973 "Place the entity/component under the cursor as component." 15974 (interactive) 15975 (if (not (vhdl-speedbar-check-unit 'entity)) 15976 (error "ERROR: No entity/component under cursor") 15977 (vhdl-speedbar-port-copy) 15978 (if (fboundp 'speedbar-select-attached-frame) 15979 (speedbar-select-attached-frame) 15980 (select-frame speedbar-attached-frame)) 15981 (vhdl-compose-place-component) 15982 (select-frame speedbar-frame))) 15983 15984(defun vhdl-speedbar-configuration () 15985 "Generate configuration for the architecture under the cursor." 15986 (interactive) 15987 (if (not (vhdl-speedbar-check-unit 'architecture)) 15988 (error "ERROR: No architecture under cursor") 15989 (let ((arch-name (vhdl-speedbar-line-text)) 15990 (ent-name (vhdl-speedbar-higher-text))) 15991 (if (fboundp 'speedbar-select-attached-frame) 15992 (speedbar-select-attached-frame) 15993 (select-frame speedbar-attached-frame)) 15994 (vhdl-compose-configuration ent-name arch-name)))) 15995 15996(defun vhdl-speedbar-select-mra () 15997 "Select the architecture under the cursor as MRA." 15998 (interactive) 15999 (if (not (vhdl-speedbar-check-unit 'architecture)) 16000 (error "ERROR: No architecture under cursor") 16001 (let* ((arch-key (downcase (vhdl-speedbar-line-text))) 16002 (ent-key (downcase (vhdl-speedbar-higher-text))) 16003 (ent-alist (vhdl-aget 16004 vhdl-entity-alist 16005 (or (vhdl-project-p) 16006 (abbreviate-file-name default-directory)))) 16007 (ent-entry (vhdl-aget ent-alist ent-key))) 16008 (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) 16009 (speedbar-refresh)))) 16010 16011(declare-function speedbar-line-file "speedbar" (&optional p)) 16012 16013(defun vhdl-speedbar-make-design () 16014 "Make (compile) design unit or directory/project under the cursor." 16015 (interactive) 16016 (if (not (save-excursion (beginning-of-line) 16017 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) 16018 (error "ERROR: No primary design unit or directory/project under cursor") 16019 (let ((is-unit (match-string 2)) 16020 (unit-name (vhdl-speedbar-line-text)) 16021 (vhdl-project (vhdl-speedbar-line-project)) 16022 (directory (file-name-as-directory 16023 (or (speedbar-line-file) (speedbar-line-directory))))) 16024 (if (fboundp 'speedbar-select-attached-frame) 16025 (speedbar-select-attached-frame) 16026 (select-frame speedbar-attached-frame)) 16027 (let ((default-directory directory)) 16028 (vhdl-make (and is-unit unit-name)))))) 16029 16030(defun vhdl-speedbar-generate-makefile () 16031 "Generate Makefile for directory/project under the cursor." 16032 (interactive) 16033 (let ((vhdl-project (vhdl-speedbar-line-project)) 16034 (default-directory (file-name-as-directory 16035 (or (speedbar-line-file) (speedbar-line-directory))))) 16036 (vhdl-generate-makefile))) 16037 16038(defun vhdl-speedbar-check-unit (design-unit) 16039 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its 16040expansion function)." 16041 (save-excursion 16042 (speedbar-position-cursor-on-line) 16043 (cond ((eq design-unit 'entity) 16044 (memq (get-text-property (match-end 0) 'face) 16045 '(vhdl-speedbar-entity-face 16046 vhdl-speedbar-entity-selected-face))) 16047 ((eq design-unit 'architecture) 16048 (memq (get-text-property (match-end 0) 'face) 16049 '(vhdl-speedbar-architecture-face 16050 vhdl-speedbar-architecture-selected-face))) 16051 ((eq design-unit 'subprogram) 16052 (eq (get-text-property (match-end 0) 'face) 16053 'vhdl-speedbar-subprogram-face)) 16054 (t nil)))) 16055 16056(defun vhdl-speedbar-set-depth (depth) 16057 "Set hierarchy display depth to DEPTH and refresh speedbar." 16058 (setq vhdl-speedbar-hierarchy-depth depth) 16059 (speedbar-refresh)) 16060 16061;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16062;; Fontification 16063 16064(defface vhdl-speedbar-entity-face 16065 '((((class color) (background light)) (:foreground "ForestGreen")) 16066 (((class color) (background dark)) (:foreground "PaleGreen"))) 16067 "Face used for displaying entity names." 16068 :group 'speedbar-faces) 16069 16070(defface vhdl-speedbar-architecture-face 16071 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) 16072 (((class color) (background light)) (:foreground "Blue")) 16073 16074 (((class color) (background dark)) (:foreground "LightSkyBlue"))) 16075 "Face used for displaying architecture names." 16076 :group 'speedbar-faces) 16077 16078(defface vhdl-speedbar-configuration-face 16079 '((((class color) (background light)) (:foreground "DarkGoldenrod")) 16080 (((class color) (background dark)) (:foreground "Salmon"))) 16081 "Face used for displaying configuration names." 16082 :group 'speedbar-faces) 16083 16084(defface vhdl-speedbar-package-face 16085 '((((class color) (background light)) (:foreground "Grey50")) 16086 (((class color) (background dark)) (:foreground "Grey80"))) 16087 "Face used for displaying package names." 16088 :group 'speedbar-faces) 16089 16090(defface vhdl-speedbar-library-face 16091 '((((class color) (background light)) (:foreground "Purple")) 16092 (((class color) (background dark)) (:foreground "Orchid1"))) 16093 "Face used for displaying library names." 16094 :group 'speedbar-faces) 16095 16096(defface vhdl-speedbar-instantiation-face 16097 '((((class color) (background light)) (:foreground "Brown")) 16098 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) 16099 (((class color) (background dark)) (:foreground "Yellow"))) 16100 "Face used for displaying instantiation names." 16101 :group 'speedbar-faces) 16102 16103(defface vhdl-speedbar-subprogram-face 16104 '((((class color) (background light)) (:foreground "Orchid4")) 16105 (((class color) (background dark)) (:foreground "BurlyWood2"))) 16106 "Face used for displaying subprogram names." 16107 :group 'speedbar-faces) 16108 16109(defface vhdl-speedbar-entity-selected-face 16110 '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) 16111 (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) 16112 "Face used for displaying entity names." 16113 :group 'speedbar-faces) 16114 16115(defface vhdl-speedbar-architecture-selected-face 16116 '((((min-colors 88) (class color) (background light)) (:foreground 16117 "Blue1" :underline t)) 16118 (((class color) (background light)) (:foreground "Blue" :underline t)) 16119 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) 16120 "Face used for displaying architecture names." 16121 :group 'speedbar-faces) 16122 16123(defface vhdl-speedbar-configuration-selected-face 16124 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) 16125 (((class color) (background dark)) (:foreground "Salmon" :underline t))) 16126 "Face used for displaying configuration names." 16127 :group 'speedbar-faces) 16128 16129(defface vhdl-speedbar-package-selected-face 16130 '((((class color) (background light)) (:foreground "Grey50" :underline t)) 16131 (((class color) (background dark)) (:foreground "Grey80" :underline t))) 16132 "Face used for displaying package names." 16133 :group 'speedbar-faces) 16134 16135(defface vhdl-speedbar-instantiation-selected-face 16136 '((((class color) (background light)) (:foreground "Brown" :underline t)) 16137 (((class color) (background dark)) (:foreground "Yellow" :underline t))) 16138 "Face used for displaying instantiation names." 16139 :group 'speedbar-faces) 16140 16141;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16142;; Initialization 16143 16144;; add speedbar 16145(when (fboundp 'speedbar) 16146 (let ((current-frame (selected-frame))) 16147 (condition-case () 16148 (when (and vhdl-speedbar-auto-open 16149 (not (and (boundp 'speedbar-frame) 16150 (frame-live-p speedbar-frame)))) 16151 (speedbar-frame-mode 1)) 16152 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))) 16153 (select-frame current-frame))) 16154 16155;; initialize speedbar 16156(if (not (boundp 'speedbar-frame)) 16157 (with-no-warnings (add-hook 'speedbar-load-hook #'vhdl-speedbar-initialize)) 16158 (vhdl-speedbar-initialize) 16159 (when speedbar-frame (vhdl-speedbar-refresh))) 16160 16161 16162;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16163;;; Structural composition 16164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16165 16166(defun vhdl-get-components-package-name () 16167 "Return the name of the components package." 16168 (let ((project (vhdl-project-p))) 16169 (if project 16170 (vhdl-replace-string (car vhdl-components-package-name) 16171 (subst-char-in-string ? ?_ project)) 16172 (cdr vhdl-components-package-name)))) 16173 16174(defun vhdl-compose-new-component () 16175 "Create entity and architecture for new component." 16176 (interactive) 16177 (let* ((case-fold-search t) 16178 (ent-name (read-from-minibuffer "entity name: " 16179 nil vhdl-minibuffer-local-map)) 16180 (arch-name 16181 (if (equal (cdr vhdl-compose-architecture-name) "") 16182 (read-from-minibuffer "architecture name: " 16183 nil vhdl-minibuffer-local-map) 16184 (vhdl-replace-string vhdl-compose-architecture-name ent-name))) 16185 ent-file-name arch-file-name ent-buffer arch-buffer end-pos) ;; project 16186 (message "Creating component \"%s(%s)\"..." ent-name arch-name) 16187 ;; open entity file 16188 (unless (eq vhdl-compose-create-files 'none) 16189 (setq ent-file-name 16190 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16191 "." (file-name-extension (buffer-file-name)))) 16192 (when (and (file-exists-p ent-file-name) 16193 (not (y-or-n-p (concat "File \"" ent-file-name 16194 "\" exists; overwrite? ")))) 16195 (error "ERROR: Creating component...aborted")) 16196 (find-file ent-file-name) 16197 (erase-buffer) 16198 (set-buffer-modified-p nil)) 16199 ;; insert header 16200 (if vhdl-compose-include-header 16201 (progn (vhdl-template-header) 16202 (setq end-pos (point)) 16203 (goto-char (point-max))) 16204 (vhdl-comment-display-line) (insert "\n\n")) 16205 ;; insert library clause 16206 (vhdl-template-package-std-logic-1164) 16207 (when vhdl-use-components-package 16208 (insert "\n") 16209 (vhdl-template-standard-package (vhdl-work-library) 16210 (vhdl-get-components-package-name))) 16211 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") 16212 ;; insert entity declaration 16213 (vhdl-insert-keyword "ENTITY ") (insert ent-name) 16214 (vhdl-insert-keyword " IS\n") 16215 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16216 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") 16217 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 16218 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16219 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") 16220 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 16221 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 16222 (vhdl-insert-keyword "END ") 16223 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 16224 (insert ent-name ";\n\n") 16225 (vhdl-comment-display-line) (insert "\n") 16226 ;; open architecture file 16227 (if (not (eq vhdl-compose-create-files 'separate)) 16228 (insert "\n") 16229 (goto-char (or end-pos (point-min))) 16230 (setq ent-buffer (current-buffer)) 16231 (setq arch-file-name 16232 (concat (vhdl-replace-string vhdl-architecture-file-name 16233 (concat ent-name " " arch-name) t) 16234 "." (file-name-extension (buffer-file-name)))) 16235 (when (and (file-exists-p arch-file-name) 16236 (not (y-or-n-p (concat "File \"" arch-file-name 16237 "\" exists; overwrite? ")))) 16238 (error "ERROR: Creating component...aborted")) 16239 (find-file arch-file-name) 16240 (erase-buffer) 16241 (set-buffer-modified-p nil) 16242 ;; insert header 16243 (if vhdl-compose-include-header 16244 (progn (vhdl-template-header) 16245 (goto-char (point-max))) 16246 (vhdl-comment-display-line) (insert "\n\n"))) 16247 ;; insert architecture body 16248 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) 16249 (vhdl-insert-keyword " OF ") (insert ent-name) 16250 (vhdl-insert-keyword " IS\n\n") 16251 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16252 (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") 16253 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16254 (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) 16255 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16256 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 16257 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) 16258 (vhdl-insert-keyword "BEGIN") 16259 (when vhdl-self-insert-comments 16260 (insert " -- ") 16261 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 16262 (insert arch-name)) 16263 (insert "\n\n") 16264 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16265 (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") 16266 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16267 (vhdl-insert-keyword "END ") 16268 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 16269 (insert arch-name ";\n\n") 16270 ;; insert footer and save 16271 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16272 (vhdl-template-footer) 16273 (vhdl-comment-display-line) (insert "\n")) 16274 (goto-char (or end-pos (point-min))) 16275 (setq arch-buffer (current-buffer)) 16276 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 16277 (set-buffer arch-buffer) (save-buffer) 16278 (message "%s" 16279 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) 16280 (and ent-file-name 16281 (format "\n File created: \"%s\"" ent-file-name)) 16282 (and arch-file-name 16283 (format "\n File created: \"%s\"" arch-file-name)))))) 16284 16285(defun vhdl-compose-place-component () 16286 "Place new component by pasting current port as component declaration and 16287component instantiation." 16288 (interactive) 16289 (if (not vhdl-port-list) 16290 (error "ERROR: No port has been read") 16291 (save-excursion 16292 (vhdl-prepare-search-2 16293 (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) 16294 (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)) 16295 (error "ERROR: No architecture found")) 16296 (let* ((ent-name (match-string 1)) 16297 (ent-file-name 16298 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16299 "." (file-name-extension (buffer-file-name)))) 16300 (orig-buffer (current-buffer))) 16301 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) 16302 ;; place component declaration 16303 (unless (or vhdl-use-components-package 16304 (vhdl-use-direct-instantiation) 16305 (save-excursion 16306 (re-search-forward 16307 (concat "^\\s-*component\\s-+" 16308 (car vhdl-port-list) "\\>") nil t))) 16309 (re-search-forward "^begin\\>" 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-component t)) 16314 ;; place component instantiation 16315 (re-search-forward "^end\\>" nil) 16316 (beginning-of-line) 16317 (skip-chars-backward " \t\n\r\f") 16318 (insert "\n\n") (indent-to vhdl-basic-offset) 16319 (vhdl-port-paste-instance nil t t) 16320 ;; place use clause for used packages 16321 (when (nth 3 vhdl-port-list) 16322 ;; open entity file 16323 (when (file-exists-p ent-file-name) 16324 (find-file ent-file-name)) 16325 (goto-char (point-min)) 16326 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) 16327 (error "ERROR: Entity not found: \"%s\"" ent-name)) 16328 (goto-char (match-beginning 0)) 16329 (if (and (save-excursion 16330 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) 16331 (match-string 1)) 16332 (progn (goto-char (match-end 0)) 16333 (beginning-of-line 2)) 16334 (insert "\n") 16335 (backward-char)) 16336 (vhdl-port-paste-context-clause) 16337 (switch-to-buffer orig-buffer)) 16338 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) 16339 16340(defun vhdl-compose-wire-components () 16341 "Connect components." 16342 (interactive) 16343 (save-excursion 16344 (vhdl-prepare-search-2 16345 (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) 16346 (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)) 16347 (error "ERROR: No architecture found")) 16348 (let* ((ent-name (match-string 1)) 16349 (ent-file-name 16350 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 16351 "." (file-name-extension (buffer-file-name)))) 16352 (arch-decl-pos (point-marker)) 16353 (arch-stat-pos (re-search-forward "^begin\\>" nil)) 16354 (arch-end-pos (re-search-forward "^end\\>" nil)) 16355 (pack-name (vhdl-get-components-package-name)) 16356 (pack-file-name 16357 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 16358 "." (file-name-extension (buffer-file-name)))) 16359 inst-name comp-name comp-ent-name comp-ent-file-name has-generic 16360 port-alist generic-alist inst-alist 16361 signal-name signal-entry signal-alist local-list written-list 16362 single-in-list multi-in-list single-out-list multi-out-list 16363 constant-name constant-entry constant-alist single-list multi-list 16364 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos 16365 generic-beg-pos generic-pos generic-inst-pos generic-end-pos 16366 signal-beg-pos signal-pos 16367 constant-temp-pos port-temp-pos signal-temp-pos) 16368 (message "Wiring components...") 16369 ;; process all instances 16370 (goto-char arch-stat-pos) 16371 (while (re-search-forward 16372 (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" 16373 "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)" 16374 "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|" 16375 "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?" 16376 "[ \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) 16377 (setq inst-name (match-string-no-properties 1) 16378 comp-name (match-string-no-properties 4) 16379 comp-ent-name (match-string-no-properties 12) 16380 has-generic (or (match-string 7) (match-string 17))) 16381 ;; get port ... 16382 (if comp-name 16383 ;; ... from component declaration 16384 (vhdl-visit-file 16385 (when vhdl-use-components-package pack-file-name) t 16386 (save-excursion 16387 (goto-char (point-min)) 16388 (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) 16389 (error "ERROR: Component declaration not found: \"%s\"" comp-name)) 16390 (vhdl-port-copy))) 16391 ;; ... from entity declaration (direct instantiation) 16392 (setq comp-ent-file-name 16393 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) 16394 "." (file-name-extension (buffer-file-name)))) 16395 (vhdl-visit-file 16396 comp-ent-file-name t 16397 (save-excursion 16398 (goto-char (point-min)) 16399 (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) 16400 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) 16401 (vhdl-port-copy)))) 16402 (vhdl-port-flatten t) 16403 (setq generic-alist (nth 1 vhdl-port-list) 16404 port-alist (nth 2 vhdl-port-list) 16405 vhdl-port-list nil) 16406 (setq constant-alist nil 16407 signal-alist nil) 16408 (when has-generic 16409 ;; process all constants in generic map 16410 (vhdl-forward-syntactic-ws) 16411 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) 16412 (setq constant-name (match-string-no-properties 3)) 16413 (setq constant-entry 16414 (cons constant-name 16415 (if (match-string 1) 16416 (or (vhdl-aget generic-alist (match-string 2)) 16417 (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 16418 (cdar generic-alist)))) 16419 (push constant-entry constant-alist) 16420 (setq constant-name (downcase constant-name)) 16421 (if (or (member constant-name single-list) 16422 (member constant-name multi-list)) 16423 (progn (setq single-list (delete constant-name single-list)) 16424 (vhdl--pushnew constant-name multi-list :test #'equal)) 16425 (vhdl--pushnew constant-name single-list :test #'equal)) 16426 (unless (match-string 1) 16427 (setq generic-alist (cdr generic-alist))) 16428 (vhdl-forward-syntactic-ws)) 16429 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t)) 16430 ;; process all signals in port map 16431 (vhdl-forward-syntactic-ws) 16432 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) 16433 (setq signal-name (match-string-no-properties 3)) 16434 (setq signal-entry 16435 (cons signal-name 16436 (if (match-string 1) 16437 (or (vhdl-aget port-alist (match-string 2)) 16438 (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 16439 (cdar port-alist)))) 16440 (push signal-entry signal-alist) 16441 (setq signal-name (downcase signal-name)) 16442 (if (equal (upcase (nth 2 signal-entry)) "IN") 16443 ;; input signal 16444 (cond 16445 ((member signal-name local-list) 16446 nil) 16447 ((or (member signal-name single-out-list) 16448 (member signal-name multi-out-list)) 16449 (setq single-out-list (delete signal-name single-out-list)) 16450 (setq multi-out-list (delete signal-name multi-out-list)) 16451 (vhdl--pushnew signal-name local-list :test #'equal)) 16452 ((member signal-name single-in-list) 16453 (setq single-in-list (delete signal-name single-in-list)) 16454 (vhdl--pushnew signal-name multi-in-list :test #'equal)) 16455 ((not (member signal-name multi-in-list)) 16456 (vhdl--pushnew signal-name single-in-list :test #'equal))) 16457 ;; output signal 16458 (cond 16459 ((member signal-name local-list) 16460 nil) 16461 ((or (member signal-name single-in-list) 16462 (member signal-name multi-in-list)) 16463 (setq single-in-list (delete signal-name single-in-list)) 16464 (setq multi-in-list (delete signal-name multi-in-list)) 16465 (vhdl--pushnew signal-name local-list :test #'equal)) 16466 ((member signal-name single-out-list) 16467 (setq single-out-list (delete signal-name single-out-list)) 16468 (vhdl--pushnew signal-name multi-out-list :test #'equal)) 16469 ((not (member signal-name multi-out-list)) 16470 (vhdl--pushnew signal-name single-out-list :test #'equal)))) 16471 (unless (match-string 1) 16472 (setq port-alist (cdr port-alist))) 16473 (vhdl-forward-syntactic-ws)) 16474 (push (list inst-name (nreverse constant-alist) 16475 (nreverse signal-alist)) 16476 inst-alist)) 16477 ;; prepare signal insertion 16478 (vhdl-goto-marker arch-decl-pos) 16479 (forward-line 1) 16480 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t) 16481 (setq signal-pos (point-marker)) 16482 (while (progn (vhdl-forward-syntactic-ws) 16483 (looking-at "signal\\>")) 16484 (beginning-of-line 2) 16485 (delete-region signal-pos (point))) 16486 (setq signal-beg-pos signal-pos) 16487 ;; open entity file 16488 (when (file-exists-p ent-file-name) 16489 (find-file ent-file-name)) 16490 (goto-char (point-min)) 16491 (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) 16492 (error "ERROR: Entity not found: \"%s\"" ent-name)) 16493 ;; prepare generic clause insertion 16494 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t) 16495 (match-string 1)) 16496 (goto-char (match-beginning 0)) 16497 (indent-to vhdl-basic-offset) 16498 (insert "generic ();\n\n") 16499 (backward-char 4)) 16500 (backward-char) 16501 (setq generic-pos (point-marker)) 16502 (forward-sexp) (end-of-line) 16503 (delete-region generic-pos (point)) (delete-char 1) 16504 (insert "(\n") 16505 (when multi-list 16506 (insert "\n") 16507 (indent-to (* 2 vhdl-basic-offset)) 16508 (insert "-- global generics\n")) 16509 (setq generic-beg-pos (point-marker) generic-pos (point-marker) 16510 generic-inst-pos (point-marker) generic-end-pos (point-marker)) 16511 ;; prepare port clause insertion 16512 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t) 16513 (match-string 1)) 16514 (goto-char (match-beginning 0)) 16515 (indent-to vhdl-basic-offset) 16516 (insert "port ();\n\n") 16517 (backward-char 4)) 16518 (backward-char) 16519 (setq port-in-pos (point-marker)) 16520 (forward-sexp) (end-of-line) 16521 (delete-region port-in-pos (point)) (delete-char 1) 16522 (insert "(\n") 16523 (when (or multi-in-list multi-out-list) 16524 (insert "\n") 16525 (indent-to (* 2 vhdl-basic-offset)) 16526 (insert "-- global ports\n")) 16527 (setq port-beg-pos (point-marker) port-in-pos (point-marker) 16528 port-out-pos (point-marker) port-inst-pos (point-marker) 16529 port-end-pos (point-marker)) 16530 ;; insert generics, ports and signals 16531 (setq inst-alist (nreverse inst-alist)) 16532 (while inst-alist 16533 (setq inst-name (nth 0 (car inst-alist)) 16534 constant-alist (nth 1 (car inst-alist)) 16535 signal-alist (nth 2 (car inst-alist)) 16536 constant-temp-pos generic-inst-pos 16537 port-temp-pos port-inst-pos 16538 signal-temp-pos signal-pos) 16539 ;; generics 16540 (while constant-alist 16541 (setq constant-name (downcase (caar constant-alist)) 16542 constant-entry (car constant-alist)) 16543 (unless (string-match "^[0-9]+" constant-name) 16544 (cond ((member constant-name written-list) 16545 nil) 16546 ((member constant-name multi-list) 16547 (vhdl-goto-marker generic-pos) 16548 (setq generic-end-pos 16549 (vhdl-max-marker 16550 generic-end-pos 16551 (vhdl-compose-insert-generic constant-entry))) 16552 (setq generic-pos (point-marker)) 16553 (vhdl--pushnew constant-name written-list :test #'equal)) 16554 (t 16555 (vhdl-goto-marker 16556 (vhdl-max-marker generic-inst-pos generic-pos)) 16557 (setq generic-end-pos 16558 (vhdl-compose-insert-generic constant-entry)) 16559 (setq generic-inst-pos (point-marker)) 16560 (vhdl--pushnew constant-name written-list :test #'equal)))) 16561 (setq constant-alist (cdr constant-alist))) 16562 (when (/= constant-temp-pos generic-inst-pos) 16563 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) 16564 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16565 (insert "-- generics for \"" inst-name "\"\n") 16566 (vhdl-goto-marker generic-inst-pos)) 16567 ;; ports and signals 16568 (while signal-alist 16569 (setq signal-name (downcase (caar signal-alist)) 16570 signal-entry (car signal-alist)) 16571 (cond ((member signal-name written-list) 16572 nil) 16573 ((member signal-name multi-in-list) 16574 (vhdl-goto-marker port-in-pos) 16575 (setq port-end-pos 16576 (vhdl-max-marker 16577 port-end-pos (vhdl-compose-insert-port signal-entry))) 16578 (setq port-in-pos (point-marker)) 16579 (vhdl--pushnew signal-name written-list :test #'equal)) 16580 ((member signal-name multi-out-list) 16581 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) 16582 (setq port-end-pos 16583 (vhdl-max-marker 16584 port-end-pos (vhdl-compose-insert-port signal-entry))) 16585 (setq port-out-pos (point-marker)) 16586 (vhdl--pushnew signal-name written-list :test #'equal)) 16587 ((or (member signal-name single-in-list) 16588 (member signal-name single-out-list)) 16589 (vhdl-goto-marker 16590 (vhdl-max-marker 16591 port-inst-pos 16592 (vhdl-max-marker port-out-pos port-in-pos))) 16593 (setq port-end-pos (vhdl-compose-insert-port signal-entry)) 16594 (setq port-inst-pos (point-marker)) 16595 (vhdl--pushnew signal-name written-list :test #'equal)) 16596 ((equal (upcase (nth 2 signal-entry)) "OUT") 16597 (vhdl-goto-marker signal-pos) 16598 (vhdl-compose-insert-signal signal-entry) 16599 (setq signal-pos (point-marker)) 16600 (vhdl--pushnew signal-name written-list :test #'equal))) 16601 (setq signal-alist (cdr signal-alist))) 16602 (when (/= port-temp-pos port-inst-pos) 16603 (vhdl-goto-marker 16604 (vhdl-max-marker port-temp-pos 16605 (vhdl-max-marker port-in-pos port-out-pos))) 16606 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16607 (insert "-- ports to \"" inst-name "\"\n") 16608 (vhdl-goto-marker port-inst-pos)) 16609 (when (/= signal-temp-pos signal-pos) 16610 (vhdl-goto-marker signal-temp-pos) 16611 (insert "\n") (indent-to vhdl-basic-offset) 16612 (insert "-- outputs of \"" inst-name "\"\n") 16613 (vhdl-goto-marker signal-pos)) 16614 (setq inst-alist (cdr inst-alist))) 16615 ;; finalize generic/port clause 16616 (vhdl-goto-marker generic-end-pos) (backward-char) 16617 (when (= generic-beg-pos generic-end-pos) 16618 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16619 (insert ";") (backward-char)) 16620 (insert ")") 16621 (vhdl-goto-marker port-end-pos) (backward-char) 16622 (when (= port-beg-pos port-end-pos) 16623 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 16624 (insert ";") (backward-char)) 16625 (insert ")") 16626 ;; align everything 16627 (when vhdl-auto-align 16628 (vhdl-goto-marker generic-beg-pos) 16629 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) 16630 (vhdl-align-region-groups port-beg-pos port-end-pos 1) 16631 (vhdl-goto-marker signal-beg-pos) 16632 (vhdl-align-region-groups signal-beg-pos signal-pos)) 16633 (switch-to-buffer (marker-buffer signal-beg-pos)) 16634 (message "Wiring components...done"))))) 16635 16636(defun vhdl-compose-insert-generic (entry) 16637 "Insert ENTRY as generic declaration." 16638 (let (pos) 16639 (indent-to (* 2 vhdl-basic-offset)) 16640 (insert (nth 0 entry) " : " (nth 1 entry)) 16641 (when (nth 2 entry) 16642 (insert " := " (nth 2 entry))) 16643 (insert ";") 16644 (setq pos (point-marker)) 16645 (when (and vhdl-include-port-comments (nth 3 entry)) 16646 (vhdl-comment-insert-inline (nth 3 entry) t)) 16647 (insert "\n") 16648 pos)) 16649 16650(defun vhdl-compose-insert-port (entry) 16651 "Insert ENTRY as port declaration." 16652 (let (pos) 16653 (indent-to (* 2 vhdl-basic-offset)) 16654 (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") 16655 (setq pos (point-marker)) 16656 (when (and vhdl-include-port-comments (nth 4 entry)) 16657 (vhdl-comment-insert-inline (nth 4 entry) t)) 16658 (insert "\n") 16659 pos)) 16660 16661(defun vhdl-compose-insert-signal (entry) 16662 "Insert ENTRY as signal declaration." 16663 (indent-to vhdl-basic-offset) 16664 (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") 16665 (when (and vhdl-include-port-comments (nth 4 entry)) 16666 (vhdl-comment-insert-inline (nth 4 entry) t)) 16667 (insert "\n")) 16668 16669(defvar lazy-lock-minimum-size) 16670 16671(defun vhdl-compose-components-package () 16672 "Generate a package containing component declarations for all entities in the 16673current project/directory." 16674 (interactive) 16675 (vhdl-require-hierarchy-info) 16676 (let* ((project (vhdl-project-p)) 16677 (pack-name (vhdl-get-components-package-name)) 16678 (pack-file-name 16679 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 16680 "." (file-name-extension (buffer-file-name)))) 16681 (ent-alist (vhdl-aget vhdl-entity-alist 16682 (or project 16683 (abbreviate-file-name default-directory)))) 16684 (lazy-lock-minimum-size 0) 16685 clause-pos component-pos) 16686 (message "Generating components package \"%s\"..." pack-name) 16687 ;; open package file 16688 (when (and (file-exists-p pack-file-name) 16689 (not (y-or-n-p (concat "File \"" pack-file-name 16690 "\" exists; overwrite? ")))) 16691 (error "ERROR: Generating components package...aborted")) 16692 (find-file pack-file-name) 16693 (erase-buffer) 16694 ;; insert header 16695 (if vhdl-compose-include-header 16696 (progn (vhdl-template-header 16697 (concat "Components package (generated by Emacs VHDL Mode " 16698 vhdl-version ")")) 16699 (goto-char (point-max))) 16700 (vhdl-comment-display-line) (insert "\n\n")) 16701 ;; insert std_logic_1164 package 16702 (vhdl-template-package-std-logic-1164) 16703 (insert "\n") (setq clause-pos (point-marker)) 16704 (insert "\n") (vhdl-comment-display-line) (insert "\n\n") 16705 ;; insert package declaration 16706 (vhdl-insert-keyword "PACKAGE ") (insert pack-name) 16707 (vhdl-insert-keyword " IS\n\n") 16708 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 16709 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 16710 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 16711 (indent-to vhdl-basic-offset) 16712 (setq component-pos (point-marker)) 16713 (insert "\n\n") (vhdl-insert-keyword "END ") 16714 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) 16715 (insert pack-name ";\n\n") 16716 ;; insert footer 16717 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16718 (vhdl-template-footer) 16719 (vhdl-comment-display-line) (insert "\n")) 16720 ;; insert component declarations 16721 (while ent-alist 16722 (vhdl-visit-file (nth 2 (car ent-alist)) nil 16723 (goto-char (point-min)) 16724 (forward-line (1- (nth 3 (car ent-alist)))) 16725 (end-of-line) 16726 (vhdl-port-copy)) 16727 (goto-char component-pos) 16728 (vhdl-port-paste-component t) 16729 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) 16730 (setq component-pos (point-marker)) 16731 (goto-char clause-pos) 16732 (vhdl-port-paste-context-clause pack-name) 16733 (setq clause-pos (point-marker)) 16734 (setq ent-alist (cdr ent-alist))) 16735 (goto-char (point-min)) 16736 (save-buffer) 16737 (message "Generating components package \"%s\"...done\n File created: \"%s\"" 16738 pack-name pack-file-name))) 16739 16740(defun vhdl-compose-configuration-architecture ( _ent-name arch-name 16741 ent-alist-arg conf-alist-arg 16742 inst-alist 16743 &optional insert-conf) 16744 "Generate block configuration for architecture." 16745 (let ((ent-alist ent-alist-arg) 16746 (conf-alist conf-alist-arg) 16747 (margin (current-indentation)) 16748 (beg (point-at-bol)) 16749 ent-entry inst-entry inst-path inst-prev-path tmp-alist) ;; cons-key 16750 ;; insert block configuration (for architecture) 16751 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 16752 (setq margin (+ margin vhdl-basic-offset)) 16753 ;; process all instances 16754 (while inst-alist 16755 (setq inst-entry (car inst-alist)) 16756 ;; is component? 16757 (when (nth 4 inst-entry) 16758 (setq insert-conf t) 16759 (setq inst-path (nth 9 inst-entry)) 16760 ;; skip common path with previous instance 16761 (while (and inst-path (equal (car inst-path) (car inst-prev-path))) 16762 (setq inst-path (cdr inst-path) 16763 inst-prev-path (cdr inst-prev-path))) 16764 ;; insert block configuration end (for previous block/generate) 16765 (while inst-prev-path 16766 (setq margin (- margin vhdl-basic-offset)) 16767 (indent-to margin) 16768 (vhdl-insert-keyword "END FOR;\n") 16769 (setq inst-prev-path (cdr inst-prev-path))) 16770 ;; insert block configuration beginning (for current block/generate) 16771 (indent-to margin) 16772 (while inst-path 16773 (setq margin (+ margin vhdl-basic-offset)) 16774 (vhdl-insert-keyword "FOR ") 16775 (insert (car inst-path) "\n") 16776 (indent-to margin) 16777 (setq inst-path (cdr inst-path))) 16778 ;; insert component configuration beginning 16779 (vhdl-insert-keyword "FOR ") 16780 (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") 16781 ;; find subconfiguration 16782 (setq conf-key (nth 7 inst-entry)) 16783 (setq tmp-alist conf-alist) 16784 ;; use first configuration found for instance's entity 16785 (while (and tmp-alist (null conf-key)) 16786 (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) 16787 (setq conf-key (nth 0 (car tmp-alist)))) 16788 (setq tmp-alist (cdr tmp-alist))) 16789 (setq conf-entry (vhdl-aget conf-alist conf-key)) 16790 ;; insert binding indication ... 16791 ;; ... with subconfiguration (if exists) 16792 (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) 16793 (progn 16794 (indent-to (+ margin vhdl-basic-offset)) 16795 (vhdl-insert-keyword "USE CONFIGURATION ") 16796 (insert (vhdl-work-library) "." (nth 0 conf-entry)) 16797 (insert ";\n")) 16798 ;; ... with entity (if exists) 16799 (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry))) 16800 (when ent-entry 16801 (indent-to (+ margin vhdl-basic-offset)) 16802 (vhdl-insert-keyword "USE ENTITY ") 16803 (insert (vhdl-work-library) "." (nth 0 ent-entry)) 16804 ;; insert architecture name (if architecture exists) 16805 (when (nth 3 ent-entry) 16806 (setq arch-name 16807 ;; choose architecture name a) from configuration, 16808 ;; b) from mra, or c) from first architecture 16809 (or (nth 0 (vhdl-aget (nth 3 ent-entry) 16810 (or (nth 6 inst-entry) 16811 (nth 4 ent-entry)))) 16812 (nth 1 (car (nth 3 ent-entry))))) 16813 (insert "(" arch-name ")")) 16814 (insert ";\n") 16815 ;; insert block configuration (for architecture of subcomponent) 16816 (when (and vhdl-compose-configuration-hierarchical 16817 (nth 3 ent-entry)) 16818 (indent-to (+ margin vhdl-basic-offset)) 16819 (vhdl-compose-configuration-architecture 16820 (nth 0 ent-entry) arch-name ent-alist conf-alist 16821 (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name))))))) 16822 ;; insert component configuration end 16823 (indent-to margin) 16824 (vhdl-insert-keyword "END FOR;\n") 16825 (setq inst-prev-path (nth 9 inst-entry))) 16826 (setq inst-alist (cdr inst-alist))) 16827 ;; insert block configuration end (for block/generate) 16828 (while inst-prev-path 16829 (setq margin (- margin vhdl-basic-offset)) 16830 (indent-to margin) 16831 (vhdl-insert-keyword "END FOR;\n") 16832 (setq inst-prev-path (cdr inst-prev-path))) 16833 (indent-to (- margin vhdl-basic-offset)) 16834 ;; insert block configuration end or remove beginning (for architecture) 16835 (if insert-conf 16836 (vhdl-insert-keyword "END FOR;\n") 16837 (delete-region beg (point))))) 16838 16839(defun vhdl-compose-configuration (&optional ent-name arch-name) 16840 "Generate configuration declaration." 16841 (interactive) 16842 (vhdl-require-hierarchy-info) 16843 (let ((ent-alist (vhdl-aget vhdl-entity-alist 16844 (or (vhdl-project-p) 16845 (abbreviate-file-name default-directory)))) 16846 (conf-alist (vhdl-aget vhdl-config-alist 16847 (or (vhdl-project-p) 16848 (abbreviate-file-name default-directory)))) 16849 (from-speedbar ent-name) 16850 inst-alist conf-name conf-file-name pos) 16851 (vhdl-prepare-search-2 16852 ;; get entity and architecture name 16853 (unless ent-name 16854 (save-excursion 16855 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 16856 (not (equal "END" (upcase (match-string 1)))) 16857 (setq ent-name (match-string-no-properties 3)) 16858 (setq arch-name (match-string-no-properties 2))) 16859 (error "ERROR: Not within an architecture")))) 16860 (setq conf-name (vhdl-replace-string 16861 vhdl-compose-configuration-name 16862 (concat ent-name " " arch-name))) 16863 (setq inst-alist 16864 (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name))) 16865 (downcase arch-name))))) 16866 (message "Generating configuration \"%s\"..." conf-name) 16867 (if vhdl-compose-configuration-create-file 16868 ;; open configuration file 16869 (progn 16870 (setq conf-file-name 16871 (concat (vhdl-replace-string vhdl-configuration-file-name 16872 conf-name t) 16873 "." (file-name-extension (buffer-file-name)))) 16874 (when (and (file-exists-p conf-file-name) 16875 (not (y-or-n-p (concat "File \"" conf-file-name 16876 "\" exists; overwrite? ")))) 16877 (error "ERROR: Creating configuration...aborted")) 16878 (find-file conf-file-name) 16879 (erase-buffer) 16880 (set-buffer-modified-p nil) 16881 ;; insert header 16882 (if vhdl-compose-include-header 16883 (progn (vhdl-template-header 16884 (concat "Configuration declaration for design \"" 16885 ent-name "(" arch-name ")\"")) 16886 (goto-char (point-max))) 16887 (vhdl-comment-display-line) (insert "\n\n"))) 16888 ;; goto end of architecture 16889 (unless from-speedbar 16890 (re-search-forward "^end\\>" nil) 16891 (end-of-line) (insert "\n\n") 16892 (vhdl-comment-display-line) (insert "\n\n"))) 16893 ;; insert library clause 16894 (setq pos (point)) 16895 (vhdl-template-standard-package (vhdl-work-library) nil) 16896 (when (/= pos (point)) 16897 (insert "\n\n")) 16898 ;; insert configuration 16899 (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) 16900 (vhdl-insert-keyword " OF ") (insert ent-name) 16901 (vhdl-insert-keyword " IS\n") 16902 (indent-to vhdl-basic-offset) 16903 ;; insert block configuration (for architecture) 16904 (vhdl-compose-configuration-architecture 16905 ent-name arch-name ent-alist conf-alist inst-alist t) 16906 (vhdl-insert-keyword "END ") (insert conf-name ";") 16907 (when conf-file-name 16908 ;; insert footer and save 16909 (insert "\n\n") 16910 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16911 (vhdl-template-footer) 16912 (vhdl-comment-display-line) (insert "\n")) 16913 (save-buffer)) 16914 (message "%s" 16915 (concat (format "Generating configuration \"%s\"...done" conf-name) 16916 (and conf-file-name 16917 (format "\n File created: \"%s\"" conf-file-name)))))) 16918 16919 16920;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16921;;; Compilation / Makefile generation 16922;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16923;; (using `compile.el') 16924 16925(defvar vhdl-compile-post-command "" 16926 "String appended to compile command after file name.") 16927 16928(defun vhdl-makefile-name () 16929 "Return the Makefile name of the current project or the current compiler if 16930no project is defined." 16931 (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project)) 16932 (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler))) 16933 (vhdl-replace-string 16934 (cons "\\(.*\\)\n\\(.*\\)" 16935 (or (nth 8 project-alist) (nth 8 compiler-alist))) 16936 (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) 16937 16938(defun vhdl-compile-directory () 16939 "Return the directory where compilation/make should be run." 16940 (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t))) 16941 (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 16942 (directory (vhdl-resolve-env-variable 16943 (if project 16944 (vhdl-replace-string 16945 (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) 16946 (nth 6 compiler))))) 16947 (file-name-as-directory 16948 (if (file-name-absolute-p directory) 16949 directory 16950 (expand-file-name directory (vhdl-default-directory)))))) 16951 16952(defun vhdl-uniquify (in-list) 16953 "Remove duplicate elements from IN-LIST." 16954 (let (out-list) 16955 (while in-list 16956 (vhdl--pushnew (car in-list) out-list :test #'equal) 16957 (setq in-list (cdr in-list))) 16958 out-list)) 16959 16960(defun vhdl-set-compiler (name) 16961 "Set current compiler to NAME." 16962 (interactive 16963 (list (let ((completion-ignore-case t)) 16964 (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) 16965 (if (assoc name vhdl-compiler-alist) 16966 (progn (setq vhdl-compiler name) 16967 (message "Current compiler: \"%s\"" vhdl-compiler)) 16968 (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) 16969 16970;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16971;; Compilation 16972 16973(defun vhdl-compile-init () 16974 "Initialize for compilation." 16975 (when (and (not vhdl-emacs-22) 16976 (or (null compilation-error-regexp-alist) 16977 (not (assoc (car (nth 11 (car vhdl-compiler-alist))) 16978 compilation-error-regexp-alist)))) 16979 ;; `compilation-error-regexp-alist' 16980 (let ((commands-alist vhdl-compiler-alist) 16981 regexp-alist sublist) 16982 (while commands-alist 16983 (setq sublist (nth 11 (car commands-alist))) 16984 (unless (or (equal "" (car sublist)) 16985 (assoc (car sublist) regexp-alist)) 16986 (push (list (nth 0 sublist) 16987 (if (and (featurep 'xemacs) (not (nth 1 sublist))) 16988 9 16989 (nth 1 sublist)) 16990 (nth 2 sublist) (nth 3 sublist)) 16991 regexp-alist)) 16992 (setq commands-alist (cdr commands-alist))) 16993 (setq compilation-error-regexp-alist 16994 (append compilation-error-regexp-alist (nreverse regexp-alist)))) 16995 ;; `compilation-file-regexp-alist' 16996 (let ((commands-alist vhdl-compiler-alist) 16997 regexp-alist sublist) 16998 ;; matches vhdl-mode file name output 16999 (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) 17000 (while commands-alist 17001 (setq sublist (nth 12 (car commands-alist))) 17002 (unless (or (equal "" (car sublist)) 17003 (assoc (car sublist) regexp-alist)) 17004 (push sublist regexp-alist)) 17005 (setq commands-alist (cdr commands-alist))) 17006 (setq compilation-file-regexp-alist 17007 (append compilation-file-regexp-alist (nreverse regexp-alist)))))) 17008 17009(defvar vhdl-compile-file-name nil 17010 "Name of file to be compiled.") 17011 17012(defun vhdl-compile-print-file-name () 17013 "Function called within `compile' to print out file name for compilers that 17014do not print any file names." 17015 (insert "Compiling \"" vhdl-compile-file-name "\"\n")) 17016 17017(defun vhdl-get-compile-options (project compiler file-name 17018 &optional file-options-only) 17019 "Get compiler options. Returning nil means do not compile this file." 17020 (let* ((compiler-options (nth 1 compiler)) 17021 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) 17022 (project-options (nth 0 project-entry)) 17023 (exception-list (and file-name (nth 2 project-entry))) 17024 (work-library (vhdl-work-library)) 17025 (case-fold-search nil) 17026 file-options) 17027 (while (and exception-list 17028 (not (string-match (caar exception-list) file-name))) 17029 (setq exception-list (cdr exception-list))) 17030 (if (and exception-list (not (cdar exception-list))) 17031 nil 17032 (if (and file-options-only (not exception-list)) 17033 'default 17034 (setq file-options (cdar exception-list)) 17035 ;; insert library name in compiler-specific options 17036 (setq compiler-options 17037 (vhdl-replace-string (cons "\\(.*\\)" compiler-options) 17038 work-library)) 17039 ;; insert compiler-specific options in project-specific options 17040 (when project-options 17041 (setq project-options 17042 (vhdl-replace-string 17043 (cons "\\(.*\\)\n\\(.*\\)" project-options) 17044 (concat work-library "\n" compiler-options)))) 17045 ;; insert project-specific options in file-specific options 17046 (when file-options 17047 (setq file-options 17048 (vhdl-replace-string 17049 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) 17050 (concat work-library "\n" compiler-options "\n" 17051 project-options)))) 17052 ;; return options 17053 (or file-options project-options compiler-options))))) 17054 17055(defun vhdl-get-make-options (project compiler) 17056 "Get make options." 17057 (let* ((compiler-options (nth 3 compiler)) 17058 (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) 17059 (project-options (nth 1 project-entry)) 17060 (makefile-name (vhdl-makefile-name))) 17061 ;; insert Makefile name in compiler-specific options 17062 (setq compiler-options 17063 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) 17064 makefile-name)) 17065 ;; insert compiler-specific options in project-specific options 17066 (when project-options 17067 (setq project-options 17068 (vhdl-replace-string 17069 (cons "\\(.*\\)\n\\(.*\\)" project-options) 17070 (concat makefile-name "\n" compiler-options)))) 17071 ;; return options 17072 (or project-options compiler-options))) 17073 17074(defun vhdl-compile () 17075 "Compile current buffer using the VHDL compiler specified in `vhdl-compiler'." 17076 (interactive) 17077 (vhdl-compile-init) 17078 (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) 17079 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17080 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17081 (command (nth 0 compiler)) 17082 (default-directory (vhdl-compile-directory)) 17083 (file-name (if vhdl-compile-absolute-path 17084 (buffer-file-name) 17085 (file-relative-name (buffer-file-name)))) 17086 (options (vhdl-get-compile-options project compiler file-name)) 17087 compilation-process-setup-function) 17088 (unless (file-directory-p default-directory) 17089 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 17090 ;; put file name into quotes if it contains spaces 17091 (when (string-match " " file-name) 17092 (setq file-name (concat "\"" file-name "\""))) 17093 ;; print out file name if compiler does not 17094 (setq vhdl-compile-file-name (if vhdl-compile-absolute-path 17095 (buffer-file-name) 17096 (file-relative-name (buffer-file-name)))) 17097 (when (and (= 0 (nth 1 (nth 10 compiler))) 17098 (= 0 (nth 1 (nth 11 compiler)))) 17099 (setq compilation-process-setup-function #'vhdl-compile-print-file-name)) 17100 ;; run compilation 17101 (if options 17102 (when command 17103 (compile (concat command " " options " " file-name 17104 (unless (equal vhdl-compile-post-command "") 17105 (concat " " vhdl-compile-post-command))))) 17106 (vhdl-warning "Your project settings tell me not to compile this file")))) 17107 17108(defvar vhdl-make-target "all" 17109 "Default target for `vhdl-make' command.") 17110 17111(defun vhdl-make (&optional target) 17112 "Call make command for compilation of all updated source files (requires 17113`Makefile'). Optional argument TARGET allows you to compile the design 17114specified by a target." 17115 (interactive) 17116 (setq vhdl-make-target 17117 (or target (read-from-minibuffer "Target: " vhdl-make-target 17118 vhdl-minibuffer-local-map))) 17119 (vhdl-compile-init) 17120 (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) 17121 (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17122 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17123 (command (nth 2 compiler)) 17124 (options (vhdl-get-make-options project compiler)) 17125 (default-directory (vhdl-compile-directory))) 17126 (unless (file-directory-p default-directory) 17127 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 17128 ;; run make 17129 (compile (concat (if (equal command "") "make" command) 17130 " " options " " vhdl-make-target)))) 17131 17132;; Emacs 22+ setup 17133(defvar vhdl-error-regexp-emacs-alist 17134 ;; Get regexps from `vhdl-compiler-alist' 17135 (let ((compiler-alist vhdl-compiler-alist) 17136 (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) 17137 (while compiler-alist 17138 ;; only add regexps for currently selected compiler 17139 (when (or (not vhdl-compile-use-local-error-regexp) 17140 (equal vhdl-compiler (nth 0 (car compiler-alist)))) 17141 ;; add error message regexps 17142 (setq error-regexp-alist 17143 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) 17144 (nth 11 (car compiler-alist))) 17145 error-regexp-alist)) 17146 ;; add filename regexps 17147 (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) 17148 (setq error-regexp-alist 17149 (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) 17150 (nth 12 (car compiler-alist))) 17151 error-regexp-alist)))) 17152 (setq compiler-alist (cdr compiler-alist))) 17153 error-regexp-alist) 17154 "List of regexps for VHDL compilers. For Emacs 22+.") 17155 17156;; Add error regexps using compilation-mode-hook. 17157(defun vhdl-error-regexp-add-emacs () 17158 "Set up Emacs compile for VHDL." 17159 (interactive) 17160 (when (and (boundp 'compilation-error-regexp-alist-alist) 17161 (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) 17162 ;; remove all other compilers 17163 (when vhdl-compile-use-local-error-regexp 17164 (setq compilation-error-regexp-alist nil)) 17165 ;; add VHDL compilers 17166 (mapcar 17167 (lambda (item) 17168 (push (car item) compilation-error-regexp-alist) 17169 (push item compilation-error-regexp-alist-alist)) 17170 vhdl-error-regexp-emacs-alist))) 17171 17172(when vhdl-emacs-22 17173 (add-hook 'compilation-mode-hook #'vhdl-error-regexp-add-emacs)) 17174 17175;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17176;; Makefile generation 17177 17178(defun vhdl-generate-makefile () 17179 "Generate `Makefile'." 17180 (interactive) 17181 (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) 17182 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 17183 (command (nth 4 compiler))) 17184 ;; generate makefile 17185 (if command 17186 (let ((default-directory (vhdl-compile-directory))) 17187 (compile (vhdl-replace-string 17188 (cons "\\(.*\\) \\(.*\\)" command) 17189 (concat (vhdl-makefile-name) " " (vhdl-work-library))))) 17190 (vhdl-generate-makefile-1)))) 17191 17192(defun vhdl-get-packages (lib-alist work-library) 17193 "Get packages from LIB-ALIST that belong to WORK-LIBRARY." 17194 (let (pack-list) 17195 (while lib-alist 17196 (when (equal (downcase (caar lib-alist)) (downcase work-library)) 17197 (push (cdar lib-alist) pack-list)) 17198 (setq lib-alist (cdr lib-alist))) 17199 pack-list)) 17200 17201(defun vhdl-generate-makefile-1 () 17202 "Generate Makefile for current project or directory." 17203 ;; scan hierarchy if required 17204 (if (vhdl-project-p) 17205 (unless (or (assoc vhdl-project vhdl-file-alist) 17206 (vhdl-load-cache vhdl-project)) 17207 (vhdl-scan-project-contents vhdl-project)) 17208 (let ((directory (abbreviate-file-name default-directory))) 17209 (unless (or (assoc directory vhdl-file-alist) 17210 (vhdl-load-cache directory)) 17211 (vhdl-scan-directory-contents directory)))) 17212 (let* ((directory (abbreviate-file-name (vhdl-default-directory))) 17213 (project (vhdl-project-p)) 17214 (ent-alist (vhdl-aget vhdl-entity-alist (or project directory))) 17215 (conf-alist (vhdl-aget vhdl-config-alist (or project directory))) 17216 (pack-alist (vhdl-aget vhdl-package-alist (or project directory))) 17217 (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 17218 '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" 17219 "\\1.vhd" "\\1_body.vhd" identity))) 17220 (mapping-exist 17221 (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) 17222 (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) 17223 (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) 17224 (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) 17225 (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) 17226 (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) 17227 (adjust-case (nth 5 regexp-list)) 17228 (work-library (downcase (vhdl-work-library))) 17229 (compile-directory (expand-file-name (vhdl-compile-directory) 17230 default-directory)) 17231 (makefile-name (vhdl-makefile-name)) 17232 rule-alist arch-alist inst-alist 17233 target-list depend-list unit-list prim-list second-list subcomp-list 17234 lib-alist lib-body-alist pack-list all-pack-list 17235 ent-key ent-file-name arch-key arch-file-name ent-arch-key 17236 conf-key conf-file-name pack-key pack-file-name 17237 ent-entry arch-entry conf-entry pack-entry inst-entry 17238 pack-body-key pack-body-file-name inst-ent-key inst-conf-key 17239 tmp-key tmp-list rule) 17240 ;; check prerequisites 17241 (unless (file-exists-p compile-directory) 17242 (make-directory compile-directory t)) 17243 (unless mapping-exist 17244 (vhdl-warning 17245 (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\"" 17246 vhdl-compiler vhdl-compiler) t)) 17247 (message "Generating makefile \"%s\"..." makefile-name) 17248 ;; rules for all entities 17249 (setq tmp-list ent-alist) 17250 (while ent-alist 17251 (setq ent-entry (car ent-alist) 17252 ent-key (nth 0 ent-entry)) 17253 (when (nth 2 ent-entry) 17254 (setq ent-file-name (if vhdl-compile-absolute-path 17255 (nth 2 ent-entry) 17256 (file-relative-name (nth 2 ent-entry) 17257 compile-directory)) 17258 arch-alist (nth 4 ent-entry) 17259 lib-alist (nth 6 ent-entry) 17260 rule (vhdl-aget rule-alist ent-file-name) 17261 target-list (nth 0 rule) 17262 depend-list (nth 1 rule) 17263 second-list nil 17264 subcomp-list nil) 17265 (setq tmp-key (vhdl-replace-string 17266 ent-regexp 17267 (funcall adjust-case 17268 (concat ent-key " " work-library)))) 17269 (push (cons ent-key tmp-key) unit-list) 17270 ;; rule target for this entity 17271 (push ent-key target-list) 17272 ;; rule dependencies for all used packages 17273 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17274 (setq depend-list (append depend-list pack-list)) 17275 (setq all-pack-list pack-list) 17276 ;; add rule 17277 (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list)) 17278 ;; rules for all corresponding architectures 17279 (while arch-alist 17280 (setq arch-entry (car arch-alist) 17281 arch-key (nth 0 arch-entry) 17282 ent-arch-key (concat ent-key "-" arch-key) 17283 arch-file-name (if vhdl-compile-absolute-path 17284 (nth 2 arch-entry) 17285 (file-relative-name (nth 2 arch-entry) 17286 compile-directory)) 17287 inst-alist (nth 4 arch-entry) 17288 lib-alist (nth 5 arch-entry) 17289 rule (vhdl-aget rule-alist arch-file-name) 17290 target-list (nth 0 rule) 17291 depend-list (nth 1 rule)) 17292 (setq tmp-key (vhdl-replace-string 17293 arch-regexp 17294 (funcall adjust-case 17295 (concat arch-key " " ent-key " " 17296 work-library)))) 17297 (setq unit-list 17298 (cons (cons ent-arch-key tmp-key) unit-list)) 17299 (push ent-arch-key second-list) 17300 ;; rule target for this architecture 17301 (push ent-arch-key target-list) 17302 ;; rule dependency for corresponding entity 17303 (push ent-key depend-list) 17304 ;; rule dependencies for contained component instantiations 17305 (while inst-alist 17306 (setq inst-entry (car inst-alist)) 17307 (when (or (null (nth 8 inst-entry)) 17308 (equal (downcase (nth 8 inst-entry)) work-library)) 17309 (setq inst-ent-key (or (nth 7 inst-entry) 17310 (nth 5 inst-entry))) 17311 (setq depend-list (cons inst-ent-key depend-list) 17312 subcomp-list (cons inst-ent-key subcomp-list))) 17313 (setq inst-alist (cdr inst-alist))) 17314 ;; rule dependencies for all used packages 17315 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17316 (setq depend-list (append depend-list pack-list)) 17317 (setq all-pack-list (append all-pack-list pack-list)) 17318 ;; add rule 17319 (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) 17320 (setq arch-alist (cdr arch-alist))) 17321 (push (list ent-key second-list (append subcomp-list all-pack-list)) 17322 prim-list)) 17323 (setq ent-alist (cdr ent-alist))) 17324 (setq ent-alist tmp-list) 17325 ;; rules for all configurations 17326 (setq tmp-list conf-alist) 17327 (while conf-alist 17328 (setq conf-entry (car conf-alist) 17329 conf-key (nth 0 conf-entry) 17330 conf-file-name (if vhdl-compile-absolute-path 17331 (nth 2 conf-entry) 17332 (file-relative-name (nth 2 conf-entry) 17333 compile-directory)) 17334 ent-key (nth 4 conf-entry) 17335 arch-key (nth 5 conf-entry) 17336 inst-alist (nth 6 conf-entry) 17337 lib-alist (nth 7 conf-entry) 17338 rule (vhdl-aget rule-alist conf-file-name) 17339 target-list (nth 0 rule) 17340 depend-list (nth 1 rule) 17341 subcomp-list (list ent-key)) 17342 (setq tmp-key (vhdl-replace-string 17343 conf-regexp 17344 (funcall adjust-case 17345 (concat conf-key " " work-library)))) 17346 (push (cons conf-key tmp-key) unit-list) 17347 ;; rule target for this configuration 17348 (push conf-key target-list) 17349 ;; rule dependency for corresponding entity and architecture 17350 (setq depend-list 17351 (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) 17352 ;; rule dependencies for used packages 17353 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17354 (setq depend-list (append depend-list pack-list)) 17355 ;; rule dependencies for contained component configurations 17356 (while inst-alist 17357 (setq inst-entry (car inst-alist)) 17358 (setq inst-ent-key (nth 2 inst-entry) 17359 inst-conf-key (nth 4 inst-entry)) 17360 (when (equal (downcase (nth 5 inst-entry)) work-library) 17361 (when inst-ent-key 17362 (setq depend-list (cons inst-ent-key depend-list) 17363 subcomp-list (cons inst-ent-key subcomp-list))) 17364 (when inst-conf-key 17365 (setq depend-list (cons inst-conf-key depend-list) 17366 subcomp-list (cons inst-conf-key subcomp-list)))) 17367 (setq inst-alist (cdr inst-alist))) 17368 ;; add rule 17369 (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list)) 17370 (push (list conf-key nil (append subcomp-list pack-list)) prim-list) 17371 (setq conf-alist (cdr conf-alist))) 17372 (setq conf-alist tmp-list) 17373 ;; rules for all packages 17374 (setq tmp-list pack-alist) 17375 (while pack-alist 17376 (setq pack-entry (car pack-alist) 17377 pack-key (nth 0 pack-entry) 17378 pack-body-key nil) 17379 (when (nth 2 pack-entry) 17380 (setq pack-file-name (if vhdl-compile-absolute-path 17381 (nth 2 pack-entry) 17382 (file-relative-name (nth 2 pack-entry) 17383 compile-directory)) 17384 lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) 17385 rule (vhdl-aget rule-alist pack-file-name) 17386 target-list (nth 0 rule) depend-list (nth 1 rule)) 17387 (setq tmp-key (vhdl-replace-string 17388 pack-regexp 17389 (funcall adjust-case 17390 (concat pack-key " " work-library)))) 17391 (push (cons pack-key tmp-key) unit-list) 17392 ;; rule target for this package 17393 (push pack-key target-list) 17394 ;; rule dependencies for all used packages 17395 (setq pack-list (vhdl-get-packages lib-alist work-library)) 17396 (setq depend-list (append depend-list pack-list)) 17397 (setq all-pack-list pack-list) 17398 ;; add rule 17399 (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list)) 17400 ;; rules for this package's body 17401 (when (nth 7 pack-entry) 17402 (setq pack-body-key (concat pack-key "-body") 17403 pack-body-file-name (if vhdl-compile-absolute-path 17404 (nth 7 pack-entry) 17405 (file-relative-name (nth 7 pack-entry) 17406 compile-directory)) 17407 rule (vhdl-aget rule-alist pack-body-file-name) 17408 target-list (nth 0 rule) 17409 depend-list (nth 1 rule)) 17410 (setq tmp-key (vhdl-replace-string 17411 pack-body-regexp 17412 (funcall adjust-case 17413 (concat pack-key " " work-library)))) 17414 (setq unit-list 17415 (cons (cons pack-body-key tmp-key) unit-list)) 17416 ;; rule target for this package's body 17417 (push pack-body-key target-list) 17418 ;; rule dependency for corresponding package declaration 17419 (push pack-key depend-list) 17420 ;; rule dependencies for all used packages 17421 (setq pack-list (vhdl-get-packages lib-body-alist work-library)) 17422 (setq depend-list (append depend-list pack-list)) 17423 (setq all-pack-list (append all-pack-list pack-list)) 17424 ;; add rule 17425 (vhdl-aput 'rule-alist pack-body-file-name 17426 (list target-list depend-list))) 17427 (setq prim-list 17428 (cons (list pack-key (when pack-body-key (list pack-body-key)) 17429 all-pack-list) 17430 prim-list))) 17431 (setq pack-alist (cdr pack-alist))) 17432 (setq pack-alist tmp-list) 17433 ;; generate Makefile 17434 (let* ((project (vhdl-aget vhdl-project-alist project)) 17435 (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) 17436 (compiler-id (nth 9 compiler)) 17437 (library-directory 17438 (vhdl-resolve-env-variable 17439 (vhdl-replace-string 17440 (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) 17441 compiler-id))) 17442 (makefile-path-name (expand-file-name 17443 makefile-name compile-directory)) 17444 (orig-buffer (current-buffer)) 17445 cell second-list subcomp-list options unit-key unit-name) 17446 ;; sort lists 17447 (setq unit-list (vhdl-sort-alist unit-list)) 17448 (setq prim-list (vhdl-sort-alist prim-list)) 17449 (setq tmp-list rule-alist) 17450 (while tmp-list ; pre-sort rule targets 17451 (setq cell (cdar tmp-list)) 17452 (setcar cell (sort (car cell) #'string<)) 17453 (setq tmp-list (cdr tmp-list))) 17454 (setq rule-alist ; sort by first rule target 17455 (sort rule-alist 17456 (lambda (a b) 17457 (string< (car (cadr a)) (car (cadr b)))))) 17458 ;; open and clear Makefile 17459 (set-buffer (find-file-noselect makefile-path-name t t)) 17460 (erase-buffer) 17461 (insert "# -*- Makefile -*-\n" 17462 "### " (file-name-nondirectory makefile-name) 17463 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version 17464 "\n") 17465 (if project 17466 (insert "\n# Project : " (nth 0 project)) 17467 (insert "\n# Directory : \"" directory "\"")) 17468 (insert "\n# Platform : " vhdl-compiler 17469 "\n# Generated : " (format-time-string "%Y-%m-%d %T ") 17470 (user-login-name) "\n") 17471 ;; insert compile and option variable settings 17472 (insert "\n\n# Define compilation command and options\n" 17473 "\nCOMPILE = " (nth 0 compiler) 17474 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) 17475 (if (equal vhdl-compile-post-command "") "" 17476 (concat "\nPOST-COMPILE = " vhdl-compile-post-command)) 17477 "\n") 17478 ;; insert library paths 17479 (setq library-directory 17480 (directory-file-name 17481 (if (file-name-absolute-p library-directory) 17482 library-directory 17483 (file-relative-name 17484 (expand-file-name library-directory directory) 17485 compile-directory)))) 17486 (insert "\n\n# Define library paths\n" 17487 "\nLIBRARY-" work-library " = " library-directory "\n") 17488 (unless mapping-exist 17489 (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library 17490 ")/make" "\n")) 17491 ;; insert variable definitions for all library unit files 17492 (insert "\n\n# Define library unit files\n") 17493 (setq tmp-list unit-list) 17494 (while unit-list 17495 (insert "\nUNIT-" work-library "-" (caar unit-list) 17496 " = \\\n\t$(LIBRARY-" work-library 17497 (if mapping-exist "" "-make") ")/" (cdar unit-list)) 17498 (setq unit-list (cdr unit-list))) 17499 ;; insert variable definition for list of all library unit files 17500 (insert "\n\n\n# Define list of all library unit files\n" 17501 "\nALL_UNITS =") 17502 (setq unit-list tmp-list) 17503 (while unit-list 17504 (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") 17505 (setq unit-list (cdr unit-list))) 17506 (insert "\n") 17507 (setq unit-list tmp-list) 17508 ;; insert `make all' rule 17509 (insert "\n\n\n# Rule for compiling entire design\n" 17510 "\n" (nth 0 vhdl-makefile-default-targets) " :" 17511 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) 17512 " \\\n\t\t$(ALL_UNITS)\n") 17513 ;; insert `make clean' rule 17514 (insert "\n\n# Rule for cleaning entire design\n" 17515 "\n" (nth 1 vhdl-makefile-default-targets) " : " 17516 "\n\t-rm -f $(ALL_UNITS)\n") 17517 ;; insert `make library' rule 17518 (insert "\n\n# Rule for creating library directory\n" 17519 "\n" (nth 2 vhdl-makefile-default-targets) " :" 17520 " \\\n\t\t$(LIBRARY-" work-library ")" 17521 (if mapping-exist "" 17522 (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n")) 17523 "\n" 17524 "\n$(LIBRARY-" work-library ") :" 17525 "\n\t" 17526 (vhdl-replace-string 17527 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) 17528 (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) 17529 "\n") 17530 (unless mapping-exist 17531 (insert "\n$(LIBRARY-" work-library "-make) :" 17532 "\n\t" 17533 "mkdir -p $(LIBRARY-" work-library "-make)\n")) 17534 ;; insert '.PHONY' declaration 17535 (insert "\n\n.PHONY : " 17536 (nth 0 vhdl-makefile-default-targets) " " 17537 (nth 1 vhdl-makefile-default-targets) " " 17538 (nth 2 vhdl-makefile-default-targets) "\n") 17539 ;; insert rule for each library unit 17540 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") 17541 (while prim-list 17542 (setq second-list (sort (nth 1 (car prim-list)) #'string<)) 17543 (setq subcomp-list 17544 (sort (vhdl-uniquify (nth 2 (car prim-list))) #'string<)) 17545 (setq unit-key (caar prim-list) 17546 unit-name (or (nth 0 (vhdl-aget ent-alist unit-key)) 17547 (nth 0 (vhdl-aget conf-alist unit-key)) 17548 (nth 0 (vhdl-aget pack-alist unit-key)))) 17549 (insert "\n" unit-key) 17550 (unless (equal unit-key unit-name) 17551 (insert " \\\n" unit-name)) 17552 (insert " :" 17553 " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) 17554 (while subcomp-list 17555 (when (and (assoc (car subcomp-list) unit-list) 17556 (not (equal unit-key (car subcomp-list)))) 17557 (insert " \\\n\t\t" (car subcomp-list))) 17558 (setq subcomp-list (cdr subcomp-list))) 17559 (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") 17560 (while second-list 17561 (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") 17562 (setq second-list (cdr second-list))) 17563 (insert "\n") 17564 (setq prim-list (cdr prim-list))) 17565 ;; insert rule for each library unit file 17566 (insert "\n\n# Rules for compiling single library unit files\n") 17567 (while rule-alist 17568 (setq rule (car rule-alist)) 17569 ;; get compiler options for this file 17570 (setq options 17571 (vhdl-get-compile-options project compiler (nth 0 rule) t)) 17572 ;; insert rule if file is supposed to be compiled 17573 (setq target-list (nth 1 rule) 17574 depend-list (sort (vhdl-uniquify (nth 2 rule)) #'string<)) 17575 ;; insert targets 17576 (setq tmp-list target-list) 17577 (while target-list 17578 (insert "\n$(UNIT-" work-library "-" (car target-list) ")" 17579 (if (cdr target-list) " \\" " :")) 17580 (setq target-list (cdr target-list))) 17581 (setq target-list tmp-list) 17582 ;; insert file name as first dependency 17583 (insert " \\\n\t\t" (nth 0 rule)) 17584 ;; insert dependencies (except if also target or unit does not exist) 17585 (while depend-list 17586 (when (and (not (member (car depend-list) target-list)) 17587 (assoc (car depend-list) unit-list)) 17588 (insert " \\\n\t\t" 17589 "$(UNIT-" work-library "-" (car depend-list) ")")) 17590 (setq depend-list (cdr depend-list))) 17591 ;; insert compile command 17592 (if options 17593 (insert "\n\t$(COMPILE) " 17594 (if (eq options 'default) "$(OPTIONS)" options) " " 17595 (nth 0 rule) 17596 (if (equal vhdl-compile-post-command "") "" 17597 " $(POST-COMPILE)") 17598 "\n") 17599 (insert "\n")) 17600 (unless (and options mapping-exist) 17601 (setq tmp-list target-list) 17602 (while target-list 17603 (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n") 17604 (setq target-list (cdr target-list))) 17605 (setq target-list tmp-list)) 17606 (setq rule-alist (cdr rule-alist))) 17607 17608 (insert "\n\n### " makefile-name " ends here\n") 17609 ;; run Makefile generation hook 17610 (run-hooks 'vhdl-makefile-generation-hook) 17611 (message "Generating makefile \"%s\"...done" makefile-name) 17612 ;; save and close file 17613 (if (file-writable-p makefile-path-name) 17614 (progn (save-buffer) 17615 (kill-buffer (current-buffer)) 17616 (set-buffer orig-buffer) 17617 (when (fboundp 'add-to-history) 17618 (add-to-history 'file-name-history makefile-path-name))) 17619 (vhdl-warning-when-idle 17620 (format "File not writable: \"%s\"" 17621 (abbreviate-file-name makefile-path-name))) 17622 (switch-to-buffer (current-buffer)))))) 17623 17624 17625;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17626;;; Bug reports 17627;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17628;; (using `reporter.el') 17629 17630(defconst vhdl-mode-help-address 17631 "Reto Zimmermann <reto@gnu.org>" 17632 "Address for VHDL Mode bug reports.") 17633 17634(defun vhdl-submit-bug-report () 17635 "Submit via mail a bug report on VHDL Mode." 17636 (interactive) 17637 ;; load in reporter 17638 (defvar reporter-prompt-for-summary-p) 17639 (and 17640 (y-or-n-p "Do you want to submit a report on VHDL Mode? ") 17641 (let ((reporter-prompt-for-summary-p t)) 17642 (reporter-submit-bug-report 17643 vhdl-mode-help-address 17644 (concat "VHDL Mode " vhdl-version) 17645 (list 17646 ;; report all important user options 17647 'vhdl-offsets-alist 17648 'vhdl-comment-only-line-offset 17649 'tab-width 17650 'vhdl-electric-mode 17651 'vhdl-stutter-mode 17652 'vhdl-indent-tabs-mode 17653 'vhdl-project-alist 17654 'vhdl-project 17655 'vhdl-project-file-name 17656 'vhdl-project-autoload 17657 'vhdl-project-sort 17658 'vhdl-compiler-alist 17659 'vhdl-compiler 17660 'vhdl-compile-use-local-error-regexp 17661 'vhdl-makefile-default-targets 17662 'vhdl-makefile-generation-hook 17663 'vhdl-default-library 17664 'vhdl-standard 17665 'vhdl-basic-offset 17666 'vhdl-upper-case-keywords 17667 'vhdl-upper-case-types 17668 'vhdl-upper-case-attributes 17669 'vhdl-upper-case-enum-values 17670 'vhdl-upper-case-constants 17671 'vhdl-use-direct-instantiation 17672 'vhdl-array-index-record-field-in-sensitivity-list 17673 'vhdl-compose-configuration-name 17674 'vhdl-entity-file-name 17675 'vhdl-architecture-file-name 17676 'vhdl-configuration-file-name 17677 'vhdl-package-file-name 17678 'vhdl-file-name-case 17679 'vhdl-electric-keywords 17680 'vhdl-optional-labels 17681 'vhdl-insert-empty-lines 17682 'vhdl-argument-list-indent 17683 'vhdl-association-list-with-formals 17684 'vhdl-conditions-in-parenthesis 17685 'vhdl-sensitivity-list-all 17686 'vhdl-zero-string 17687 'vhdl-one-string 17688 'vhdl-file-header 17689 'vhdl-file-footer 17690 'vhdl-company-name 17691 'vhdl-copyright-string 17692 'vhdl-platform-spec 17693 'vhdl-date-format 17694 'vhdl-modify-date-prefix-string 17695 'vhdl-modify-date-on-saving 17696 'vhdl-reset-kind 17697 'vhdl-reset-active-high 17698 'vhdl-clock-rising-edge 17699 'vhdl-clock-edge-condition 17700 'vhdl-clock-name 17701 'vhdl-reset-name 17702 'vhdl-model-alist 17703 'vhdl-include-port-comments 17704 'vhdl-include-direction-comments 17705 'vhdl-include-type-comments 17706 'vhdl-include-group-comments 17707 'vhdl-actual-generic-name 17708 'vhdl-actual-port-name 17709 'vhdl-instance-name 17710 'vhdl-testbench-entity-name 17711 'vhdl-testbench-architecture-name 17712 'vhdl-testbench-configuration-name 17713 'vhdl-testbench-dut-name 17714 'vhdl-testbench-include-header 17715 'vhdl-testbench-declarations 17716 'vhdl-testbench-statements 17717 'vhdl-testbench-initialize-signals 17718 'vhdl-testbench-include-library 17719 'vhdl-testbench-include-configuration 17720 'vhdl-testbench-create-files 17721 'vhdl-testbench-entity-file-name 17722 'vhdl-testbench-architecture-file-name 17723 'vhdl-compose-create-files 17724 'vhdl-compose-configuration-create-file 17725 'vhdl-compose-configuration-hierarchical 17726 'vhdl-compose-configuration-use-subconfiguration 17727 'vhdl-compose-include-header 17728 'vhdl-compose-architecture-name 17729 'vhdl-components-package-name 17730 'vhdl-use-components-package 17731 'vhdl-self-insert-comments 17732 'vhdl-prompt-for-comments 17733 'vhdl-inline-comment-column 17734 'vhdl-end-comment-column 17735 'vhdl-auto-align 17736 'vhdl-align-groups 17737 'vhdl-align-group-separate 17738 'vhdl-align-same-indent 17739 'vhdl-highlight-keywords 17740 'vhdl-highlight-names 17741 'vhdl-highlight-special-words 17742 'vhdl-highlight-forbidden-words 17743 'vhdl-highlight-verilog-keywords 17744 'vhdl-highlight-translate-off 17745 'vhdl-highlight-case-sensitive 17746 'vhdl-special-syntax-alist 17747 'vhdl-forbidden-words 17748 'vhdl-forbidden-syntax 17749 'vhdl-directive-keywords 17750 'vhdl-speedbar-auto-open 17751 'vhdl-speedbar-display-mode 17752 'vhdl-speedbar-scan-limit 17753 'vhdl-speedbar-jump-to-unit 17754 'vhdl-speedbar-update-on-saving 17755 'vhdl-speedbar-save-cache 17756 'vhdl-speedbar-cache-file-name 17757 'vhdl-index-menu 17758 'vhdl-source-file-menu 17759 'vhdl-hideshow-menu 17760 'vhdl-hide-all-init 17761 'vhdl-print-two-column 17762 'vhdl-print-customize-faces 17763 'vhdl-intelligent-tab 17764 'vhdl-indent-syntax-based 17765 'vhdl-indent-comment-like-next-code-line 17766 'vhdl-word-completion-case-sensitive 17767 'vhdl-word-completion-in-minibuffer 17768 'vhdl-underscore-is-part-of-word 17769 'vhdl-mode-hook) 17770 (lambda () 17771 (insert 17772 (if vhdl-special-indent-hook 17773 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" 17774 "vhdl-special-indent-hook is set to '" 17775 (format "%s" vhdl-special-indent-hook) 17776 ".\nPerhaps this is your problem?\n" 17777 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") 17778 "\n"))) 17779 nil 17780 "Hi Reto,")))) 17781 17782 17783;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17784;;; Documentation 17785;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17786 17787(defconst vhdl-doc-release-notes nil 17788 "\ 17789Release Notes for VHDL Mode 3.37 17790================================ 17791 17792- Added support for VHDL'08: 17793 - New keywords, types, functions, attributes, operators, packages 17794 - Context declaration 17795 - Block comments 17796 - Directives 17797 - `all' keyword in sensitivity list 17798 17799 17800Release Notes for VHDL Mode 3.34 17801================================ 17802 17803- Added support for GNU Emacs 22/23/24: 17804 - Compilation error parsing fixed for new `compile.el' package. 17805 17806- Port translation: Derive actual generic name from formal generic name. 17807 17808- New user options: 17809 `vhdl-actual-generic-name': Specify how actual generic names are obtained. 17810 17811 17812Release Notes for VHDL Mode 3.33 17813================================ 17814 17815New Features 17816------------ 17817 17818CONFIGURATION DECLARATION GENERATION: 17819 - Automatic generation of a configuration declaration for a design. 17820 (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) 17821 17822 17823Key Bindings 17824------------ 17825 17826For Emacs compliance the following key bindings have been changed: 17827 17828- `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region' 17829- `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer' 17830- `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer' 17831- `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...' 17832 17833 17834User Options 17835------------ 17836 17837`vhdl-configuration-file-name': (new) 17838 Specify how the configuration file name is obtained. 17839`vhdl-compose-configuration-name': (new) 17840 Specify how the configuration name is obtained. 17841`vhdl-compose-configuration-create-file': (new) 17842 Specify whether a new file should be created for a configuration. 17843`vhdl-compose-configuration-hierarchical': (new) 17844 Specify whether hierarchical configurations should be created. 17845`vhdl-compose-configuration-use-subconfiguration': (new) 17846 Specify whether subconfigurations should be used inside configurations. 17847`vhdl-makefile-default-targets': (new) 17848 Customize names of Makefile default targets. 17849`vhdl-indent-comment-like-next-code-line': (new) 17850 Specify whether comment lines are indented like following code line. 17851`vhdl-array-index-record-field-in-sensitivity-list': (new) 17852 Specify whether to include array indices / record fields in sensitivity list.") 17853 17854 17855(defconst vhdl-doc-keywords nil 17856 "\ 17857Reserved words in VHDL 17858---------------------- 17859 17860VHDL'08 (IEEE Std 1076-2008): 17861 `vhdl-08-keywords' : keywords 17862 `vhdl-08-types' : standardized types 17863 `vhdl-08-attributes' : standardized attributes 17864 `vhdl-08-functions' : standardized functions 17865 `vhdl-08-packages' : standardized packages and libraries 17866 17867VHDL'93/02 (IEEE Std 1076-1993/2002): 17868 `vhdl-02-keywords' : keywords 17869 `vhdl-02-types' : standardized types 17870 `vhdl-02-attributes' : standardized attributes 17871 `vhdl-02-enum-values' : standardized enumeration values 17872 `vhdl-02-functions' : standardized functions 17873 `vhdl-02-packages' : standardized packages and libraries 17874 17875VHDL-AMS (IEEE Std 1076.1 / 1076.1.1): 17876 `vhdl-ams-keywords' : keywords 17877 `vhdl-ams-types' : standardized types 17878 `vhdl-ams-attributes' : standardized attributes 17879 `vhdl-ams-enum-values' : standardized enumeration values 17880 `vhdl-ams-constants' : standardized constants 17881 `vhdl-ams-functions' : standardized functions 17882 17883Math Packages (IEEE Std 1076.2): 17884 `vhdl-math-types' : standardized types 17885 `vhdl-math-constants' : standardized constants 17886 `vhdl-math-functions' : standardized functions 17887 `vhdl-math-packages' : standardized packages 17888 17889Forbidden words: 17890 `vhdl-verilog-keywords' : Verilog reserved words 17891 17892NOTE: click `mouse-2' on variable names above (not in XEmacs).") 17893 17894 17895(defconst vhdl-doc-coding-style nil 17896 "\ 17897For VHDL coding style and naming convention guidelines, see the following 17898references: 17899 17900[1] Ben Cohen. 17901 \"VHDL Coding Styles and Methodologies\". 17902 Kluwer Academic Publishers, 1999. 17903 http://members.aol.com/vhdlcohen/vhdl/ 17904 17905[2] Michael Keating and Pierre Bricaud. 17906 \"Reuse Methodology Manual, Second Edition\". 17907 Kluwer Academic Publishers, 1999. 17908 http://www.openmore.com/openmore/rmm2.html 17909 17910[3] European Space Agency. 17911 \"VHDL Modelling Guidelines\". 17912 https://amstel.estec.esa.int/tecedm/website/docs_generic/ModelGuide.pdf 17913 17914Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' 17915to visually support naming conventions.") 17916 17917 17918(defun vhdl-version () 17919 "Echo the current version of VHDL Mode in the minibuffer." 17920 (interactive) 17921 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) 17922 (vhdl-keep-region-active)) 17923 17924(defun vhdl-doc-variable (variable) 17925 "Display VARIABLE's documentation in *Help* buffer." 17926 (interactive) 17927 (unless (featurep 'xemacs) 17928 (help-setup-xref (list #'vhdl-doc-variable variable) 17929 (called-interactively-p 'interactive))) 17930 (with-output-to-temp-buffer 17931 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17932 (princ (documentation-property variable 'variable-documentation)) 17933 (with-current-buffer standard-output 17934 (help-mode)) 17935 (help-print-return-message))) 17936 17937(defun vhdl-doc-mode () 17938 "Display VHDL Mode documentation in *Help* buffer." 17939 (interactive) 17940 (unless (featurep 'xemacs) 17941 (help-setup-xref (list #'vhdl-doc-mode) 17942 (called-interactively-p 'interactive))) 17943 (with-output-to-temp-buffer 17944 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17945 (princ mode-name) 17946 (princ " mode:\n") 17947 (princ (documentation 'vhdl-mode)) 17948 (with-current-buffer standard-output 17949 (help-mode)) 17950 (help-print-return-message))) 17951 17952 17953;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17954 17955(provide 'vhdl-mode) 17956 17957;;; vhdl-mode.el ends here 17958