1;;; vhdl-mode.el --- major mode for editing VHDL code 2 3;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 4;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Authors: Reto Zimmermann <reto@gnu.org> 7;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net> 8;; Maintainer: Reto Zimmermann <reto@gnu.org> 9;; Keywords: languages vhdl 10;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html 11 12(defconst vhdl-version "3.33.6" 13 "VHDL Mode version number.") 14 15(defconst vhdl-time-stamp "2005-08-30" 16 "VHDL Mode time stamp for last update.") 17 18;; This file is part of GNU Emacs. 19 20;; GNU Emacs is free software; you can redistribute it and/or modify 21;; it under the terms of the GNU General Public License as published by 22;; the Free Software Foundation; either version 2, or (at your option) 23;; any later version. 24 25;; GNU Emacs is distributed in the hope that it will be useful, 26;; but WITHOUT ANY WARRANTY; without even the implied warranty of 27;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28;; GNU General Public License for more details. 29 30;; You should have received a copy of the GNU General Public License 31;; along with GNU Emacs; see the file COPYING. If not, write to the 32;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 33;; Boston, MA 02110-1301, USA. 34 35;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36;;; Commentary: 37;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 38 39;; This package provides an Emacs major mode for editing VHDL code. 40;; It includes the following features: 41 42;; - Syntax highlighting 43;; - Indentation 44;; - Template insertion (electrification) 45;; - Insertion of file headers 46;; - Insertion of user-specified models 47;; - Port translation / testbench generation 48;; - Structural composition 49;; - Configuration generation 50;; - Sensitivity list updating 51;; - File browser 52;; - Design hierarchy browser 53;; - Source file compilation (syntax analysis) 54;; - Makefile generation 55;; - Code hiding 56;; - Word/keyword completion 57;; - Block commenting 58;; - Code fixing/alignment/beautification 59;; - Postscript printing 60;; - VHDL'87/'93 and VHDL-AMS supported 61;; - Comprehensive menu 62;; - Fully customizable 63;; - Works under GNU Emacs (recommended) and XEmacs 64 65;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 66;; Documentation 67 68;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs. 69 70;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71;; Emacs Versions 72 73;; supported: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X 74;; tested on: GNU Emacs 20.4, XEmacs 21.1 (marginally) 75 76;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 77;; Installation 78 79;; Prerequisites: GNU Emacs 20.X/21.X/22.X, XEmacs 20.X/21.X. 80 81;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation 82;; or into an arbitrary directory that is added to the load path by the 83;; following line in your Emacs start-up file `.emacs': 84 85;; (setq load-path (cons (expand-file-name "<directory-name>") load-path)) 86 87;; If you already have the compiled `vhdl-mode.elc' file, put it in the same 88;; directory. Otherwise, byte-compile the source file: 89;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET 90;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el 91 92;; Add the following lines to the `site-start.el' file in the `site-lisp' 93;; directory of your Emacs installation or to your Emacs start-up file `.emacs' 94;; (not required in Emacs 20.X): 95 96;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) 97;; (setq auto-mode-alist (cons '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist)) 98 99;; More detailed installation instructions are included in the official 100;; VHDL Mode distribution. 101 102;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 103;; Acknowledgements 104 105;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> 106;; and Steve Grout. 107 108;; Fontification approach suggested by Ken Wood <ken@eda.com.au>. 109;; Ideas about alignment from John Wiegley <johnw@gnu.org>. 110 111;; Many thanks to all the users who sent me bug reports and enhancement 112;; requests. 113;; Thanks to Colin Marquardt for his serious beta testing, his innumerable 114;; enhancement suggestions and the fruitful discussions. 115;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. 116;; Thanks to Ulf Klaperski for the indentation speedup hint. 117 118;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated 119;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for 120;; giving me the opportunity to develop this code. 121;; This work has been funded in part by MICROSWISS, a Microelectronics Program 122;; of the Swiss Government. 123 124;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 125 126;;; Code: 127 128;; XEmacs handling 129(defconst vhdl-xemacs (string-match "XEmacs" emacs-version) 130 "Non-nil if XEmacs is used.") 131;; Emacs 21+ handling 132(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs)) 133 "Non-nil if GNU Emacs 21, 22, ... is used.") 134(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs)) 135 "Non-nil if GNU Emacs 22, ... is used.") 136 137(defvar compilation-file-regexp-alist) 138(defvar conf-alist) 139(defvar conf-entry) 140(defvar conf-key) 141(defvar ent-alist) 142(defvar itimer-version) 143(defvar lazy-lock-defer-contextually) 144(defvar lazy-lock-defer-on-scrolling) 145(defvar lazy-lock-defer-on-the-fly) 146(defvar speedbar-attached-frame) 147 148 149;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 150;;; Variables 151;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 152 153;; help function for user options 154(defun vhdl-custom-set (variable value &rest functions) 155 "Set variables as in `custom-set-default' and call FUNCTIONS afterwards." 156 (if (fboundp 'custom-set-default) 157 (custom-set-default variable value) 158 (set-default variable value)) 159 (while functions 160 (when (fboundp (car functions)) (funcall (car functions))) 161 (setq functions (cdr functions)))) 162 163(defun vhdl-widget-directory-validate (widget) 164 "Check that the value of WIDGET is a valid directory entry (i.e. ends with 165'/' or is empty)." 166 (let ((val (widget-value widget))) 167 (unless (string-match "^\\(\\|.*/\\)$" val) 168 (widget-put widget :error "Invalid directory entry: must end with '/'") 169 widget))) 170 171;; help string for user options 172(defconst vhdl-name-doc-string " 173 174FROM REGEXP is a regular expression matching the original name: 175 \".*\" matches the entire string 176 \"\\(...\\)\" matches a substring 177TO STRING specifies the string to be inserted as new name: 178 \"\\&\" means substitute entire matched text 179 \"\\N\" means substitute what matched the Nth \"\\(...\\)\" 180Examples: 181 \".*\" \"\\&\" inserts original string 182 \".*\" \"\\&_i\" attaches \"_i\" to original string 183 \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string 184 \".*\" \"foo\" inserts constant string \"foo\" 185 \".*\" \"\" inserts empty string") 186 187;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 188;; User variables 189 190(defgroup vhdl nil 191 "Customizations for VHDL Mode." 192 :prefix "vhdl-" 193 :group 'languages 194; :version "21.2" ; comment out for XEmacs 195 ) 196 197(defgroup vhdl-mode nil 198 "Customizations for modes." 199 :group 'vhdl) 200 201(defcustom vhdl-electric-mode t 202 "*Non-nil enables electrification (automatic template generation). 203If nil, template generators can still be invoked through key bindings and 204menu. Is indicated in the modeline by \"/e\" after the mode name and can be 205toggled by `\\[vhdl-electric-mode]'." 206 :type 'boolean 207 :group 'vhdl-mode) 208 209(defcustom vhdl-stutter-mode t 210 "*Non-nil enables stuttering. 211Is indicated in the modeline by \"/s\" after the mode name and can be toggled 212by `\\[vhdl-stutter-mode]'." 213 :type 'boolean 214 :group 'vhdl-mode) 215 216(defcustom vhdl-indent-tabs-mode nil 217 "*Non-nil means indentation can insert tabs. 218Overrides local variable `indent-tabs-mode'." 219 :type 'boolean 220 :group 'vhdl-mode) 221 222 223(defgroup vhdl-compile nil 224 "Customizations for compilation." 225 :group 'vhdl) 226 227(defcustom vhdl-compiler-alist 228 '( 229 ;; Cadence Leapfrog: cv -file test.vhd 230 ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared 231 ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" 232 nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" 233 ("duluth: \\*E,[0-9]+ (\\(.+\\),\\([0-9]+\\)):" 1 2 0) ("" 0) 234 ("\\1/entity" "\\2/\\1" "\\1/configuration" 235 "\\1/package" "\\1/body" downcase)) 236 ;; Cadence Affirma NC vhdl: ncvhdl test.vhd 237 ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier 238 ;; (PLL_400X_TOP) is not declared [10.3]. 239 ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" 240 nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" 241 ("ncvhdl_p: \\*E,\\w+ (\\(.+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) 242 ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" 243 "\\1/package/pc.db" "\\1/body/pc.db" downcase)) 244 ;; Ikos Voyager: analyze test.vhd 245 ;; analyze test.vhd 246 ;; E L4/C5: this library unit is inaccessible 247 ("Ikos" "analyze" "-l \\1" "make" "-f \\1" 248 nil "mkdir \\1" "./" "work/" "Makefile" "ikos" 249 ("E L\\([0-9]+\\)/C\\([0-9]+\\):" 0 1 2) 250 ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) 251 nil) 252 ;; ModelSim, Model Technology: vcom test.vhd 253 ;; ERROR: test.vhd(14): Unknown identifier: positiv 254 ;; WARNING[2]: test.vhd(85): Possible infinite loop 255 ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb 256 ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" 257 nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" 258 ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) 259 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" 260 "\\1/_primary.dat" "\\1/body.dat" downcase)) 261 ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd 262 ;; test.vhd:34: error message 263 ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" 264 nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" 265 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) 266 ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" 267 "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) 268 ;; QuickHDL, Mentor Graphics: qvhcom test.vhd 269 ;; ERROR: test.vhd(24): near "dnd": expecting: END 270 ;; WARNING[4]: test.vhd(30): A space is required between ... 271 ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" 272 nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" 273 ("\\(ERROR\\|WARNING\\)[^:]*: \\(.+\\)(\\([0-9]+\\)):" 2 3 0) ("" 0) 274 ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" 275 "\\1/_primary.dat" "\\1/body.dat" downcase)) 276 ;; Savant: scram -publish-cc test.vhd 277 ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for 278 ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" 279 nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" 280 ("\\([^ \t\n]+\\):\\([0-9]+\\): " 1 2 0) ("" 0) 281 ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" 282 "\\1_config.vhdl" "\\1_package.vhdl" 283 "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) 284 ;; Simili: vhdlp -work test.vhd 285 ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix 286 ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" 287 nil "mkdir \\1" "./" "work/" "Makefile" "simili" 288 ("\\(Error\\|Warning\\): \\w+: \\(.+\\): (line \\([0-9]+\\)): " 2 3 0) ("" 0) 289 ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" 290 "\\1/prim.var" "\\1/_body.var" downcase)) 291 ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd 292 ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier 293 ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 294 nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" 295 ("^ *ERROR\[[0-9]+\]::File \\(.+\\) Line \\([0-9]+\\):" 1 2 0) ("" 0) 296 nil) 297 ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd 298 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. 299 ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" 300 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" 301 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) 302 ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) 303 ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd 304 ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. 305 ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" 306 nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" 307 ("\\*\\*Error: vhdlan,[0-9]+ \\(.+\\)(\\([0-9]+\\)):" 1 2 0) ("" 0) 308 ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) 309 ;; Synplify: 310 ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 311 ("Synplify" "n/a" "n/a" "make" "-f \\1" 312 nil "mkdir \\1" "./" "work/" "Makefile" "synplify" 313 ("@[EWN]:\"\\(.+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) 314 nil) 315 ;; Vantage: analyze -libfile vsslib.ini -src test.vhd 316 ;; Compiling "test.vhd" line 1... 317 ;; **Error: LINE 49 *** No aggregate value is valid in this context. 318 ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 319 nil "mkdir \\1" "./" "work/" "Makefile" "vantage" 320 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) 321 ("^ *Compiling \"\\(.+\\)\" " 1) 322 nil) 323 ;; VeriBest: vc vhdl test.vhd 324 ;; (no file name printed out!) 325 ;; 32: Z <= A and BitA ; 326 ;; ^^^^ 327 ;; [Error] Name BITA is unknown 328 ("VeriBest" "vc" "vhdl" "make" "-f \\1" 329 nil "mkdir \\1" "./" "work/" "Makefile" "veribest" 330 ("^ +\\([0-9]+\\): +[^ ]" 0 1 0) ("" 0) 331 nil) 332 ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd 333 ;; Compiling "test.vhd" line 1... 334 ;; **Error: LINE 49 *** No aggregate value is valid in this context. 335 ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" 336 nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" 337 ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" 0 1 0) 338 ("^ *Compiling \"\\(.+\\)\" " 1) 339 nil) 340 ) 341 "*List of available VHDL compilers and their properties. 342Each list entry specifies the following items for a compiler: 343Compiler: 344 Compiler name : name used in option `vhdl-compiler' to choose compiler 345 Compile command : command used for source file compilation 346 Compile options : compile options (\"\\1\" inserts library name) 347 Make command : command used for compilation using a Makefile 348 Make options : make options (\"\\1\" inserts Makefile name) 349 Generate Makefile: use built-in function or command to generate a Makefile 350 \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name) 351 Library command : command to create library directory \(\"\\1\" inserts 352 library directory, \"\\2\" inserts library name) 353 Compile directory: where compilation is run and the Makefile is placed 354 Library directory: directory of default library 355 Makefile name : name of Makefile (default is \"Makefile\") 356 ID string : compiler identification string (see `vhdl-project-alist') 357Error message: 358 Regexp : regular expression to match error messages (*) 359 File subexp index: index of subexpression that matches the file name 360 Line subexp index: index of subexpression that matches the line number 361 Column subexp idx: index of subexpression that matches the column number 362File message: 363 Regexp : regular expression to match a file name message 364 File subexp index: index of subexpression that matches the file name 365Unit-to-file name mapping: mapping of library unit names to names of files 366 generated by the compiler (used for Makefile generation) 367 To string : string a name is mapped to (\"\\1\" inserts the unit name, 368 \"\\2\" inserts the entity name for architectures) 369 Case adjustment : adjust case of inserted unit names 370 371\(*) The regular expression must match the error message starting from the 372 beginning of the line (but not necessarily to the end of the line). 373 374Compile options allows insertion of the library name (see `vhdl-project-alist') 375in order to set the compilers library option (e.g. \"vcom -work my_lib\"). 376 377For Makefile generation, the built-in function can be used (requires 378specification of the unit-to-file name mapping). Alternatively, an 379external command can be specified. Work directory allows specification of 380an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\", 381used for Makefile generation). To use another library name than \"work\", 382customize `vhdl-project-alist'. The library command is inserted in Makefiles 383to automatically create the library directory if not existent. 384 385Compile options, compile directory, library directory, and Makefile name are 386overwritten by the project settings if a project is defined (see 387`vhdl-project-alist'). Directory paths are relative to the source file 388directory. 389 390Some compilers do not include the file name in the error message, but print 391out a file name message in advance. In this case, set \"File Subexp Index\" 392under \"Error Message\" to 0 and fill out the \"File Message\" entries. 393If no file name at all is printed out, set both \"File Message\" entries to 0 394\(a default file name message will be printed out instead, does not work in 395XEmacs). 396 397A compiler is selected for syntax analysis (`\\[vhdl-compile]') by 398assigning its name to option `vhdl-compiler'. 399 400Please send any missing or erroneous compiler properties to the maintainer for 401updating. 402 403NOTE: Activate new error and file message regexps and reflect the new setting 404 in the choice list of option `vhdl-compiler' by restarting Emacs." 405 :type '(repeat 406 (list :tag "Compiler" :indent 2 407 (string :tag "Compiler name ") 408 (string :tag "Compile command ") 409 (string :tag "Compile options " "-work \\1") 410 (string :tag "Make command " "make") 411 (string :tag "Make options " "-f \\1") 412 (choice :tag "Generate Makefile " 413 (const :tag "Built-in function" nil) 414 (string :tag "Command" "vmake \\2 > \\1")) 415 (string :tag "Library command " "mkdir \\1") 416 (directory :tag "Compile directory " 417 :validate vhdl-widget-directory-validate "./") 418 (directory :tag "Library directory " 419 :validate vhdl-widget-directory-validate "work/") 420 (file :tag "Makefile name " "Makefile") 421 (string :tag "ID string ") 422 (list :tag "Error message" :indent 4 423 (regexp :tag "Regexp ") 424 (integer :tag "File subexp index") 425 (integer :tag "Line subexp index") 426 (integer :tag "Column subexp idx")) 427 (list :tag "File message" :indent 4 428 (regexp :tag "Regexp ") 429 (integer :tag "File subexp index")) 430 (choice :tag "Unit-to-file name mapping" 431 :format "%t: %[Value Menu%] %v\n" 432 (const :tag "Not defined" nil) 433 (list :tag "To string" :indent 4 434 (string :tag "Entity " "\\1.vhd") 435 (string :tag "Architecture " "\\2_\\1.vhd") 436 (string :tag "Configuration " "\\1.vhd") 437 (string :tag "Package " "\\1.vhd") 438 (string :tag "Package Body " "\\1_body.vhd") 439 (choice :tag "Case adjustment " 440 (const :tag "None" identity) 441 (const :tag "Upcase" upcase) 442 (const :tag "Downcase" downcase)))))) 443 :set (lambda (variable value) 444 (vhdl-custom-set variable value 'vhdl-update-mode-menu)) 445 :group 'vhdl-compile) 446 447(defcustom vhdl-compiler "ModelSim" 448 "*Specifies the VHDL compiler to be used for syntax analysis. 449Select a compiler name from the ones defined in option `vhdl-compiler-alist'." 450 :type (let ((alist vhdl-compiler-alist) list) 451 (while alist 452 (setq list (cons (list 'const (caar alist)) list)) 453 (setq alist (cdr alist))) 454 (append '(choice) (nreverse list))) 455 :group 'vhdl-compile) 456 457(defcustom vhdl-compile-use-local-error-regexp t 458 "*Non-nil means use buffer-local `compilation-error-regexp-alist'. 459In this case, only error message regexps for VHDL compilers are active if 460compilation is started from a VHDL buffer. Otherwise, the error message 461regexps are appended to the predefined global regexps, and all regexps are 462active all the time. Note that by doing that, the predefined global regexps 463might result in erroneous parsing of error messages for some VHDL compilers. 464 465NOTE: Activate the new setting by restarting Emacs." 466 :type 'boolean 467 :group 'vhdl-compile) 468 469(defcustom vhdl-makefile-generation-hook nil 470 "*Functions to run at the end of Makefile generation. 471Allows to insert user specific parts into a Makefile. 472 473Example: 474 \(lambda nil 475 \(re-search-backward \"^# Rule for compiling entire design\") 476 \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))" 477 :type 'hook 478 :group 'vhdl-compile) 479 480(defcustom vhdl-default-library "work" 481 "*Name of default library. 482Is overwritten by project settings if a project is active." 483 :type 'string 484 :group 'vhdl-compile) 485 486 487(defgroup vhdl-project nil 488 "Customizations for projects." 489 :group 'vhdl) 490 491(defcustom vhdl-project-alist 492 '(("Example 1" "Source files in two directories, custom library name, VHDL'87" 493 "~/example1/" ("src/system/" "src/components/") "" 494 (("ModelSim" "-87 \\2" "-f \\1 top_level" nil) 495 ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) 496 "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "") 497 ("Example 2" "Individual source files, multiple compilers in different directories" 498 "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") "" 499 nil "\\1/" "work" "\\1/work/" "Makefile" "") 500 ("Example 3" "Source files in a directory tree, multiple compilers in same directory" 501 "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/" 502 nil "./" "work" "work-\\1/" "Makefile-\\1" "\ 503------------------------------------------------------------------------------- 504-- This is a multi-line project description 505-- that can be used as a project dependent part of the file header. 506")) 507 "*List of projects and their properties. 508 Name : name used in option `vhdl-project' to choose project 509 Title : title of project (single-line string) 510 Default directory: default project directory (absolute path) 511 Sources : a) source files : path + \"/\" + file name 512 b) directory : path + \"/\" 513 c) directory tree: \"-r \" + path + \"/\" 514 Exclude regexp : matches file/directory names to be excluded as sources 515 Compile options : project-specific options for each compiler 516 Compiler name : name of compiler for which these options are valid 517 Compile options: project-specific compiler options 518 (\"\\1\" inserts library name, \"\\2\" default options) 519 Make options: project-specific make options 520 (\"\\1\" inserts Makefile name, \"\\2\" default options) 521 Exceptions : file-specific exceptions 522 File name regexp: matches file names for which exceptions are valid 523 - Options : file-specific compiler options string 524 (\"\\1\" inserts library name, \"\\2\" default options, 525 \"\\3\" project-specific options) 526 - Do not compile: do not compile this file (in Makefile) 527 Compile directory: where compilation is run and the Makefile is placed 528 \(\"\\1\" inserts compiler ID string) 529 Library name : name of library (default is \"work\") 530 Library directory: path to library (\"\\1\" inserts compiler ID string) 531 Makefile name : name of Makefile 532 (\"\\1\" inserts compiler ID string, \"\\2\" library name) 533 Description : description of project (multi-line string) 534 535Project title and description are used to insert into the file header (see 536option `vhdl-file-header'). 537 538The default directory must have an absolute path (use `M-TAB' for completion). 539All other paths can be absolute or relative to the default directory. All 540paths must end with '/'. 541 542The design units found in the sources (files and directories) are shown in the 543hierarchy browser. Path and file name can contain wildcards `*' and `?' as 544well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute. 545Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are 546specified, the default directory is taken as source directory. Otherwise, 547the default directory is only taken as source directory if there is a sources 548entry with the empty string or \"./\". Exclude regexp allows to filter out 549specific file and directory names from the list of sources (e.g. CVS 550directories). 551 552Files are compiled in the compile directory. Makefiles are also placed into 553the compile directory. Library directory specifies which directory the 554compiler compiles into (used to generate the Makefile). 555 556Since different compile/library directories and Makefiles may exist for 557different compilers within one project, these paths and names allow the 558insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist'). 559Compile options, compile directory, library directory, and Makefile name 560overwrite the settings of the current compiler. 561 562File-specific compiler options (highest priority) overwrite project-specific 563options which overwrite default options (lowest priority). Lower priority 564options can be inserted in higher priority options. This allows to reuse 565default options (e.g. \"-file\") in project- or file-specific options (e.g. 566\"-93 -file\"). 567 568NOTE: Reflect the new setting in the choice list of option `vhdl-project' 569 by restarting Emacs." 570 :type `(repeat 571 (list :tag "Project" :indent 2 572 (string :tag "Name ") 573 (string :tag "Title ") 574 (directory :tag "Default directory" 575 :validate vhdl-widget-directory-validate 576 ,(abbreviate-file-name default-directory)) 577 (repeat :tag "Sources " :indent 4 578 (directory :format " %v" "./")) 579 (regexp :tag "Exclude regexp ") 580 (repeat 581 :tag "Compile options " :indent 4 582 (list :tag "Compiler" :indent 6 583 ,(let ((alist vhdl-compiler-alist) list) 584 (while alist 585 (setq list (cons (list 'const (caar alist)) list)) 586 (setq alist (cdr alist))) 587 (append '(choice :tag "Compiler name") 588 (nreverse list))) 589 (string :tag "Compile options" "\\2") 590 (string :tag "Make options " "\\2") 591 (repeat 592 :tag "Exceptions " :indent 8 593 (cons :format "%v" 594 (regexp :tag "File name regexp ") 595 (choice :format "%[Value Menu%] %v" 596 (string :tag "Options" "\\3") 597 (const :tag "Do not compile" nil)))))) 598 (directory :tag "Compile directory" 599 :validate vhdl-widget-directory-validate "./") 600 (string :tag "Library name " "work") 601 (directory :tag "Library directory" 602 :validate vhdl-widget-directory-validate "work/") 603 (file :tag "Makefile name " "Makefile") 604 (string :tag "Description: (type `C-j' for newline)" 605 :format "%t\n%v\n"))) 606 :set (lambda (variable value) 607 (vhdl-custom-set variable value 608 'vhdl-update-mode-menu 609 'vhdl-speedbar-refresh)) 610 :group 'vhdl-project) 611 612(defcustom vhdl-project nil 613 "*Specifies the default for the current project. 614Select a project name from the ones defined in option `vhdl-project-alist'. 615Is used to determine the project title and description to be inserted in file 616headers and the source files/directories to be scanned in the hierarchy 617browser. The current project can also be changed temporarily in the menu." 618 :type (let ((alist vhdl-project-alist) list) 619 (while alist 620 (setq list (cons (list 'const (caar alist)) list)) 621 (setq alist (cdr alist))) 622 (append '(choice (const :tag "None" nil) (const :tag "--")) 623 (nreverse list))) 624 :group 'vhdl-project) 625 626(defcustom vhdl-project-file-name '("\\1.prj") 627 "*List of file names/paths for importing/exporting project setups. 628\"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is 629replaced by the user name (allows to have user-specific project setups). 630The first entry is used as file name to import/export individual project 631setups. All entries are used to automatically import project setups at 632startup (see option `vhdl-project-auto-load'). Projects loaded from the 633first entry are automatically made current. Hint: specify local project 634setups in first entry, global setups in following entries; loading a local 635project setup will make it current, while loading the global setups 636is done without changing the current project. 637Names can also have an absolute path (i.e. project setups can be stored 638in global directories)." 639 :type '(repeat (string :tag "File name" "\\1.prj")) 640 :group 'vhdl-project) 641 642(defcustom vhdl-project-auto-load '(startup) 643 "*Automatically load project setups from files. 644All project setup files that match the file names specified in option 645`vhdl-project-file-name' are automatically loaded. The project of the 646\(alphabetically) last loaded setup of the first `vhdl-project-file-name' 647entry is activated. 648A project setup file can be obtained by exporting a project (see menu). 649 At startup: project setup file is loaded at Emacs startup" 650 :type '(set (const :tag "At startup" startup)) 651 :group 'vhdl-project) 652 653(defcustom vhdl-project-sort t 654 "*Non-nil means projects are displayed in alphabetical order." 655 :type 'boolean 656 :group 'vhdl-project) 657 658 659(defgroup vhdl-style nil 660 "Customizations for coding styles." 661 :group 'vhdl 662 :group 'vhdl-template 663 :group 'vhdl-port 664 :group 'vhdl-compose) 665 666(defcustom vhdl-standard '(87 nil) 667 "*VHDL standards used. 668Basic standard: 669 VHDL'87 : IEEE Std 1076-1987 670 VHDL'93 : IEEE Std 1076-1993 671Additional standards: 672 VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal) 673 Math packages: IEEE Std 1076.2 (`math_real', `math_complex') 674 675NOTE: Activate the new setting in a VHDL buffer by using the menu entry 676 \"Activate Options\"." 677 :type '(list (choice :tag "Basic standard" 678 (const :tag "VHDL'87" 87) 679 (const :tag "VHDL'93" 93)) 680 (set :tag "Additional standards" :indent 2 681 (const :tag "VHDL-AMS" ams) 682 (const :tag "Math packages" math))) 683 :set (lambda (variable value) 684 (vhdl-custom-set variable value 685 'vhdl-template-map-init 686 'vhdl-mode-abbrev-table-init 687 'vhdl-template-construct-alist-init 688 'vhdl-template-package-alist-init 689 'vhdl-update-mode-menu 690 'vhdl-words-init 'vhdl-font-lock-init)) 691 :group 'vhdl-style) 692 693(defcustom vhdl-basic-offset 2 694 "*Amount of basic offset used for indentation. 695This value is used by + and - symbols in `vhdl-offsets-alist'." 696 :type 'integer 697 :group 'vhdl-style) 698 699(defcustom vhdl-upper-case-keywords nil 700 "*Non-nil means convert keywords to upper case. 701This is done when typed or expanded or by the fix case functions." 702 :type 'boolean 703 :set (lambda (variable value) 704 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 705 :group 'vhdl-style) 706 707(defcustom vhdl-upper-case-types nil 708 "*Non-nil means convert standardized types to upper case. 709This is done when expanded or by the fix case functions." 710 :type 'boolean 711 :set (lambda (variable value) 712 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 713 :group 'vhdl-style) 714 715(defcustom vhdl-upper-case-attributes nil 716 "*Non-nil means convert standardized attributes to upper case. 717This is done when expanded or by the fix case functions." 718 :type 'boolean 719 :set (lambda (variable value) 720 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 721 :group 'vhdl-style) 722 723(defcustom vhdl-upper-case-enum-values nil 724 "*Non-nil means convert standardized enumeration values to upper case. 725This is done when expanded or by the fix case functions." 726 :type 'boolean 727 :set (lambda (variable value) 728 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 729 :group 'vhdl-style) 730 731(defcustom vhdl-upper-case-constants t 732 "*Non-nil means convert standardized constants to upper case. 733This is done when expanded." 734 :type 'boolean 735 :set (lambda (variable value) 736 (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) 737 :group 'vhdl-style) 738 739(defcustom vhdl-use-direct-instantiation 'standard 740 "*Non-nil means use VHDL'93 direct component instantiation. 741 Never : never 742 Standard: only in VHDL standards that allow it (VHDL'93 and higher) 743 Always : always" 744 :type '(choice (const :tag "Never" never) 745 (const :tag "Standard" standard) 746 (const :tag "Always" always)) 747 :group 'vhdl-style) 748 749 750(defgroup vhdl-naming nil 751 "Customizations for naming conventions." 752 :group 'vhdl) 753 754(defcustom vhdl-entity-file-name '(".*" . "\\&") 755 (concat 756 "*Specifies how the entity file name is obtained. 757The entity file name can be obtained by modifying the entity name (e.g. 758attaching or stripping off a substring). The file extension is automatically 759taken from the file name of the current buffer." 760 vhdl-name-doc-string) 761 :type '(cons (regexp :tag "From regexp") 762 (string :tag "To string ")) 763 :group 'vhdl-naming 764 :group 'vhdl-compose) 765 766(defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2") 767 (concat 768 "*Specifies how the architecture file name is obtained. 769The architecture file name can be obtained by modifying the entity 770and/or architecture name (e.g. attaching or stripping off a substring). The 771file extension is automatically taken from the file name of the current 772buffer. The string that is matched against the regexp is the concatenation 773of the entity and the architecture name separated by a space. This gives 774access to both names (see default setting as example)." 775 vhdl-name-doc-string) 776 :type '(cons (regexp :tag "From regexp") 777 (string :tag "To string ")) 778 :group 'vhdl-naming 779 :group 'vhdl-compose) 780 781(defcustom vhdl-configuration-file-name '(".*" . "\\&") 782 (concat 783 "*Specifies how the configuration file name is obtained. 784The configuration file name can be obtained by modifying the configuration 785name (e.g. attaching or stripping off a substring). The file extension is 786automatically taken from the file name of the current buffer." 787 vhdl-name-doc-string) 788 :type '(cons (regexp :tag "From regexp") 789 (string :tag "To string ")) 790 :group 'vhdl-naming 791 :group 'vhdl-compose) 792 793(defcustom vhdl-package-file-name '(".*" . "\\&") 794 (concat 795 "*Specifies how the package file name is obtained. 796The package file name can be obtained by modifying the package name (e.g. 797attaching or stripping off a substring). The file extension is automatically 798taken from the file name of the current buffer. Package files can be created 799in a different directory by prepending a relative or absolute path to the 800file name." 801 vhdl-name-doc-string) 802 :type '(cons (regexp :tag "From regexp") 803 (string :tag "To string ")) 804 :group 'vhdl-naming 805 :group 'vhdl-compose) 806 807(defcustom vhdl-file-name-case 'identity 808 "*Specifies how to change case for obtaining file names. 809When deriving a file name from a VHDL unit name, case can be changed as 810follows: 811 As Is: case is not changed (taken as is) 812 Lower Case: whole name is changed to lower case 813 Upper Case: whole name is changed to upper case 814 Capitalize: first letter of each word in name is capitalized" 815 :type '(choice (const :tag "As Is" identity) 816 (const :tag "Lower Case" downcase) 817 (const :tag "Upper Case" upcase) 818 (const :tag "Capitalize" capitalize)) 819 :group 'vhdl-naming 820 :group 'vhdl-compose) 821 822 823(defgroup vhdl-template nil 824 "Customizations for electrification." 825 :group 'vhdl) 826 827(defcustom vhdl-electric-keywords '(vhdl user) 828 "*Type of keywords for which electrification is enabled. 829 VHDL keywords: invoke built-in templates 830 User keywords: invoke user models (see option `vhdl-model-alist')" 831 :type '(set (const :tag "VHDL keywords" vhdl) 832 (const :tag "User model keywords" user)) 833 :set (lambda (variable value) 834 (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) 835 :group 'vhdl-template) 836 837(defcustom vhdl-optional-labels 'process 838 "*Constructs for which labels are to be queried. 839Template generators prompt for optional labels for: 840 None : no constructs 841 Processes only: processes only (also procedurals in VHDL-AMS) 842 All constructs: all constructs with optional labels and keyword END" 843 :type '(choice (const :tag "None" none) 844 (const :tag "Processes only" process) 845 (const :tag "All constructs" all)) 846 :group 'vhdl-template) 847 848(defcustom vhdl-insert-empty-lines 'unit 849 "*Specifies whether to insert empty lines in some templates. 850This improves readability of code. Empty lines are inserted in: 851 None : no constructs 852 Design units only: entities, architectures, configurations, packages only 853 All constructs : also all constructs with BEGIN...END parts 854 855Replaces option `vhdl-additional-empty-lines'." 856 :type '(choice (const :tag "None" none) 857 (const :tag "Design units only" unit) 858 (const :tag "All constructs" all)) 859 :group 'vhdl-template 860 :group 'vhdl-port 861 :group 'vhdl-compose) 862 863(defcustom vhdl-argument-list-indent nil 864 "*Non-nil means indent argument lists relative to opening parenthesis. 865That is, argument, association, and port lists start on the same line as the 866opening parenthesis and subsequent lines are indented accordingly. 867Otherwise, lists start on a new line and are indented as normal code." 868 :type 'boolean 869 :group 'vhdl-template 870 :group 'vhdl-port 871 :group 'vhdl-compose) 872 873(defcustom vhdl-association-list-with-formals t 874 "*Non-nil means write association lists with formal parameters. 875Templates prompt for formal and actual parameters (ports/generics). 876When pasting component instantiations, formals are included. 877If nil, only a list of actual parameters is entered." 878 :type 'boolean 879 :group 'vhdl-template 880 :group 'vhdl-port 881 :group 'vhdl-compose) 882 883(defcustom vhdl-conditions-in-parenthesis nil 884 "*Non-nil means place parenthesis around condition expressions." 885 :type 'boolean 886 :group 'vhdl-template) 887 888(defcustom vhdl-zero-string "'0'" 889 "*String to use for a logic zero." 890 :type 'string 891 :group 'vhdl-template) 892 893(defcustom vhdl-one-string "'1'" 894 "*String to use for a logic one." 895 :type 'string 896 :group 'vhdl-template) 897 898 899(defgroup vhdl-header nil 900 "Customizations for file header." 901 :group 'vhdl-template 902 :group 'vhdl-compose) 903 904(defcustom vhdl-file-header "\ 905------------------------------------------------------------------------------- 906-- Title : <title string> 907-- Project : <project> 908------------------------------------------------------------------------------- 909-- File : <filename> 910-- Author : <author> 911-- Company : <company> 912-- Created : <date> 913-- Last update: <date> 914-- Platform : <platform> 915-- Standard : <standard> 916<projectdesc>------------------------------------------------------------------------------- 917-- Description: <cursor> 918<copyright>------------------------------------------------------------------------------- 919-- Revisions : 920-- Date Version Author Description 921-- <date> 1.0 <login>\tCreated 922------------------------------------------------------------------------------- 923 924" 925 "*String or file to insert as file header. 926If the string specifies an existing file name, the contents of the file is 927inserted, otherwise the string itself is inserted as file header. 928Type `C-j' for newlines. 929If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> 930if the header needs to be version controlled. 931 932The following keywords for template generation are supported: 933 <filename> : replaced by the name of the buffer 934 <author> : replaced by the user name and email address 935 \(`user-full-name',`mail-host-address', `user-mail-address') 936 <login> : replaced by user login name (`user-login-name') 937 <company> : replaced by contents of option `vhdl-company-name' 938 <date> : replaced by the current date 939 <year> : replaced by the current year 940 <project> : replaced by title of current project (`vhdl-project') 941 <projectdesc> : replaced by description of current project (`vhdl-project') 942 <copyright> : replaced by copyright string (`vhdl-copyright-string') 943 <platform> : replaced by contents of option `vhdl-platform-spec' 944 <standard> : replaced by the VHDL language standard(s) used 945 <... string> : replaced by a queried string (\"...\" is the prompt word) 946 <title string>: replaced by file title in automatically generated files 947 <cursor> : final cursor position 948 949The (multi-line) project description <projectdesc> can be used as a project 950dependent part of the file header and can also contain the above keywords." 951 :type 'string 952 :group 'vhdl-header) 953 954(defcustom vhdl-file-footer "" 955 "*String or file to insert as file footer. 956If the string specifies an existing file name, the contents of the file is 957inserted, otherwise the string itself is inserted as file footer (i.e. at 958the end of the file). 959Type `C-j' for newlines. 960The same keywords as in option `vhdl-file-header' can be used." 961 :type 'string 962 :group 'vhdl-header) 963 964(defcustom vhdl-company-name "" 965 "*Name of company to insert in file header. 966See option `vhdl-file-header'." 967 :type 'string 968 :group 'vhdl-header) 969 970(defcustom vhdl-copyright-string "\ 971------------------------------------------------------------------------------- 972-- Copyright (c) <year> <company> 973" 974 "*Copyright string to insert in file header. 975Can be multi-line string (type `C-j' for newline) and contain other file 976header keywords (see option `vhdl-file-header')." 977 :type 'string 978 :group 'vhdl-header) 979 980(defcustom vhdl-platform-spec "" 981 "*Specification of VHDL platform to insert in file header. 982The platform specification should contain names and versions of the 983simulation and synthesis tools used. 984See option `vhdl-file-header'." 985 :type 'string 986 :group 'vhdl-header) 987 988(defcustom vhdl-date-format "%Y-%m-%d" 989 "*Specifies the date format to use in the header. 990This string is passed as argument to the command `format-time-string'. 991For more information on format strings, see the documentation for the 992`format-time-string' command (C-h f `format-time-string')." 993 :type 'string 994 :group 'vhdl-header) 995 996(defcustom vhdl-modify-date-prefix-string "-- Last update: " 997 "*Prefix string of modification date in VHDL file header. 998If actualization of the modification date is called (menu, 999`\\[vhdl-template-modify]'), this string is searched and the rest 1000of the line replaced by the current date." 1001 :type 'string 1002 :group 'vhdl-header) 1003 1004(defcustom vhdl-modify-date-on-saving t 1005 "*Non-nil means update the modification date when the buffer is saved. 1006Calls function `\\[vhdl-template-modify]'). 1007 1008NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1009 \"Activate Options\"." 1010 :type 'boolean 1011 :group 'vhdl-header) 1012 1013 1014(defgroup vhdl-sequential-process nil 1015 "Customizations for sequential processes." 1016 :group 'vhdl-template) 1017 1018(defcustom vhdl-reset-kind 'async 1019 "*Specifies which kind of reset to use in sequential processes." 1020 :type '(choice (const :tag "None" none) 1021 (const :tag "Synchronous" sync) 1022 (const :tag "Asynchronous" async)) 1023 :group 'vhdl-sequential-process) 1024 1025(defcustom vhdl-reset-active-high nil 1026 "*Non-nil means reset in sequential processes is active high. 1027Otherwise, reset is active low." 1028 :type 'boolean 1029 :group 'vhdl-sequential-process) 1030 1031(defcustom vhdl-clock-rising-edge t 1032 "*Non-nil means rising edge of clock triggers sequential processes. 1033Otherwise, falling edge triggers." 1034 :type 'boolean 1035 :group 'vhdl-sequential-process) 1036 1037(defcustom vhdl-clock-edge-condition 'standard 1038 "*Syntax of the clock edge condition. 1039 Standard: \"clk'event and clk = '1'\" 1040 Function: \"rising_edge(clk)\"" 1041 :type '(choice (const :tag "Standard" standard) 1042 (const :tag "Function" function)) 1043 :group 'vhdl-sequential-process) 1044 1045(defcustom vhdl-clock-name "" 1046 "*Name of clock signal to use in templates." 1047 :type 'string 1048 :group 'vhdl-sequential-process) 1049 1050(defcustom vhdl-reset-name "" 1051 "*Name of reset signal to use in templates." 1052 :type 'string 1053 :group 'vhdl-sequential-process) 1054 1055 1056(defgroup vhdl-model nil 1057 "Customizations for user models." 1058 :group 'vhdl) 1059 1060(defcustom vhdl-model-alist 1061 '(("Example Model" 1062 "<label> : process (<clock>, <reset>) 1063begin -- process <label> 1064 if <reset> = '0' then -- asynchronous reset (active low) 1065 <cursor> 1066 elsif <clock>'event and <clock> = '1' then -- rising clock edge 1067 if <enable> = '1' then -- synchronous load 1068 1069 end if; 1070 end if; 1071end process <label>;" 1072 "e" "")) 1073 "*List of user models. 1074VHDL models (templates) can be specified by the user in this list. They can be 1075invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword 1076electrification (i.e. overriding existing or creating new keywords, see 1077option `vhdl-electric-keywords'). 1078 Name : name of model (string of words and spaces) 1079 String : string or name of file to be inserted as model (newline: `C-j') 1080 Key Binding: key binding to invoke model, added to prefix `C-c C-m' 1081 (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\") 1082 Keyword : keyword to invoke model 1083 1084The models can contain prompts to be queried. A prompt is of the form \"<...>\". 1085A prompt that appears several times is queried once and replaced throughout 1086the model. Special prompts are: 1087 <clock> : name specified in `vhdl-clock-name' (if not empty) 1088 <reset> : name specified in `vhdl-reset-name' (if not empty) 1089 <cursor>: final cursor position 1090File header prompts (see variable `vhdl-file-header') are automatically 1091replaced, so that user models can also be used to insert different types of 1092headers. 1093 1094If the string specifies an existing file name, the contents of the file is 1095inserted, otherwise the string itself is inserted. 1096The code within the models should be correctly indented. 1097Type `C-j' for newlines. 1098 1099NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1100 \"Activate Options\"." 1101 :type '(repeat (list :tag "Model" :indent 2 1102 (string :tag "Name ") 1103 (string :tag "String : (type `C-j' for newline)" 1104 :format "%t\n%v") 1105 (sexp :tag "Key binding" x) 1106 (string :tag "Keyword " :format "%t: %v\n"))) 1107 :set (lambda (variable value) 1108 (vhdl-custom-set variable value 1109 'vhdl-model-map-init 1110 'vhdl-model-defun 1111 'vhdl-mode-abbrev-table-init 1112 'vhdl-update-mode-menu)) 1113 :group 'vhdl-model) 1114 1115 1116(defgroup vhdl-compose nil 1117 "Customizations for structural composition." 1118 :group 'vhdl) 1119 1120(defcustom vhdl-compose-architecture-name '(".*" . "str") 1121 (concat 1122 "*Specifies how the component architecture name is obtained. 1123The component architecture name can be obtained by modifying the entity name 1124\(e.g. attaching or stripping off a substring). 1125If TO STRING is empty, the architecture name is queried." 1126 vhdl-name-doc-string) 1127 :type '(cons (regexp :tag "From regexp") 1128 (string :tag "To string ")) 1129 :group 'vhdl-compose) 1130 1131(defcustom vhdl-compose-configuration-name 1132 '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg") 1133 (concat 1134 "*Specifies how the configuration name is obtained. 1135The configuration name can be obtained by modifying the entity and/or 1136architecture name (e.g. attaching or stripping off a substring). The string 1137that is matched against the regexp is the concatenation of the entity and the 1138architecture name separated by a space. This gives access to both names (see 1139default setting as example)." 1140 vhdl-name-doc-string) 1141 :type '(cons (regexp :tag "From regexp") 1142 (string :tag "To string ")) 1143 :group 'vhdl-compose) 1144 1145(defcustom vhdl-components-package-name 1146 '((".*" . "\\&_components") . "components") 1147 (concat 1148 "*Specifies how the name for the components package is obtained. 1149The components package is a package containing all component declarations for 1150the current design. Its name can be obtained by modifying the project name 1151\(e.g. attaching or stripping off a substring). If no project is defined, the 1152DIRECTORY entry is chosen." 1153 vhdl-name-doc-string) 1154 :type '(cons (cons :tag "Project" :indent 2 1155 (regexp :tag "From regexp") 1156 (string :tag "To string ")) 1157 (string :tag "Directory:\n String ")) 1158 :group 'vhdl-compose) 1159 1160(defcustom vhdl-use-components-package nil 1161 "*Non-nil means use a separate components package for component declarations. 1162Otherwise, component declarations are inserted and searched for in the 1163architecture declarative parts." 1164 :type 'boolean 1165 :group 'vhdl-compose) 1166 1167(defcustom vhdl-compose-include-header t 1168 "*Non-nil means include a header in automatically generated files." 1169 :type 'boolean 1170 :group 'vhdl-compose) 1171 1172(defcustom vhdl-compose-create-files 'single 1173 "*Specifies whether new files should be created for the new component. 1174The component's entity and architecture are inserted: 1175 None : in current buffer 1176 Single file : in new single file 1177 Separate files: in two separate files 1178The file names are obtained from variables `vhdl-entity-file-name' and 1179`vhdl-architecture-file-name'." 1180 :type '(choice (const :tag "None" none) 1181 (const :tag "Single file" single) 1182 (const :tag "Separate files" separate)) 1183 :group 'vhdl-compose) 1184 1185(defcustom vhdl-compose-configuration-create-file nil 1186 "*Specifies whether a new file should be created for the configuration. 1187If non-nil, a new file is created for the configuration. 1188The file name is obtained from variable `vhdl-configuration-file-name'." 1189 :type 'boolean 1190 :group 'vhdl-compose) 1191 1192(defcustom vhdl-compose-configuration-hierarchical t 1193 "*Specifies whether hierarchical configurations should be created. 1194If non-nil, automatically created configurations are hierarchical and include 1195the whole hierarchy of subcomponents. Otherwise the configuration only 1196includes one level of subcomponents." 1197 :type 'boolean 1198 :group 'vhdl-compose) 1199 1200(defcustom vhdl-compose-configuration-use-subconfiguration t 1201 "*Specifies whether subconfigurations should be used inside configurations. 1202If non-nil, automatically created configurations use configurations in binding 1203indications for subcomponents, if such configurations exist. Otherwise, 1204entities are used in binding indications for subcomponents." 1205 :type 'boolean 1206 :group 'vhdl-compose) 1207 1208 1209(defgroup vhdl-port nil 1210 "Customizations for port translation functions." 1211 :group 'vhdl 1212 :group 'vhdl-compose) 1213 1214(defcustom vhdl-include-port-comments nil 1215 "*Non-nil means include port comments when a port is pasted." 1216 :type 'boolean 1217 :group 'vhdl-port) 1218 1219(defcustom vhdl-include-direction-comments nil 1220 "*Non-nil means include port direction in instantiations as comments." 1221 :type 'boolean 1222 :group 'vhdl-port) 1223 1224(defcustom vhdl-include-type-comments nil 1225 "*Non-nil means include generic/port type in instantiations as comments." 1226 :type 'boolean 1227 :group 'vhdl-port) 1228 1229(defcustom vhdl-include-group-comments 'never 1230 "*Specifies whether to include group comments and spacings. 1231The comments and empty lines between groups of ports are pasted: 1232 Never : never 1233 Declarations: in entity/component/constant/signal declarations only 1234 Always : also in generic/port maps" 1235 :type '(choice (const :tag "Never" never) 1236 (const :tag "Declarations" decl) 1237 (const :tag "Always" always)) 1238 :group 'vhdl-port) 1239 1240(defcustom vhdl-actual-port-name '(".*" . "\\&") 1241 (concat 1242 "*Specifies how actual port names are obtained from formal port names. 1243In a component instantiation, an actual port name can be obtained by 1244modifying the formal port name (e.g. attaching or stripping off a substring)." 1245 vhdl-name-doc-string) 1246 :type '(cons (regexp :tag "From regexp") 1247 (string :tag "To string ")) 1248 :group 'vhdl-port) 1249 1250(defcustom vhdl-instance-name '(".*" . "\\&_%d") 1251 (concat 1252 "*Specifies how an instance name is obtained. 1253The instance name can be obtained by modifying the name of the component to be 1254instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced 1255by a unique number (starting with 1). 1256If TO STRING is empty, the instance name is queried." 1257 vhdl-name-doc-string) 1258 :type '(cons (regexp :tag "From regexp") 1259 (string :tag "To string ")) 1260 :group 'vhdl-port) 1261 1262 1263(defgroup vhdl-testbench nil 1264 "Customizations for testbench generation." 1265 :group 'vhdl-port) 1266 1267(defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb") 1268 (concat 1269 "*Specifies how the testbench entity name is obtained. 1270The entity name of a testbench can be obtained by modifying the name of 1271the component to be tested (e.g. attaching or stripping off a substring)." 1272 vhdl-name-doc-string) 1273 :type '(cons (regexp :tag "From regexp") 1274 (string :tag "To string ")) 1275 :group 'vhdl-testbench) 1276 1277(defcustom vhdl-testbench-architecture-name '(".*" . "") 1278 (concat 1279 "*Specifies how the testbench architecture name is obtained. 1280The testbench architecture name can be obtained by modifying the name of 1281the component to be tested (e.g. attaching or stripping off a substring). 1282If TO STRING is empty, the architecture name is queried." 1283 vhdl-name-doc-string) 1284 :type '(cons (regexp :tag "From regexp") 1285 (string :tag "To string ")) 1286 :group 'vhdl-testbench) 1287 1288(defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name 1289 (concat 1290 "*Specifies how the testbench configuration name is obtained. 1291The configuration name of a testbench can be obtained by modifying the entity 1292and/or architecture name (e.g. attaching or stripping off a substring). The 1293string that is matched against the regexp is the concatenation of the entity 1294and the architecture name separated by a space. This gives access to both 1295names (see default setting as example)." 1296 vhdl-name-doc-string) 1297 :type '(cons (regexp :tag "From regexp") 1298 (string :tag "To string ")) 1299 :group 'vhdl-testbench) 1300 1301(defcustom vhdl-testbench-dut-name '(".*" . "DUT") 1302 (concat 1303 "*Specifies how a DUT instance name is obtained. 1304The design-under-test instance name (i.e. the component instantiated in the 1305testbench) can be obtained by modifying the component name (e.g. attaching 1306or stripping off a substring)." 1307 vhdl-name-doc-string) 1308 :type '(cons (regexp :tag "From regexp") 1309 (string :tag "To string ")) 1310 :group 'vhdl-testbench) 1311 1312(defcustom vhdl-testbench-include-header t 1313 "*Non-nil means include a header in automatically generated files." 1314 :type 'boolean 1315 :group 'vhdl-testbench) 1316 1317(defcustom vhdl-testbench-declarations "\ 1318 -- clock 1319 signal Clk : std_logic := '1'; 1320" 1321 "*String or file to be inserted in the testbench declarative part. 1322If the string specifies an existing file name, the contents of the file is 1323inserted, otherwise the string itself is inserted in the testbench 1324architecture before the BEGIN keyword. 1325Type `C-j' for newlines." 1326 :type 'string 1327 :group 'vhdl-testbench) 1328 1329(defcustom vhdl-testbench-statements "\ 1330 -- clock generation 1331 Clk <= not Clk after 10 ns; 1332 1333 -- waveform generation 1334 WaveGen_Proc: process 1335 begin 1336 -- insert signal assignments here 1337 1338 wait until Clk = '1'; 1339 end process WaveGen_Proc; 1340" 1341 "*String or file to be inserted in the testbench statement part. 1342If the string specifies an existing file name, the contents of the file is 1343inserted, otherwise the string itself is inserted in the testbench 1344architecture before the END keyword. 1345Type `C-j' for newlines." 1346 :type 'string 1347 :group 'vhdl-testbench) 1348 1349(defcustom vhdl-testbench-initialize-signals nil 1350 "*Non-nil means initialize signals with `0' when declared in testbench." 1351 :type 'boolean 1352 :group 'vhdl-testbench) 1353 1354(defcustom vhdl-testbench-include-library t 1355 "*Non-nil means a library/use clause for std_logic_1164 is included." 1356 :type 'boolean 1357 :group 'vhdl-testbench) 1358 1359(defcustom vhdl-testbench-include-configuration t 1360 "*Non-nil means a testbench configuration is attached at the end." 1361 :type 'boolean 1362 :group 'vhdl-testbench) 1363 1364(defcustom vhdl-testbench-create-files 'single 1365 "*Specifies whether new files should be created for the testbench. 1366testbench entity and architecture are inserted: 1367 None : in current buffer 1368 Single file : in new single file 1369 Separate files: in two separate files 1370The file names are obtained from variables `vhdl-testbench-entity-file-name' 1371and `vhdl-testbench-architecture-file-name'." 1372 :type '(choice (const :tag "None" none) 1373 (const :tag "Single file" single) 1374 (const :tag "Separate files" separate)) 1375 :group 'vhdl-testbench) 1376 1377(defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name 1378 (concat 1379 "*Specifies how the testbench entity file name is obtained. 1380The entity file name can be obtained by modifying the testbench entity name 1381\(e.g. attaching or stripping off a substring). The file extension is 1382automatically taken from the file name of the current buffer. Testbench 1383files can be created in a different directory by prepending a relative or 1384absolute path to the file name." 1385 vhdl-name-doc-string) 1386 :type '(cons (regexp :tag "From regexp") 1387 (string :tag "To string ")) 1388 :group 'vhdl-testbench) 1389 1390(defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name 1391 (concat 1392 "*Specifies how the testbench architecture file name is obtained. 1393The architecture file name can be obtained by modifying the testbench entity 1394and/or architecture name (e.g. attaching or stripping off a substring). The 1395string that is matched against the regexp is the concatenation of the entity 1396and the architecture name separated by a space. This gives access to both 1397names (see default setting as example). Testbench files can be created in 1398a different directory by prepending a relative or absolute path to the file 1399name." 1400 vhdl-name-doc-string) 1401 :type '(cons (regexp :tag "From regexp") 1402 (string :tag "To string ")) 1403 :group 'vhdl-testbench) 1404 1405 1406(defgroup vhdl-comment nil 1407 "Customizations for comments." 1408 :group 'vhdl) 1409 1410(defcustom vhdl-self-insert-comments t 1411 "*Non-nil means various templates automatically insert help comments." 1412 :type 'boolean 1413 :group 'vhdl-comment) 1414 1415(defcustom vhdl-prompt-for-comments t 1416 "*Non-nil means various templates prompt for user definable comments." 1417 :type 'boolean 1418 :group 'vhdl-comment) 1419 1420(defcustom vhdl-inline-comment-column 40 1421 "*Column to indent and align inline comments to. 1422Overrides local option `comment-column'. 1423 1424NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1425 \"Activate Options\"." 1426 :type 'integer 1427 :group 'vhdl-comment) 1428 1429(defcustom vhdl-end-comment-column 79 1430 "*End of comment column. 1431Comments that exceed this column number are wrapped. 1432 1433NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1434 \"Activate Options\"." 1435 :type 'integer 1436 :group 'vhdl-comment) 1437 1438(defvar end-comment-column) 1439 1440 1441(defgroup vhdl-align nil 1442 "Customizations for alignment." 1443 :group 'vhdl) 1444 1445(defcustom vhdl-auto-align t 1446 "*Non-nil means align some templates automatically after generation." 1447 :type 'boolean 1448 :group 'vhdl-align) 1449 1450(defcustom vhdl-align-groups t 1451 "*Non-nil means align groups of code lines separately. 1452A group of code lines is a region of consecutive lines between two lines that 1453match the regexp in option `vhdl-align-group-separate'." 1454 :type 'boolean 1455 :group 'vhdl-align) 1456 1457(defcustom vhdl-align-group-separate "^\\s-*$" 1458 "*Regexp for matching a line that separates groups of lines for alignment. 1459Examples: 1460 \"^\\s-*$\": matches an empty line 1461 \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" 1462 :type 'regexp 1463 :group 'vhdl-align) 1464 1465(defcustom vhdl-align-same-indent t 1466 "*Non-nil means align blocks with same indent separately. 1467When a region or the entire buffer is aligned, the code is divided into 1468blocks of same indent which are aligned separately (except for argument/port 1469lists). This gives nicer alignment in most cases. 1470Option `vhdl-align-groups' still applies within these blocks." 1471 :type 'boolean 1472 :group 'vhdl-align) 1473 1474 1475(defgroup vhdl-highlight nil 1476 "Customizations for highlighting." 1477 :group 'vhdl) 1478 1479(defcustom vhdl-highlight-keywords t 1480 "*Non-nil means highlight VHDL keywords and other standardized words. 1481The following faces are used: 1482 `font-lock-keyword-face' : keywords 1483 `font-lock-type-face' : standardized types 1484 `vhdl-font-lock-attribute-face': standardized attributes 1485 `vhdl-font-lock-enumvalue-face': standardized enumeration values 1486 `vhdl-font-lock-function-face' : standardized function and package names 1487 1488NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1489 entry \"Fontify Buffer\")." 1490 :type 'boolean 1491 :set (lambda (variable value) 1492 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1493 :group 'vhdl-highlight) 1494 1495(defcustom vhdl-highlight-names t 1496 "*Non-nil means highlight declaration names and construct labels. 1497The following faces are used: 1498 `font-lock-function-name-face' : names in declarations of units, 1499 subprograms, components, as well as labels of VHDL constructs 1500 `font-lock-type-face' : names in type/nature declarations 1501 `vhdl-font-lock-attribute-face': names in attribute declarations 1502 `font-lock-variable-name-face' : names in declarations of signals, 1503 variables, constants, subprogram parameters, generics, and ports 1504 1505NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1506 entry \"Fontify Buffer\")." 1507 :type 'boolean 1508 :set (lambda (variable value) 1509 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1510 :group 'vhdl-highlight) 1511 1512(defcustom vhdl-highlight-special-words nil 1513 "*Non-nil means highlight words with special syntax. 1514The words with syntax and color specified in option `vhdl-special-syntax-alist' 1515are highlighted accordingly. 1516Can be used for visual support of naming conventions. 1517 1518NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1519 entry \"Fontify Buffer\")." 1520 :type 'boolean 1521 :set (lambda (variable value) 1522 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1523 :group 'vhdl-highlight) 1524 1525(defcustom vhdl-highlight-forbidden-words nil 1526 "*Non-nil means highlight forbidden words. 1527The reserved words specified in option `vhdl-forbidden-words' or having the 1528syntax specified in option `vhdl-forbidden-syntax' are highlighted in a 1529warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to 1530use them. 1531 1532NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1533 entry \"Fontify Buffer\")." 1534 :type 'boolean 1535 :set (lambda (variable value) 1536 (vhdl-custom-set variable value 1537 'vhdl-words-init 'vhdl-font-lock-init)) 1538 :group 'vhdl-highlight) 1539 1540(defcustom vhdl-highlight-verilog-keywords nil 1541 "*Non-nil means highlight Verilog keywords as reserved words. 1542Verilog keywords are highlighted in a warning color (face 1543`vhdl-font-lock-reserved-words-face') to indicate not to use them. 1544 1545NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1546 entry \"Fontify Buffer\")." 1547 :type 'boolean 1548 :set (lambda (variable value) 1549 (vhdl-custom-set variable value 1550 'vhdl-words-init 'vhdl-font-lock-init)) 1551 :group 'vhdl-highlight) 1552 1553(defcustom vhdl-highlight-translate-off nil 1554 "*Non-nil means background-highlight code excluded from translation. 1555That is, all code between \"-- pragma translate_off\" and 1556\"-- pragma translate_on\" is highlighted using a different background color 1557\(face `vhdl-font-lock-translate-off-face'). 1558Note: this might slow down on-the-fly fontification (and thus editing). 1559 1560NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1561 entry \"Fontify Buffer\")." 1562 :type 'boolean 1563 :set (lambda (variable value) 1564 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1565 :group 'vhdl-highlight) 1566 1567(defcustom vhdl-highlight-case-sensitive nil 1568 "*Non-nil means consider case for highlighting. 1569Possible trade-off: 1570 non-nil also upper-case VHDL words are highlighted, but case of words with 1571 special syntax is not considered 1572 nil only lower-case VHDL words are highlighted, but case of words with 1573 special syntax is considered 1574Overrides local option `font-lock-keywords-case-fold-search'. 1575 1576NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1577 entry \"Fontify Buffer\")." 1578 :type 'boolean 1579 :group 'vhdl-highlight) 1580 1581(defcustom vhdl-special-syntax-alist 1582 '(("generic/constant" "\\w+_[cg]" "Gold3" "BurlyWood1") 1583 ("type" "\\w+_t" "ForestGreen" "PaleGreen") 1584 ("variable" "\\w+_v" "Grey50" "Grey80")) 1585 "*List of special syntax to be highlighted. 1586If option `vhdl-highlight-special-words' is non-nil, words with the specified 1587syntax (as regular expression) are highlighted in the corresponding color. 1588 1589 Name : string of words and spaces 1590 Regexp : regular expression describing word syntax 1591 (e.g. \"\\\w+_c\" matches word with suffix \"_c\") 1592 Color (light): foreground color for light background 1593 (matching color examples: Gold3, Grey50, LimeGreen, Tomato, 1594 LightSeaGreen, DodgerBlue, Gold, PaleVioletRed) 1595 Color (dark) : foreground color for dark background 1596 (matching color examples: BurlyWood1, Grey80, Green, Coral, 1597 AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1) 1598 1599Can be used for visual support of naming conventions, such as highlighting 1600different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g. 1601\"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using 1602common substrings or name suffices. 1603For each entry, a new face is generated with the specified colors and name 1604\"vhdl-font-lock-\" + name + \"-face\". 1605 1606NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu 1607 entry \"Fontify Buffer\"). All other changes require restarting Emacs." 1608 :type '(repeat (list :tag "Face" :indent 2 1609 (string :tag "Name ") 1610 (regexp :tag "Regexp " "\\w+_") 1611 (string :tag "Color (light)") 1612 (string :tag "Color (dark) "))) 1613 :set (lambda (variable value) 1614 (vhdl-custom-set variable value 'vhdl-font-lock-init)) 1615 :group 'vhdl-highlight) 1616 1617(defcustom vhdl-forbidden-words '() 1618 "*List of forbidden words to be highlighted. 1619If option `vhdl-highlight-forbidden-words' is non-nil, these reserved 1620words are highlighted in a warning color to indicate not to use them. 1621 1622NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1623 entry \"Fontify Buffer\")." 1624 :type '(repeat (string :format "%v")) 1625 :set (lambda (variable value) 1626 (vhdl-custom-set variable value 1627 'vhdl-words-init 'vhdl-font-lock-init)) 1628 :group 'vhdl-highlight) 1629 1630(defcustom vhdl-forbidden-syntax "" 1631 "*Syntax of forbidden words to be highlighted. 1632If option `vhdl-highlight-forbidden-words' is non-nil, words with this 1633syntax are highlighted in a warning color to indicate not to use them. 1634Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\" 1635highlights identifiers with 10 or more characters). 1636 1637NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1638 entry \"Fontify Buffer\")." 1639 :type 'regexp 1640 :set (lambda (variable value) 1641 (vhdl-custom-set variable value 1642 'vhdl-words-init 'vhdl-font-lock-init)) 1643 :group 'vhdl-highlight) 1644 1645(defcustom vhdl-directive-keywords '("pragma" "synopsys") 1646 "*List of compiler directive keywords recognized for highlighting. 1647 1648NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu 1649 entry \"Fontify Buffer\")." 1650 :type '(repeat (string :format "%v")) 1651 :set (lambda (variable value) 1652 (vhdl-custom-set variable value 1653 'vhdl-words-init 'vhdl-font-lock-init)) 1654 :group 'vhdl-highlight) 1655 1656 1657(defgroup vhdl-speedbar nil 1658 "Customizations for speedbar." 1659 :group 'vhdl) 1660 1661(defcustom vhdl-speedbar-auto-open nil 1662 "*Non-nil means automatically open speedbar at startup. 1663Alternatively, the speedbar can be opened from the VHDL menu." 1664 :type 'boolean 1665 :group 'vhdl-speedbar) 1666 1667(defcustom vhdl-speedbar-display-mode 'files 1668 "*Specifies the default displaying mode when opening speedbar. 1669Alternatively, the displaying mode can be selected from the speedbar menu or 1670by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)." 1671 :type '(choice (const :tag "Files" files) 1672 (const :tag "Directory hierarchy" directory) 1673 (const :tag "Project hierarchy" project)) 1674 :group 'vhdl-speedbar) 1675 1676(defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50)) 1677 "*Limits scanning of large files and netlists. 1678Design units: maximum file size to scan for design units 1679Hierarchy (instances of subcomponents): 1680 File size: maximum file size to scan for instances (in bytes) 1681 Instances per arch: maximum number of instances to scan per architecture 1682 1683\"None\" always means that there is no limit. 1684In case of files not or incompletely scanned, a warning message and the file 1685names are printed out. 1686Background: scanning for instances is considerably slower than scanning for 1687design units, especially when there are many instances. These limits should 1688prevent the scanning of large netlists." 1689 :type '(list (choice :tag "Design units" 1690 :format "%t : %[Value Menu%] %v" 1691 (const :tag "None" nil) 1692 (integer :tag "File size")) 1693 (list :tag "Hierarchy" :indent 2 1694 (choice :tag "File size" 1695 :format "%t : %[Value Menu%] %v" 1696 (const :tag "None" nil) 1697 (integer :tag "Size ")) 1698 (choice :tag "Instances per arch" 1699 (const :tag "None" nil) 1700 (integer :tag "Number ")))) 1701 :group 'vhdl-speedbar) 1702 1703(defcustom vhdl-speedbar-jump-to-unit t 1704 "*Non-nil means jump to the design unit code when opened in a buffer. 1705The buffer cursor position is left unchanged otherwise." 1706 :type 'boolean 1707 :group 'vhdl-speedbar) 1708 1709(defcustom vhdl-speedbar-update-on-saving t 1710 "*Automatically update design hierarchy when buffer is saved." 1711 :type 'boolean 1712 :group 'vhdl-speedbar) 1713 1714(defcustom vhdl-speedbar-save-cache '(hierarchy display) 1715 "*Automatically save modified hierarchy caches when exiting Emacs. 1716 Hierarchy: design hierarchy information 1717 Display: displaying information (which design units to expand)" 1718 :type '(set (const :tag "Hierarchy" hierarchy) 1719 (const :tag "Display" display)) 1720 :group 'vhdl-speedbar) 1721 1722(defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2" 1723 "*Name of file for saving hierarchy cache. 1724\"\\1\" is replaced by the project name if a project is specified, 1725\"directory\" otherwise. \"\\2\" is replaced by the user name (allows for 1726different users to have cache files in the same directory). Can also have 1727an absolute path (i.e. all caches can be stored in one global directory)." 1728 :type 'string 1729 :group 'vhdl-speedbar) 1730 1731 1732(defgroup vhdl-menu nil 1733 "Customizations for menues." 1734 :group 'vhdl) 1735 1736(defcustom vhdl-index-menu nil 1737 "*Non-nil means add an index menu for a source file when loading. 1738Alternatively, the speedbar can be used. Note that the index menu scans a file 1739when it is opened, while speedbar only scans the file upon request." 1740 :type 'boolean 1741 :group 'vhdl-menu) 1742 1743(defcustom vhdl-source-file-menu nil 1744 "*Non-nil means add a menu of all source files in current directory. 1745Alternatively, the speedbar can be used." 1746 :type 'boolean 1747 :group 'vhdl-menu) 1748 1749(defcustom vhdl-hideshow-menu nil 1750 "*Non-nil means add hideshow menu and functionality at startup. 1751Hideshow can also be enabled from the VHDL Mode menu. 1752Hideshow allows hiding code of various VHDL constructs. 1753 1754NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1755 \"Activate Options\"." 1756 :type 'boolean 1757 :group 'vhdl-menu) 1758 1759(defcustom vhdl-hide-all-init nil 1760 "*Non-nil means hide all design units initially after a file is loaded." 1761 :type 'boolean 1762 :group 'vhdl-menu) 1763 1764 1765(defgroup vhdl-print nil 1766 "Customizations for printing." 1767 :group 'vhdl) 1768 1769(defcustom vhdl-print-two-column t 1770 "*Non-nil means print code in two columns and landscape format. 1771Adjusts settings in a way that postscript printing (\"File\" menu, `ps-print') 1772prints VHDL files in a nice two-column landscape style. 1773 1774NOTE: Activate the new setting by restarting Emacs. 1775 Overrides `ps-print' settings locally." 1776 :type 'boolean 1777 :group 'vhdl-print) 1778 1779(defcustom vhdl-print-customize-faces t 1780 "*Non-nil means use an optimized set of faces for postscript printing. 1781 1782NOTE: Activate the new setting by restarting Emacs. 1783 Overrides `ps-print' settings locally." 1784 :type 'boolean 1785 :group 'vhdl-print) 1786 1787 1788(defgroup vhdl-misc nil 1789 "Miscellaneous customizations." 1790 :group 'vhdl) 1791 1792(defcustom vhdl-intelligent-tab t 1793 "*Non-nil means `TAB' does indentation, word completion and tab insertion. 1794That is, if preceeding character is part of a word then complete word, 1795else if not at beginning of line then insert tab, 1796else if last command was a `TAB' or `RET' then dedent one step, 1797else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab'). 1798If nil, TAB always indents current line (i.e. `TAB' is bound to 1799`indent-according-to-mode'). 1800 1801NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1802 \"Activate Options\"." 1803 :type 'boolean 1804 :group 'vhdl-misc) 1805 1806(defcustom vhdl-indent-syntax-based t 1807 "*Non-nil means indent lines of code based on their syntactic context. 1808Otherwise, a line is indented like the previous nonblank line. This can be 1809useful in large files where syntax-based indentation gets very slow." 1810 :type 'boolean 1811 :group 'vhdl-misc) 1812 1813(defcustom vhdl-word-completion-case-sensitive nil 1814 "*Non-nil means word completion using `TAB' is case sensitive. 1815That is, `TAB' completes words that start with the same letters and case. 1816Otherwise, case is ignored." 1817 :type 'boolean 1818 :group 'vhdl-misc) 1819 1820(defcustom vhdl-word-completion-in-minibuffer t 1821 "*Non-nil enables word completion in minibuffer (for template prompts). 1822 1823NOTE: Activate the new setting by restarting Emacs." 1824 :type 'boolean 1825 :group 'vhdl-misc) 1826 1827(defcustom vhdl-underscore-is-part-of-word nil 1828 "*Non-nil means consider the underscore character `_' as part of word. 1829An identifier containing underscores is then treated as a single word in 1830select and move operations. All parts of an identifier separated by underscore 1831are treated as single words otherwise. 1832 1833NOTE: Activate the new setting in a VHDL buffer by using the menu entry 1834 \"Activate Options\"." 1835 :type 'boolean 1836 :set (lambda (variable value) 1837 (vhdl-custom-set variable value 'vhdl-mode-syntax-table-init)) 1838 :group 'vhdl-misc) 1839 1840 1841(defgroup vhdl-related nil 1842 "Related general customizations." 1843 :group 'vhdl) 1844 1845;; add related general customizations 1846(custom-add-to-group 'vhdl-related 'hideshow 'custom-group) 1847(if vhdl-xemacs 1848 (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) 1849 (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) 1850(custom-add-to-group 'vhdl-related 'ps-print 'custom-group) 1851(custom-add-to-group 'vhdl-related 'speedbar 'custom-group) 1852(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) 1853(unless vhdl-xemacs 1854 (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) 1855(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) 1856(custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable) 1857(custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable) 1858 1859;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1860;; Internal variables 1861 1862(defvar vhdl-menu-max-size 20 1863 "*Specifies the maximum size of a menu before splitting it into submenues.") 1864 1865(defvar vhdl-progress-interval 1 1866 "*Interval used to update progress status during long operations. 1867If a number, percentage complete gets updated after each interval of 1868that many seconds. To inhibit all messages, set this option to nil.") 1869 1870(defvar vhdl-inhibit-startup-warnings-p nil 1871 "*If non-nil, inhibits start up compatibility warnings.") 1872 1873(defvar vhdl-strict-syntax-p nil 1874 "*If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. 1875If the syntactic symbol for a particular line does not match a symbol 1876in the offsets alist, an error is generated, otherwise no error is 1877reported and the syntactic symbol is ignored.") 1878 1879(defvar vhdl-echo-syntactic-information-p nil 1880 "*If non-nil, syntactic info is echoed when the line is indented.") 1881 1882(defconst vhdl-offsets-alist-default 1883 '((string . -1000) 1884 (cpp-macro . -1000) 1885 (block-open . 0) 1886 (block-close . 0) 1887 (statement . 0) 1888 (statement-cont . vhdl-lineup-statement-cont) 1889 (statement-block-intro . +) 1890 (statement-case-intro . +) 1891 (case-alternative . +) 1892 (comment . vhdl-lineup-comment) 1893 (arglist-intro . +) 1894 (arglist-cont . 0) 1895 (arglist-cont-nonempty . vhdl-lineup-arglist) 1896 (arglist-close . vhdl-lineup-arglist) 1897 (entity . 0) 1898 (configuration . 0) 1899 (package . 0) 1900 (architecture . 0) 1901 (package-body . 0) 1902 ) 1903 "Default settings for offsets of syntactic elements. 1904Do not change this constant! See the variable `vhdl-offsets-alist' for 1905more information.") 1906 1907(defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) 1908 "*Association list of syntactic element symbols and indentation offsets. 1909As described below, each cons cell in this list has the form: 1910 1911 (SYNTACTIC-SYMBOL . OFFSET) 1912 1913When a line is indented, `vhdl-mode' first determines the syntactic 1914context of the line by generating a list of symbols called syntactic 1915elements. This list can contain more than one syntactic element and 1916the global variable `vhdl-syntactic-context' contains the context list 1917for the line being indented. Each element in this list is actually a 1918cons cell of the syntactic symbol and a buffer position. This buffer 1919position is call the relative indent point for the line. Some 1920syntactic symbols may not have a relative indent point associated with 1921them. 1922 1923After the syntactic context list for a line is generated, `vhdl-mode' 1924calculates the absolute indentation for the line by looking at each 1925syntactic element in the list. First, it compares the syntactic 1926element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it 1927finds a match, it adds the OFFSET to the column of the relative indent 1928point. The sum of this calculation for each element in the syntactic 1929list is the absolute offset for line being indented. 1930 1931If the syntactic element does not match any in the `vhdl-offsets-alist', 1932an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise 1933the element is ignored. 1934 1935Actually, OFFSET can be an integer, a function, a variable, or one of 1936the following symbols: `+', `-', `++', or `--'. These latter 1937designate positive or negative multiples of `vhdl-basic-offset', 1938respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is 1939called with a single argument containing the cons of the syntactic 1940element symbol and the relative indent point. The function should 1941return an integer offset. 1942 1943Here is the current list of valid syntactic element symbols: 1944 1945 string -- inside multi-line string 1946 block-open -- statement block open 1947 block-close -- statement block close 1948 statement -- a VHDL statement 1949 statement-cont -- a continuation of a VHDL statement 1950 statement-block-intro -- the first line in a new statement block 1951 statement-case-intro -- the first line in a case alternative block 1952 case-alternative -- a case statement alternative clause 1953 comment -- a line containing only a comment 1954 arglist-intro -- the first line in an argument list 1955 arglist-cont -- subsequent argument list lines when no 1956 arguments follow on the same line as the 1957 the arglist opening paren 1958 arglist-cont-nonempty -- subsequent argument list lines when at 1959 least one argument follows on the same 1960 line as the arglist opening paren 1961 arglist-close -- the solo close paren of an argument list 1962 entity -- inside an entity declaration 1963 configuration -- inside a configuration declaration 1964 package -- inside a package declaration 1965 architecture -- inside an architecture body 1966 package-body -- inside a package body") 1967 1968(defvar vhdl-comment-only-line-offset 0 1969 "*Extra offset for line which contains only the start of a comment. 1970Can contain an integer or a cons cell of the form: 1971 1972 (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) 1973 1974Where NON-ANCHORED-OFFSET is the amount of offset given to 1975non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is 1976the amount of offset to give column-zero anchored comment-only lines. 1977Just an integer as value is equivalent to (<val> . 0)") 1978 1979(defvar vhdl-special-indent-hook nil 1980 "*Hook for user defined special indentation adjustments. 1981This hook gets called after a line is indented by the mode.") 1982 1983(defvar vhdl-style-alist 1984 '(("IEEE" 1985 (vhdl-basic-offset . 4) 1986 (vhdl-offsets-alist . ()))) 1987 "Styles of Indentation. 1988Elements of this alist are of the form: 1989 1990 (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) 1991 1992where STYLE-STRING is a short descriptive string used to select a 1993style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended 1994value for that variable when using the selected style. 1995 1996There is one special case when VARIABLE is `vhdl-offsets-alist'. In this 1997case, the VALUE is a list containing elements of the form: 1998 1999 (SYNTACTIC-SYMBOL . VALUE) 2000 2001as described in `vhdl-offsets-alist'. These are passed directly to 2002`vhdl-set-offset' so there is no need to set every syntactic symbol in 2003your style, only those that are different from the default.") 2004 2005;; dynamically append the default value of most variables 2006(or (assoc "Default" vhdl-style-alist) 2007 (let* ((varlist '(vhdl-inhibit-startup-warnings-p 2008 vhdl-strict-syntax-p 2009 vhdl-echo-syntactic-information-p 2010 vhdl-basic-offset 2011 vhdl-offsets-alist 2012 vhdl-comment-only-line-offset)) 2013 (default (cons "Default" 2014 (mapcar 2015 (function 2016 (lambda (var) 2017 (cons var (symbol-value var)))) 2018 varlist)))) 2019 (setq vhdl-style-alist (cons default vhdl-style-alist)))) 2020 2021(defvar vhdl-mode-hook nil 2022 "*Hook called by `vhdl-mode'.") 2023 2024 2025;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2026;;; Required packages 2027;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2028 2029;; mandatory 2030(require 'assoc) 2031(require 'compile) ; XEmacs 2032(require 'easymenu) 2033(require 'hippie-exp) 2034 2035;; optional (minimize warning messages during compile) 2036(eval-when-compile 2037 (require 'font-lock) 2038 (require 'ps-print) 2039 (require 'speedbar)) 2040 2041 2042;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2043;;; Compatibility 2044;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2045 2046;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2047;; XEmacs compatibility 2048 2049;; active regions 2050(defun vhdl-keep-region-active () 2051 "Do whatever is necessary to keep the region active in XEmacs. 2052Ignore byte-compiler warnings you might see." 2053 (and (boundp 'zmacs-region-stays) 2054 (setq zmacs-region-stays t))) 2055 2056;; `wildcard-to-regexp' is included only in XEmacs 21 2057(unless (fboundp 'wildcard-to-regexp) 2058 (defun wildcard-to-regexp (wildcard) 2059 "Simplified version of `wildcard-to-regexp' from Emacs' `files.el'." 2060 (let* ((i (string-match "[*?]" wildcard)) 2061 (result (substring wildcard 0 i)) 2062 (len (length wildcard))) 2063 (when i 2064 (while (< i len) 2065 (let ((ch (aref wildcard i))) 2066 (setq result (concat result 2067 (cond ((eq ch ?*) "[^\000]*") 2068 ((eq ch ??) "[^\000]") 2069 (t (char-to-string ch))))) 2070 (setq i (1+ i))))) 2071 (concat "\\`" result "\\'")))) 2072 2073;; `regexp-opt' undefined (`xemacs-devel' not installed) 2074;; `regexp-opt' accelerates fontification by 10-20% 2075(unless (fboundp 'regexp-opt) 2076; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") 2077 (defun regexp-opt (strings &optional paren) 2078 (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) 2079 (concat open (mapconcat 'regexp-quote strings "\\|") close)))) 2080 2081;; `match-string-no-properties' undefined (XEmacs, what else?) 2082(unless (fboundp 'match-string-no-properties) 2083 (defalias 'match-string-no-properties 'match-string)) 2084 2085;; `subst-char-in-string' undefined (XEmacs) 2086(unless (fboundp 'subst-char-in-string) 2087 (defun subst-char-in-string (fromchar tochar string &optional inplace) 2088 (let ((i (length string)) 2089 (newstr (if inplace string (copy-sequence string)))) 2090 (while (> i 0) 2091 (setq i (1- i)) 2092 (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) 2093 newstr))) 2094 2095;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) 2096(when (and vhdl-xemacs (string< itimer-version "1.09") 2097 (not noninteractive)) 2098 (load "itimer") 2099 (when (string< itimer-version "1.09") 2100 (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") 2101 (beep) (sit-for 5))) 2102 2103;; `file-expand-wildcards' undefined (XEmacs) 2104(unless (fboundp 'file-expand-wildcards) 2105 (defun file-expand-wildcards (pattern &optional full) 2106 "Taken from Emacs' `files.el'." 2107 (let* ((nondir (file-name-nondirectory pattern)) 2108 (dirpart (file-name-directory pattern)) 2109 (dirs (if (and dirpart (string-match "[[*?]" dirpart)) 2110 (mapcar 'file-name-as-directory 2111 (file-expand-wildcards (directory-file-name dirpart))) 2112 (list dirpart))) 2113 contents) 2114 (while dirs 2115 (when (or (null (car dirs)) ; Possible if DIRPART is not wild. 2116 (file-directory-p (directory-file-name (car dirs)))) 2117 (let ((this-dir-contents 2118 (delq nil 2119 (mapcar #'(lambda (name) 2120 (unless (string-match "\\`\\.\\.?\\'" 2121 (file-name-nondirectory name)) 2122 name)) 2123 (directory-files (or (car dirs) ".") full 2124 (wildcard-to-regexp nondir)))))) 2125 (setq contents 2126 (nconc 2127 (if (and (car dirs) (not full)) 2128 (mapcar (function (lambda (name) (concat (car dirs) name))) 2129 this-dir-contents) 2130 this-dir-contents) 2131 contents)))) 2132 (setq dirs (cdr dirs))) 2133 contents))) 2134 2135;; `member-ignore-case' undefined (XEmacs) 2136(unless (fboundp 'member-ignore-case) 2137 (defalias 'member-ignore-case 'member)) 2138 2139;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2140;; Compatibility with older VHDL Mode versions 2141 2142(defvar vhdl-warnings nil 2143 "Warnings to tell the user during start up.") 2144 2145(defun vhdl-run-when-idle (secs repeat function) 2146 "Wait until idle, then run FUNCTION." 2147 (if (fboundp 'start-itimer) 2148 (start-itimer "vhdl-mode" function secs repeat t) 2149; (run-with-idle-timer secs repeat function))) 2150 ;; explicitely activate timer (necessary when Emacs is already idle) 2151 (aset (run-with-idle-timer secs repeat function) 0 nil))) 2152 2153(defun vhdl-warning-when-idle (&rest args) 2154 "Wait until idle, then print out warning STRING and beep." 2155 (if noninteractive 2156 (vhdl-warning (apply 'format args) t) 2157 (unless vhdl-warnings 2158 (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) 2159 (setq vhdl-warnings (cons (apply 'format args) vhdl-warnings)))) 2160 2161(defun vhdl-warning (string &optional nobeep) 2162 "Print out warning STRING and beep." 2163 (message "WARNING: %s" string) 2164 (unless (or nobeep noninteractive) (beep))) 2165 2166(defun vhdl-print-warnings () 2167 "Print out messages in variable `vhdl-warnings'." 2168 (let ((no-warnings (length vhdl-warnings))) 2169 (setq vhdl-warnings (nreverse vhdl-warnings)) 2170 (while vhdl-warnings 2171 (message "WARNING: %s" (car vhdl-warnings)) 2172 (setq vhdl-warnings (cdr vhdl-warnings))) 2173 (beep) 2174 (when (> no-warnings 1) 2175 (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) 2176 2177;; Backward compatibility checks and fixes 2178;; option `vhdl-compiler' changed format 2179(unless (stringp vhdl-compiler) 2180 (setq vhdl-compiler "ModelSim") 2181 (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) 2182 2183;; option `vhdl-standard' changed format 2184(unless (listp vhdl-standard) 2185 (setq vhdl-standard '(87 nil)) 2186 (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) 2187 2188;; option `vhdl-model-alist' changed format 2189(when (= (length (car vhdl-model-alist)) 3) 2190 (let ((old-alist vhdl-model-alist) 2191 new-alist) 2192 (while old-alist 2193 (setq new-alist (cons (append (car old-alist) '("")) new-alist)) 2194 (setq old-alist (cdr old-alist))) 2195 (setq vhdl-model-alist (nreverse new-alist))) 2196 (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) 2197 2198;; option `vhdl-project-alist' changed format 2199(when (= (length (car vhdl-project-alist)) 3) 2200 (let ((old-alist vhdl-project-alist) 2201 new-alist) 2202 (while old-alist 2203 (setq new-alist (cons (append (car old-alist) '("")) new-alist)) 2204 (setq old-alist (cdr old-alist))) 2205 (setq vhdl-project-alist (nreverse new-alist))) 2206 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2207 2208;; option `vhdl-project-alist' changed format (3.31.1) 2209(when (= (length (car vhdl-project-alist)) 4) 2210 (let ((old-alist vhdl-project-alist) 2211 new-alist elem) 2212 (while old-alist 2213 (setq elem (car old-alist)) 2214 (setq new-alist 2215 (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) 2216 nil "./" "work" "work/" "Makefile" (nth 3 elem)) 2217 new-alist)) 2218 (setq old-alist (cdr old-alist))) 2219 (setq vhdl-project-alist (nreverse new-alist))) 2220 (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) 2221 2222;; option `vhdl-project-alist' changed format (3.31.12) 2223(when (= (length (car vhdl-project-alist)) 10) 2224 (let ((tmp-alist vhdl-project-alist)) 2225 (while tmp-alist 2226 (setcdr (nthcdr 3 (car tmp-alist)) 2227 (cons "" (nthcdr 4 (car tmp-alist)))) 2228 (setq tmp-alist (cdr tmp-alist)))) 2229 (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) 2230 2231;; option `vhdl-compiler-alist' changed format (3.31.1) 2232(when (= (length (car vhdl-compiler-alist)) 7) 2233 (let ((old-alist vhdl-compiler-alist) 2234 new-alist elem) 2235 (while old-alist 2236 (setq elem (car old-alist)) 2237 (setq new-alist 2238 (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" 2239 (if (equal (nth 3 elem) "") nil (nth 3 elem)) 2240 (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) 2241 (nth 5 elem) (nth 6 elem) nil) 2242 new-alist)) 2243 (setq old-alist (cdr old-alist))) 2244 (setq vhdl-compiler-alist (nreverse new-alist))) 2245 (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) 2246 2247;; option `vhdl-compiler-alist' changed format (3.31.10) 2248(when (= (length (car vhdl-compiler-alist)) 12) 2249 (let ((tmp-alist vhdl-compiler-alist)) 2250 (while tmp-alist 2251 (setcdr (nthcdr 4 (car tmp-alist)) 2252 (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) 2253 (setq tmp-alist (cdr tmp-alist)))) 2254 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2255 2256;; option `vhdl-compiler-alist' changed format (3.31.11) 2257(when (= (length (car vhdl-compiler-alist)) 13) 2258 (let ((tmp-alist vhdl-compiler-alist)) 2259 (while tmp-alist 2260 (setcdr (nthcdr 3 (car tmp-alist)) 2261 (cons "" (nthcdr 4 (car tmp-alist)))) 2262 (setq tmp-alist (cdr tmp-alist)))) 2263 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2264 2265;; option `vhdl-compiler-alist' changed format (3.32.7) 2266(when (= (length (nth 11 (car vhdl-compiler-alist))) 3) 2267 (let ((tmp-alist vhdl-compiler-alist)) 2268 (while tmp-alist 2269 (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) 2270 '(0 . nil)) 2271 (setq tmp-alist (cdr tmp-alist)))) 2272 (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) 2273 2274;; option `vhdl-project': empty value changed from "" to nil (3.31.1) 2275(when (equal vhdl-project "") 2276 (setq vhdl-project nil) 2277 (customize-save-variable 'vhdl-project vhdl-project)) 2278 2279;; option `vhdl-project-file-name': changed format (3.31.17 beta) 2280(when (stringp vhdl-project-file-name) 2281 (setq vhdl-project-file-name (list vhdl-project-file-name)) 2282 (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) 2283 2284;; option `speedbar-indentation-width': introduced in speedbar 0.10 2285(if (not (boundp 'speedbar-indentation-width)) 2286 (defvar speedbar-indentation-width 2) 2287 ;; set default to 2 if not already customized 2288 (unless (get 'speedbar-indentation-width 'saved-value) 2289 (setq speedbar-indentation-width 2))) 2290 2291 2292;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2293;;; Help functions / inline substitutions / macros 2294;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2295 2296(defun vhdl-standard-p (standard) 2297 "Check if STANDARD is specified as used standard." 2298 (or (eq standard (car vhdl-standard)) 2299 (memq standard (cadr vhdl-standard)))) 2300 2301(defun vhdl-project-p (&optional warning) 2302 "Return non-nil if a project is displayed, i.e. directories or files are 2303specified." 2304 (if (assoc vhdl-project vhdl-project-alist) 2305 vhdl-project 2306 (when (and vhdl-project warning) 2307 (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) 2308 nil)) 2309 2310(defun vhdl-resolve-env-variable (string) 2311 "Resolve environment variables in STRING." 2312 (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) 2313 (setq string (concat (match-string 1 string) 2314 (getenv (match-string 2 string)) 2315 (match-string 4 string)))) 2316 string) 2317 2318(defun vhdl-default-directory () 2319 "Return the default directory of the current project or the directory of the 2320current buffer if no project is defined." 2321 (if (vhdl-project-p) 2322 (expand-file-name (vhdl-resolve-env-variable 2323 (nth 1 (aget vhdl-project-alist vhdl-project)))) 2324 default-directory)) 2325 2326(defmacro vhdl-prepare-search-1 (&rest body) 2327 "Enable case insensitive search and switch to syntax table that includes '_', 2328then execute BODY, and finally restore the old environment. Used for 2329consistent searching." 2330 `(let ((case-fold-search t) ; case insensitive search 2331 (current-syntax-table (syntax-table)) 2332 result 2333 (restore-prog ; program to restore enviroment 2334 '(progn 2335 ;; restore syntax table 2336 (set-syntax-table current-syntax-table)))) 2337 ;; use extended syntax table 2338 (set-syntax-table vhdl-mode-ext-syntax-table) 2339 ;; execute BODY safely 2340 (setq result 2341 (condition-case info 2342 (progn ,@body) 2343 (error (eval restore-prog) ; restore environment on error 2344 (error (cadr info))))) ; pass error up 2345 ;; restore environment 2346 (eval restore-prog) 2347 result)) 2348 2349(defmacro vhdl-prepare-search-2 (&rest body) 2350 "Enable case insensitive search, switch to syntax table that includes '_', 2351and remove `intangible' overlays, then execute BODY, and finally restore the 2352old environment. Used for consistent searching." 2353 `(let ((case-fold-search t) ; case insensitive search 2354 (current-syntax-table (syntax-table)) 2355 result overlay-all-list overlay-intangible-list overlay 2356 (restore-prog ; program to restore enviroment 2357 '(progn 2358 ;; restore syntax table 2359 (set-syntax-table current-syntax-table) 2360 ;; restore `intangible' overlays 2361 (when (fboundp 'overlay-lists) 2362 (while overlay-intangible-list 2363 (overlay-put (car overlay-intangible-list) 'intangible t) 2364 (setq overlay-intangible-list 2365 (cdr overlay-intangible-list))))))) 2366 ;; use extended syntax table 2367 (set-syntax-table vhdl-mode-ext-syntax-table) 2368 ;; remove `intangible' overlays 2369 (when (fboundp 'overlay-lists) 2370 (setq overlay-all-list (overlay-lists)) 2371 (setq overlay-all-list 2372 (append (car overlay-all-list) (cdr overlay-all-list))) 2373 (while overlay-all-list 2374 (setq overlay (car overlay-all-list)) 2375 (when (memq 'intangible (overlay-properties overlay)) 2376 (setq overlay-intangible-list 2377 (cons overlay overlay-intangible-list)) 2378 (overlay-put overlay 'intangible nil)) 2379 (setq overlay-all-list (cdr overlay-all-list)))) 2380 ;; execute BODY safely 2381 (setq result 2382 (condition-case info 2383 (progn ,@body) 2384 (error (eval restore-prog) ; restore environment on error 2385 (error (cadr info))))) ; pass error up 2386 ;; restore environment 2387 (eval restore-prog) 2388 result)) 2389 2390(defmacro vhdl-visit-file (file-name issue-error &rest body) 2391 "Visit file FILE-NAME and execute BODY." 2392 `(if (null ,file-name) 2393 (progn ,@body) 2394 (unless (file-directory-p ,file-name) 2395 (let ((source-buffer (current-buffer)) 2396 (visiting-buffer (find-buffer-visiting ,file-name)) 2397 file-opened) 2398 (when (or (and visiting-buffer (set-buffer visiting-buffer)) 2399 (condition-case () 2400 (progn (set-buffer (create-file-buffer ,file-name)) 2401 (setq file-opened t) 2402 (vhdl-insert-file-contents ,file-name) 2403 (modify-syntax-entry ?\- ". 12" (syntax-table)) 2404 (modify-syntax-entry ?\n ">" (syntax-table)) 2405 (modify-syntax-entry ?\^M ">" (syntax-table)) 2406 (modify-syntax-entry ?_ "w" (syntax-table)) 2407 t) 2408 (error 2409 (if ,issue-error 2410 (progn 2411 (when file-opened (kill-buffer (current-buffer))) 2412 (set-buffer source-buffer) 2413 (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) 2414 (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) 2415 nil)))) 2416 (condition-case info 2417 (progn ,@body) 2418 (error 2419 (if ,issue-error 2420 (progn 2421 (when file-opened (kill-buffer (current-buffer))) 2422 (set-buffer source-buffer) 2423 (error (cadr info))) 2424 (vhdl-warning (cadr info)))))) 2425 (when file-opened (kill-buffer (current-buffer))) 2426 (set-buffer source-buffer))))) 2427 2428(defun vhdl-insert-file-contents (filename) 2429 "Nicked from `insert-file-contents-literally', but allow coding system 2430conversion." 2431 (let ((format-alist nil) 2432 (after-insert-file-functions nil) 2433 (jka-compr-compression-info-list nil)) 2434 (insert-file-contents filename t))) 2435 2436(defun vhdl-sort-alist (alist) 2437 "Sort ALIST." 2438 (sort alist (function (lambda (a b) (string< (car a) (car b)))))) 2439 2440(defun vhdl-get-subdirs (directory) 2441 "Recursively get subdirectories of DIRECTORY." 2442 (let ((dir-list (list (file-name-as-directory directory))) 2443 file-list) 2444 (setq file-list (vhdl-directory-files directory t "\\w.*")) 2445 (while file-list 2446 (when (file-directory-p (car file-list)) 2447 (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) 2448 (setq file-list (cdr file-list))) 2449 dir-list)) 2450 2451(defun vhdl-aput (alist-symbol key &optional value) 2452 "As `aput', but delete key-value pair if VALUE is nil." 2453 (if value 2454 (aput alist-symbol key value) 2455 (adelete alist-symbol key))) 2456 2457(defun vhdl-delete (elt list) 2458 "Delete by side effect the first occurrence of ELT as a member of LIST." 2459 (setq list (cons nil list)) 2460 (let ((list1 list)) 2461 (while (and (cdr list1) (not (equal elt (cadr list1)))) 2462 (setq list1 (cdr list1))) 2463 (when list 2464 (setcdr list1 (cddr list1)))) 2465 (cdr list)) 2466 2467(defun vhdl-speedbar-refresh (&optional key) 2468 "Refresh directory or project with name KEY." 2469 (when (and (boundp 'speedbar-frame) 2470 (frame-live-p speedbar-frame)) 2471 (let ((pos (point)) 2472 (last-frame (selected-frame))) 2473 (if (null key) 2474 (speedbar-refresh) 2475 (select-frame speedbar-frame) 2476 (when (save-excursion 2477 (goto-char (point-min)) 2478 (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) 2479 (goto-char (match-end 1)) 2480 (speedbar-do-function-pointer) 2481 (backward-char 2) 2482 (speedbar-do-function-pointer) 2483 (message "Refreshing speedbar...done")) 2484 (select-frame last-frame))))) 2485 2486(defun vhdl-show-messages () 2487 "Get *Messages* buffer to show recent messages." 2488 (interactive) 2489 (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*"))) 2490 2491(defun vhdl-use-direct-instantiation () 2492 "Return whether direct instantiation is used." 2493 (or (eq vhdl-use-direct-instantiation 'always) 2494 (and (eq vhdl-use-direct-instantiation 'standard) 2495 (not (vhdl-standard-p '87))))) 2496 2497(defun vhdl-max-marker (marker1 marker2) 2498 "Return larger marker." 2499 (if (> marker1 marker2) marker1 marker2)) 2500 2501(defun vhdl-goto-marker (marker) 2502 "Goto marker in appropriate buffer." 2503 (when (markerp marker) 2504 (set-buffer (marker-buffer marker))) 2505 (goto-char marker)) 2506 2507(defun vhdl-menu-split (list title) 2508 "Split menu LIST into several submenues, if number of 2509elements > `vhdl-menu-max-size'." 2510 (if (> (length list) vhdl-menu-max-size) 2511 (let ((remain list) 2512 (result '()) 2513 (sublist '()) 2514 (menuno 1) 2515 (i 0)) 2516 (while remain 2517 (setq sublist (cons (car remain) sublist)) 2518 (setq remain (cdr remain)) 2519 (setq i (+ i 1)) 2520 (if (= i vhdl-menu-max-size) 2521 (progn 2522 (setq result (cons (cons (format "%s %s" title menuno) 2523 (nreverse sublist)) result)) 2524 (setq i 0) 2525 (setq menuno (+ menuno 1)) 2526 (setq sublist '())))) 2527 (and sublist 2528 (setq result (cons (cons (format "%s %s" title menuno) 2529 (nreverse sublist)) result))) 2530 (nreverse result)) 2531 list)) 2532 2533 2534;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2535;;; Bindings 2536;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2537 2538;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2539;; Key bindings 2540 2541(defvar vhdl-template-map nil 2542 "Keymap for VHDL templates.") 2543 2544(defun vhdl-template-map-init () 2545 "Initialize `vhdl-template-map'." 2546 (setq vhdl-template-map (make-sparse-keymap)) 2547 ;; key bindings for VHDL templates 2548 (define-key vhdl-template-map "al" 'vhdl-template-alias) 2549 (define-key vhdl-template-map "ar" 'vhdl-template-architecture) 2550 (define-key vhdl-template-map "at" 'vhdl-template-assert) 2551 (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) 2552 (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) 2553 (define-key vhdl-template-map "bl" 'vhdl-template-block) 2554 (define-key vhdl-template-map "ca" 'vhdl-template-case-is) 2555 (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) 2556 (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) 2557 (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) 2558 (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) 2559 (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) 2560 (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) 2561 (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) 2562 (define-key vhdl-template-map "co" 'vhdl-template-constant) 2563 (define-key vhdl-template-map "di" 'vhdl-template-disconnect) 2564 (define-key vhdl-template-map "el" 'vhdl-template-else) 2565 (define-key vhdl-template-map "ei" 'vhdl-template-elsif) 2566 (define-key vhdl-template-map "en" 'vhdl-template-entity) 2567 (define-key vhdl-template-map "ex" 'vhdl-template-exit) 2568 (define-key vhdl-template-map "fi" 'vhdl-template-file) 2569 (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) 2570 (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) 2571 (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) 2572 (define-key vhdl-template-map "fb" 'vhdl-template-function-body) 2573 (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) 2574 (define-key vhdl-template-map "ge" 'vhdl-template-generic) 2575 (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) 2576 (define-key vhdl-template-map "gt" 'vhdl-template-group-template) 2577 (define-key vhdl-template-map "\C-h" 'vhdl-template-header) 2578 (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) 2579 (define-key vhdl-template-map "it" 'vhdl-template-if-then) 2580 (define-key vhdl-template-map "li" 'vhdl-template-library) 2581 (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) 2582 (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) 2583 (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) 2584 (define-key vhdl-template-map "ma" 'vhdl-template-map) 2585 (define-key vhdl-template-map "ne" 'vhdl-template-next) 2586 (define-key vhdl-template-map "ot" 'vhdl-template-others) 2587 (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) 2588 (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) 2589 (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) 2590 (define-key vhdl-template-map "po" 'vhdl-template-port) 2591 (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) 2592 (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) 2593 (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) 2594 (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) 2595 (define-key vhdl-template-map "rp" 'vhdl-template-report) 2596 (define-key vhdl-template-map "rt" 'vhdl-template-return) 2597 (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) 2598 (define-key vhdl-template-map "si" 'vhdl-template-signal) 2599 (define-key vhdl-template-map "su" 'vhdl-template-subtype) 2600 (define-key vhdl-template-map "ty" 'vhdl-template-type) 2601 (define-key vhdl-template-map "us" 'vhdl-template-use) 2602 (define-key vhdl-template-map "va" 'vhdl-template-variable) 2603 (define-key vhdl-template-map "wa" 'vhdl-template-wait) 2604 (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) 2605 (define-key vhdl-template-map "wi" 'vhdl-template-with) 2606 (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) 2607 (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) 2608 (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) 2609 (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) 2610 (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) 2611 (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) 2612 (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) 2613 (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) 2614 (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) 2615 (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) 2616 (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) 2617 (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) 2618 (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) 2619 (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) 2620 (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) 2621 (when (vhdl-standard-p 'ams) 2622 (define-key vhdl-template-map "br" 'vhdl-template-break) 2623 (define-key vhdl-template-map "cu" 'vhdl-template-case-use) 2624 (define-key vhdl-template-map "iu" 'vhdl-template-if-use) 2625 (define-key vhdl-template-map "lm" 'vhdl-template-limit) 2626 (define-key vhdl-template-map "na" 'vhdl-template-nature) 2627 (define-key vhdl-template-map "pa" 'vhdl-template-procedural) 2628 (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) 2629 (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) 2630 (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) 2631 (define-key vhdl-template-map "sn" 'vhdl-template-subnature) 2632 (define-key vhdl-template-map "te" 'vhdl-template-terminal) 2633 ) 2634 (when (vhdl-standard-p 'math) 2635 (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) 2636 (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) 2637 )) 2638 2639;; initialize template map for VHDL Mode 2640(vhdl-template-map-init) 2641 2642(defun vhdl-function-name (prefix string &optional postfix) 2643 "Generate a Lisp function name. 2644PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in 2645STRING are replaced by `-' and substrings are converted to lower case." 2646 (let ((name prefix)) 2647 (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) 2648 (setq name 2649 (concat name "-" (downcase (substring string 0 (match-end 1))))) 2650 (setq string (substring string (match-beginning 2)))) 2651 (when postfix (setq name (concat name "-" postfix))) 2652 (intern name))) 2653 2654(defvar vhdl-model-map nil 2655 "Keymap for VHDL models.") 2656 2657(defun vhdl-model-map-init () 2658 "Initialize `vhdl-model-map'." 2659 (setq vhdl-model-map (make-sparse-keymap)) 2660 ;; key bindings for VHDL models 2661 (let ((model-alist vhdl-model-alist) model) 2662 (while model-alist 2663 (setq model (car model-alist)) 2664 (define-key vhdl-model-map (nth 2 model) 2665 (vhdl-function-name "vhdl-model" (nth 0 model))) 2666 (setq model-alist (cdr model-alist))))) 2667 2668;; initialize user model map for VHDL Mode 2669(vhdl-model-map-init) 2670 2671(defvar vhdl-mode-map nil 2672 "Keymap for VHDL Mode.") 2673 2674(defun vhdl-mode-map-init () 2675 "Initialize `vhdl-mode-map'." 2676 (setq vhdl-mode-map (make-sparse-keymap)) 2677 ;; template key bindings 2678 (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) 2679 ;; model key bindings 2680 (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) 2681 ;; standard key bindings 2682 (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) 2683 (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) 2684 (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) 2685 (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) 2686 (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) 2687 (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) 2688 (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) 2689 (unless vhdl-xemacs ; would override `M-backspace' in XEmacs 2690 (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) 2691 (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) 2692 (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) 2693 ;; backspace/delete key bindings 2694 (define-key vhdl-mode-map [backspace] 'backward-delete-char-untabify) 2695 (unless (boundp 'delete-key-deletes-forward) ; XEmacs variable 2696 (define-key vhdl-mode-map [delete] 'delete-char) 2697 (define-key vhdl-mode-map [(meta delete)] 'kill-word)) 2698 ;; mode specific key bindings 2699 (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) 2700 (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) 2701 (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) 2702 (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) 2703 (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) 2704 (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) 2705 (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) 2706 (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) 2707 (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) 2708 (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) 2709 (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) 2710 (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) 2711 (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) 2712 (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) 2713 (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) 2714 (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) 2715 (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) 2716 (if vhdl-xemacs ; `... C-g' not allowed in XEmacs 2717 (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) 2718 (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) 2719 (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) 2720 (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) 2721 (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) 2722 (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) 2723 (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) 2724 (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) 2725 (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) 2726 (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) 2727 (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) 2728 (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) 2729 (define-key vhdl-mode-map "\C-c\C-c\C-n" 'vhdl-compose-new-component) 2730 (define-key vhdl-mode-map "\C-c\C-c\C-p" 'vhdl-compose-place-component) 2731 (define-key vhdl-mode-map "\C-c\C-c\C-w" 'vhdl-compose-wire-components) 2732 (define-key vhdl-mode-map "\C-c\C-c\C-f" 'vhdl-compose-configuration) 2733 (define-key vhdl-mode-map "\C-c\C-c\C-k" 'vhdl-compose-components-package) 2734 (define-key vhdl-mode-map "\C-cc" 'vhdl-comment-uncomment-region) 2735 (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) 2736 (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) 2737 (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) 2738 (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) 2739 (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) 2740 (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) 2741 (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) 2742 (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) 2743 (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) 2744 (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) 2745 (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) 2746 (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) 2747 (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) 2748 (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) 2749 (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) 2750 (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) 2751 (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) 2752 (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) 2753 (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) 2754 (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) 2755 (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) 2756 (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) 2757 (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) 2758 (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) 2759 (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) 2760 (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) 2761 (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) 2762 (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) 2763 (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) 2764 (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) 2765 (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) 2766 (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) 2767 (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) 2768 (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) 2769 (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) 2770 (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) 2771 (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) 2772 (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) 2773 (define-key vhdl-mode-map "\C-cf" 'vhdl-fontify-buffer) 2774 (define-key vhdl-mode-map "\C-cs" 'vhdl-statistics-buffer) 2775 (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) 2776 (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) 2777 (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) 2778 (define-key vhdl-mode-map "\M-\t" 'insert-tab) 2779 ;; insert commands bindings 2780 (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) 2781 (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) 2782 (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) 2783 (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) 2784 ;; electric key bindings 2785 (define-key vhdl-mode-map " " 'vhdl-electric-space) 2786 (when vhdl-intelligent-tab 2787 (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) 2788 (define-key vhdl-mode-map "\r" 'vhdl-electric-return) 2789 (define-key vhdl-mode-map "-" 'vhdl-electric-dash) 2790 (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) 2791 (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) 2792 (define-key vhdl-mode-map "'" 'vhdl-electric-quote) 2793 (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) 2794 (define-key vhdl-mode-map "," 'vhdl-electric-comma) 2795 (define-key vhdl-mode-map "." 'vhdl-electric-period) 2796 (when (vhdl-standard-p 'ams) 2797 (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) 2798 2799;; initialize mode map for VHDL Mode 2800(vhdl-mode-map-init) 2801 2802;; define special minibuffer keymap for enabling word completion in minibuffer 2803;; (useful in template generator prompts) 2804(defvar vhdl-minibuffer-local-map 2805 (let ((map (make-sparse-keymap))) 2806 (set-keymap-parent map minibuffer-local-map) 2807 (when vhdl-word-completion-in-minibuffer 2808 (define-key map "\t" 'vhdl-minibuffer-tab)) 2809 map) 2810 "Keymap for minibuffer used in VHDL Mode.") 2811 2812;; set up electric character functions to work with 2813;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) 2814(mapcar 2815 (function 2816 (lambda (sym) 2817 (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) 2818 (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs) 2819 '(vhdl-electric-space 2820 vhdl-electric-tab 2821 vhdl-electric-return 2822 vhdl-electric-dash 2823 vhdl-electric-open-bracket 2824 vhdl-electric-close-bracket 2825 vhdl-electric-quote 2826 vhdl-electric-semicolon 2827 vhdl-electric-comma 2828 vhdl-electric-period 2829 vhdl-electric-equal)) 2830 2831;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2832;; Syntax table 2833 2834(defvar vhdl-mode-syntax-table nil 2835 "Syntax table used in `vhdl-mode' buffers.") 2836 2837(defvar vhdl-mode-ext-syntax-table nil 2838 "Syntax table extended by `_' used in `vhdl-mode' buffers.") 2839 2840(defun vhdl-mode-syntax-table-init () 2841 "Initialize `vhdl-mode-syntax-table'." 2842 (setq vhdl-mode-syntax-table (make-syntax-table)) 2843 ;; define punctuation 2844 (modify-syntax-entry ?\# "." vhdl-mode-syntax-table) 2845 (modify-syntax-entry ?\$ "." vhdl-mode-syntax-table) 2846 (modify-syntax-entry ?\% "." vhdl-mode-syntax-table) 2847 (modify-syntax-entry ?\& "." vhdl-mode-syntax-table) 2848 (modify-syntax-entry ?\' "." vhdl-mode-syntax-table) 2849 (modify-syntax-entry ?\* "." vhdl-mode-syntax-table) 2850 (modify-syntax-entry ?\+ "." vhdl-mode-syntax-table) 2851 (modify-syntax-entry ?\. "." vhdl-mode-syntax-table) 2852 (modify-syntax-entry ?\/ "." vhdl-mode-syntax-table) 2853 (modify-syntax-entry ?\: "." vhdl-mode-syntax-table) 2854 (modify-syntax-entry ?\; "." vhdl-mode-syntax-table) 2855 (modify-syntax-entry ?\< "." vhdl-mode-syntax-table) 2856 (modify-syntax-entry ?\= "." vhdl-mode-syntax-table) 2857 (modify-syntax-entry ?\> "." vhdl-mode-syntax-table) 2858 (modify-syntax-entry ?\\ "." vhdl-mode-syntax-table) 2859 (modify-syntax-entry ?\| "." vhdl-mode-syntax-table) 2860 ;; define string 2861 (modify-syntax-entry ?\" "\"" vhdl-mode-syntax-table) 2862 ;; define underscore 2863 (when vhdl-underscore-is-part-of-word 2864 (modify-syntax-entry ?\_ "w" vhdl-mode-syntax-table)) 2865 ;; a single hyphen is punctuation, but a double hyphen starts a comment 2866 (modify-syntax-entry ?\- ". 12" vhdl-mode-syntax-table) 2867 ;; and \n and \^M end a comment 2868 (modify-syntax-entry ?\n ">" vhdl-mode-syntax-table) 2869 (modify-syntax-entry ?\^M ">" vhdl-mode-syntax-table) 2870 ;; define parentheses to match 2871 (modify-syntax-entry ?\( "()" vhdl-mode-syntax-table) 2872 (modify-syntax-entry ?\) ")(" vhdl-mode-syntax-table) 2873 (modify-syntax-entry ?\[ "(]" vhdl-mode-syntax-table) 2874 (modify-syntax-entry ?\] ")[" vhdl-mode-syntax-table) 2875 (modify-syntax-entry ?\{ "(}" vhdl-mode-syntax-table) 2876 (modify-syntax-entry ?\} "){" vhdl-mode-syntax-table) 2877 ;; extended syntax table including '_' (for simpler search regexps) 2878 (setq vhdl-mode-ext-syntax-table (copy-syntax-table vhdl-mode-syntax-table)) 2879 (modify-syntax-entry ?_ "w" vhdl-mode-ext-syntax-table)) 2880 2881;; initialize syntax table for VHDL Mode 2882(vhdl-mode-syntax-table-init) 2883 2884(defvar vhdl-syntactic-context nil 2885 "Buffer local variable containing syntactic analysis list.") 2886(make-variable-buffer-local 'vhdl-syntactic-context) 2887 2888;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2889;; Abbrev ook bindings 2890 2891(defvar vhdl-mode-abbrev-table nil 2892 "Abbrev table to use in `vhdl-mode' buffers.") 2893 2894(defun vhdl-mode-abbrev-table-init () 2895 "Initialize `vhdl-mode-abbrev-table'." 2896 (define-abbrev-table 'vhdl-mode-abbrev-table 2897 (append 2898 (when (memq 'vhdl vhdl-electric-keywords) 2899 ;; VHDL'93 keywords 2900 '( 2901 ("--" "" vhdl-template-display-comment-hook 0) 2902 ("abs" "" vhdl-template-default-hook 0) 2903 ("access" "" vhdl-template-default-hook 0) 2904 ("after" "" vhdl-template-default-hook 0) 2905 ("alias" "" vhdl-template-alias-hook 0) 2906 ("all" "" vhdl-template-default-hook 0) 2907 ("and" "" vhdl-template-default-hook 0) 2908 ("arch" "" vhdl-template-architecture-hook 0) 2909 ("architecture" "" vhdl-template-architecture-hook 0) 2910 ("array" "" vhdl-template-default-hook 0) 2911 ("assert" "" vhdl-template-assert-hook 0) 2912 ("attr" "" vhdl-template-attribute-hook 0) 2913 ("attribute" "" vhdl-template-attribute-hook 0) 2914 ("begin" "" vhdl-template-default-indent-hook 0) 2915 ("block" "" vhdl-template-block-hook 0) 2916 ("body" "" vhdl-template-default-hook 0) 2917 ("buffer" "" vhdl-template-default-hook 0) 2918 ("bus" "" vhdl-template-default-hook 0) 2919 ("case" "" vhdl-template-case-hook 0) 2920 ("comp" "" vhdl-template-component-hook 0) 2921 ("component" "" vhdl-template-component-hook 0) 2922 ("cond" "" vhdl-template-conditional-signal-asst-hook 0) 2923 ("conditional" "" vhdl-template-conditional-signal-asst-hook 0) 2924 ("conf" "" vhdl-template-configuration-hook 0) 2925 ("configuration" "" vhdl-template-configuration-hook 0) 2926 ("cons" "" vhdl-template-constant-hook 0) 2927 ("constant" "" vhdl-template-constant-hook 0) 2928 ("disconnect" "" vhdl-template-disconnect-hook 0) 2929 ("downto" "" vhdl-template-default-hook 0) 2930 ("else" "" vhdl-template-else-hook 0) 2931 ("elseif" "" vhdl-template-elsif-hook 0) 2932 ("elsif" "" vhdl-template-elsif-hook 0) 2933 ("end" "" vhdl-template-default-indent-hook 0) 2934 ("entity" "" vhdl-template-entity-hook 0) 2935 ("exit" "" vhdl-template-exit-hook 0) 2936 ("file" "" vhdl-template-file-hook 0) 2937 ("for" "" vhdl-template-for-hook 0) 2938 ("func" "" vhdl-template-function-hook 0) 2939 ("function" "" vhdl-template-function-hook 0) 2940 ("generic" "" vhdl-template-generic-hook 0) 2941 ("group" "" vhdl-template-group-hook 0) 2942 ("guarded" "" vhdl-template-default-hook 0) 2943 ("if" "" vhdl-template-if-hook 0) 2944 ("impure" "" vhdl-template-default-hook 0) 2945 ("in" "" vhdl-template-default-hook 0) 2946 ("inertial" "" vhdl-template-default-hook 0) 2947 ("inout" "" vhdl-template-default-hook 0) 2948 ("inst" "" vhdl-template-instance-hook 0) 2949 ("instance" "" vhdl-template-instance-hook 0) 2950 ("is" "" vhdl-template-default-hook 0) 2951 ("label" "" vhdl-template-default-hook 0) 2952 ("library" "" vhdl-template-library-hook 0) 2953 ("linkage" "" vhdl-template-default-hook 0) 2954 ("literal" "" vhdl-template-default-hook 0) 2955 ("loop" "" vhdl-template-bare-loop-hook 0) 2956 ("map" "" vhdl-template-map-hook 0) 2957 ("mod" "" vhdl-template-default-hook 0) 2958 ("nand" "" vhdl-template-default-hook 0) 2959 ("new" "" vhdl-template-default-hook 0) 2960 ("next" "" vhdl-template-next-hook 0) 2961 ("nor" "" vhdl-template-default-hook 0) 2962 ("not" "" vhdl-template-default-hook 0) 2963 ("null" "" vhdl-template-default-hook 0) 2964 ("of" "" vhdl-template-default-hook 0) 2965 ("on" "" vhdl-template-default-hook 0) 2966 ("open" "" vhdl-template-default-hook 0) 2967 ("or" "" vhdl-template-default-hook 0) 2968 ("others" "" vhdl-template-others-hook 0) 2969 ("out" "" vhdl-template-default-hook 0) 2970 ("pack" "" vhdl-template-package-hook 0) 2971 ("package" "" vhdl-template-package-hook 0) 2972 ("port" "" vhdl-template-port-hook 0) 2973 ("postponed" "" vhdl-template-default-hook 0) 2974 ("procedure" "" vhdl-template-procedure-hook 0) 2975 ("process" "" vhdl-template-process-hook 0) 2976 ("pure" "" vhdl-template-default-hook 0) 2977 ("range" "" vhdl-template-default-hook 0) 2978 ("record" "" vhdl-template-default-hook 0) 2979 ("register" "" vhdl-template-default-hook 0) 2980 ("reject" "" vhdl-template-default-hook 0) 2981 ("rem" "" vhdl-template-default-hook 0) 2982 ("report" "" vhdl-template-report-hook 0) 2983 ("return" "" vhdl-template-return-hook 0) 2984 ("rol" "" vhdl-template-default-hook 0) 2985 ("ror" "" vhdl-template-default-hook 0) 2986 ("select" "" vhdl-template-selected-signal-asst-hook 0) 2987 ("severity" "" vhdl-template-default-hook 0) 2988 ("shared" "" vhdl-template-default-hook 0) 2989 ("sig" "" vhdl-template-signal-hook 0) 2990 ("signal" "" vhdl-template-signal-hook 0) 2991 ("sla" "" vhdl-template-default-hook 0) 2992 ("sll" "" vhdl-template-default-hook 0) 2993 ("sra" "" vhdl-template-default-hook 0) 2994 ("srl" "" vhdl-template-default-hook 0) 2995 ("subtype" "" vhdl-template-subtype-hook 0) 2996 ("then" "" vhdl-template-default-hook 0) 2997 ("to" "" vhdl-template-default-hook 0) 2998 ("transport" "" vhdl-template-default-hook 0) 2999 ("type" "" vhdl-template-type-hook 0) 3000 ("unaffected" "" vhdl-template-default-hook 0) 3001 ("units" "" vhdl-template-default-hook 0) 3002 ("until" "" vhdl-template-default-hook 0) 3003 ("use" "" vhdl-template-use-hook 0) 3004 ("var" "" vhdl-template-variable-hook 0) 3005 ("variable" "" vhdl-template-variable-hook 0) 3006 ("wait" "" vhdl-template-wait-hook 0) 3007 ("when" "" vhdl-template-when-hook 0) 3008 ("while" "" vhdl-template-while-loop-hook 0) 3009 ("with" "" vhdl-template-with-hook 0) 3010 ("xnor" "" vhdl-template-default-hook 0) 3011 ("xor" "" vhdl-template-default-hook 0) 3012 )) 3013 ;; VHDL-AMS keywords 3014 (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) 3015 '( 3016 ("across" "" vhdl-template-default-hook 0) 3017 ("break" "" vhdl-template-break-hook 0) 3018 ("limit" "" vhdl-template-limit-hook 0) 3019 ("nature" "" vhdl-template-nature-hook 0) 3020 ("noise" "" vhdl-template-default-hook 0) 3021 ("procedural" "" vhdl-template-procedural-hook 0) 3022 ("quantity" "" vhdl-template-quantity-hook 0) 3023 ("reference" "" vhdl-template-default-hook 0) 3024 ("spectrum" "" vhdl-template-default-hook 0) 3025 ("subnature" "" vhdl-template-subnature-hook 0) 3026 ("terminal" "" vhdl-template-terminal-hook 0) 3027 ("through" "" vhdl-template-default-hook 0) 3028 ("tolerance" "" vhdl-template-default-hook 0) 3029 )) 3030 ;; user model keywords 3031 (when (memq 'user vhdl-electric-keywords) 3032 (let ((alist vhdl-model-alist) 3033 abbrev-list keyword) 3034 (while alist 3035 (setq keyword (nth 3 (car alist))) 3036 (unless (equal keyword "") 3037 (setq abbrev-list 3038 (cons (list keyword "" 3039 (vhdl-function-name 3040 "vhdl-model" (nth 0 (car alist)) "hook") 0) 3041 abbrev-list))) 3042 (setq alist (cdr alist))) 3043 abbrev-list))))) 3044 3045;; initialize abbrev table for VHDL Mode 3046(vhdl-mode-abbrev-table-init) 3047 3048;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3049;; Template completion lists 3050 3051(defvar vhdl-template-construct-alist nil 3052 "List of built-in construct templates.") 3053 3054(defun vhdl-template-construct-alist-init () 3055 "Initialize `vhdl-template-construct-alist'." 3056 (setq 3057 vhdl-template-construct-alist 3058 (append 3059 '( 3060 ("alias declaration" vhdl-template-alias) 3061 ("architecture body" vhdl-template-architecture) 3062 ("assertion" vhdl-template-assert) 3063 ("attribute declaration" vhdl-template-attribute-decl) 3064 ("attribute specification" vhdl-template-attribute-spec) 3065 ("block configuration" vhdl-template-block-configuration) 3066 ("block statement" vhdl-template-block) 3067 ("case statement" vhdl-template-case-is) 3068 ("component configuration" vhdl-template-component-conf) 3069 ("component declaration" vhdl-template-component-decl) 3070 ("component instantiation statement" vhdl-template-component-inst) 3071 ("conditional signal assignment" vhdl-template-conditional-signal-asst) 3072 ("configuration declaration" vhdl-template-configuration-decl) 3073 ("configuration specification" vhdl-template-configuration-spec) 3074 ("constant declaration" vhdl-template-constant) 3075 ("disconnection specification" vhdl-template-disconnect) 3076 ("entity declaration" vhdl-template-entity) 3077 ("exit statement" vhdl-template-exit) 3078 ("file declaration" vhdl-template-file) 3079 ("generate statement" vhdl-template-generate) 3080 ("generic clause" vhdl-template-generic) 3081 ("group declaration" vhdl-template-group-decl) 3082 ("group template declaration" vhdl-template-group-template) 3083 ("if statement" vhdl-template-if-then) 3084 ("library clause" vhdl-template-library) 3085 ("loop statement" vhdl-template-loop) 3086 ("next statement" vhdl-template-next) 3087 ("package declaration" vhdl-template-package-decl) 3088 ("package body" vhdl-template-package-body) 3089 ("port clause" vhdl-template-port) 3090 ("process statement" vhdl-template-process) 3091 ("report statement" vhdl-template-report) 3092 ("return statement" vhdl-template-return) 3093 ("selected signal assignment" vhdl-template-selected-signal-asst) 3094 ("signal declaration" vhdl-template-signal) 3095 ("subprogram declaration" vhdl-template-subprogram-decl) 3096 ("subprogram body" vhdl-template-subprogram-body) 3097 ("subtype declaration" vhdl-template-subtype) 3098 ("type declaration" vhdl-template-type) 3099 ("use clause" vhdl-template-use) 3100 ("variable declaration" vhdl-template-variable) 3101 ("wait statement" vhdl-template-wait) 3102 ) 3103 (when (vhdl-standard-p 'ams) 3104 '( 3105 ("break statement" vhdl-template-break) 3106 ("nature declaration" vhdl-template-nature) 3107 ("quantity declaration" vhdl-template-quantity) 3108 ("simultaneous case statement" vhdl-template-case-use) 3109 ("simultaneous if statement" vhdl-template-if-use) 3110 ("simultaneous procedural statement" vhdl-template-procedural) 3111 ("step limit specification" vhdl-template-limit) 3112 ("subnature declaration" vhdl-template-subnature) 3113 ("terminal declaration" vhdl-template-terminal) 3114 ))))) 3115 3116;; initialize for VHDL Mode 3117(vhdl-template-construct-alist-init) 3118 3119(defvar vhdl-template-package-alist nil 3120 "List of built-in package templates.") 3121 3122(defun vhdl-template-package-alist-init () 3123 "Initialize `vhdl-template-package-alist'." 3124 (setq 3125 vhdl-template-package-alist 3126 (append 3127 '( 3128 ("numeric_bit" vhdl-template-package-numeric-bit) 3129 ("numeric_std" vhdl-template-package-numeric-std) 3130 ("std_logic_1164" vhdl-template-package-std-logic-1164) 3131 ("std_logic_arith" vhdl-template-package-std-logic-arith) 3132 ("std_logic_misc" vhdl-template-package-std-logic-misc) 3133 ("std_logic_signed" vhdl-template-package-std-logic-signed) 3134 ("std_logic_textio" vhdl-template-package-std-logic-textio) 3135 ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) 3136 ("textio" vhdl-template-package-textio) 3137 ) 3138 (when (vhdl-standard-p 'math) 3139 '( 3140 ("math_complex" vhdl-template-package-math-complex) 3141 ("math_real" vhdl-template-package-math-real) 3142 ))))) 3143 3144;; initialize for VHDL Mode 3145(vhdl-template-package-alist-init) 3146 3147(defvar vhdl-template-directive-alist 3148 '( 3149 ("translate_on" vhdl-template-directive-translate-on) 3150 ("translate_off" vhdl-template-directive-translate-off) 3151 ("synthesis_on" vhdl-template-directive-synthesis-on) 3152 ("synthesis_off" vhdl-template-directive-synthesis-off) 3153 ) 3154 "List of built-in directive templates.") 3155 3156 3157;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3158;;; Menues 3159;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3160 3161;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3162;; VHDL menu (using `easy-menu.el') 3163 3164(defun vhdl-customize () 3165 "Call the customize function with `vhdl' as argument." 3166 (interactive) 3167 (customize-browse 'vhdl)) 3168 3169(defun vhdl-create-mode-menu () 3170 "Create VHDL Mode menu." 3171 `("VHDL" 3172 ,(append 3173 '("Project" 3174 ["None" (vhdl-set-project "") 3175 :style radio :selected (null vhdl-project)] 3176 "--") 3177 ;; add menu entries for defined projects 3178 (let ((project-alist vhdl-project-alist) menu-list name) 3179 (while project-alist 3180 (setq name (caar project-alist)) 3181 (setq menu-list 3182 (cons `[,name (vhdl-set-project ,name) 3183 :style radio :selected (equal ,name vhdl-project)] 3184 menu-list)) 3185 (setq project-alist (cdr project-alist))) 3186 (setq menu-list 3187 (if vhdl-project-sort 3188 (sort menu-list 3189 (function (lambda (a b) (string< (elt a 0) (elt b 0))))) 3190 (nreverse menu-list))) 3191 (vhdl-menu-split menu-list "Project")) 3192 '("--" "--" 3193 ["Select Project..." vhdl-set-project t] 3194 ["Set As Default Project" vhdl-set-default-project t] 3195 "--" 3196 ["Duplicate Project" vhdl-duplicate-project vhdl-project] 3197 ["Import Project..." vhdl-import-project 3198 :keys "C-c C-p C-m" :active t] 3199 ["Export Project" vhdl-export-project vhdl-project] 3200 "--" 3201 ["Customize Project..." (customize-option 'vhdl-project-alist) t])) 3202 "--" 3203 ("Compile" 3204 ["Compile Buffer" vhdl-compile t] 3205 ["Stop Compilation" kill-compilation t] 3206 "--" 3207 ["Make" vhdl-make t] 3208 ["Generate Makefile" vhdl-generate-makefile t] 3209 "--" 3210 ["Next Error" next-error t] 3211 ["Previous Error" previous-error t] 3212 ["First Error" first-error t] 3213 "--" 3214 ,(append 3215 '("Compiler") 3216 ;; add menu entries for defined compilers 3217 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3218 (while comp-alist 3219 (setq name (caar comp-alist)) 3220 (setq menu-list 3221 (cons `[,name (setq vhdl-compiler ,name) 3222 :style radio :selected (equal ,name vhdl-compiler)] 3223 menu-list)) 3224 (setq comp-alist (cdr comp-alist))) 3225 (setq menu-list (nreverse menu-list)) 3226 (vhdl-menu-split menu-list "Compiler")) 3227 '("--" "--" 3228 ["Select Compiler..." vhdl-set-compiler t] 3229 "--" 3230 ["Customize Compiler..." 3231 (customize-option 'vhdl-compiler-alist) t]))) 3232 "--" 3233 ,(append 3234 '("Template" 3235 ("VHDL Construct 1" 3236 ["Alias" vhdl-template-alias t] 3237 ["Architecture" vhdl-template-architecture t] 3238 ["Assert" vhdl-template-assert t] 3239 ["Attribute (Decl)" vhdl-template-attribute-decl t] 3240 ["Attribute (Spec)" vhdl-template-attribute-spec t] 3241 ["Block" vhdl-template-block t] 3242 ["Case" vhdl-template-case-is t] 3243 ["Component (Decl)" vhdl-template-component-decl t] 3244 ["(Component) Instance" vhdl-template-component-inst t] 3245 ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] 3246 ["Configuration (Block)" vhdl-template-block-configuration t] 3247 ["Configuration (Comp)" vhdl-template-component-conf t] 3248 ["Configuration (Decl)" vhdl-template-configuration-decl t] 3249 ["Configuration (Spec)" vhdl-template-configuration-spec t] 3250 ["Constant" vhdl-template-constant t] 3251 ["Disconnect" vhdl-template-disconnect t] 3252 ["Else" vhdl-template-else t] 3253 ["Elsif" vhdl-template-elsif t] 3254 ["Entity" vhdl-template-entity t] 3255 ["Exit" vhdl-template-exit t] 3256 ["File" vhdl-template-file t] 3257 ["For (Generate)" vhdl-template-for-generate t] 3258 ["For (Loop)" vhdl-template-for-loop t] 3259 ["Function (Body)" vhdl-template-function-body t] 3260 ["Function (Decl)" vhdl-template-function-decl t] 3261 ["Generic" vhdl-template-generic t] 3262 ["Group (Decl)" vhdl-template-group-decl t] 3263 ["Group (Template)" vhdl-template-group-template t]) 3264 ("VHDL Construct 2" 3265 ["If (Generate)" vhdl-template-if-generate t] 3266 ["If (Then)" vhdl-template-if-then t] 3267 ["Library" vhdl-template-library t] 3268 ["Loop" vhdl-template-bare-loop t] 3269 ["Map" vhdl-template-map t] 3270 ["Next" vhdl-template-next t] 3271 ["Others (Aggregate)" vhdl-template-others t] 3272 ["Package (Decl)" vhdl-template-package-decl t] 3273 ["Package (Body)" vhdl-template-package-body t] 3274 ["Port" vhdl-template-port t] 3275 ["Procedure (Body)" vhdl-template-procedure-body t] 3276 ["Procedure (Decl)" vhdl-template-procedure-decl t] 3277 ["Process (Comb)" vhdl-template-process-comb t] 3278 ["Process (Seq)" vhdl-template-process-seq t] 3279 ["Report" vhdl-template-report t] 3280 ["Return" vhdl-template-return t] 3281 ["Select" vhdl-template-selected-signal-asst t] 3282 ["Signal" vhdl-template-signal t] 3283 ["Subtype" vhdl-template-subtype t] 3284 ["Type" vhdl-template-type t] 3285 ["Use" vhdl-template-use t] 3286 ["Variable" vhdl-template-variable t] 3287 ["Wait" vhdl-template-wait t] 3288 ["(Clocked Wait)" vhdl-template-clocked-wait t] 3289 ["When" vhdl-template-when t] 3290 ["While (Loop)" vhdl-template-while-loop t] 3291 ["With" vhdl-template-with t])) 3292 (when (vhdl-standard-p 'ams) 3293 '(("VHDL-AMS Construct" 3294 ["Break" vhdl-template-break t] 3295 ["Case (Use)" vhdl-template-case-use t] 3296 ["If (Use)" vhdl-template-if-use t] 3297 ["Limit" vhdl-template-limit t] 3298 ["Nature" vhdl-template-nature t] 3299 ["Procedural" vhdl-template-procedural t] 3300 ["Quantity (Free)" vhdl-template-quantity-free t] 3301 ["Quantity (Branch)" vhdl-template-quantity-branch t] 3302 ["Quantity (Source)" vhdl-template-quantity-source t] 3303 ["Subnature" vhdl-template-subnature t] 3304 ["Terminal" vhdl-template-terminal t]))) 3305 '(["Insert Construct..." vhdl-template-insert-construct 3306 :keys "C-c C-i C-t"] 3307 "--") 3308 (list 3309 (append 3310 '("Package") 3311 (when (vhdl-standard-p 'math) 3312 '(["math_complex" vhdl-template-package-math-complex t] 3313 ["math_real" vhdl-template-package-math-real t])) 3314 '(["numeric_bit" vhdl-template-package-numeric-bit t] 3315 ["numeric_std" vhdl-template-package-numeric-std t] 3316 ["std_logic_1164" vhdl-template-package-std-logic-1164 t] 3317 ["textio" vhdl-template-package-textio t] 3318 "--" 3319 ["std_logic_arith" vhdl-template-package-std-logic-arith t] 3320 ["std_logic_signed" vhdl-template-package-std-logic-signed t] 3321 ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] 3322 ["std_logic_misc" vhdl-template-package-std-logic-misc t] 3323 ["std_logic_textio" vhdl-template-package-std-logic-textio t] 3324 "--" 3325 ["Insert Package..." vhdl-template-insert-package 3326 :keys "C-c C-i C-p"]))) 3327 '(("Directive" 3328 ["translate_on" vhdl-template-directive-translate-on t] 3329 ["translate_off" vhdl-template-directive-translate-off t] 3330 ["synthesis_on" vhdl-template-directive-synthesis-on t] 3331 ["synthesis_off" vhdl-template-directive-synthesis-off t] 3332 "--" 3333 ["Insert Directive..." vhdl-template-insert-directive 3334 :keys "C-c C-i C-d"]) 3335 "--" 3336 ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] 3337 ["Insert Footer" vhdl-template-footer t] 3338 ["Insert Date" vhdl-template-insert-date t] 3339 ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] 3340 "--" 3341 ["Query Next Prompt" vhdl-template-search-prompt t])) 3342 ,(append 3343 '("Model") 3344 ;; add menu entries for defined models 3345 (let ((model-alist vhdl-model-alist) menu-list model) 3346 (while model-alist 3347 (setq model (car model-alist)) 3348 (setq menu-list 3349 (cons 3350 (vector 3351 (nth 0 model) 3352 (vhdl-function-name "vhdl-model" (nth 0 model)) 3353 :keys (concat "C-c C-m " (key-description (nth 2 model)))) 3354 menu-list)) 3355 (setq model-alist (cdr model-alist))) 3356 (setq menu-list (nreverse menu-list)) 3357 (vhdl-menu-split menu-list "Model")) 3358 '("--" "--" 3359 ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] 3360 ["Customize Model..." (customize-option 'vhdl-model-alist) t])) 3361 ("Port" 3362 ["Copy" vhdl-port-copy t] 3363 "--" 3364 ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] 3365 ["Paste As Component" vhdl-port-paste-component vhdl-port-list] 3366 ["Paste As Instance" vhdl-port-paste-instance 3367 :keys "C-c C-p C-i" :active vhdl-port-list] 3368 ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] 3369 ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] 3370 ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] 3371 ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] 3372 "--" 3373 ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] 3374 "--" 3375 ["Flatten" vhdl-port-flatten 3376 :style toggle :selected vhdl-port-flattened :active vhdl-port-list] 3377 ["Reverse Direction" vhdl-port-reverse-direction 3378 :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) 3379 ("Compose" 3380 ["New Component" vhdl-compose-new-component t] 3381 ["Copy Component" vhdl-port-copy t] 3382 ["Place Component" vhdl-compose-place-component vhdl-port-list] 3383 ["Wire Components" vhdl-compose-wire-components t] 3384 "--" 3385 ["Generate Configuration" vhdl-compose-configuration t] 3386 ["Generate Components Package" vhdl-compose-components-package t]) 3387 ("Subprogram" 3388 ["Copy" vhdl-subprog-copy t] 3389 "--" 3390 ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] 3391 ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] 3392 ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] 3393 "--" 3394 ["Flatten" vhdl-subprog-flatten 3395 :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) 3396 "--" 3397 ("Comment" 3398 ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] 3399 "--" 3400 ["Insert Inline Comment" vhdl-comment-append-inline t] 3401 ["Insert Horizontal Line" vhdl-comment-display-line t] 3402 ["Insert Display Comment" vhdl-comment-display t] 3403 "--" 3404 ["Fill Comment" fill-paragraph t] 3405 ["Fill Comment Region" fill-region (mark)] 3406 ["Kill Comment Region" vhdl-comment-kill-region (mark)] 3407 ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) 3408 ("Line" 3409 ["Kill" vhdl-line-kill t] 3410 ["Copy" vhdl-line-copy t] 3411 ["Yank" vhdl-line-yank t] 3412 ["Expand" vhdl-line-expand t] 3413 "--" 3414 ["Transpose Next" vhdl-line-transpose-next t] 3415 ["Transpose Prev" vhdl-line-transpose-previous t] 3416 ["Open" vhdl-line-open t] 3417 ["Join" vhdl-delete-indentation t] 3418 "--" 3419 ["Goto" goto-line t] 3420 ["(Un)Comment Out" vhdl-comment-uncomment-line t]) 3421 ("Move" 3422 ["Forward Statement" vhdl-end-of-statement t] 3423 ["Backward Statement" vhdl-beginning-of-statement t] 3424 ["Forward Expression" vhdl-forward-sexp t] 3425 ["Backward Expression" vhdl-backward-sexp t] 3426 ["Forward Same Indent" vhdl-forward-same-indent t] 3427 ["Backward Same Indent" vhdl-backward-same-indent t] 3428 ["Forward Function" vhdl-end-of-defun t] 3429 ["Backward Function" vhdl-beginning-of-defun t] 3430 ["Mark Function" vhdl-mark-defun t]) 3431 "--" 3432 ("Indent" 3433 ["Line" indent-according-to-mode :keys "C-c C-i C-l"] 3434 ["Group" vhdl-indent-group :keys "C-c C-i C-g"] 3435 ["Region" vhdl-indent-region (mark)] 3436 ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) 3437 ("Align" 3438 ["Group" vhdl-align-group t] 3439 ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] 3440 ["List" vhdl-align-list t] 3441 ["Declarations" vhdl-align-declarations t] 3442 ["Region" vhdl-align-region (mark)] 3443 ["Buffer" vhdl-align-buffer t] 3444 "--" 3445 ["Inline Comment Group" vhdl-align-inline-comment-group t] 3446 ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] 3447 ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) 3448 ("Fill" 3449 ["List" vhdl-fill-list t] 3450 ["Group" vhdl-fill-group t] 3451 ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] 3452 ["Region" vhdl-fill-region (mark)]) 3453 ("Beautify" 3454 ["Region" vhdl-beautify-region (mark)] 3455 ["Buffer" vhdl-beautify-buffer t]) 3456 ("Fix" 3457 ["Generic/Port Clause" vhdl-fix-clause t] 3458 "--" 3459 ["Case Region" vhdl-fix-case-region (mark)] 3460 ["Case Buffer" vhdl-fix-case-buffer t] 3461 "--" 3462 ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] 3463 ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] 3464 "--" 3465 ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) 3466 ("Update" 3467 ["Sensitivity List" vhdl-update-sensitivity-list-process t] 3468 ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) 3469 "--" 3470 ["Fontify Buffer" vhdl-fontify-buffer t] 3471 ["Statistics Buffer" vhdl-statistics-buffer t] 3472 ["Show Messages" vhdl-show-messages t] 3473 ["Syntactic Info" vhdl-show-syntactic-information t] 3474 "--" 3475 ["Speedbar" vhdl-speedbar t] 3476 ["Hide/Show" vhdl-hs-minor-mode t] 3477 "--" 3478 ("Documentation" 3479 ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] 3480 ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] 3481 ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] 3482 ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) 3483 ["Version" vhdl-version t] 3484 ["Bug Report..." vhdl-submit-bug-report t] 3485 "--" 3486 ("Options" 3487 ("Mode" 3488 ["Electric Mode" 3489 (progn (customize-set-variable 'vhdl-electric-mode 3490 (not vhdl-electric-mode)) 3491 (vhdl-mode-line-update)) 3492 :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] 3493 ["Stutter Mode" 3494 (progn (customize-set-variable 'vhdl-stutter-mode 3495 (not vhdl-stutter-mode)) 3496 (vhdl-mode-line-update)) 3497 :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] 3498 ["Indent Tabs Mode" 3499 (progn (customize-set-variable 'vhdl-indent-tabs-mode 3500 (not vhdl-indent-tabs-mode)) 3501 (setq indent-tabs-mode vhdl-indent-tabs-mode)) 3502 :style toggle :selected vhdl-indent-tabs-mode] 3503 "--" 3504 ["Customize Group..." (customize-group 'vhdl-mode) t]) 3505 ("Project" 3506 ["Project Setup..." (customize-option 'vhdl-project-alist) t] 3507 ,(append 3508 '("Selected Project at Startup" 3509 ["None" (progn (customize-set-variable 'vhdl-project nil) 3510 (vhdl-set-project "")) 3511 :style radio :selected (null vhdl-project)] 3512 "--") 3513 ;; add menu entries for defined projects 3514 (let ((project-alist vhdl-project-alist) menu-list name) 3515 (while project-alist 3516 (setq name (caar project-alist)) 3517 (setq menu-list 3518 (cons `[,name (progn (customize-set-variable 3519 'vhdl-project ,name) 3520 (vhdl-set-project ,name)) 3521 :style radio :selected (equal ,name vhdl-project)] 3522 menu-list)) 3523 (setq project-alist (cdr project-alist))) 3524 (setq menu-list (nreverse menu-list)) 3525 (vhdl-menu-split menu-list "Project"))) 3526 ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] 3527 ("Auto Load Setup File" 3528 ["At Startup" 3529 (customize-set-variable 'vhdl-project-auto-load 3530 (if (memq 'startup vhdl-project-auto-load) 3531 (delq 'startup vhdl-project-auto-load) 3532 (cons 'startup vhdl-project-auto-load))) 3533 :style toggle :selected (memq 'startup vhdl-project-auto-load)]) 3534 ["Sort Projects" 3535 (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) 3536 :style toggle :selected vhdl-project-sort] 3537 "--" 3538 ["Customize Group..." (customize-group 'vhdl-project) t]) 3539 ("Compiler" 3540 ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] 3541 ,(append 3542 '("Selected Compiler at Startup") 3543 ;; add menu entries for defined compilers 3544 (let ((comp-alist vhdl-compiler-alist) menu-list name) 3545 (while comp-alist 3546 (setq name (caar comp-alist)) 3547 (setq menu-list 3548 (cons `[,name (customize-set-variable 'vhdl-compiler ,name) 3549 :style radio :selected (equal ,name vhdl-compiler)] 3550 menu-list)) 3551 (setq comp-alist (cdr comp-alist))) 3552 (setq menu-list (nreverse menu-list)) 3553 (vhdl-menu-split menu-list "Compler"))) 3554 ["Use Local Error Regexp" 3555 (customize-set-variable 'vhdl-compile-use-local-error-regexp 3556 (not vhdl-compile-use-local-error-regexp)) 3557 :style toggle :selected vhdl-compile-use-local-error-regexp] 3558 ["Makefile Generation Hook..." 3559 (customize-option 'vhdl-makefile-generation-hook) t] 3560 ["Default Library Name" (customize-option 'vhdl-default-library) t] 3561 "--" 3562 ["Customize Group..." (customize-group 'vhdl-compiler) t]) 3563 ("Style" 3564 ("VHDL Standard" 3565 ["VHDL'87" 3566 (progn (customize-set-variable 'vhdl-standard 3567 (list '87 (cadr vhdl-standard))) 3568 (vhdl-activate-customizations)) 3569 :style radio :selected (eq '87 (car vhdl-standard))] 3570 ["VHDL'93" 3571 (progn (customize-set-variable 'vhdl-standard 3572 (list '93 (cadr vhdl-standard))) 3573 (vhdl-activate-customizations)) 3574 :style radio :selected (eq '93 (car vhdl-standard))] 3575 "--" 3576 ["VHDL-AMS" 3577 (progn (customize-set-variable 3578 'vhdl-standard (list (car vhdl-standard) 3579 (if (memq 'ams (cadr vhdl-standard)) 3580 (delq 'ams (cadr vhdl-standard)) 3581 (cons 'ams (cadr vhdl-standard))))) 3582 (vhdl-activate-customizations)) 3583 :style toggle :selected (memq 'ams (cadr vhdl-standard))] 3584 ["Math Packages" 3585 (progn (customize-set-variable 3586 'vhdl-standard (list (car vhdl-standard) 3587 (if (memq 'math (cadr vhdl-standard)) 3588 (delq 'math (cadr vhdl-standard)) 3589 (cons 'math (cadr vhdl-standard))))) 3590 (vhdl-activate-customizations)) 3591 :style toggle :selected (memq 'math (cadr vhdl-standard))]) 3592 ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] 3593 ["Upper Case Keywords" 3594 (customize-set-variable 'vhdl-upper-case-keywords 3595 (not vhdl-upper-case-keywords)) 3596 :style toggle :selected vhdl-upper-case-keywords] 3597 ["Upper Case Types" 3598 (customize-set-variable 'vhdl-upper-case-types 3599 (not vhdl-upper-case-types)) 3600 :style toggle :selected vhdl-upper-case-types] 3601 ["Upper Case Attributes" 3602 (customize-set-variable 'vhdl-upper-case-attributes 3603 (not vhdl-upper-case-attributes)) 3604 :style toggle :selected vhdl-upper-case-attributes] 3605 ["Upper Case Enumeration Values" 3606 (customize-set-variable 'vhdl-upper-case-enum-values 3607 (not vhdl-upper-case-enum-values)) 3608 :style toggle :selected vhdl-upper-case-enum-values] 3609 ["Upper Case Constants" 3610 (customize-set-variable 'vhdl-upper-case-constants 3611 (not vhdl-upper-case-constants)) 3612 :style toggle :selected vhdl-upper-case-constants] 3613 ("Use Direct Instantiation" 3614 ["Never" 3615 (customize-set-variable 'vhdl-use-direct-instantiation 'never) 3616 :style radio :selected (eq 'never vhdl-use-direct-instantiation)] 3617 ["Standard" 3618 (customize-set-variable 'vhdl-use-direct-instantiation 'standard) 3619 :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] 3620 ["Always" 3621 (customize-set-variable 'vhdl-use-direct-instantiation 'always) 3622 :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) 3623 "--" 3624 ["Customize Group..." (customize-group 'vhdl-style) t]) 3625 ("Naming" 3626 ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] 3627 ["Architecture File Name..." 3628 (customize-option 'vhdl-architecture-file-name) t] 3629 ["Configuration File Name..." 3630 (customize-option 'vhdl-configuration-file-name) t] 3631 ["Package File Name..." (customize-option 'vhdl-package-file-name) t] 3632 ("File Name Case" 3633 ["As Is" 3634 (customize-set-variable 'vhdl-file-name-case 'identity) 3635 :style radio :selected (eq 'identity vhdl-file-name-case)] 3636 ["Lower Case" 3637 (customize-set-variable 'vhdl-file-name-case 'downcase) 3638 :style radio :selected (eq 'downcase vhdl-file-name-case)] 3639 ["Upper Case" 3640 (customize-set-variable 'vhdl-file-name-case 'upcase) 3641 :style radio :selected (eq 'upcase vhdl-file-name-case)] 3642 ["Capitalize" 3643 (customize-set-variable 'vhdl-file-name-case 'capitalize) 3644 :style radio :selected (eq 'capitalize vhdl-file-name-case)]) 3645 "--" 3646 ["Customize Group..." (customize-group 'vhdl-naming) t]) 3647 ("Template" 3648 ("Electric Keywords" 3649 ["VHDL Keywords" 3650 (customize-set-variable 'vhdl-electric-keywords 3651 (if (memq 'vhdl vhdl-electric-keywords) 3652 (delq 'vhdl vhdl-electric-keywords) 3653 (cons 'vhdl vhdl-electric-keywords))) 3654 :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] 3655 ["User Model Keywords" 3656 (customize-set-variable 'vhdl-electric-keywords 3657 (if (memq 'user vhdl-electric-keywords) 3658 (delq 'user vhdl-electric-keywords) 3659 (cons 'user vhdl-electric-keywords))) 3660 :style toggle :selected (memq 'user vhdl-electric-keywords)]) 3661 ("Insert Optional Labels" 3662 ["None" 3663 (customize-set-variable 'vhdl-optional-labels 'none) 3664 :style radio :selected (eq 'none vhdl-optional-labels)] 3665 ["Processes Only" 3666 (customize-set-variable 'vhdl-optional-labels 'process) 3667 :style radio :selected (eq 'process vhdl-optional-labels)] 3668 ["All Constructs" 3669 (customize-set-variable 'vhdl-optional-labels 'all) 3670 :style radio :selected (eq 'all vhdl-optional-labels)]) 3671 ("Insert Empty Lines" 3672 ["None" 3673 (customize-set-variable 'vhdl-insert-empty-lines 'none) 3674 :style radio :selected (eq 'none vhdl-insert-empty-lines)] 3675 ["Design Units Only" 3676 (customize-set-variable 'vhdl-insert-empty-lines 'unit) 3677 :style radio :selected (eq 'unit vhdl-insert-empty-lines)] 3678 ["All Constructs" 3679 (customize-set-variable 'vhdl-insert-empty-lines 'all) 3680 :style radio :selected (eq 'all vhdl-insert-empty-lines)]) 3681 ["Argument List Indent" 3682 (customize-set-variable 'vhdl-argument-list-indent 3683 (not vhdl-argument-list-indent)) 3684 :style toggle :selected vhdl-argument-list-indent] 3685 ["Association List with Formals" 3686 (customize-set-variable 'vhdl-association-list-with-formals 3687 (not vhdl-association-list-with-formals)) 3688 :style toggle :selected vhdl-association-list-with-formals] 3689 ["Conditions in Parenthesis" 3690 (customize-set-variable 'vhdl-conditions-in-parenthesis 3691 (not vhdl-conditions-in-parenthesis)) 3692 :style toggle :selected vhdl-conditions-in-parenthesis] 3693 ["Zero String..." (customize-option 'vhdl-zero-string) t] 3694 ["One String..." (customize-option 'vhdl-one-string) t] 3695 ("File Header" 3696 ["Header String..." (customize-option 'vhdl-file-header) t] 3697 ["Footer String..." (customize-option 'vhdl-file-footer) t] 3698 ["Company Name..." (customize-option 'vhdl-company-name) t] 3699 ["Copyright String..." (customize-option 'vhdl-copyright-string) t] 3700 ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] 3701 ["Date Format..." (customize-option 'vhdl-date-format) t] 3702 ["Modify Date Prefix String..." 3703 (customize-option 'vhdl-modify-date-prefix-string) t] 3704 ["Modify Date on Saving" 3705 (progn (customize-set-variable 'vhdl-modify-date-on-saving 3706 (not vhdl-modify-date-on-saving)) 3707 (vhdl-activate-customizations)) 3708 :style toggle :selected vhdl-modify-date-on-saving]) 3709 ("Sequential Process" 3710 ("Kind of Reset" 3711 ["None" 3712 (customize-set-variable 'vhdl-reset-kind 'none) 3713 :style radio :selected (eq 'none vhdl-reset-kind)] 3714 ["Synchronous" 3715 (customize-set-variable 'vhdl-reset-kind 'sync) 3716 :style radio :selected (eq 'sync vhdl-reset-kind)] 3717 ["Asynchronous" 3718 (customize-set-variable 'vhdl-reset-kind 'async) 3719 :style radio :selected (eq 'async vhdl-reset-kind)]) 3720 ["Reset is Active High" 3721 (customize-set-variable 'vhdl-reset-active-high 3722 (not vhdl-reset-active-high)) 3723 :style toggle :selected vhdl-reset-active-high] 3724 ["Use Rising Clock Edge" 3725 (customize-set-variable 'vhdl-clock-rising-edge 3726 (not vhdl-clock-rising-edge)) 3727 :style toggle :selected vhdl-clock-rising-edge] 3728 ("Clock Edge Condition" 3729 ["Standard" 3730 (customize-set-variable 'vhdl-clock-edge-condition 'standard) 3731 :style radio :selected (eq 'standard vhdl-clock-edge-condition)] 3732 ["Function \"rising_edge\"" 3733 (customize-set-variable 'vhdl-clock-edge-condition 'function) 3734 :style radio :selected (eq 'function vhdl-clock-edge-condition)]) 3735 ["Clock Name..." (customize-option 'vhdl-clock-name) t] 3736 ["Reset Name..." (customize-option 'vhdl-reset-name) t]) 3737 "--" 3738 ["Customize Group..." (customize-group 'vhdl-template) t]) 3739 ("Model" 3740 ["Model Definition..." (customize-option 'vhdl-model-alist) t]) 3741 ("Port" 3742 ["Include Port Comments" 3743 (customize-set-variable 'vhdl-include-port-comments 3744 (not vhdl-include-port-comments)) 3745 :style toggle :selected vhdl-include-port-comments] 3746 ["Include Direction Comments" 3747 (customize-set-variable 'vhdl-include-direction-comments 3748 (not vhdl-include-direction-comments)) 3749 :style toggle :selected vhdl-include-direction-comments] 3750 ["Include Type Comments" 3751 (customize-set-variable 'vhdl-include-type-comments 3752 (not vhdl-include-type-comments)) 3753 :style toggle :selected vhdl-include-type-comments] 3754 ("Include Group Comments" 3755 ["Never" 3756 (customize-set-variable 'vhdl-include-group-comments 'never) 3757 :style radio :selected (eq 'never vhdl-include-group-comments)] 3758 ["Declarations" 3759 (customize-set-variable 'vhdl-include-group-comments 'decl) 3760 :style radio :selected (eq 'decl vhdl-include-group-comments)] 3761 ["Always" 3762 (customize-set-variable 'vhdl-include-group-comments 'always) 3763 :style radio :selected (eq 'always vhdl-include-group-comments)]) 3764 ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] 3765 ["Instance Name..." (customize-option 'vhdl-instance-name) t] 3766 ("Testbench" 3767 ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] 3768 ["Architecture Name..." 3769 (customize-option 'vhdl-testbench-architecture-name) t] 3770 ["Configuration Name..." 3771 (customize-option 'vhdl-testbench-configuration-name) t] 3772 ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] 3773 ["Include Header" 3774 (customize-set-variable 'vhdl-testbench-include-header 3775 (not vhdl-testbench-include-header)) 3776 :style toggle :selected vhdl-testbench-include-header] 3777 ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] 3778 ["Statements..." (customize-option 'vhdl-testbench-statements) t] 3779 ["Initialize Signals" 3780 (customize-set-variable 'vhdl-testbench-initialize-signals 3781 (not vhdl-testbench-initialize-signals)) 3782 :style toggle :selected vhdl-testbench-initialize-signals] 3783 ["Include Library Clause" 3784 (customize-set-variable 'vhdl-testbench-include-library 3785 (not vhdl-testbench-include-library)) 3786 :style toggle :selected vhdl-testbench-include-library] 3787 ["Include Configuration" 3788 (customize-set-variable 'vhdl-testbench-include-configuration 3789 (not vhdl-testbench-include-configuration)) 3790 :style toggle :selected vhdl-testbench-include-configuration] 3791 ("Create Files" 3792 ["None" 3793 (customize-set-variable 'vhdl-testbench-create-files 'none) 3794 :style radio :selected (eq 'none vhdl-testbench-create-files)] 3795 ["Single" 3796 (customize-set-variable 'vhdl-testbench-create-files 'single) 3797 :style radio :selected (eq 'single vhdl-testbench-create-files)] 3798 ["Separate" 3799 (customize-set-variable 'vhdl-testbench-create-files 'separate) 3800 :style radio :selected (eq 'separate vhdl-testbench-create-files)]) 3801 ["Testbench Entity File Name..." 3802 (customize-option 'vhdl-testbench-entity-file-name) t] 3803 ["Testbench Architecture File Name..." 3804 (customize-option 'vhdl-testbench-architecture-file-name) t]) 3805 "--" 3806 ["Customize Group..." (customize-group 'vhdl-port) t]) 3807 ("Compose" 3808 ["Architecture Name..." 3809 (customize-option 'vhdl-compose-architecture-name) t] 3810 ["Configuration Name..." 3811 (customize-option 'vhdl-compose-configuration-name) t] 3812 ["Components Package Name..." 3813 (customize-option 'vhdl-components-package-name) t] 3814 ["Use Components Package" 3815 (customize-set-variable 'vhdl-use-components-package 3816 (not vhdl-use-components-package)) 3817 :style toggle :selected vhdl-use-components-package] 3818 ["Include Header" 3819 (customize-set-variable 'vhdl-compose-include-header 3820 (not vhdl-compose-include-header)) 3821 :style toggle :selected vhdl-compose-include-header] 3822 ("Create Entity/Architecture Files" 3823 ["None" 3824 (customize-set-variable 'vhdl-compose-create-files 'none) 3825 :style radio :selected (eq 'none vhdl-compose-create-files)] 3826 ["Single" 3827 (customize-set-variable 'vhdl-compose-create-files 'single) 3828 :style radio :selected (eq 'single vhdl-compose-create-files)] 3829 ["Separate" 3830 (customize-set-variable 'vhdl-compose-create-files 'separate) 3831 :style radio :selected (eq 'separate vhdl-compose-create-files)]) 3832 ["Create Configuration File" 3833 (customize-set-variable 'vhdl-compose-configuration-create-file 3834 (not vhdl-compose-configuration-create-file)) 3835 :style toggle :selected vhdl-compose-configuration-create-file] 3836 ["Hierarchical Configuration" 3837 (customize-set-variable 'vhdl-compose-configuration-hierarchical 3838 (not vhdl-compose-configuration-hierarchical)) 3839 :style toggle :selected vhdl-compose-configuration-hierarchical] 3840 ["Use Subconfiguration" 3841 (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration 3842 (not vhdl-compose-configuration-use-subconfiguration)) 3843 :style toggle :selected vhdl-compose-configuration-use-subconfiguration] 3844 "--" 3845 ["Customize Group..." (customize-group 'vhdl-compose) t]) 3846 ("Comment" 3847 ["Self Insert Comments" 3848 (customize-set-variable 'vhdl-self-insert-comments 3849 (not vhdl-self-insert-comments)) 3850 :style toggle :selected vhdl-self-insert-comments] 3851 ["Prompt for Comments" 3852 (customize-set-variable 'vhdl-prompt-for-comments 3853 (not vhdl-prompt-for-comments)) 3854 :style toggle :selected vhdl-prompt-for-comments] 3855 ["Inline Comment Column..." 3856 (customize-option 'vhdl-inline-comment-column) t] 3857 ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] 3858 "--" 3859 ["Customize Group..." (customize-group 'vhdl-comment) t]) 3860 ("Align" 3861 ["Auto Align Templates" 3862 (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) 3863 :style toggle :selected vhdl-auto-align] 3864 ["Align Line Groups" 3865 (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) 3866 :style toggle :selected vhdl-align-groups] 3867 ["Group Separation String..." 3868 (customize-set-variable 'vhdl-align-group-separate) t] 3869 ["Align Lines with Same Indent" 3870 (customize-set-variable 'vhdl-align-same-indent 3871 (not vhdl-align-same-indent)) 3872 :style toggle :selected vhdl-align-same-indent] 3873 "--" 3874 ["Customize Group..." (customize-group 'vhdl-align) t]) 3875 ("Highlight" 3876 ["Highlighting On/Off..." 3877 (customize-option 3878 (if (fboundp 'global-font-lock-mode) 3879 'global-font-lock-mode 'font-lock-auto-fontify)) t] 3880 ["Highlight Keywords" 3881 (progn (customize-set-variable 'vhdl-highlight-keywords 3882 (not vhdl-highlight-keywords)) 3883 (vhdl-fontify-buffer)) 3884 :style toggle :selected vhdl-highlight-keywords] 3885 ["Highlight Names" 3886 (progn (customize-set-variable 'vhdl-highlight-names 3887 (not vhdl-highlight-names)) 3888 (vhdl-fontify-buffer)) 3889 :style toggle :selected vhdl-highlight-names] 3890 ["Highlight Special Words" 3891 (progn (customize-set-variable 'vhdl-highlight-special-words 3892 (not vhdl-highlight-special-words)) 3893 (vhdl-fontify-buffer)) 3894 :style toggle :selected vhdl-highlight-special-words] 3895 ["Highlight Forbidden Words" 3896 (progn (customize-set-variable 'vhdl-highlight-forbidden-words 3897 (not vhdl-highlight-forbidden-words)) 3898 (vhdl-fontify-buffer)) 3899 :style toggle :selected vhdl-highlight-forbidden-words] 3900 ["Highlight Verilog Keywords" 3901 (progn (customize-set-variable 'vhdl-highlight-verilog-keywords 3902 (not vhdl-highlight-verilog-keywords)) 3903 (vhdl-fontify-buffer)) 3904 :style toggle :selected vhdl-highlight-verilog-keywords] 3905 ["Highlight \"translate_off\"" 3906 (progn (customize-set-variable 'vhdl-highlight-translate-off 3907 (not vhdl-highlight-translate-off)) 3908 (vhdl-fontify-buffer)) 3909 :style toggle :selected vhdl-highlight-translate-off] 3910 ["Case Sensitive Highlighting" 3911 (progn (customize-set-variable 'vhdl-highlight-case-sensitive 3912 (not vhdl-highlight-case-sensitive)) 3913 (vhdl-fontify-buffer)) 3914 :style toggle :selected vhdl-highlight-case-sensitive] 3915 ["Special Syntax Definition..." 3916 (customize-option 'vhdl-special-syntax-alist) t] 3917 ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] 3918 ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] 3919 ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] 3920 ["Colors..." (customize-group 'vhdl-highlight-faces) t] 3921 "--" 3922 ["Customize Group..." (customize-group 'vhdl-highlight) t]) 3923 ("Speedbar" 3924 ["Auto Open at Startup" 3925 (customize-set-variable 'vhdl-speedbar-auto-open 3926 (not vhdl-speedbar-auto-open)) 3927 :style toggle :selected vhdl-speedbar-auto-open] 3928 ("Default Displaying Mode" 3929 ["Files" 3930 (customize-set-variable 'vhdl-speedbar-display-mode 'files) 3931 :style radio :selected (eq 'files vhdl-speedbar-display-mode)] 3932 ["Directory Hierarchy" 3933 (customize-set-variable 'vhdl-speedbar-display-mode 'directory) 3934 :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] 3935 ["Project Hierarchy" 3936 (customize-set-variable 'vhdl-speedbar-display-mode 'project) 3937 :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) 3938 ["Indentation Offset..." 3939 (customize-option 'speedbar-indentation-width) t] 3940 ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] 3941 ["Jump to Unit when Opening" 3942 (customize-set-variable 'vhdl-speedbar-jump-to-unit 3943 (not vhdl-speedbar-jump-to-unit)) 3944 :style toggle :selected vhdl-speedbar-jump-to-unit] 3945 ["Update Hierarchy on File Saving" 3946 (customize-set-variable 'vhdl-speedbar-update-on-saving 3947 (not vhdl-speedbar-update-on-saving)) 3948 :style toggle :selected vhdl-speedbar-update-on-saving] 3949 ("Save in Cache File" 3950 ["Hierarchy Information" 3951 (customize-set-variable 'vhdl-speedbar-save-cache 3952 (if (memq 'hierarchy vhdl-speedbar-save-cache) 3953 (delq 'hierarchy vhdl-speedbar-save-cache) 3954 (cons 'hierarchy vhdl-speedbar-save-cache))) 3955 :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] 3956 ["Displaying Status" 3957 (customize-set-variable 'vhdl-speedbar-save-cache 3958 (if (memq 'display vhdl-speedbar-save-cache) 3959 (delq 'display vhdl-speedbar-save-cache) 3960 (cons 'display vhdl-speedbar-save-cache))) 3961 :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) 3962 ["Cache File Name..." 3963 (customize-option 'vhdl-speedbar-cache-file-name) t] 3964 "--" 3965 ["Customize Group..." (customize-group 'vhdl-speedbar) t]) 3966 ("Menu" 3967 ["Add Index Menu when Loading File" 3968 (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) 3969 (vhdl-index-menu-init)) 3970 :style toggle :selected vhdl-index-menu] 3971 ["Add Source File Menu when Loading File" 3972 (progn (customize-set-variable 'vhdl-source-file-menu 3973 (not vhdl-source-file-menu)) 3974 (vhdl-add-source-files-menu)) 3975 :style toggle :selected vhdl-source-file-menu] 3976 ["Add Hideshow Menu at Startup" 3977 (progn (customize-set-variable 'vhdl-hideshow-menu 3978 (not vhdl-hideshow-menu)) 3979 (vhdl-activate-customizations)) 3980 :style toggle :selected vhdl-hideshow-menu] 3981 ["Hide Everything Initially" 3982 (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) 3983 :style toggle :selected vhdl-hide-all-init] 3984 "--" 3985 ["Customize Group..." (customize-group 'vhdl-menu) t]) 3986 ("Print" 3987 ["In Two Column Format" 3988 (progn (customize-set-variable 'vhdl-print-two-column 3989 (not vhdl-print-two-column)) 3990 (message "Activate new setting by saving options and restarting Emacs")) 3991 :style toggle :selected vhdl-print-two-column] 3992 ["Use Customized Faces" 3993 (progn (customize-set-variable 'vhdl-print-customize-faces 3994 (not vhdl-print-customize-faces)) 3995 (message "Activate new setting by saving options and restarting Emacs")) 3996 :style toggle :selected vhdl-print-customize-faces] 3997 "--" 3998 ["Customize Group..." (customize-group 'vhdl-print) t]) 3999 ("Miscellaneous" 4000 ["Use Intelligent Tab" 4001 (progn (customize-set-variable 'vhdl-intelligent-tab 4002 (not vhdl-intelligent-tab)) 4003 (vhdl-activate-customizations)) 4004 :style toggle :selected vhdl-intelligent-tab] 4005 ["Indent Syntax-Based" 4006 (customize-set-variable 'vhdl-indent-syntax-based 4007 (not vhdl-indent-syntax-based)) 4008 :style toggle :selected vhdl-indent-syntax-based] 4009 ["Word Completion is Case Sensitive" 4010 (customize-set-variable 'vhdl-word-completion-case-sensitive 4011 (not vhdl-word-completion-case-sensitive)) 4012 :style toggle :selected vhdl-word-completion-case-sensitive] 4013 ["Word Completion in Minibuffer" 4014 (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer 4015 (not vhdl-word-completion-in-minibuffer)) 4016 (message "Activate new setting by saving options and restarting Emacs")) 4017 :style toggle :selected vhdl-word-completion-in-minibuffer] 4018 ["Underscore is Part of Word" 4019 (progn (customize-set-variable 'vhdl-underscore-is-part-of-word 4020 (not vhdl-underscore-is-part-of-word)) 4021 (vhdl-activate-customizations)) 4022 :style toggle :selected vhdl-underscore-is-part-of-word] 4023 "--" 4024 ["Customize Group..." (customize-group 'vhdl-misc) t]) 4025 ["Related..." (customize-browse 'vhdl-related) t] 4026 "--" 4027 ["Save Options" customize-save-customized t] 4028 ["Activate Options" vhdl-activate-customizations t] 4029 ["Browse Options..." vhdl-customize t]))) 4030 4031(defvar vhdl-mode-menu-list (vhdl-create-mode-menu) 4032 "VHDL Mode menu.") 4033 4034(defun vhdl-update-mode-menu () 4035 "Update VHDL Mode menu." 4036 (interactive) 4037 (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs 4038 (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) 4039 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs 4040 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4041 "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) 4042 4043;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4044;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') 4045 4046(defconst vhdl-imenu-generic-expression 4047 '( 4048 ("Subprogram" 4049 "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" 4050 4) 4051 ("Instance" 4052 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" 4053 1) 4054 ("Component" 4055 "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4056 2) 4057 ("Procedural" 4058 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" 4059 1) 4060 ("Process" 4061 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" 4062 1) 4063 ("Block" 4064 "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" 4065 1) 4066 ("Package" 4067 "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4068 3) 4069 ("Configuration" 4070 "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4071 2) 4072 ("Architecture" 4073 "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" 4074 2) 4075 ("Entity" 4076 "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" 4077 2) 4078 ) 4079 "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") 4080 4081(defun vhdl-index-menu-init () 4082 "Initialize index menu." 4083 (set (make-local-variable 'imenu-case-fold-search) t) 4084 (set (make-local-variable 'imenu-generic-expression) 4085 vhdl-imenu-generic-expression) 4086 (when (and vhdl-index-menu (fboundp 'imenu)) 4087 (if (or (not (boundp 'font-lock-maximum-size)) 4088 (> font-lock-maximum-size (buffer-size))) 4089 (imenu-add-to-menubar "Index") 4090 (message "Scanning buffer for index...buffer too big")))) 4091 4092;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4093;; Source file menu (using `easy-menu.el') 4094 4095(defvar vhdl-sources-menu nil) 4096 4097(defun vhdl-directory-files (directory &optional full match) 4098 "Call `directory-files' if DIRECTORY exists, otherwise generate error 4099message." 4100 (if (not (file-directory-p directory)) 4101 (vhdl-warning-when-idle "No such directory: \"%s\"" directory) 4102 (let ((dir (directory-files directory full match))) 4103 (setq dir (delete "." dir)) 4104 (setq dir (delete ".." dir)) 4105 dir))) 4106 4107(defun vhdl-get-source-files (&optional full directory) 4108 "Get list of VHDL source files in DIRECTORY or current directory." 4109 (let ((mode-alist auto-mode-alist) 4110 filename-regexp) 4111 ;; create regular expressions for matching file names 4112 (setq filename-regexp "\\`[^.].*\\(") 4113 (while mode-alist 4114 (when (eq (cdar mode-alist) 'vhdl-mode) 4115 (setq filename-regexp 4116 (concat filename-regexp (caar mode-alist) "\\|"))) 4117 (setq mode-alist (cdr mode-alist))) 4118 (setq filename-regexp 4119 (concat (substring filename-regexp 0 4120 (string-match "\\\\|$" filename-regexp)) "\\)")) 4121 ;; find files 4122 (vhdl-directory-files 4123 (or directory default-directory) full filename-regexp))) 4124 4125(defun vhdl-add-source-files-menu () 4126 "Scan directory for all VHDL source files and generate menu. 4127The directory of the current source file is scanned." 4128 (interactive) 4129 (message "Scanning directory for source files ...") 4130 (let ((newmap (current-local-map)) 4131 (file-list (vhdl-get-source-files)) 4132 menu-list found) 4133 ;; Create list for menu 4134 (setq found nil) 4135 (while file-list 4136 (setq found t) 4137 (setq menu-list (cons (vector (car file-list) 4138 (list 'find-file (car file-list)) t) 4139 menu-list)) 4140 (setq file-list (cdr file-list))) 4141 (setq menu-list (vhdl-menu-split menu-list "Sources")) 4142 (when found (setq menu-list (cons "--" menu-list))) 4143 (setq menu-list (cons ["*Rescan*" vhdl-add-source-files-menu t] menu-list)) 4144 (setq menu-list (cons "Sources" menu-list)) 4145 ;; Create menu 4146 (easy-menu-add menu-list) 4147 (easy-menu-define vhdl-sources-menu newmap 4148 "VHDL source files menu" menu-list)) 4149 (message "")) 4150 4151 4152;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4153;;; Mode definition 4154;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4155;; performs all buffer local initializations 4156 4157;;;###autoload 4158(defun vhdl-mode () 4159 "Major mode for editing VHDL code. 4160 4161Usage: 4162------ 4163 4164 TEMPLATE INSERTION (electrification): 4165 After typing a VHDL keyword and entering `SPC', you are prompted for 4166 arguments while a template is generated for that VHDL construct. Typing 4167 `RET' or `C-g' at the first \(mandatory) prompt aborts the current 4168 template generation. Optional arguments are indicated by square 4169 brackets and removed if the queried string is left empty. Prompts for 4170 mandatory arguments remain in the code if the queried string is left 4171 empty. They can be queried again by `C-c C-t C-q'. Enabled 4172 electrification is indicated by `/e' in the modeline. 4173 4174 Typing `M-SPC' after a keyword inserts a space without calling the 4175 template generator. Automatic template generation (i.e. 4176 electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by 4177 setting option `vhdl-electric-mode' (see OPTIONS). 4178 4179 Template generators can be invoked from the VHDL menu, by key 4180 bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing 4181 the keyword (i.e. first word of menu entry not in parenthesis) and 4182 `SPC'. The following abbreviations can also be used: arch, attr, cond, 4183 conf, comp, cons, func, inst, pack, sig, var. 4184 4185 Template styles can be customized in customization group 4186 `vhdl-template' \(see OPTIONS). 4187 4188 4189 HEADER INSERTION: 4190 A file header can be inserted by `C-c C-t C-h'. A file footer 4191 (template at the end of the file) can be inserted by `C-c C-t C-f'. 4192 See customization group `vhdl-header'. 4193 4194 4195 STUTTERING: 4196 Double striking of some keys inserts cumbersome VHDL syntax elements. 4197 Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by 4198 option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in 4199 the modeline. The stuttering keys and their effects are: 4200 4201 ;; --> \" : \" [ --> ( -- --> comment 4202 ;;; --> \" := \" [[ --> [ --CR --> comment-out code 4203 .. --> \" => \" ] --> ) --- --> horizontal line 4204 ,, --> \" <= \" ]] --> ] ---- --> display comment 4205 == --> \" == \" '' --> \\\" 4206 4207 4208 WORD COMPLETION: 4209 Typing `TAB' after a (not completed) word looks for a VHDL keyword or a 4210 word in the buffer that starts alike, inserts it and adjusts case. 4211 Re-typing `TAB' toggles through alternative word completions. This also 4212 works in the minibuffer (i.e. in template generator prompts). 4213 4214 Typing `TAB' after `(' looks for and inserts complete parenthesized 4215 expressions (e.g. for array index ranges). All keywords as well as 4216 standard types and subprograms of VHDL have predefined abbreviations 4217 \(e.g. type \"std\" and `TAB' will toggle through all standard types 4218 beginning with \"std\"). 4219 4220 Typing `TAB' after a non-word character indents the line if at the 4221 beginning of a line (i.e. no preceding non-blank characters), and 4222 inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator 4223 stop. 4224 4225 4226 COMMENTS: 4227 `--' puts a single comment. 4228 `---' draws a horizontal line for separating code segments. 4229 `----' inserts a display comment, i.e. two horizontal lines 4230 with a comment in between. 4231 `--CR' comments out code on that line. Re-hitting CR comments 4232 out following lines. 4233 `C-c c' comments out a region if not commented out, 4234 uncomments a region if already commented out. 4235 4236 You are prompted for comments after object definitions (i.e. signals, 4237 variables, constants, ports) and after subprogram and process 4238 specifications if option `vhdl-prompt-for-comments' is non-nil. 4239 Comments are automatically inserted as additional labels (e.g. after 4240 begin statements) and as help comments if `vhdl-self-insert-comments' is 4241 non-nil. 4242 4243 Inline comments (i.e. comments after a piece of code on the same line) 4244 are indented at least to `vhdl-inline-comment-column'. Comments go at 4245 maximum to `vhdl-end-comment-column'. `RET' after a space in a comment 4246 will open a new comment line. Typing beyond `vhdl-end-comment-column' 4247 in a comment automatically opens a new comment line. `M-q' re-fills 4248 multi-line comments. 4249 4250 4251 INDENTATION: 4252 `TAB' indents a line if at the beginning of the line. The amount of 4253 indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' 4254 always indents the current line (is bound to `TAB' if option 4255 `vhdl-intelligent-tab' is nil). 4256 4257 Indentation can be done for a group of lines (`C-c C-i C-g'), a region 4258 \(`M-C-\\') or the entire buffer (menu). Argument and port lists are 4259 indented normally (nil) or relative to the opening parenthesis (non-nil) 4260 according to option `vhdl-argument-list-indent'. 4261 4262 If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of 4263 tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs 4264 and vice versa. 4265 4266 Syntax-based indentation can be very slow in large files. Option 4267 `vhdl-indent-syntax-based' allows to use faster but simpler indentation. 4268 4269 4270 ALIGNMENT: 4271 The alignment functions align operators, keywords, and inline comments 4272 to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines 4273 separated by blank lines, `C-c C-a C-i' a block of lines with same 4274 indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by 4275 a pair of parentheses (e.g. port clause/map, argument list), and `C-c 4276 C-a C-d' all lines within the declarative part of a design unit. `C-c 4277 C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments 4278 for a group of lines, and `C-c C-a M-c' for a region. 4279 4280 If option `vhdl-align-groups' is non-nil, groups of code lines 4281 separated by special lines (see option `vhdl-align-group-separate') are 4282 aligned individually. If option `vhdl-align-same-indent' is non-nil, 4283 blocks of lines with same indent are aligned separately. Some templates 4284 are automatically aligned after generation if option `vhdl-auto-align' 4285 is non-nil. 4286 4287 Alignment tries to align inline comments at 4288 `vhdl-inline-comment-column' and tries inline comment not to exceed 4289 `vhdl-end-comment-column'. 4290 4291 `C-c C-x M-w' fixes up whitespace in a region. That is, operator 4292 symbols are surrounded by one space, and multiple spaces are eliminated. 4293 4294 4295 CODE FILLING: 4296 Code filling allows to condense code (e.g. sensitivity lists or port 4297 maps) by removing comments and newlines and re-wrapping so that all 4298 lines are maximally filled (block filling). `C-c C-f C-f' fills a list 4299 enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by 4300 blank lines, `C-c C-f C-i' a block of lines with same indent, and 4301 `C-c C-f M-f' an entire region. 4302 4303 4304 CODE BEAUTIFICATION: 4305 `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire 4306 buffer respectively. This inludes indentation, alignment, and case 4307 fixing. Code beautification can also be run non-interactively using the 4308 command: 4309 4310 emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer 4311 4312 4313 PORT TRANSLATION: 4314 Generic and port clauses from entity or component declarations can be 4315 copied (`C-c C-p C-w') and pasted as entity and component declarations, 4316 as component instantiations and corresponding internal constants and 4317 signals, as a generic map with constants as actual generics, and as 4318 internal signal initializations (menu). 4319 4320 To include formals in component instantiations, see option 4321 `vhdl-association-list-with-formals'. To include comments in pasting, 4322 see options `vhdl-include-...-comments'. 4323 4324 A clause with several generic/port names on the same line can be 4325 flattened (`C-c C-p C-f') so that only one name per line exists. The 4326 direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become 4327 outputs and vice versa, which can be useful in testbenches. (This 4328 reversion is done on the internal data structure and is only reflected 4329 in subsequent paste operations.) 4330 4331 Names for actual ports, instances, testbenches, and 4332 design-under-test instances can be derived from existing names according 4333 to options `vhdl-...-name'. See customization group `vhdl-port'. 4334 4335 4336 SUBPROGRAM TRANSLATION: 4337 Similar functionality exists for copying/pasting the interface of 4338 subprograms (function/procedure). A subprogram interface can be copied 4339 and then pasted as a subprogram declaration, body or call (uses 4340 association list with formals). 4341 4342 4343 TESTBENCH GENERATION: 4344 A copied port can also be pasted as a testbench. The generated 4345 testbench includes an entity, an architecture, and an optional 4346 configuration. The architecture contains the component declaration and 4347 instantiation of the DUT as well as internal constant and signal 4348 declarations. Additional user-defined templates can be inserted. The 4349 names used for entity/architecture/configuration/DUT as well as the file 4350 structure to be generated can be customized. See customization group 4351 `vhdl-testbench'. 4352 4353 4354 KEY BINDINGS: 4355 Key bindings (`C-c ...') exist for most commands (see in menu). 4356 4357 4358 VHDL MENU: 4359 All commands can be found in the VHDL menu including their key bindings. 4360 4361 4362 FILE BROWSER: 4363 The speedbar allows browsing of directories and file contents. It can 4364 be accessed from the VHDL menu and is automatically opened if option 4365 `vhdl-speedbar-auto-open' is non-nil. 4366 4367 In speedbar, open files and directories with `mouse-2' on the name and 4368 browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. 4369 4370 4371 DESIGN HIERARCHY BROWSER: 4372 The speedbar can also be used for browsing the hierarchy of design units 4373 contained in the source files of the current directory or the specified 4374 projects (see option `vhdl-project-alist'). 4375 4376 The speedbar can be switched between file, directory hierarchy and 4377 project hierarchy browsing mode in the speedbar menu or by typing `f', 4378 `h' or `H' in speedbar. 4379 4380 In speedbar, open design units with `mouse-2' on the name and browse 4381 their hierarchy with `mouse-2' on the `+'. Ports can directly be copied 4382 from entities and components (in packages). Individual design units and 4383 complete designs can directly be compiled (\"Make\" menu entry). 4384 4385 The hierarchy is automatically updated upon saving a modified source 4386 file when option `vhdl-speedbar-update-on-saving' is non-nil. The 4387 hierarchy is only updated for projects that have been opened once in the 4388 speedbar. The hierarchy is cached between Emacs sessions in a file (see 4389 options in group `vhdl-speedbar'). 4390 4391 Simple design consistency checks are done during scanning, such as 4392 multiple declarations of the same unit or missing primary units that are 4393 required by secondary units. 4394 4395 4396 STRUCTURAL COMPOSITION: 4397 Enables simple structural composition. `C-c C-c C-n' creates a skeleton 4398 for a new component. Subcomponents (i.e. component declaration and 4399 instantiation) can be automatically placed from a previously read port 4400 \(`C-c C-c C-p') or directly from the hierarchy browser (`P'). Finally, 4401 all subcomponents can be automatically connected using internal signals 4402 and ports (`C-c C-c C-w') following these rules: 4403 - subcomponent actual ports with same name are considered to be 4404 connected by a signal (internal signal or port) 4405 - signals that are only inputs to subcomponents are considered as 4406 inputs to this component -> input port created 4407 - signals that are only outputs from subcomponents are considered as 4408 outputs from this component -> output port created 4409 - signals that are inputs to AND outputs from subcomponents are 4410 considered as internal connections -> internal signal created 4411 4412 Purpose: With appropriate naming conventions it is possible to 4413 create higher design levels with only a few mouse clicks or key 4414 strokes. A new design level can be created by simply generating a new 4415 component, placing the required subcomponents from the hierarchy 4416 browser, and wiring everything automatically. 4417 4418 Note: Automatic wiring only works reliably on templates of new 4419 components and component instantiations that were created by VHDL mode. 4420 4421 Component declarations can be placed in a components package (option 4422 `vhdl-use-components-package') which can be automatically generated for 4423 an entire directory or project (`C-c C-c M-p'). The VHDL'93 direct 4424 component instantiation is also supported (option 4425 `vhdl-use-direct-instantiation'). 4426 4427| Configuration declarations can automatically be generated either from 4428| the menu (`C-c C-c C-f') (for the architecture the cursor is in) or from 4429| the speedbar menu (for the architecture under the cursor). The 4430| configurations can optionally be hierarchical (i.e. include all 4431| component levels of a hierarchical design, option 4432| `vhdl-compose-configuration-hierarchical') or include subconfigurations 4433| (option `vhdl-compose-configuration-use-subconfiguration'). For 4434| subcomponents in hierarchical configurations, the most-recently-analyzed 4435| (mra) architecture is selected. If another architecture is desired, it 4436| can be marked as most-recently-analyzed (speedbar menu) before 4437| generating the configuration. 4438| 4439| Note: Configurations of subcomponents (i.e. hierarchical configuration 4440| declarations) are currently not considered when displaying 4441| configurations in speedbar. 4442 4443 See the options group `vhdl-compose' for all relevant user options. 4444 4445 4446 SOURCE FILE COMPILATION: 4447 The syntax of the current buffer can be analyzed by calling a VHDL 4448 compiler (menu, `C-c C-k'). The compiler to be used is specified by 4449 option `vhdl-compiler'. The available compilers are listed in option 4450 `vhdl-compiler-alist' including all required compilation command, 4451 command options, compilation directory, and error message syntax 4452 information. New compilers can be added. 4453 4454 All the source files of an entire design can be compiled by the `make' 4455 command (menu, `C-c M-C-k') if an appropriate Makefile exists. 4456 4457 4458 MAKEFILE GENERATION: 4459 Makefiles can be generated automatically by an internal generation 4460 routine (`C-c M-k'). The library unit dependency information is 4461 obtained from the hierarchy browser. Makefile generation can be 4462 customized for each compiler in option `vhdl-compiler-alist'. 4463 4464 Makefile generation can also be run non-interactively using the 4465 command: 4466 4467 emacs -batch -l ~/.emacs -l vhdl-mode 4468 [-compiler compilername] [-project projectname] 4469 -f vhdl-generate-makefile 4470 4471 The Makefile's default target \"all\" compiles the entire design, the 4472 target \"clean\" removes it and the target \"library\" creates the 4473 library directory if not existent. The Makefile also includes a target 4474 for each primary library unit which allows selective compilation of this 4475 unit, its secondary units and its subhierarchy (example: compilation of 4476 a design specified by a configuration). User specific parts can be 4477 inserted into a Makefile with option `vhdl-makefile-generation-hook'. 4478 4479 Limitations: 4480 - Only library units and dependencies within the current library are 4481 considered. Makefiles for designs that span multiple libraries are 4482 not (yet) supported. 4483 - Only one-level configurations are supported (also hierarchical), 4484 but configurations that go down several levels are not. 4485 - The \"others\" keyword in configurations is not supported. 4486 4487 4488 PROJECTS: 4489 Projects can be defined in option `vhdl-project-alist' and a current 4490 project be selected using option `vhdl-project' (permanently) or from 4491 the menu or speedbar (temporarily). For each project, title and 4492 description strings (for the file headers), source files/directories 4493 (for the hierarchy browser and Makefile generation), library name, and 4494 compiler-dependent options, exceptions and compilation directory can be 4495 specified. Compilation settings overwrite the settings of option 4496 `vhdl-compiler-alist'. 4497 4498 Project setups can be exported (i.e. written to a file) and imported. 4499 Imported setups are not automatically saved in `vhdl-project-alist' but 4500 can be saved afterwards in its customization buffer. When starting 4501 Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l 4502 vhdl-mode\") in a directory with an existing project setup file, it is 4503 automatically loaded and its project activated if option 4504 `vhdl-project-auto-load' is non-nil. Names/paths of the project setup 4505 files can be specified in option `vhdl-project-file-name'. Multiple 4506 project setups can be automatically loaded from global directories. 4507 This is an alternative to specifying project setups with option 4508 `vhdl-project-alist'. 4509 4510 4511 SPECIAL MENUES: 4512 As an alternative to the speedbar, an index menu can be added (set 4513 option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu 4514 (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up 4515 file) for browsing the file contents (is not populated if buffer is 4516 larger than `font-lock-maximum-size'). Also, a source file menu can be 4517 added (set option `vhdl-source-file-menu' to non-nil) for browsing the 4518 current directory for VHDL source files. 4519 4520 4521 VHDL STANDARDS: 4522 The VHDL standards to be used are specified in option `vhdl-standard'. 4523 Available standards are: VHDL'87/'93, VHDL-AMS, and Math Packages. 4524 4525 4526 KEYWORD CASE: 4527 Lower and upper case for keywords and standardized types, attributes, 4528 and enumeration values is supported. If the option 4529 `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in 4530 lower case and are converted into upper case automatically (not for 4531 types, attributes, and enumeration values). The case of keywords, 4532 types, attributes,and enumeration values can be fixed for an entire 4533 region (menu) or buffer (`C-c C-x C-c') according to the options 4534 `vhdl-upper-case-{keywords,types,attributes,enum-values}'. 4535 4536 4537 HIGHLIGHTING (fontification): 4538 Keywords and standardized types, attributes, enumeration values, and 4539 function names (controlled by option `vhdl-highlight-keywords'), as well 4540 as comments, strings, and template prompts are highlighted using 4541 different colors. Unit, subprogram, signal, variable, constant, 4542 parameter and generic/port names in declarations as well as labels are 4543 highlighted if option `vhdl-highlight-names' is non-nil. 4544 4545 Additional reserved words or words with a forbidden syntax (e.g. words 4546 that should be avoided) can be specified in option 4547 `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in 4548 a warning color (option `vhdl-highlight-forbidden-words'). Verilog 4549 keywords are highlighted as forbidden words if option 4550 `vhdl-highlight-verilog-keywords' is non-nil. 4551 4552 Words with special syntax can be highlighted by specifying their 4553 syntax and color in option `vhdl-special-syntax-alist' and by setting 4554 option `vhdl-highlight-special-words' to non-nil. This allows to 4555 establish some naming conventions (e.g. to distinguish different kinds 4556 of signals or other objects by using name suffices) and to support them 4557 visually. 4558 4559 Option `vhdl-highlight-case-sensitive' can be set to non-nil in order 4560 to support case-sensitive highlighting. However, keywords are then only 4561 highlighted if written in lower case. 4562 4563 Code between \"translate_off\" and \"translate_on\" pragmas is 4564 highlighted using a different background color if option 4565 `vhdl-highlight-translate-off' is non-nil. 4566 4567 For documentation and customization of the used colors see 4568 customization group `vhdl-highlight-faces' (`M-x customize-group'). For 4569 highlighting of matching parenthesis, see customization group 4570 `paren-showing'. Automatic buffer highlighting is turned on/off by 4571 option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). 4572 4573 4574 USER MODELS: 4575 VHDL models (templates) can be specified by the user and made accessible 4576 in the menu, through key bindings (`C-c C-m ...'), or by keyword 4577 electrification. See option `vhdl-model-alist'. 4578 4579 4580 HIDE/SHOW: 4581 The code of blocks, processes, subprograms, component declarations and 4582 instantiations, generic/port clauses, and configuration declarations can 4583 be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within 4584 the code (see customization group `vhdl-menu'). XEmacs: limited 4585 functionality due to old `hideshow.el' package. 4586 4587 4588 CODE UPDATING: 4589 - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the 4590 current process, `C-c C-u M-s' of all processes in the current buffer. 4591 Limitations: 4592 - Only declared local signals (ports, signals declared in 4593 architecture and blocks) are automatically inserted. 4594 - Global signals declared in packages are not automatically inserted. 4595 Insert them once manually (will be kept afterwards). 4596 - Out parameters of procedures are considered to be read. 4597 Use option `vhdl-entity-file-name' to specify the entity file name 4598 \(used to obtain the port names). 4599 4600 4601 CODE FIXING: 4602 `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause 4603 \(e.g. if the closing parenthesis is on the wrong line or is missing). 4604 4605 4606 PRINTING: 4607 Postscript printing with different faces (an optimized set of faces is 4608 used if `vhdl-print-customize-faces' is non-nil) or colors \(if 4609 `ps-print-color-p' is non-nil) is possible using the standard Emacs 4610 postscript printing commands. Option `vhdl-print-two-column' defines 4611 appropriate default settings for nice landscape two-column printing. 4612 The paper format can be set by option `ps-paper-type'. Do not forget to 4613 switch `ps-print-color-p' to nil for printing on black-and-white 4614 printers. 4615 4616 4617 OPTIONS: 4618 User options allow customization of VHDL Mode. All options are 4619 accessible from the \"Options\" menu entry. Simple options (switches 4620 and choices) can directly be changed, while for complex options a 4621 customization buffer is opened. Changed options can be saved for future 4622 sessions using the \"Save Options\" menu entry. 4623 4624 Options and their detailed descriptions can also be accessed by using 4625 the \"Customize\" menu entry or the command `M-x customize-option' (`M-x 4626 customize-group' for groups). Some customizations only take effect 4627 after some action (read the NOTE in the option documentation). 4628 Customization can also be done globally (i.e. site-wide, read the 4629 INSTALL file). 4630 4631 Not all options are described in this documentation, so go and see 4632 what other useful user options there are (`M-x vhdl-customize' or menu)! 4633 4634 4635 FILE EXTENSIONS: 4636 As default, files with extensions \".vhd\" and \".vhdl\" are 4637 automatically recognized as VHDL source files. To add an extension 4638 \".xxx\", add the following line to your Emacs start-up file (`.emacs'): 4639 4640 \(setq auto-mode-alist (cons '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist)) 4641 4642 4643 HINTS: 4644 - To start Emacs with open VHDL hierarchy browser without having to load 4645 a VHDL file first, use the command: 4646 4647 emacs -l vhdl-mode -f speedbar-frame-mode 4648 4649 - Type `C-g C-g' to interrupt long operations or if Emacs hangs. 4650 4651 - Some features only work on properly indented code. 4652 4653 4654 RELEASE NOTES: 4655 See also the release notes (menu) for added features in new releases. 4656 4657 4658Maintenance: 4659------------ 4660 4661To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode. 4662Add a description of the problem and include a reproducible test case. 4663 4664Questions and enhancement requests can be sent to <reto@gnu.org>. 4665 4666The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. 4667The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta 4668releases. You are kindly invited to participate in beta testing. Subscribe 4669to above mailing lists by sending an email to <reto@gnu.org>. 4670 4671VHDL Mode is officially distributed at 4672http://opensource.ethz.ch/emacs/vhdl-mode.html 4673where the latest version can be found. 4674 4675 4676Known problems: 4677--------------- 4678 4679- Indentation bug in simultaneous if- and case-statements (VHDL-AMS). 4680- XEmacs: Incorrect start-up when automatically opening speedbar. 4681- XEmacs: Indentation in XEmacs 21.4 (and higher). 4682 4683 4684 The VHDL Mode Authors 4685 Reto Zimmermann and Rod Whitby 4686 4687Key bindings: 4688------------- 4689 4690\\{vhdl-mode-map}" 4691 (interactive) 4692 (kill-all-local-variables) 4693 (setq major-mode 'vhdl-mode) 4694 (setq mode-name "VHDL") 4695 4696 ;; set maps and tables 4697 (use-local-map vhdl-mode-map) 4698 (set-syntax-table vhdl-mode-syntax-table) 4699 (setq local-abbrev-table vhdl-mode-abbrev-table) 4700 4701 ;; set local variables 4702 (set (make-local-variable 'paragraph-start) 4703 "\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)") 4704 (set (make-local-variable 'paragraph-separate) paragraph-start) 4705 (set (make-local-variable 'paragraph-ignore-fill-prefix) t) 4706 (set (make-local-variable 'require-final-newline) 4707 (if vhdl-emacs-22 mode-require-final-newline t)) 4708 (set (make-local-variable 'parse-sexp-ignore-comments) t) 4709 (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) 4710 (set (make-local-variable 'comment-start) "--") 4711 (set (make-local-variable 'comment-end) "") 4712 (when vhdl-emacs-21 4713 (set (make-local-variable 'comment-padding) "")) 4714 (set (make-local-variable 'comment-column) vhdl-inline-comment-column) 4715 (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) 4716 (set (make-local-variable 'comment-start-skip) "--+\\s-*") 4717 (set (make-local-variable 'comment-multi-line) nil) 4718 (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) 4719 (set (make-local-variable 'hippie-expand-verbose) nil) 4720 4721 ;; setup the comment indent variable in a Emacs version portable way 4722 ;; ignore any byte compiler warnings you might get here 4723 (when (boundp 'comment-indent-function) 4724 (make-local-variable 'comment-indent-function) 4725 (setq comment-indent-function 'vhdl-comment-indent)) 4726 4727 ;; initialize font locking 4728 (set (make-local-variable 'font-lock-defaults) 4729 (list 4730 '(nil vhdl-font-lock-keywords) nil 4731 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line 4732 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) 4733 (unless vhdl-emacs-21 4734 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) 4735 (set (make-local-variable 'lazy-lock-defer-contextually) nil) 4736 (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) 4737; (set (make-local-variable 'lazy-lock-defer-time) 0.1) 4738 (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) 4739; (turn-on-font-lock) 4740 4741 ;; variables for source file compilation 4742 (when vhdl-compile-use-local-error-regexp 4743 (set (make-local-variable 'compilation-error-regexp-alist) nil) 4744 (set (make-local-variable 'compilation-file-regexp-alist) nil)) 4745 4746 ;; add index menu 4747 (vhdl-index-menu-init) 4748 ;; add source file menu 4749 (if vhdl-source-file-menu (vhdl-add-source-files-menu)) 4750 ;; add VHDL menu 4751 (easy-menu-add vhdl-mode-menu-list) ; for XEmacs 4752 (easy-menu-define vhdl-mode-menu vhdl-mode-map 4753 "Menu keymap for VHDL Mode." vhdl-mode-menu-list) 4754 ;; initialize hideshow and add menu 4755 (vhdl-hideshow-init) 4756 (run-hooks 'menu-bar-update-hook) 4757 4758 ;; miscellaneous 4759 (vhdl-ps-print-init) 4760 (vhdl-write-file-hooks-init) 4761 (vhdl-mode-line-update) 4762 (message "VHDL Mode %s.%s" vhdl-version 4763 (if noninteractive "" " See menu for documentation and release notes.")) 4764 4765 ;; run hooks 4766 (if vhdl-emacs-22 4767 (run-mode-hooks 'vhdl-mode-hook) 4768 (run-hooks 'vhdl-mode-hook))) 4769 4770(defun vhdl-activate-customizations () 4771 "Activate all customizations on local variables." 4772 (interactive) 4773 (vhdl-mode-map-init) 4774 (use-local-map vhdl-mode-map) 4775 (set-syntax-table vhdl-mode-syntax-table) 4776 (setq comment-column vhdl-inline-comment-column) 4777 (setq end-comment-column vhdl-end-comment-column) 4778 (vhdl-write-file-hooks-init) 4779 (vhdl-update-mode-menu) 4780 (vhdl-hideshow-init) 4781 (run-hooks 'menu-bar-update-hook) 4782 (vhdl-mode-line-update)) 4783 4784(defun vhdl-write-file-hooks-init () 4785 "Add/remove hooks when buffer is saved." 4786 (if vhdl-modify-date-on-saving 4787 (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror) 4788 (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)) 4789 (make-local-variable 'after-save-hook) 4790 (add-hook 'after-save-hook 'vhdl-add-modified-file)) 4791 4792(defun vhdl-process-command-line-option (option) 4793 "Process command line options for VHDL Mode." 4794 (cond 4795 ;; set compiler 4796 ((equal option "-compiler") 4797 (vhdl-set-compiler (car command-line-args-left)) 4798 (setq command-line-args-left (cdr command-line-args-left))) 4799 ;; set project 4800 ((equal option "-project") 4801 (vhdl-set-project (car command-line-args-left)) 4802 (setq command-line-args-left (cdr command-line-args-left))))) 4803 4804;; make Emacs process VHDL Mode options 4805(setq command-switch-alist 4806 (append command-switch-alist 4807 '(("-compiler" . vhdl-process-command-line-option) 4808 ("-project" . vhdl-process-command-line-option)))) 4809 4810 4811;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4812;;; Keywords and standardized words 4813;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4814 4815(defconst vhdl-93-keywords 4816 '( 4817 "abs" "access" "after" "alias" "all" "and" "architecture" "array" 4818 "assert" "attribute" 4819 "begin" "block" "body" "buffer" "bus" 4820 "case" "component" "configuration" "constant" 4821 "disconnect" "downto" 4822 "else" "elsif" "end" "entity" "exit" 4823 "file" "for" "function" 4824 "generate" "generic" "group" "guarded" 4825 "if" "impure" "in" "inertial" "inout" "is" 4826 "label" "library" "linkage" "literal" "loop" 4827 "map" "mod" 4828 "nand" "new" "next" "nor" "not" "null" 4829 "of" "on" "open" "or" "others" "out" 4830 "package" "port" "postponed" "procedure" "process" "pure" 4831 "range" "record" "register" "reject" "rem" "report" "return" 4832 "rol" "ror" 4833 "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" 4834 "then" "to" "transport" "type" 4835 "unaffected" "units" "until" "use" 4836 "variable" 4837 "wait" "when" "while" "with" 4838 "xnor" "xor" 4839 ) 4840 "List of VHDL'93 keywords.") 4841 4842(defconst vhdl-ams-keywords 4843 '( 4844 "across" "break" "limit" "nature" "noise" "procedural" "quantity" 4845 "reference" "spectrum" "subnature" "terminal" "through" 4846 "tolerance" 4847 ) 4848 "List of VHDL-AMS keywords.") 4849 4850(defconst vhdl-verilog-keywords 4851 '( 4852 "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" 4853 "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" 4854 "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" 4855 "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" 4856 "endprimitive" "endspecify" "endtable" "endtask" "event" 4857 "for" "force" "forever" "fork" "function" 4858 "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" 4859 "macromodule" "makefile" "medium" "module" 4860 "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" 4861 "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" 4862 "pullup" 4863 "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" 4864 "rtranif0" "rtranif1" 4865 "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" 4866 "strong1" "supply" "supply0" "supply1" 4867 "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" 4868 "triand" "trior" "trireg" 4869 "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" 4870 ) 4871 "List of Verilog keywords as candidate for additional reserved words.") 4872 4873(defconst vhdl-93-types 4874 '( 4875 "boolean" "bit" "bit_vector" "character" "severity_level" "integer" 4876 "real" "time" "natural" "positive" "string" "line" "text" "side" 4877 "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" 4878 "std_logic" "std_logic_vector" 4879 "std_ulogic" "std_ulogic_vector" 4880 ) 4881 "List of VHDL'93 standardized types.") 4882 4883(defconst vhdl-ams-types 4884 '( 4885 "domain_type" "real_vector" 4886 ;; from `nature_pkg' package 4887 "voltage" "current" "electrical" "position" "velocity" "force" 4888 "mechanical_vf" "mechanical_pf" "rotvel" "torque" "rotational" 4889 "pressure" "flowrate" "fluid" 4890 ) 4891 "List of VHDL-AMS standardized types.") 4892 4893(defconst vhdl-math-types 4894 '( 4895 "complex" "complex_polar" 4896 ) 4897 "List of Math Packages standardized types.") 4898 4899(defconst vhdl-93-attributes 4900 '( 4901 "base" "left" "right" "high" "low" "pos" "val" "succ" 4902 "pred" "leftof" "rightof" "range" "reverse_range" 4903 "length" "delayed" "stable" "quiet" "transaction" 4904 "event" "active" "last_event" "last_active" "last_value" 4905 "driving" "driving_value" "ascending" "value" "image" 4906 "simple_name" "instance_name" "path_name" 4907 "foreign" 4908 ) 4909 "List of VHDL'93 standardized attributes.") 4910 4911(defconst vhdl-ams-attributes 4912 '( 4913 "across" "through" 4914 "reference" "contribution" "tolerance" 4915 "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" 4916 "ramp" "slew" 4917 ) 4918 "List of VHDL-AMS standardized attributes.") 4919 4920(defconst vhdl-93-enum-values 4921 '( 4922 "true" "false" 4923 "note" "warning" "error" "failure" 4924 "read_mode" "write_mode" "append_mode" 4925 "open_ok" "status_error" "name_error" "mode_error" 4926 "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" 4927 "right" "left" 4928 ) 4929 "List of VHDL'93 standardized enumeration values.") 4930 4931(defconst vhdl-ams-enum-values 4932 '( 4933 "quiescent_domain" "time_domain" "frequency_domain" 4934 ;; from `nature_pkg' package 4935 "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" 4936 ) 4937 "List of VHDL-AMS standardized enumeration values.") 4938 4939(defconst vhdl-math-constants 4940 '( 4941 "math_e" "math_1_over_e" 4942 "math_pi" "math_two_pi" "math_1_over_pi" 4943 "math_half_pi" "math_q_pi" "math_3_half_pi" 4944 "math_log_of_2" "math_log_of_10" "math_log2_of_e" "math_log10_of_e" 4945 "math_sqrt2" "math_sqrt1_2" "math_sqrt_pi" 4946 "math_deg_to_rad" "math_rad_to_deg" 4947 "cbase_1" "cbase_j" "czero" 4948 ) 4949 "List of Math Packages standardized constants.") 4950 4951(defconst vhdl-93-functions 4952 '( 4953 "now" "resolved" "rising_edge" "falling_edge" 4954 "read" "readline" "write" "writeline" "endfile" 4955 "resize" "is_X" "std_match" 4956 "shift_left" "shift_right" "rotate_left" "rotate_right" 4957 "to_unsigned" "to_signed" "to_integer" 4958 "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" 4959 "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" 4960 "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" 4961 "shl" "shr" "ext" "sxt" 4962 "deallocate" 4963 ) 4964 "List of VHDL'93 standardized functions.") 4965 4966(defconst vhdl-ams-functions 4967 '( 4968 "frequency" 4969 ) 4970 "List of VHDL-AMS standardized functions.") 4971 4972(defconst vhdl-math-functions 4973 '( 4974 "sign" "ceil" "floor" "round" "trunc" "fmax" "fmin" "uniform" 4975 "sqrt" "cbrt" "exp" "log" 4976 "sin" "cos" "tan" "arcsin" "arccos" "arctan" 4977 "sinh" "cosh" "tanh" "arcsinh" "arccosh" "arctanh" 4978 "cmplx" "complex_to_polar" "polar_to_complex" "arg" "conj" 4979 ) 4980 "List of Math Packages standardized functions.") 4981 4982(defconst vhdl-93-packages 4983 '( 4984 "std_logic_1164" "numeric_std" "numeric_bit" 4985 "standard" "textio" 4986 "std_logic_arith" "std_logic_signed" "std_logic_unsigned" 4987 "std_logic_misc" "std_logic_textio" 4988 "ieee" "std" "work" 4989 ) 4990 "List of VHDL'93 standardized packages and libraries.") 4991 4992(defconst vhdl-ams-packages 4993 '( 4994 ;; from `nature_pkg' package 4995 "nature_pkg" 4996 ) 4997 "List of VHDL-AMS standardized packages and libraries.") 4998 4999(defconst vhdl-math-packages 5000 '( 5001 "math_real" "math_complex" 5002 ) 5003 "List of Math Packages standardized packages and libraries.") 5004 5005(defvar vhdl-keywords nil 5006 "List of VHDL keywords.") 5007 5008(defvar vhdl-types nil 5009 "List of VHDL standardized types.") 5010 5011(defvar vhdl-attributes nil 5012 "List of VHDL standardized attributes.") 5013 5014(defvar vhdl-enum-values nil 5015 "List of VHDL standardized enumeration values.") 5016 5017(defvar vhdl-constants nil 5018 "List of VHDL standardized constants.") 5019 5020(defvar vhdl-functions nil 5021 "List of VHDL standardized functions.") 5022 5023(defvar vhdl-packages nil 5024 "List of VHDL standardized packages and libraries.") 5025 5026(defvar vhdl-reserved-words nil 5027 "List of additional reserved words.") 5028 5029(defvar vhdl-keywords-regexp nil 5030 "Regexp for VHDL keywords.") 5031 5032(defvar vhdl-types-regexp nil 5033 "Regexp for VHDL standardized types.") 5034 5035(defvar vhdl-attributes-regexp nil 5036 "Regexp for VHDL standardized attributes.") 5037 5038(defvar vhdl-enum-values-regexp nil 5039 "Regexp for VHDL standardized enumeration values.") 5040 5041(defvar vhdl-functions-regexp nil 5042 "Regexp for VHDL standardized functions.") 5043 5044(defvar vhdl-packages-regexp nil 5045 "Regexp for VHDL standardized packages and libraries.") 5046 5047(defvar vhdl-reserved-words-regexp nil 5048 "Regexp for additional reserved words.") 5049 5050(defvar vhdl-directive-keywords-regexp nil 5051 "Regexp for compiler directive keywords.") 5052 5053(defun vhdl-words-init () 5054 "Initialize reserved words." 5055 (setq vhdl-keywords 5056 (append vhdl-93-keywords 5057 (when (vhdl-standard-p 'ams) vhdl-ams-keywords))) 5058 (setq vhdl-types 5059 (append vhdl-93-types 5060 (when (vhdl-standard-p 'ams) vhdl-ams-types) 5061 (when (vhdl-standard-p 'math) vhdl-math-types))) 5062 (setq vhdl-attributes 5063 (append vhdl-93-attributes 5064 (when (vhdl-standard-p 'ams) vhdl-ams-attributes))) 5065 (setq vhdl-enum-values 5066 (append vhdl-93-enum-values 5067 (when (vhdl-standard-p 'ams) vhdl-ams-enum-values))) 5068 (setq vhdl-constants 5069 (append (when (vhdl-standard-p 'math) vhdl-math-constants))) 5070 (setq vhdl-functions 5071 (append vhdl-93-functions 5072 (when (vhdl-standard-p 'ams) vhdl-ams-functions) 5073 (when (vhdl-standard-p 'math) vhdl-math-functions))) 5074 (setq vhdl-packages 5075 (append vhdl-93-packages 5076 (when (vhdl-standard-p 'ams) vhdl-ams-packages) 5077 (when (vhdl-standard-p 'math) vhdl-math-packages))) 5078 (setq vhdl-reserved-words 5079 (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) 5080 (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) 5081 '(""))) 5082 (setq vhdl-keywords-regexp 5083 (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) 5084 (setq vhdl-types-regexp 5085 (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) 5086 (setq vhdl-attributes-regexp 5087 (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) 5088 (setq vhdl-enum-values-regexp 5089 (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) 5090 (setq vhdl-functions-regexp 5091 (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) 5092 (setq vhdl-packages-regexp 5093 (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) 5094 (setq vhdl-reserved-words-regexp 5095 (concat "\\<\\(" 5096 (unless (equal vhdl-forbidden-syntax "") 5097 (concat vhdl-forbidden-syntax "\\|")) 5098 (regexp-opt vhdl-reserved-words) 5099 "\\)\\>")) 5100 (setq vhdl-directive-keywords-regexp 5101 (concat "\\<\\(" (mapconcat 'regexp-quote 5102 vhdl-directive-keywords "\\|") "\\)\\>")) 5103 (vhdl-abbrev-list-init)) 5104 5105;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5106;; Words to expand 5107 5108(defvar vhdl-abbrev-list nil 5109 "Predefined abbreviations for VHDL.") 5110 5111(defun vhdl-abbrev-list-init () 5112 (setq vhdl-abbrev-list 5113 (append 5114 (list vhdl-upper-case-keywords) vhdl-keywords 5115 (list vhdl-upper-case-types) vhdl-types 5116 (list vhdl-upper-case-attributes) vhdl-attributes 5117 (list vhdl-upper-case-enum-values) vhdl-enum-values 5118 (list vhdl-upper-case-constants) vhdl-constants 5119 (list nil) vhdl-functions 5120 (list nil) vhdl-packages))) 5121 5122;; initialize reserved words for VHDL Mode 5123(vhdl-words-init) 5124 5125 5126;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5127;;; Indentation 5128;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5129 5130;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5131;; Syntax analysis 5132 5133;; constant regular expressions for looking at various constructs 5134 5135(defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" 5136 "Regexp describing a VHDL symbol. 5137We cannot use just `word' syntax class since `_' cannot be in word 5138class. Putting underscore in word class breaks forward word movement 5139behavior that users are familiar with.") 5140 5141(defconst vhdl-case-header-key "case[( \t\n][^;=>]+[) \t\n]is" 5142 "Regexp describing a case statement header key.") 5143 5144(defconst vhdl-label-key 5145 (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") 5146 "Regexp describing a VHDL label.") 5147 5148;; Macro definitions: 5149 5150(defmacro vhdl-point (position) 5151 "Return the value of point at certain commonly referenced POSITIONs. 5152POSITION can be one of the following symbols: 5153 5154bol -- beginning of line 5155eol -- end of line 5156bod -- beginning of defun 5157boi -- back to indentation 5158eoi -- last whitespace on line 5159ionl -- indentation of next line 5160iopl -- indentation of previous line 5161bonl -- beginning of next line 5162bopl -- beginning of previous line 5163 5164This function does not modify point or mark." 5165 (or (and (eq 'quote (car-safe position)) 5166 (null (cddr position))) 5167 (error "ERROR: Bad buffer position requested: %s" position)) 5168 (setq position (nth 1 position)) 5169 `(let ((here (point))) 5170 ,@(cond 5171 ((eq position 'bol) '((beginning-of-line))) 5172 ((eq position 'eol) '((end-of-line))) 5173 ((eq position 'bod) '((save-match-data 5174 (vhdl-beginning-of-defun)))) 5175 ((eq position 'boi) '((back-to-indentation))) 5176 ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t"))) 5177 ((eq position 'bonl) '((forward-line 1))) 5178 ((eq position 'bopl) '((forward-line -1))) 5179 ((eq position 'iopl) 5180 '((forward-line -1) 5181 (back-to-indentation))) 5182 ((eq position 'ionl) 5183 '((forward-line 1) 5184 (back-to-indentation))) 5185 (t (error "ERROR: Unknown buffer position requested: %s" position)) 5186 ) 5187 (prog1 5188 (point) 5189 (goto-char here)) 5190 ;; workaround for an Emacs18 bug -- blech! Well, at least it 5191 ;; doesn't hurt for v19 5192 ,@nil 5193 )) 5194 5195(defmacro vhdl-safe (&rest body) 5196 "Safely execute BODY, return nil if an error occurred." 5197 `(condition-case nil 5198 (progn ,@body) 5199 (error nil))) 5200 5201(defmacro vhdl-add-syntax (symbol &optional relpos) 5202 "A simple macro to append the syntax in SYMBOL to the syntax list. 5203Try to increase performance by using this macro." 5204 `(setq vhdl-syntactic-context 5205 (cons (cons ,symbol ,relpos) vhdl-syntactic-context))) 5206 5207(defmacro vhdl-has-syntax (symbol) 5208 "A simple macro to return check the syntax list. 5209Try to increase performance by using this macro." 5210 `(assoc ,symbol vhdl-syntactic-context)) 5211 5212;; Syntactic element offset manipulation: 5213 5214(defun vhdl-read-offset (langelem) 5215 "Read new offset value for LANGELEM from minibuffer. 5216Return a valid value only." 5217 (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) 5218 (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") 5219 (prompt "Offset: ") 5220 offset input interned) 5221 (while (not offset) 5222 (setq input (read-string prompt oldoff) 5223 offset (cond ((string-equal "+" input) '+) 5224 ((string-equal "-" input) '-) 5225 ((string-equal "++" input) '++) 5226 ((string-equal "--" input) '--) 5227 ((string-match "^-?[0-9]+$" input) 5228 (string-to-number input)) 5229 ((fboundp (setq interned (intern input))) 5230 interned) 5231 ((boundp interned) interned) 5232 ;; error, but don't signal one, keep trying 5233 ;; to read an input value 5234 (t (ding) 5235 (setq prompt errmsg) 5236 nil)))) 5237 offset)) 5238 5239(defun vhdl-set-offset (symbol offset &optional add-p) 5240 "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. 5241SYMBOL is the syntactic element symbol to change and OFFSET is the new 5242offset for that syntactic element. Optional ADD-P says to add SYMBOL to 5243`vhdl-offsets-alist' if it doesn't already appear there." 5244 (interactive 5245 (let* ((langelem 5246 (intern (completing-read 5247 (concat "Syntactic symbol to change" 5248 (if current-prefix-arg " or add" "") 5249 ": ") 5250 (mapcar 5251 (function 5252 (lambda (langelem) 5253 (cons (format "%s" (car langelem)) nil))) 5254 vhdl-offsets-alist) 5255 nil (not current-prefix-arg) 5256 ;; initial contents tries to be the last element 5257 ;; on the syntactic analysis list for the current 5258 ;; line 5259 (let* ((syntax (vhdl-get-syntactic-context)) 5260 (len (length syntax)) 5261 (ic (format "%s" (car (nth (1- len) syntax))))) 5262 ic) 5263 ))) 5264 (offset (vhdl-read-offset langelem))) 5265 (list langelem offset current-prefix-arg))) 5266 ;; sanity check offset 5267 (or (eq offset '+) 5268 (eq offset '-) 5269 (eq offset '++) 5270 (eq offset '--) 5271 (integerp offset) 5272 (fboundp offset) 5273 (boundp offset) 5274 (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" 5275 offset)) 5276 (let ((entry (assq symbol vhdl-offsets-alist))) 5277 (if entry 5278 (setcdr entry offset) 5279 (if add-p 5280 (setq vhdl-offsets-alist 5281 (cons (cons symbol offset) vhdl-offsets-alist)) 5282 (error "ERROR: %s is not a valid syntactic symbol" symbol)))) 5283 (vhdl-keep-region-active)) 5284 5285(defun vhdl-set-style (style &optional local) 5286 "Set `vhdl-mode' variables to use one of several different indentation styles. 5287STYLE is a string representing the desired style and optional LOCAL is 5288a flag which, if non-nil, means to make the style variables being 5289changed buffer local, instead of the default, which is to set the 5290global variables. Interactively, the flag comes from the prefix 5291argument. The styles are chosen from the `vhdl-style-alist' variable." 5292 (interactive (list (completing-read "Use which VHDL indentation style? " 5293 vhdl-style-alist nil t) 5294 current-prefix-arg)) 5295 (let ((vars (cdr (assoc style vhdl-style-alist)))) 5296 (or vars 5297 (error "ERROR: Invalid VHDL indentation style `%s'" style)) 5298 ;; set all the variables 5299 (mapcar 5300 (function 5301 (lambda (varentry) 5302 (let ((var (car varentry)) 5303 (val (cdr varentry))) 5304 (and local 5305 (make-local-variable var)) 5306 ;; special case for vhdl-offsets-alist 5307 (if (not (eq var 'vhdl-offsets-alist)) 5308 (set var val) 5309 ;; reset vhdl-offsets-alist to the default value first 5310 (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default)) 5311 ;; now set the langelems that are different 5312 (mapcar 5313 (function 5314 (lambda (langentry) 5315 (let ((langelem (car langentry)) 5316 (offset (cdr langentry))) 5317 (vhdl-set-offset langelem offset) 5318 ))) 5319 val)) 5320 ))) 5321 vars)) 5322 (vhdl-keep-region-active)) 5323 5324(defun vhdl-get-offset (langelem) 5325 "Get offset from LANGELEM which is a cons cell of the form: 5326\(SYMBOL . RELPOS). The symbol is matched against 5327vhdl-offsets-alist and the offset found there is either returned, 5328or added to the indentation at RELPOS. If RELPOS is nil, then 5329the offset is simply returned." 5330 (let* ((symbol (car langelem)) 5331 (relpos (cdr langelem)) 5332 (match (assq symbol vhdl-offsets-alist)) 5333 (offset (cdr-safe match))) 5334 ;; offset can be a number, a function, a variable, or one of the 5335 ;; symbols + or - 5336 (cond 5337 ((not match) 5338 (if vhdl-strict-syntax-p 5339 (error "ERROR: Don't know how to indent a %s" symbol) 5340 (setq offset 0 5341 relpos 0))) 5342 ((eq offset '+) (setq offset vhdl-basic-offset)) 5343 ((eq offset '-) (setq offset (- vhdl-basic-offset))) 5344 ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) 5345 ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) 5346 ((and (not (numberp offset)) 5347 (fboundp offset)) 5348 (setq offset (funcall offset langelem))) 5349 ((not (numberp offset)) 5350 (setq offset (eval offset))) 5351 ) 5352 (+ (if (and relpos 5353 (< relpos (vhdl-point 'bol))) 5354 (save-excursion 5355 (goto-char relpos) 5356 (current-column)) 5357 0) 5358 offset))) 5359 5360;; Syntactic support functions: 5361 5362(defun vhdl-in-comment-p () 5363 "Check if point is in a comment." 5364 (eq (vhdl-in-literal) 'comment)) 5365 5366(defun vhdl-in-string-p () 5367 "Check if point is in a string." 5368 (eq (vhdl-in-literal) 'string)) 5369 5370(defun vhdl-in-literal () 5371 "Determine if point is in a VHDL literal." 5372 (save-excursion 5373 (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) 5374 (cond 5375 ((nth 3 state) 'string) 5376 ((nth 4 state) 'comment) 5377 ((vhdl-beginning-of-macro) 'pound) 5378 (t nil))))) 5379 5380(defun vhdl-forward-comment (&optional direction) 5381 "Skip all comments (including whitespace). Skip backwards if DIRECTION is 5382negative, skip forward otherwise." 5383 (interactive "p") 5384 (if (and direction (< direction 0)) 5385 ;; skip backwards 5386 (progn 5387 (skip-chars-backward " \t\n") 5388 (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) 5389 (goto-char (match-beginning 3)) 5390 (skip-chars-backward " \t\n"))) 5391 ;; skip forwards 5392 (skip-chars-forward " \t\n") 5393 (while (looking-at "--.*") 5394 (goto-char (match-end 0)) 5395 (skip-chars-forward " \t\n")))) 5396 5397;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ 5398(unless (and vhdl-xemacs (string< "21.2" emacs-version)) 5399 (defalias 'vhdl-forward-comment 'forward-comment)) 5400 5401;; This is the best we can do in Win-Emacs. 5402(defun vhdl-win-il (&optional lim) 5403 "Determine if point is in a VHDL literal." 5404 (save-excursion 5405 (let* ((here (point)) 5406 (state nil) 5407 (match nil) 5408 (lim (or lim (vhdl-point 'bod)))) 5409 (goto-char lim ) 5410 (while (< (point) here) 5411 (setq match 5412 (and (re-search-forward "--\\|[\"']" 5413 here 'move) 5414 (buffer-substring (match-beginning 0) (match-end 0)))) 5415 (setq state 5416 (cond 5417 ;; no match 5418 ((null match) nil) 5419 ;; looking at the opening of a VHDL style comment 5420 ((string= "--" match) 5421 (if (<= here (progn (end-of-line) (point))) 'comment)) 5422 ;; looking at the opening of a double quote string 5423 ((string= "\"" match) 5424 (if (not (save-restriction 5425 ;; this seems to be necessary since the 5426 ;; re-search-forward will not work without it 5427 (narrow-to-region (point) here) 5428 (re-search-forward 5429 ;; this regexp matches a double quote 5430 ;; which is preceded by an even number 5431 ;; of backslashes, including zero 5432 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) 5433 'string)) 5434 ;; looking at the opening of a single quote string 5435 ((string= "'" match) 5436 (if (not (save-restriction 5437 ;; see comments from above 5438 (narrow-to-region (point) here) 5439 (re-search-forward 5440 ;; this matches a single quote which is 5441 ;; preceded by zero or two backslashes. 5442 "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" 5443 here 'move))) 5444 'string)) 5445 (t nil))) 5446 ) ; end-while 5447 state))) 5448 5449(and (string-match "Win-Emacs" emacs-version) 5450 (fset 'vhdl-in-literal 'vhdl-win-il)) 5451 5452;; Skipping of "syntactic whitespace". Syntactic whitespace is 5453;; defined as lexical whitespace or comments. Search no farther back 5454;; or forward than optional LIM. If LIM is omitted, (point-min) is 5455;; used for backward skipping, (point-max) is used for forward 5456;; skipping. 5457 5458(defun vhdl-forward-syntactic-ws (&optional lim) 5459 "Forward skip of syntactic whitespace." 5460 (let* ((here (point-max)) 5461 (hugenum (point-max))) 5462 (while (/= here (point)) 5463 (setq here (point)) 5464 (vhdl-forward-comment hugenum) 5465 ;; skip preprocessor directives 5466 (when (and (eq (char-after) ?#) 5467 (= (vhdl-point 'boi) (point))) 5468 (while (and (eq (char-before (vhdl-point 'eol)) ?\\) 5469 (= (forward-line 1) 0))) 5470 (end-of-line))) 5471 (if lim (goto-char (min (point) lim))))) 5472 5473 5474;; This is the best we can do in Win-Emacs. 5475(defun vhdl-win-fsws (&optional lim) 5476 "Forward skip syntactic whitespace for Win-Emacs." 5477 (let ((lim (or lim (point-max))) 5478 stop) 5479 (while (not stop) 5480 (skip-chars-forward " \t\n\r\f" lim) 5481 (cond 5482 ;; vhdl comment 5483 ((looking-at "--") (end-of-line)) 5484 ;; none of the above 5485 (t (setq stop t)))))) 5486 5487(and (string-match "Win-Emacs" emacs-version) 5488 (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) 5489 5490(defun vhdl-beginning-of-macro (&optional lim) 5491 "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." 5492 (let ((here (point))) 5493 (beginning-of-line) 5494 (while (eq (char-before (1- (point))) ?\\) 5495 (forward-line -1)) 5496 (back-to-indentation) 5497 (if (and (<= (point) here) 5498 (eq (char-after) ?#)) 5499 t 5500 (goto-char here) 5501 nil))) 5502 5503(defun vhdl-backward-syntactic-ws (&optional lim) 5504 "Backward skip over syntactic whitespace." 5505 (let* ((here (point-min)) 5506 (hugenum (- (point-max)))) 5507 (while (/= here (point)) 5508 (setq here (point)) 5509 (vhdl-forward-comment hugenum) 5510 (vhdl-beginning-of-macro)) 5511 (if lim (goto-char (max (point) lim))))) 5512 5513;; This is the best we can do in Win-Emacs. 5514(defun vhdl-win-bsws (&optional lim) 5515 "Backward skip syntactic whitespace for Win-Emacs." 5516 (let ((lim (or lim (vhdl-point 'bod))) 5517 stop) 5518 (while (not stop) 5519 (skip-chars-backward " \t\n\r\f" lim) 5520 (cond 5521 ;; vhdl comment 5522 ((eq (vhdl-in-literal) 'comment) 5523 (skip-chars-backward "^-" lim) 5524 (skip-chars-backward "-" lim) 5525 (while (not (or (and (= (following-char) ?-) 5526 (= (char-after (1+ (point))) ?-)) 5527 (<= (point) lim))) 5528 (skip-chars-backward "^-" lim) 5529 (skip-chars-backward "-" lim))) 5530 ;; none of the above 5531 (t (setq stop t)))))) 5532 5533(and (string-match "Win-Emacs" emacs-version) 5534 (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) 5535 5536;; Functions to help finding the correct indentation column: 5537 5538(defun vhdl-first-word (point) 5539 "If the keyword at POINT is at boi, then return (current-column) at 5540that point, else nil." 5541 (save-excursion 5542 (and (goto-char point) 5543 (eq (point) (vhdl-point 'boi)) 5544 (current-column)))) 5545 5546(defun vhdl-last-word (point) 5547 "If the keyword at POINT is at eoi, then return (current-column) at 5548that point, else nil." 5549 (save-excursion 5550 (and (goto-char point) 5551 (save-excursion (or (eq (progn (forward-sexp) (point)) 5552 (vhdl-point 'eoi)) 5553 (looking-at "\\s-*\\(--\\)?"))) 5554 (current-column)))) 5555 5556;; Core syntactic evaluation functions: 5557 5558(defconst vhdl-libunit-re 5559 "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]") 5560 5561(defun vhdl-libunit-p () 5562 (and 5563 (save-excursion 5564 (forward-sexp) 5565 (skip-chars-forward " \t\n") 5566 (not (looking-at "is\\b[^_]"))) 5567 (save-excursion 5568 (backward-sexp) 5569 (and (not (looking-at "use\\b[^_]")) 5570 (progn 5571 (forward-sexp) 5572 (vhdl-forward-syntactic-ws) 5573 (/= (following-char) ?:)))) 5574 )) 5575 5576(defconst vhdl-defun-re 5577 "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") 5578 5579(defun vhdl-defun-p () 5580 (save-excursion 5581 (if (looking-at "block\\|process\\|procedural") 5582 ;; "block", "process", "procedural": 5583 (save-excursion 5584 (backward-sexp) 5585 (not (looking-at "end\\s-+\\w"))) 5586 ;; "architecture", "configuration", "entity", 5587 ;; "package", "procedure", "function": 5588 t))) 5589 5590(defun vhdl-corresponding-defun () 5591 "If the word at the current position corresponds to a \"defun\" 5592keyword, then return a string that can be used to find the 5593corresponding \"begin\" keyword, else return nil." 5594 (save-excursion 5595 (and (looking-at vhdl-defun-re) 5596 (vhdl-defun-p) 5597 (if (looking-at "block\\|process\\|procedural") 5598 ;; "block", "process". "procedural: 5599 (buffer-substring (match-beginning 0) (match-end 0)) 5600 ;; "architecture", "configuration", "entity", "package", 5601 ;; "procedure", "function": 5602 "is")))) 5603 5604(defconst vhdl-begin-fwd-re 5605 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b\\([^_]\\|\\'\\)" 5606 "A regular expression for searching forward that matches all known 5607\"begin\" keywords.") 5608 5609(defconst vhdl-begin-bwd-re 5610 "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\|units\\|record\\|for\\)\\b[^_]" 5611 "A regular expression for searching backward that matches all known 5612\"begin\" keywords.") 5613 5614(defun vhdl-begin-p (&optional lim) 5615 "Return t if we are looking at a real \"begin\" keyword. 5616Assumes that the caller will make sure that we are looking at 5617vhdl-begin-fwd-re, and are not inside a literal, and that we are not in 5618the middle of an identifier that just happens to contain a \"begin\" 5619keyword." 5620 (cond 5621 ;; "[architecture|case|configuration|entity|package| 5622 ;; procedure|function] ... is": 5623 ((and (looking-at "i") 5624 (save-excursion 5625 ;; Skip backward over first sexp (needed to skip over a 5626 ;; procedure interface list, and is harmless in other 5627 ;; situations). Note that we need "return" in the 5628 ;; following search list so that we don't run into 5629 ;; semicolons in the function interface list. 5630 (backward-sexp) 5631 (let (foundp) 5632 (while (and (not foundp) 5633 (re-search-backward 5634 ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" 5635 lim 'move)) 5636 (if (or (= (preceding-char) ?_) 5637 (vhdl-in-literal)) 5638 (backward-char) 5639 (setq foundp t)))) 5640 (and (/= (following-char) ?\;) 5641 (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) 5642 t) 5643 ;; "begin", "then": 5644 ((looking-at "be\\|t") 5645 t) 5646 ;; "else": 5647 ((and (looking-at "e") 5648 ;; make sure that the "else" isn't inside a 5649 ;; conditional signal assignment. 5650 (save-excursion 5651 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 5652 (or (eq (following-char) ?\;) 5653 (eq (point) lim)))) 5654 t) 5655 ;; "block", "generate", "loop", "process", "procedural", 5656 ;; "units", "record": 5657 ((and (looking-at "bl\\|[glpur]") 5658 (save-excursion 5659 (backward-sexp) 5660 (not (looking-at "end\\s-+\\w")))) 5661 t) 5662 ;; "component": 5663 ((and (looking-at "c") 5664 (save-excursion 5665 (backward-sexp) 5666 (not (looking-at "end\\s-+\\w"))) 5667 ;; look out for the dreaded entity class in an attribute 5668 (save-excursion 5669 (vhdl-backward-syntactic-ws lim) 5670 (/= (preceding-char) ?:))) 5671 t) 5672 ;; "for" (inside configuration declaration): 5673 ((and (looking-at "f") 5674 (save-excursion 5675 (backward-sexp) 5676 (not (looking-at "end\\s-+\\w"))) 5677 (vhdl-has-syntax 'configuration)) 5678 t) 5679 )) 5680 5681(defun vhdl-corresponding-mid (&optional lim) 5682 (cond 5683 ((looking-at "is\\|block\\|generate\\|process\\|procedural") 5684 "begin") 5685 ((looking-at "then") 5686 "<else>") 5687 (t 5688 "end"))) 5689 5690(defun vhdl-corresponding-end (&optional lim) 5691 "If the word at the current position corresponds to a \"begin\" 5692keyword, then return a vector containing enough information to find 5693the corresponding \"end\" keyword, else return nil. The keyword to 5694search forward for is aref 0. The column in which the keyword must 5695appear is aref 1 or nil if any column is suitable. 5696Assumes that the caller will make sure that we are not in the middle 5697of an identifier that just happens to contain a \"begin\" keyword." 5698 (save-excursion 5699 (and (looking-at vhdl-begin-fwd-re) 5700 (/= (preceding-char) ?_) 5701 (not (vhdl-in-literal)) 5702 (vhdl-begin-p lim) 5703 (cond 5704 ;; "is", "generate", "loop": 5705 ((looking-at "[igl]") 5706 (vector "end" 5707 (and (vhdl-last-word (point)) 5708 (or (vhdl-first-word (point)) 5709 (save-excursion 5710 (vhdl-beginning-of-statement-1 lim) 5711 (vhdl-backward-skip-label lim) 5712 (vhdl-first-word (point))))))) 5713 ;; "begin", "else", "for": 5714 ((looking-at "be\\|[ef]") 5715 (vector "end" 5716 (and (vhdl-last-word (point)) 5717 (or (vhdl-first-word (point)) 5718 (save-excursion 5719 (vhdl-beginning-of-statement-1 lim) 5720 (vhdl-backward-skip-label lim) 5721 (vhdl-first-word (point))))))) 5722 ;; "component", "units", "record": 5723 ((looking-at "[cur]") 5724 ;; The first end found will close the block 5725 (vector "end" nil)) 5726 ;; "block", "process", "procedural": 5727 ((looking-at "bl\\|p") 5728 (vector "end" 5729 (or (vhdl-first-word (point)) 5730 (save-excursion 5731 (vhdl-beginning-of-statement-1 lim) 5732 (vhdl-backward-skip-label lim) 5733 (vhdl-first-word (point)))))) 5734 ;; "then": 5735 ((looking-at "t") 5736 (vector "elsif\\|else\\|end\\s-+if" 5737 (and (vhdl-last-word (point)) 5738 (or (vhdl-first-word (point)) 5739 (save-excursion 5740 (vhdl-beginning-of-statement-1 lim) 5741 (vhdl-backward-skip-label lim) 5742 (vhdl-first-word (point))))))) 5743 )))) 5744 5745(defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") 5746 5747(defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") 5748 5749(defun vhdl-end-p (&optional lim) 5750 "Return t if we are looking at a real \"end\" keyword. 5751Assumes that the caller will make sure that we are looking at 5752vhdl-end-fwd-re, and are not inside a literal, and that we are not in 5753the middle of an identifier that just happens to contain an \"end\" 5754keyword." 5755 (or (not (looking-at "else")) 5756 ;; make sure that the "else" isn't inside a conditional signal 5757 ;; assignment. 5758 (save-excursion 5759 (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) 5760 (or (eq (following-char) ?\;) 5761 (eq (point) lim) 5762 (vhdl-in-literal))))) 5763 5764(defun vhdl-corresponding-begin (&optional lim) 5765 "If the word at the current position corresponds to an \"end\" 5766keyword, then return a vector containing enough information to find 5767the corresponding \"begin\" keyword, else return nil. The keyword to 5768search backward for is aref 0. The column in which the keyword must 5769appear is aref 1 or nil if any column is suitable. The supplementary 5770keyword to search forward for is aref 2 or nil if this is not 5771required. If aref 3 is t, then the \"begin\" keyword may be found in 5772the middle of a statement. 5773Assumes that the caller will make sure that we are not in the middle 5774of an identifier that just happens to contain an \"end\" keyword." 5775 (save-excursion 5776 (let (pos) 5777 (if (and (looking-at vhdl-end-fwd-re) 5778 (not (vhdl-in-literal)) 5779 (vhdl-end-p lim)) 5780 (if (looking-at "el") 5781 ;; "else", "elsif": 5782 (vector "if\\|elsif" (vhdl-first-word (point)) "then" nil) 5783 ;; "end ...": 5784 (setq pos (point)) 5785 (forward-sexp) 5786 (skip-chars-forward " \t\n") 5787 (cond 5788 ;; "end if": 5789 ((looking-at "if\\b[^_]") 5790 (vector "else\\|elsif\\|if" 5791 (vhdl-first-word pos) 5792 "else\\|then" nil)) 5793 ;; "end component": 5794 ((looking-at "component\\b[^_]") 5795 (vector (buffer-substring (match-beginning 1) 5796 (match-end 1)) 5797 (vhdl-first-word pos) 5798 nil nil)) 5799 ;; "end units", "end record": 5800 ((looking-at "\\(units\\|record\\)\\b[^_]") 5801 (vector (buffer-substring (match-beginning 1) 5802 (match-end 1)) 5803 (vhdl-first-word pos) 5804 nil t)) 5805 ;; "end block", "end process", "end procedural": 5806 ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") 5807 (vector "begin" (vhdl-first-word pos) nil nil)) 5808 ;; "end case": 5809 ((looking-at "case\\b[^_]") 5810 (vector "case" (vhdl-first-word pos) "is" nil)) 5811 ;; "end generate": 5812 ((looking-at "generate\\b[^_]") 5813 (vector "generate\\|for\\|if" 5814 (vhdl-first-word pos) 5815 "generate" nil)) 5816 ;; "end loop": 5817 ((looking-at "loop\\b[^_]") 5818 (vector "loop\\|while\\|for" 5819 (vhdl-first-word pos) 5820 "loop" nil)) 5821 ;; "end for" (inside configuration declaration): 5822 ((looking-at "for\\b[^_]") 5823 (vector "for" (vhdl-first-word pos) nil nil)) 5824 ;; "end [id]": 5825 (t 5826 (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function" 5827 (vhdl-first-word pos) 5828 ;; return an alist of (statement . keyword) mappings 5829 '( 5830 ;; "begin ... end [id]": 5831 ("begin" . nil) 5832 ;; "architecture ... is ... begin ... end [id]": 5833 ("architecture" . "is") 5834 ;; "configuration ... is ... end [id]": 5835 ("configuration" . "is") 5836 ;; "entity ... is ... end [id]": 5837 ("entity" . "is") 5838 ;; "package ... is ... end [id]": 5839 ("package" . "is") 5840 ;; "procedure ... is ... begin ... end [id]": 5841 ("procedure" . "is") 5842 ;; "function ... is ... begin ... end [id]": 5843 ("function" . "is") 5844 ) 5845 nil)) 5846 ))) ; "end ..." 5847 ))) 5848 5849(defconst vhdl-leader-re 5850 "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") 5851 5852(defun vhdl-end-of-leader () 5853 (save-excursion 5854 (cond ((looking-at "block\\|process\\|procedural") 5855 (if (save-excursion 5856 (forward-sexp) 5857 (skip-chars-forward " \t\n") 5858 (= (following-char) ?\()) 5859 (forward-sexp 2) 5860 (forward-sexp)) 5861 (when (looking-at "[ \t\n]*is") 5862 (goto-char (match-end 0))) 5863 (point)) 5864 ((looking-at "component") 5865 (forward-sexp 2) 5866 (when (looking-at "[ \t\n]*is") 5867 (goto-char (match-end 0))) 5868 (point)) 5869 ((looking-at "for") 5870 (forward-sexp 2) 5871 (skip-chars-forward " \t\n") 5872 (while (looking-at "[,:(]") 5873 (forward-sexp) 5874 (skip-chars-forward " \t\n")) 5875 (point)) 5876 (t nil) 5877 ))) 5878 5879(defconst vhdl-trailer-re 5880 "\\b\\(is\\|then\\|generate\\|loop\\|record\\)\\b[^_]") 5881 5882(defconst vhdl-statement-fwd-re 5883 "\\b\\(if\\|for\\|while\\)\\b\\([^_]\\|\\'\\)" 5884 "A regular expression for searching forward that matches all known 5885\"statement\" keywords.") 5886 5887(defconst vhdl-statement-bwd-re 5888 "\\b\\(if\\|for\\|while\\)\\b[^_]" 5889 "A regular expression for searching backward that matches all known 5890\"statement\" keywords.") 5891 5892(defun vhdl-statement-p (&optional lim) 5893 "Return t if we are looking at a real \"statement\" keyword. 5894Assumes that the caller will make sure that we are looking at 5895vhdl-statement-fwd-re, and are not inside a literal, and that we are not 5896in the middle of an identifier that just happens to contain a 5897\"statement\" keyword." 5898 (cond 5899 ;; "for" ... "generate": 5900 ((and (looking-at "f") 5901 ;; Make sure it's the start of a parameter specification. 5902 (save-excursion 5903 (forward-sexp 2) 5904 (skip-chars-forward " \t\n") 5905 (looking-at "in\\b[^_]")) 5906 ;; Make sure it's not an "end for". 5907 (save-excursion 5908 (backward-sexp) 5909 (not (looking-at "end\\s-+\\w")))) 5910 t) 5911 ;; "if" ... "then", "if" ... "generate", "if" ... "loop": 5912 ((and (looking-at "i") 5913 ;; Make sure it's not an "end if". 5914 (save-excursion 5915 (backward-sexp) 5916 (not (looking-at "end\\s-+\\w")))) 5917 t) 5918 ;; "while" ... "loop": 5919 ((looking-at "w") 5920 t) 5921 )) 5922 5923(defconst vhdl-case-alternative-re "when[( \t\n][^;=>]+=>" 5924 "Regexp describing a case statement alternative key.") 5925 5926(defun vhdl-case-alternative-p (&optional lim) 5927 "Return t if we are looking at a real case alternative. 5928Assumes that the caller will make sure that we are looking at 5929vhdl-case-alternative-re, and are not inside a literal, and that 5930we are not in the middle of an identifier that just happens to 5931contain a \"when\" keyword." 5932 (save-excursion 5933 (let (foundp) 5934 (while (and (not foundp) 5935 (re-search-backward ";\\|<=" lim 'move)) 5936 (if (or (= (preceding-char) ?_) 5937 (vhdl-in-literal)) 5938 (backward-char) 5939 (setq foundp t))) 5940 (or (eq (following-char) ?\;) 5941 (eq (point) lim))) 5942 )) 5943 5944;; Core syntactic movement functions: 5945 5946(defconst vhdl-b-t-b-re 5947 (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) 5948 5949(defun vhdl-backward-to-block (&optional lim) 5950 "Move backward to the previous \"begin\" or \"end\" keyword." 5951 (let (foundp) 5952 (while (and (not foundp) 5953 (re-search-backward vhdl-b-t-b-re lim 'move)) 5954 (if (or (= (preceding-char) ?_) 5955 (vhdl-in-literal)) 5956 (backward-char) 5957 (cond 5958 ;; "begin" keyword: 5959 ((and (looking-at vhdl-begin-fwd-re) 5960 (/= (preceding-char) ?_) 5961 (vhdl-begin-p lim)) 5962 (setq foundp 'begin)) 5963 ;; "end" keyword: 5964 ((and (looking-at vhdl-end-fwd-re) 5965 (/= (preceding-char) ?_) 5966 (vhdl-end-p lim)) 5967 (setq foundp 'end)) 5968 )) 5969 ) 5970 foundp 5971 )) 5972 5973(defun vhdl-forward-sexp (&optional count lim) 5974 "Move forward across one balanced expression (sexp). 5975With COUNT, do it that many times." 5976 (interactive "p") 5977 (let ((count (or count 1)) 5978 (case-fold-search t) 5979 end-vec target) 5980 (save-excursion 5981 (while (> count 0) 5982 ;; skip whitespace 5983 (skip-chars-forward " \t\n") 5984 ;; Check for an unbalanced "end" keyword 5985 (if (and (looking-at vhdl-end-fwd-re) 5986 (/= (preceding-char) ?_) 5987 (not (vhdl-in-literal)) 5988 (vhdl-end-p lim) 5989 (not (looking-at "else"))) 5990 (error 5991 "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) 5992 ;; If the current keyword is a "begin" keyword, then find the 5993 ;; corresponding "end" keyword. 5994 (if (setq end-vec (vhdl-corresponding-end lim)) 5995 (let ( 5996 ;; end-re is the statement keyword to search for 5997 (end-re 5998 (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) 5999 ;; column is either the statement keyword target column 6000 ;; or nil 6001 (column (aref end-vec 1)) 6002 (eol (vhdl-point 'eol)) 6003 foundp literal placeholder) 6004 ;; Look for the statement keyword. 6005 (while (and (not foundp) 6006 (re-search-forward end-re nil t) 6007 (setq placeholder (match-end 1)) 6008 (goto-char (match-beginning 0))) 6009 ;; If we are in a literal, or not in the right target 6010 ;; column and not on the same line as the begin, then 6011 ;; try again. 6012 (if (or (and column 6013 (/= (current-indentation) column) 6014 (> (point) eol)) 6015 (= (preceding-char) ?_) 6016 (setq literal (vhdl-in-literal))) 6017 (if (eq literal 'comment) 6018 (end-of-line) 6019 (forward-char)) 6020 ;; An "else" keyword corresponds to both the opening brace 6021 ;; of the following sexp and the closing brace of the 6022 ;; previous sexp. 6023 (if (not (looking-at "else")) 6024 (goto-char placeholder)) 6025 (setq foundp t)) 6026 ) 6027 (if (not foundp) 6028 (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) 6029 ) 6030 ;; If the current keyword is not a "begin" keyword, then just 6031 ;; perform the normal forward-sexp. 6032 (forward-sexp) 6033 ) 6034 (setq count (1- count)) 6035 ) 6036 (setq target (point))) 6037 (goto-char target) 6038 nil)) 6039 6040(defun vhdl-backward-sexp (&optional count lim) 6041 "Move backward across one balanced expression (sexp). 6042With COUNT, do it that many times. LIM bounds any required backward 6043searches." 6044 (interactive "p") 6045 (let ((count (or count 1)) 6046 (case-fold-search t) 6047 begin-vec target) 6048 (save-excursion 6049 (while (> count 0) 6050 ;; Perform the normal backward-sexp, unless we are looking at 6051 ;; "else" - an "else" keyword corresponds to both the opening brace 6052 ;; of the following sexp and the closing brace of the previous sexp. 6053 (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") 6054 (/= (preceding-char) ?_) 6055 (not (vhdl-in-literal))) 6056 nil 6057 (backward-sexp) 6058 (if (and (looking-at vhdl-begin-fwd-re) 6059 (/= (preceding-char) ?_) 6060 (not (vhdl-in-literal)) 6061 (vhdl-begin-p lim)) 6062 (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) 6063 ;; If the current keyword is an "end" keyword, then find the 6064 ;; corresponding "begin" keyword. 6065 (if (and (setq begin-vec (vhdl-corresponding-begin lim)) 6066 (/= (preceding-char) ?_)) 6067 (let ( 6068 ;; begin-re is the statement keyword to search for 6069 (begin-re 6070 (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) 6071 ;; column is either the statement keyword target column 6072 ;; or nil 6073 (column (aref begin-vec 1)) 6074 ;; internal-p controls where the statement keyword can 6075 ;; be found. 6076 (internal-p (aref begin-vec 3)) 6077 (last-backward (point)) last-forward 6078 foundp literal keyword) 6079 ;; Look for the statement keyword. 6080 (while (and (not foundp) 6081 (re-search-backward begin-re lim t) 6082 (setq keyword 6083 (buffer-substring (match-beginning 1) 6084 (match-end 1)))) 6085 ;; If we are in a literal or in the wrong column, 6086 ;; then try again. 6087 (if (or (and column 6088 (and (/= (current-indentation) column) 6089 ;; possibly accept current-column as 6090 ;; well as current-indentation. 6091 (or (not internal-p) 6092 (/= (current-column) column)))) 6093 (= (preceding-char) ?_) 6094 (vhdl-in-literal)) 6095 (backward-char) 6096 ;; If there is a supplementary keyword, then 6097 ;; search forward for it. 6098 (if (and (setq begin-re (aref begin-vec 2)) 6099 (or (not (listp begin-re)) 6100 ;; If begin-re is an alist, then find the 6101 ;; element corresponding to the actual 6102 ;; keyword that we found. 6103 (progn 6104 (setq begin-re 6105 (assoc keyword begin-re)) 6106 (and begin-re 6107 (setq begin-re (cdr begin-re)))))) 6108 (and 6109 (setq begin-re 6110 (concat "\\b\\(" begin-re "\\)\\b[^_]")) 6111 (save-excursion 6112 (setq last-forward (point)) 6113 ;; Look for the supplementary keyword 6114 ;; (bounded by the backward search start 6115 ;; point). 6116 (while (and (not foundp) 6117 (re-search-forward begin-re 6118 last-backward t) 6119 (goto-char (match-beginning 1))) 6120 ;; If we are in a literal, then try again. 6121 (if (or (= (preceding-char) ?_) 6122 (setq literal 6123 (vhdl-in-literal))) 6124 (if (eq literal 'comment) 6125 (goto-char 6126 (min (vhdl-point 'eol) last-backward)) 6127 (forward-char)) 6128 ;; We have found the supplementary keyword. 6129 ;; Save the position of the keyword in foundp. 6130 (setq foundp (point))) 6131 ) 6132 foundp) 6133 ;; If the supplementary keyword was found, then 6134 ;; move point to the supplementary keyword. 6135 (goto-char foundp)) 6136 ;; If there was no supplementary keyword, then 6137 ;; point is already at the statement keyword. 6138 (setq foundp t))) 6139 ) ; end of the search for the statement keyword 6140 (if (not foundp) 6141 (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) 6142 )) 6143 (setq count (1- count)) 6144 ) 6145 (setq target (point))) 6146 (goto-char target) 6147 nil)) 6148 6149(defun vhdl-backward-up-list (&optional count limit) 6150 "Move backward out of one level of blocks. 6151With argument, do this that many times." 6152 (interactive "p") 6153 (let ((count (or count 1)) 6154 target) 6155 (save-excursion 6156 (while (> count 0) 6157 (if (looking-at vhdl-defun-re) 6158 (error "ERROR: Unbalanced blocks")) 6159 (vhdl-backward-to-block limit) 6160 (setq count (1- count))) 6161 (setq target (point))) 6162 (goto-char target))) 6163 6164(defun vhdl-end-of-defun (&optional count) 6165 "Move forward to the end of a VHDL defun." 6166 (interactive) 6167 (let ((case-fold-search t)) 6168 (vhdl-beginning-of-defun) 6169 (if (not (looking-at "block\\|process\\|procedural")) 6170 (re-search-forward "\\bis\\b")) 6171 (vhdl-forward-sexp))) 6172 6173(defun vhdl-mark-defun () 6174 "Put mark at end of this \"defun\", point at beginning." 6175 (interactive) 6176 (let ((case-fold-search t)) 6177 (push-mark) 6178 (vhdl-beginning-of-defun) 6179 (push-mark) 6180 (if (not (looking-at "block\\|process\\|procedural")) 6181 (re-search-forward "\\bis\\b")) 6182 (vhdl-forward-sexp) 6183 (exchange-point-and-mark))) 6184 6185(defun vhdl-beginning-of-libunit () 6186 "Move backward to the beginning of a VHDL library unit. 6187Returns the location of the corresponding begin keyword, unless search 6188stops due to beginning or end of buffer. 6189Note that if point is between the \"libunit\" keyword and the 6190corresponding \"begin\" keyword, then that libunit will not be 6191recognized, and the search will continue backwards. If point is 6192at the \"begin\" keyword, then the defun will be recognized. The 6193returned point is at the first character of the \"libunit\" keyword." 6194 (let ((last-forward (point)) 6195 (last-backward 6196 ;; Just in case we are actually sitting on the "begin" 6197 ;; keyword, allow for the keyword and an extra character, 6198 ;; as this will be used when looking forward for the 6199 ;; "begin" keyword. 6200 (save-excursion (forward-word 1) (1+ (point)))) 6201 foundp literal placeholder) 6202 ;; Find the "libunit" keyword. 6203 (while (and (not foundp) 6204 (re-search-backward vhdl-libunit-re nil 'move)) 6205 ;; If we are in a literal, or not at a real libunit, then try again. 6206 (if (or (= (preceding-char) ?_) 6207 (vhdl-in-literal) 6208 (not (vhdl-libunit-p))) 6209 (backward-char) 6210 ;; Find the corresponding "begin" keyword. 6211 (setq last-forward (point)) 6212 (while (and (not foundp) 6213 (re-search-forward "\\bis\\b[^_]" last-backward t) 6214 (setq placeholder (match-beginning 0))) 6215 (if (or (= (preceding-char) ?_) 6216 (setq literal (vhdl-in-literal))) 6217 ;; It wasn't a real keyword, so keep searching. 6218 (if (eq literal 'comment) 6219 (goto-char 6220 (min (vhdl-point 'eol) last-backward)) 6221 (forward-char)) 6222 ;; We have found the begin keyword, loop will exit. 6223 (setq foundp placeholder))) 6224 ;; Go back to the libunit keyword 6225 (goto-char last-forward))) 6226 foundp)) 6227 6228(defun vhdl-beginning-of-defun (&optional count) 6229 "Move backward to the beginning of a VHDL defun. 6230With argument, do it that many times. 6231Returns the location of the corresponding begin keyword, unless search 6232stops due to beginning or end of buffer." 6233 ;; Note that if point is between the "defun" keyword and the 6234 ;; corresponding "begin" keyword, then that defun will not be 6235 ;; recognized, and the search will continue backwards. If point is 6236 ;; at the "begin" keyword, then the defun will be recognized. The 6237 ;; returned point is at the first character of the "defun" keyword. 6238 (interactive "p") 6239 (let ((count (or count 1)) 6240 (case-fold-search t) 6241 (last-forward (point)) 6242 foundp) 6243 (while (> count 0) 6244 (setq foundp nil) 6245 (goto-char last-forward) 6246 (let ((last-backward 6247 ;; Just in case we are actually sitting on the "begin" 6248 ;; keyword, allow for the keyword and an extra character, 6249 ;; as this will be used when looking forward for the 6250 ;; "begin" keyword. 6251 (save-excursion (forward-word 1) (1+ (point)))) 6252 begin-string literal) 6253 (while (and (not foundp) 6254 (re-search-backward vhdl-defun-re nil 'move)) 6255 ;; If we are in a literal, then try again. 6256 (if (or (= (preceding-char) ?_) 6257 (vhdl-in-literal)) 6258 (backward-char) 6259 (if (setq begin-string (vhdl-corresponding-defun)) 6260 ;; This is a real defun keyword. 6261 ;; Find the corresponding "begin" keyword. 6262 ;; Look for the begin keyword. 6263 (progn 6264 ;; Save the search start point. 6265 (setq last-forward (point)) 6266 (while (and (not foundp) 6267 (search-forward begin-string last-backward t)) 6268 (if (or (= (preceding-char) ?_) 6269 (save-match-data 6270 (setq literal (vhdl-in-literal)))) 6271 ;; It wasn't a real keyword, so keep searching. 6272 (if (eq literal 'comment) 6273 (goto-char 6274 (min (vhdl-point 'eol) last-backward)) 6275 (forward-char)) 6276 ;; We have found the begin keyword, loop will exit. 6277 (setq foundp (match-beginning 0))) 6278 ) 6279 ;; Go back to the defun keyword 6280 (goto-char last-forward)) ; end search for begin keyword 6281 )) 6282 ) ; end of the search for the defun keyword 6283 ) 6284 (setq count (1- count)) 6285 ) 6286 (vhdl-keep-region-active) 6287 foundp)) 6288 6289(defun vhdl-beginning-of-statement (&optional count lim interactive) 6290 "Go to the beginning of the innermost VHDL statement. 6291With prefix arg, go back N - 1 statements. If already at the 6292beginning of a statement then go to the beginning of the preceding 6293one. If within a string or comment, or next to a comment (only 6294whitespace between), move by sentences instead of statements. 6295 6296When called from a program, this function takes 3 optional args: the 6297prefix arg, a buffer position limit which is the farthest back to 6298search, and an argument indicating an interactive call." 6299 (interactive "p\np") 6300 (let ((count (or count 1)) 6301 (case-fold-search t) 6302 (lim (or lim (point-min))) 6303 (here (point)) 6304 state) 6305 (save-excursion 6306 (goto-char lim) 6307 (setq state (parse-partial-sexp (point) here nil nil))) 6308 (if (and interactive 6309 (or (nth 3 state) 6310 (nth 4 state) 6311 (looking-at (concat "[ \t]*" comment-start-skip)))) 6312 (forward-sentence (- count)) 6313 (while (> count 0) 6314 (vhdl-beginning-of-statement-1 lim) 6315 (setq count (1- count)))) 6316 ;; its possible we've been left up-buf of lim 6317 (goto-char (max (point) lim)) 6318 ) 6319 (vhdl-keep-region-active)) 6320 6321(defconst vhdl-e-o-s-re 6322 (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) 6323 6324(defun vhdl-end-of-statement () 6325 "Very simple implementation." 6326 (interactive) 6327 (re-search-forward vhdl-e-o-s-re)) 6328 6329(defconst vhdl-b-o-s-re 6330 (concat ";\\|\(\\|\)\\|\\bwhen\\b[^_]\\|" 6331 vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) 6332 6333(defun vhdl-beginning-of-statement-1 (&optional lim) 6334 "Move to the start of the current statement, or the previous 6335statement if already at the beginning of one." 6336 (let ((lim (or lim (point-min))) 6337 (here (point)) 6338 (pos (point)) 6339 donep) 6340 ;; go backwards one balanced expression, but be careful of 6341 ;; unbalanced paren being reached 6342 (if (not (vhdl-safe (progn (backward-sexp) t))) 6343 (progn 6344 (backward-up-list 1) 6345 (forward-char) 6346 (vhdl-forward-syntactic-ws here) 6347 (setq donep t))) 6348 (while (and (not donep) 6349 (not (bobp)) 6350 ;; look backwards for a statement boundary 6351 (re-search-backward vhdl-b-o-s-re lim 'move)) 6352 (if (or (= (preceding-char) ?_) 6353 (vhdl-in-literal)) 6354 (backward-char) 6355 (cond 6356 ;; If we are looking at an open paren, then stop after it 6357 ((eq (following-char) ?\() 6358 (forward-char) 6359 (vhdl-forward-syntactic-ws here) 6360 (setq donep t)) 6361 ;; If we are looking at a close paren, then skip it 6362 ((eq (following-char) ?\)) 6363 (forward-char) 6364 (setq pos (point)) 6365 (backward-sexp) 6366 (if (< (point) lim) 6367 (progn (goto-char pos) 6368 (vhdl-forward-syntactic-ws here) 6369 (setq donep t)))) 6370 ;; If we are looking at a semicolon, then stop 6371 ((eq (following-char) ?\;) 6372 (progn 6373 (forward-char) 6374 (vhdl-forward-syntactic-ws here) 6375 (setq donep t))) 6376 ;; If we are looking at a "begin", then stop 6377 ((and (looking-at vhdl-begin-fwd-re) 6378 (/= (preceding-char) ?_) 6379 (vhdl-begin-p nil)) 6380 ;; If it's a leader "begin", then find the 6381 ;; right place 6382 (if (looking-at vhdl-leader-re) 6383 (save-excursion 6384 ;; set a default stop point at the begin 6385 (setq pos (point)) 6386 ;; is the start point inside the leader area ? 6387 (goto-char (vhdl-end-of-leader)) 6388 (vhdl-forward-syntactic-ws here) 6389 (if (< (point) here) 6390 ;; start point was not inside leader area 6391 ;; set stop point at word after leader 6392 (setq pos (point)))) 6393 (forward-word 1) 6394 (vhdl-forward-syntactic-ws here) 6395 (setq pos (point))) 6396 (goto-char pos) 6397 (setq donep t)) 6398 ;; If we are looking at a "statement", then stop 6399 ((and (looking-at vhdl-statement-fwd-re) 6400 (/= (preceding-char) ?_) 6401 (vhdl-statement-p nil)) 6402 (setq donep t)) 6403 ;; If we are looking at a case alternative key, then stop 6404 ((and (looking-at vhdl-case-alternative-re) 6405 (vhdl-case-alternative-p lim)) 6406 (save-excursion 6407 ;; set a default stop point at the when 6408 (setq pos (point)) 6409 ;; is the start point inside the case alternative key ? 6410 (looking-at vhdl-case-alternative-re) 6411 (goto-char (match-end 0)) 6412 (vhdl-forward-syntactic-ws here) 6413 (if (< (point) here) 6414 ;; start point was not inside the case alternative key 6415 ;; set stop point at word after case alternative keyleader 6416 (setq pos (point)))) 6417 (goto-char pos) 6418 (setq donep t)) 6419 ;; Bogus find, continue 6420 (t 6421 (backward-char))))) 6422 )) 6423 6424;; Defuns for calculating the current syntactic state: 6425 6426(defun vhdl-get-library-unit (bod placeholder) 6427 "If there is an enclosing library unit at BOD, with its \"begin\" 6428keyword at PLACEHOLDER, then return the library unit type." 6429 (let ((here (vhdl-point 'bol))) 6430 (if (save-excursion 6431 (goto-char placeholder) 6432 (vhdl-safe (vhdl-forward-sexp 1 bod)) 6433 (<= here (point))) 6434 (save-excursion 6435 (goto-char bod) 6436 (cond 6437 ((looking-at "e") 'entity) 6438 ((looking-at "a") 'architecture) 6439 ((looking-at "c") 'configuration) 6440 ((looking-at "p") 6441 (save-excursion 6442 (goto-char bod) 6443 (forward-sexp) 6444 (vhdl-forward-syntactic-ws here) 6445 (if (looking-at "body\\b[^_]") 6446 'package-body 'package)))))) 6447 )) 6448 6449(defun vhdl-get-block-state (&optional lim) 6450 "Finds and records all the closest opens. 6451LIM is the furthest back we need to search (it should be the 6452previous libunit keyword)." 6453 (let ((here (point)) 6454 (lim (or lim (point-min))) 6455 keyword sexp-start sexp-mid sexp-end 6456 preceding-sexp containing-sexp 6457 containing-begin containing-mid containing-paren) 6458 (save-excursion 6459 ;; Find the containing-paren, and use that as the limit 6460 (if (setq containing-paren 6461 (save-restriction 6462 (narrow-to-region lim (point)) 6463 (vhdl-safe (scan-lists (point) -1 1)))) 6464 (setq lim containing-paren)) 6465 ;; Look backwards for "begin" and "end" keywords. 6466 (while (and (> (point) lim) 6467 (not containing-sexp)) 6468 (setq keyword (vhdl-backward-to-block lim)) 6469 (cond 6470 ((eq keyword 'begin) 6471 ;; Found a "begin" keyword 6472 (setq sexp-start (point)) 6473 (setq sexp-mid (vhdl-corresponding-mid lim)) 6474 (setq sexp-end (vhdl-safe 6475 (save-excursion 6476 (vhdl-forward-sexp 1 lim) (point)))) 6477 (if (and sexp-end (<= sexp-end here)) 6478 ;; we want to record this sexp, but we only want to 6479 ;; record the last-most of any of them before here 6480 (or preceding-sexp 6481 (setq preceding-sexp sexp-start)) 6482 ;; we're contained in this sexp so put sexp-start on 6483 ;; front of list 6484 (setq containing-sexp sexp-start) 6485 (setq containing-mid sexp-mid) 6486 (setq containing-begin t))) 6487 ((eq keyword 'end) 6488 ;; Found an "end" keyword 6489 (forward-sexp) 6490 (setq sexp-end (point)) 6491 (setq sexp-mid nil) 6492 (setq sexp-start 6493 (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) 6494 (progn (backward-sexp) (point)))) 6495 ;; we want to record this sexp, but we only want to 6496 ;; record the last-most of any of them before here 6497 (or preceding-sexp 6498 (setq preceding-sexp sexp-start))) 6499 ))) 6500 ;; Check if the containing-paren should be the containing-sexp 6501 (if (and containing-paren 6502 (or (null containing-sexp) 6503 (< containing-sexp containing-paren))) 6504 (setq containing-sexp containing-paren 6505 preceding-sexp nil 6506 containing-begin nil 6507 containing-mid nil)) 6508 (vector containing-sexp preceding-sexp containing-begin containing-mid) 6509 )) 6510 6511 6512(defconst vhdl-s-c-a-re 6513 (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) 6514 6515(defun vhdl-skip-case-alternative (&optional lim) 6516 "Skip forward over case/when bodies, with optional maximal 6517limit. If no next case alternative is found, nil is returned and 6518point is not moved." 6519 (let ((lim (or lim (point-max))) 6520 (here (point)) 6521 donep foundp) 6522 (while (and (< (point) lim) 6523 (not donep)) 6524 (if (and (re-search-forward vhdl-s-c-a-re lim 'move) 6525 (save-match-data 6526 (not (vhdl-in-literal))) 6527 (/= (match-beginning 0) here)) 6528 (progn 6529 (goto-char (match-beginning 0)) 6530 (cond 6531 ((and (looking-at "case") 6532 (re-search-forward "\\bis[^_]" lim t)) 6533 (backward-sexp) 6534 (vhdl-forward-sexp)) 6535 (t 6536 (setq donep t 6537 foundp t)))))) 6538 (if (not foundp) 6539 (goto-char here)) 6540 foundp)) 6541 6542(defun vhdl-backward-skip-label (&optional lim) 6543 "Skip backward over a label, with optional maximal 6544limit. If label is not found, nil is returned and point 6545is not moved." 6546 (let ((lim (or lim (point-min))) 6547 placeholder) 6548 (if (save-excursion 6549 (vhdl-backward-syntactic-ws lim) 6550 (and (eq (preceding-char) ?:) 6551 (progn 6552 (backward-sexp) 6553 (setq placeholder (point)) 6554 (looking-at vhdl-label-key)))) 6555 (goto-char placeholder)) 6556 )) 6557 6558(defun vhdl-forward-skip-label (&optional lim) 6559 "Skip forward over a label, with optional maximal 6560limit. If label is not found, nil is returned and point 6561is not moved." 6562 (let ((lim (or lim (point-max)))) 6563 (if (looking-at vhdl-label-key) 6564 (progn 6565 (goto-char (match-end 0)) 6566 (vhdl-forward-syntactic-ws lim))) 6567 )) 6568 6569(defun vhdl-get-syntactic-context () 6570 "Guess the syntactic description of the current line of VHDL code." 6571 (save-excursion 6572 (save-restriction 6573 (beginning-of-line) 6574 (let* ((indent-point (point)) 6575 (case-fold-search t) 6576 vec literal containing-sexp preceding-sexp 6577 containing-begin containing-mid containing-leader 6578 char-before-ip char-after-ip begin-after-ip end-after-ip 6579 placeholder lim library-unit 6580 ) 6581 6582 ;; Reset the syntactic context 6583 (setq vhdl-syntactic-context nil) 6584 6585 (save-excursion 6586 ;; Move to the start of the previous library unit, and 6587 ;; record the position of the "begin" keyword. 6588 (setq placeholder (vhdl-beginning-of-libunit)) 6589 ;; The position of the "libunit" keyword gives us a gross 6590 ;; limit point. 6591 (setq lim (point)) 6592 ) 6593 6594 ;; If there is a previous library unit, and we are enclosed by 6595 ;; it, then set the syntax accordingly. 6596 (and placeholder 6597 (setq library-unit (vhdl-get-library-unit lim placeholder)) 6598 (vhdl-add-syntax library-unit lim)) 6599 6600 ;; Find the surrounding state. 6601 (if (setq vec (vhdl-get-block-state lim)) 6602 (progn 6603 (setq containing-sexp (aref vec 0)) 6604 (setq preceding-sexp (aref vec 1)) 6605 (setq containing-begin (aref vec 2)) 6606 (setq containing-mid (aref vec 3)) 6607 )) 6608 6609 ;; set the limit on the farthest back we need to search 6610 (setq lim (if containing-sexp 6611 (save-excursion 6612 (goto-char containing-sexp) 6613 ;; set containing-leader if required 6614 (if (looking-at vhdl-leader-re) 6615 (setq containing-leader (vhdl-end-of-leader))) 6616 (vhdl-point 'bol)) 6617 (point-min))) 6618 6619 ;; cache char before and after indent point, and move point to 6620 ;; the most likely position to perform the majority of tests 6621 (goto-char indent-point) 6622 (skip-chars-forward " \t") 6623 (setq literal (vhdl-in-literal)) 6624 (setq char-after-ip (following-char)) 6625 (setq begin-after-ip (and 6626 (not literal) 6627 (looking-at vhdl-begin-fwd-re) 6628 (vhdl-begin-p))) 6629 (setq end-after-ip (and 6630 (not literal) 6631 (looking-at vhdl-end-fwd-re) 6632 (vhdl-end-p))) 6633 (vhdl-backward-syntactic-ws lim) 6634 (setq char-before-ip (preceding-char)) 6635 (goto-char indent-point) 6636 (skip-chars-forward " \t") 6637 6638 ;; now figure out syntactic qualities of the current line 6639 (cond 6640 ;; CASE 1: in a string or comment. 6641 ((memq literal '(string comment)) 6642 (vhdl-add-syntax literal (vhdl-point 'bopl))) 6643 ;; CASE 2: Line is at top level. 6644 ((null containing-sexp) 6645 ;; Find the point to which indentation will be relative 6646 (save-excursion 6647 (if (null preceding-sexp) 6648 ;; CASE 2X.1 6649 ;; no preceding-sexp -> use the preceding statement 6650 (vhdl-beginning-of-statement-1 lim) 6651 ;; CASE 2X.2 6652 ;; if there is a preceding-sexp then indent relative to it 6653 (goto-char preceding-sexp) 6654 ;; if not at boi, then the block-opening keyword is 6655 ;; probably following a label, so we need a different 6656 ;; relpos 6657 (if (/= (point) (vhdl-point 'boi)) 6658 ;; CASE 2X.3 6659 (vhdl-beginning-of-statement-1 lim))) 6660 ;; v-b-o-s could have left us at point-min 6661 (and (bobp) 6662 ;; CASE 2X.4 6663 (vhdl-forward-syntactic-ws indent-point)) 6664 (setq placeholder (point))) 6665 (cond 6666 ;; CASE 2A : we are looking at a block-open 6667 (begin-after-ip 6668 (vhdl-add-syntax 'block-open placeholder)) 6669 ;; CASE 2B: we are looking at a block-close 6670 (end-after-ip 6671 (vhdl-add-syntax 'block-close placeholder)) 6672 ;; CASE 2C: we are looking at a top-level statement 6673 ((progn 6674 (vhdl-backward-syntactic-ws lim) 6675 (or (bobp) 6676 (= (preceding-char) ?\;))) 6677 (vhdl-add-syntax 'statement placeholder)) 6678 ;; CASE 2D: we are looking at a top-level statement-cont 6679 (t 6680 (vhdl-beginning-of-statement-1 lim) 6681 ;; v-b-o-s could have left us at point-min 6682 (and (bobp) 6683 ;; CASE 2D.1 6684 (vhdl-forward-syntactic-ws indent-point)) 6685 (vhdl-add-syntax 'statement-cont (point))) 6686 )) ; end CASE 2 6687 ;; CASE 3: line is inside parentheses. Most likely we are 6688 ;; either in a subprogram argument (interface) list, or a 6689 ;; continued expression containing parentheses. 6690 ((null containing-begin) 6691 (vhdl-backward-syntactic-ws containing-sexp) 6692 (cond 6693 ;; CASE 3A: we are looking at the arglist closing paren 6694 ((eq char-after-ip ?\)) 6695 (goto-char containing-sexp) 6696 (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) 6697 ;; CASE 3B: we are looking at the first argument in an empty 6698 ;; argument list. 6699 ((eq char-before-ip ?\() 6700 (goto-char containing-sexp) 6701 (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) 6702 ;; CASE 3C: we are looking at an arglist continuation line, 6703 ;; but the preceding argument is on the same line as the 6704 ;; opening paren. This case includes multi-line 6705 ;; expression paren groupings. 6706 ((and (save-excursion 6707 (goto-char (1+ containing-sexp)) 6708 (skip-chars-forward " \t") 6709 (not (eolp)) 6710 (not (looking-at "--"))) 6711 (save-excursion 6712 (vhdl-beginning-of-statement-1 containing-sexp) 6713 (skip-chars-backward " \t(") 6714 (<= (point) containing-sexp))) 6715 (goto-char containing-sexp) 6716 (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) 6717 ;; CASE 3D: we are looking at just a normal arglist 6718 ;; continuation line 6719 (t (vhdl-beginning-of-statement-1 containing-sexp) 6720 (vhdl-forward-syntactic-ws indent-point) 6721 (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) 6722 )) 6723 ;; CASE 4: A block mid open 6724 ((and begin-after-ip 6725 (looking-at containing-mid)) 6726 (goto-char containing-sexp) 6727 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 6728 (if (looking-at vhdl-trailer-re) 6729 ;; CASE 4.1 6730 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 6731 (vhdl-backward-skip-label (vhdl-point 'boi)) 6732 (vhdl-add-syntax 'block-open (point))) 6733 ;; CASE 5: block close brace 6734 (end-after-ip 6735 (goto-char containing-sexp) 6736 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 6737 (if (looking-at vhdl-trailer-re) 6738 ;; CASE 5.1 6739 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 6740 (vhdl-backward-skip-label (vhdl-point 'boi)) 6741 (vhdl-add-syntax 'block-close (point))) 6742 ;; CASE 6: A continued statement 6743 ((and (/= char-before-ip ?\;) 6744 ;; check it's not a trailer begin keyword, or a begin 6745 ;; keyword immediately following a label. 6746 (not (and begin-after-ip 6747 (or (looking-at vhdl-trailer-re) 6748 (save-excursion 6749 (vhdl-backward-skip-label containing-sexp))))) 6750 ;; check it's not a statement keyword 6751 (not (and (looking-at vhdl-statement-fwd-re) 6752 (vhdl-statement-p))) 6753 ;; see if the b-o-s is before the indent point 6754 (> indent-point 6755 (save-excursion 6756 (vhdl-beginning-of-statement-1 containing-sexp) 6757 ;; If we ended up after a leader, then this will 6758 ;; move us forward to the start of the first 6759 ;; statement. Note that a containing sexp here is 6760 ;; always a keyword, not a paren, so this will 6761 ;; have no effect if we hit the containing-sexp. 6762 (vhdl-forward-syntactic-ws indent-point) 6763 (setq placeholder (point)))) 6764 ;; check it's not a block-intro 6765 (/= placeholder containing-sexp) 6766 ;; check it's not a case block-intro 6767 (save-excursion 6768 (goto-char placeholder) 6769 (or (not (looking-at vhdl-case-alternative-re)) 6770 (> (match-end 0) indent-point)))) 6771 ;; Make placeholder skip a label, but only if it puts us 6772 ;; before the indent point at the start of a line. 6773 (let ((new placeholder)) 6774 (if (and (> indent-point 6775 (save-excursion 6776 (goto-char placeholder) 6777 (vhdl-forward-skip-label indent-point) 6778 (setq new (point)))) 6779 (save-excursion 6780 (goto-char new) 6781 (eq new (progn (back-to-indentation) (point))))) 6782 (setq placeholder new))) 6783 (vhdl-add-syntax 'statement-cont placeholder) 6784 (if begin-after-ip 6785 (vhdl-add-syntax 'block-open))) 6786 ;; Statement. But what kind? 6787 ;; CASE 7: A case alternative key 6788 ((and (looking-at vhdl-case-alternative-re) 6789 (vhdl-case-alternative-p containing-sexp)) 6790 ;; for a case alternative key, we set relpos to the first 6791 ;; non-whitespace char on the line containing the "case" 6792 ;; keyword. 6793 (goto-char containing-sexp) 6794 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 6795 (if (looking-at vhdl-trailer-re) 6796 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 6797 (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) 6798 ;; CASE 8: statement catchall 6799 (t 6800 ;; we know its a statement, but we need to find out if it is 6801 ;; the first statement in a block 6802 (if containing-leader 6803 (goto-char containing-leader) 6804 (goto-char containing-sexp) 6805 ;; Note that a containing sexp here is always a keyword, 6806 ;; not a paren, so skip over the keyword. 6807 (forward-sexp)) 6808 ;; move to the start of the first statement 6809 (vhdl-forward-syntactic-ws indent-point) 6810 (setq placeholder (point)) 6811 ;; we want to ignore case alternatives keys when skipping forward 6812 (let (incase-p) 6813 (while (looking-at vhdl-case-alternative-re) 6814 (setq incase-p (point)) 6815 ;; we also want to skip over the body of the 6816 ;; case/when statement if that doesn't put us at 6817 ;; after the indent-point 6818 (while (vhdl-skip-case-alternative indent-point)) 6819 ;; set up the match end 6820 (looking-at vhdl-case-alternative-re) 6821 (goto-char (match-end 0)) 6822 ;; move to the start of the first case alternative statement 6823 (vhdl-forward-syntactic-ws indent-point) 6824 (setq placeholder (point))) 6825 (cond 6826 ;; CASE 8A: we saw a case/when statement so we must be 6827 ;; in a switch statement. find out if we are at the 6828 ;; statement just after a case alternative key 6829 ((and incase-p 6830 (= (point) indent-point)) 6831 ;; relpos is the "when" keyword 6832 (vhdl-add-syntax 'statement-case-intro incase-p)) 6833 ;; CASE 8B: any old statement 6834 ((< (point) indent-point) 6835 ;; relpos is the first statement of the block 6836 (vhdl-add-syntax 'statement placeholder) 6837 (if begin-after-ip 6838 (vhdl-add-syntax 'block-open))) 6839 ;; CASE 8C: first statement in a block 6840 (t 6841 (goto-char containing-sexp) 6842 ;; If the \"begin\" keyword is a trailer, then find v-b-o-s 6843 (if (looking-at vhdl-trailer-re) 6844 (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) 6845 (vhdl-backward-skip-label (vhdl-point 'boi)) 6846 (vhdl-add-syntax 'statement-block-intro (point)) 6847 (if begin-after-ip 6848 (vhdl-add-syntax 'block-open))) 6849 ))) 6850 ) 6851 6852 ;; now we need to look at any modifiers 6853 (goto-char indent-point) 6854 (skip-chars-forward " \t") 6855 (if (looking-at "--") 6856 (vhdl-add-syntax 'comment)) 6857 (if (eq literal 'pound) 6858 (vhdl-add-syntax 'cpp-macro)) 6859 ;; return the syntax 6860 vhdl-syntactic-context)))) 6861 6862;; Standard indentation line-ups: 6863 6864(defun vhdl-lineup-arglist (langelem) 6865 "Lineup the current arglist line with the arglist appearing just 6866after the containing paren which starts the arglist." 6867 (save-excursion 6868 (let* ((containing-sexp 6869 (save-excursion 6870 ;; arglist-cont-nonempty gives relpos == 6871 ;; to boi of containing-sexp paren. This 6872 ;; is good when offset is +, but bad 6873 ;; when it is vhdl-lineup-arglist, so we 6874 ;; have to special case a kludge here. 6875 (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) 6876 (progn 6877 (beginning-of-line) 6878 (backward-up-list 1) 6879 (skip-chars-forward " \t" (vhdl-point 'eol))) 6880 (goto-char (cdr langelem))) 6881 (point))) 6882 (cs-curcol (save-excursion 6883 (goto-char (cdr langelem)) 6884 (current-column)))) 6885 (if (save-excursion 6886 (beginning-of-line) 6887 (looking-at "[ \t]*)")) 6888 (progn (goto-char (match-end 0)) 6889 (backward-sexp) 6890 (forward-char) 6891 (vhdl-forward-syntactic-ws) 6892 (- (current-column) cs-curcol)) 6893 (goto-char containing-sexp) 6894 (or (eolp) 6895 (let ((eol (vhdl-point 'eol)) 6896 (here (progn 6897 (forward-char) 6898 (skip-chars-forward " \t") 6899 (point)))) 6900 (vhdl-forward-syntactic-ws) 6901 (if (< (point) eol) 6902 (goto-char here)))) 6903 (- (current-column) cs-curcol) 6904 )))) 6905 6906(defun vhdl-lineup-arglist-intro (langelem) 6907 "Lineup an arglist-intro line to just after the open paren." 6908 (save-excursion 6909 (let ((cs-curcol (save-excursion 6910 (goto-char (cdr langelem)) 6911 (current-column))) 6912 (ce-curcol (save-excursion 6913 (beginning-of-line) 6914 (backward-up-list 1) 6915 (skip-chars-forward " \t" (vhdl-point 'eol)) 6916 (current-column)))) 6917 (- ce-curcol cs-curcol -1)))) 6918 6919(defun vhdl-lineup-comment (langelem) 6920 "Support old behavior for comment indentation. We look at 6921vhdl-comment-only-line-offset to decide how to indent comment 6922only-lines." 6923 (save-excursion 6924 (back-to-indentation) 6925 ;; at or to the right of comment-column 6926 (if (>= (current-column) comment-column) 6927 (vhdl-comment-indent) 6928 ;; otherwise, indent as specified by vhdl-comment-only-line-offset 6929 (if (not (bolp)) 6930 (or (car-safe vhdl-comment-only-line-offset) 6931 vhdl-comment-only-line-offset) 6932 (or (cdr-safe vhdl-comment-only-line-offset) 6933 (car-safe vhdl-comment-only-line-offset) 6934 -1000 ;jam it against the left side 6935 ))))) 6936 6937(defun vhdl-lineup-statement-cont (langelem) 6938 "Line up statement-cont after the assignment operator." 6939 (save-excursion 6940 (let* ((relpos (cdr langelem)) 6941 (assignp (save-excursion 6942 (goto-char (vhdl-point 'boi)) 6943 (and (re-search-forward "\\(<\\|:\\)=" 6944 (vhdl-point 'eol) t) 6945 (- (point) (vhdl-point 'boi))))) 6946 (curcol (progn 6947 (goto-char relpos) 6948 (current-column))) 6949 foundp) 6950 (while (and (not foundp) 6951 (< (point) (vhdl-point 'eol))) 6952 (re-search-forward "\\(<\\|:\\)=\\|(" (vhdl-point 'eol) 'move) 6953 (if (vhdl-in-literal) 6954 (forward-char) 6955 (if (= (preceding-char) ?\() 6956 ;; skip over any parenthesized expressions 6957 (goto-char (min (vhdl-point 'eol) 6958 (scan-lists (point) 1 1))) 6959 ;; found an assignment operator (not at eol) 6960 (setq foundp (not (looking-at "\\s-*$")))))) 6961 (if (not foundp) 6962 ;; there's no assignment operator on the line 6963 vhdl-basic-offset 6964 ;; calculate indentation column after assign and ws, unless 6965 ;; our line contains an assignment operator 6966 (if (not assignp) 6967 (progn 6968 (forward-char) 6969 (skip-chars-forward " \t") 6970 (setq assignp 0))) 6971 (- (current-column) assignp curcol)) 6972 ))) 6973 6974;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6975;; Progress reporting 6976 6977(defvar vhdl-progress-info nil 6978 "Array variable for progress information: 0 begin, 1 end, 2 time.") 6979 6980(defun vhdl-update-progress-info (string pos) 6981 "Update progress information." 6982 (when (and vhdl-progress-info (not noninteractive) 6983 (< vhdl-progress-interval 6984 (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) 6985 (message (concat string "... (%2d%s)") 6986 (/ (* 100 (- pos (aref vhdl-progress-info 0))) 6987 (- (aref vhdl-progress-info 1) 6988 (aref vhdl-progress-info 0))) "%") 6989 (aset vhdl-progress-info 2 (nth 1 (current-time))))) 6990 6991;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6992;; Indentation commands 6993 6994(defun vhdl-electric-tab (&optional prefix-arg) 6995 "If preceeding character is part of a word or a paren then hippie-expand, 6996else if right of non whitespace on line then insert tab, 6997else if last command was a tab or return then dedent one step or if a comment 6998toggle between normal indent and inline comment indent, 6999else indent `correctly'." 7000 (interactive "*P") 7001 (vhdl-prepare-search-2 7002 (cond 7003 ;; expand word 7004 ((= (char-syntax (preceding-char)) ?w) 7005 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7006 (case-replace nil) 7007 (hippie-expand-only-buffers 7008 (or (and (boundp 'hippie-expand-only-buffers) 7009 hippie-expand-only-buffers) 7010 '(vhdl-mode)))) 7011 (vhdl-expand-abbrev prefix-arg))) 7012 ;; expand parenthesis 7013 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 7014 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 7015 (case-replace nil)) 7016 (vhdl-expand-paren prefix-arg))) 7017 ;; insert tab 7018 ((> (current-column) (current-indentation)) 7019 (insert-tab)) 7020 ;; toggle comment indent 7021 ((and (looking-at "--") 7022 (or (eq last-command 'vhdl-electric-tab) 7023 (eq last-command 'vhdl-electric-return))) 7024 (cond ((= (current-indentation) 0) ; no indent 7025 (indent-to 1) 7026 (indent-according-to-mode)) 7027 ((< (current-indentation) comment-column) ; normal indent 7028 (indent-to comment-column) 7029 (indent-according-to-mode)) 7030 (t ; inline comment indent 7031 (delete-region (line-beginning-position) (point))))) 7032 ;; dedent 7033 ((and (>= (current-indentation) vhdl-basic-offset) 7034 (or (eq last-command 'vhdl-electric-tab) 7035 (eq last-command 'vhdl-electric-return))) 7036 (backward-delete-char-untabify vhdl-basic-offset nil)) 7037 ;; indent line 7038 (t (indent-according-to-mode))) 7039 (setq this-command 'vhdl-electric-tab))) 7040 7041(defun vhdl-electric-return () 7042 "newline-and-indent or indent-new-comment-line if in comment and preceding 7043character is a space." 7044 (interactive) 7045 (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) 7046 (indent-new-comment-line) 7047 (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) 7048 (vhdl-fix-case-word -1)) 7049 (newline-and-indent))) 7050 7051(defun vhdl-indent-line () 7052 "Indent the current line as VHDL code. Returns the amount of 7053indentation change." 7054 (interactive) 7055 (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) 7056 (pos (- (point-max) (point))) 7057 (indent 7058 (if syntax 7059 ;; indent syntax-based 7060 (if (and (eq (caar syntax) 'comment) 7061 (>= (vhdl-get-offset (car syntax)) comment-column)) 7062 ;; special case: comments at or right of comment-column 7063 (vhdl-get-offset (car syntax)) 7064 (apply '+ (mapcar 'vhdl-get-offset syntax))) 7065 ;; indent like previous nonblank line 7066 (save-excursion (beginning-of-line) 7067 (re-search-backward "^[^\n]" nil t) 7068 (current-indentation)))) 7069 (shift-amt (- indent (current-indentation)))) 7070 (and vhdl-echo-syntactic-information-p 7071 (message "syntax: %s, indent= %d" syntax indent)) 7072 (unless (zerop shift-amt) 7073 (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) 7074 (beginning-of-line) 7075 (indent-to indent)) 7076 (if (< (point) (vhdl-point 'boi)) 7077 (back-to-indentation) 7078 ;; If initial point was within line's indentation, position after 7079 ;; the indentation. Else stay at same point in text. 7080 (when (> (- (point-max) pos) (point)) 7081 (goto-char (- (point-max) pos)))) 7082 (run-hooks 'vhdl-special-indent-hook) 7083 (vhdl-update-progress-info "Indenting" (vhdl-current-line)) 7084 shift-amt)) 7085 7086(defun vhdl-indent-region (beg end column) 7087 "Indent region as VHDL code. 7088Adds progress reporting to `indent-region'." 7089 (interactive "r\nP") 7090 (when vhdl-progress-interval 7091 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7092 (count-lines (point-min) end) 0))) 7093 (indent-region beg end column) 7094 (when vhdl-progress-interval (message "Indenting...done")) 7095 (setq vhdl-progress-info nil)) 7096 7097(defun vhdl-indent-buffer () 7098 "Indent whole buffer as VHDL code. 7099Calls `indent-region' for whole buffer and adds progress reporting." 7100 (interactive) 7101 (vhdl-indent-region (point-min) (point-max) nil)) 7102 7103(defun vhdl-indent-group () 7104 "Indent group of lines between empty lines." 7105 (interactive) 7106 (let ((beg (save-excursion 7107 (if (re-search-backward vhdl-align-group-separate nil t) 7108 (point-marker) 7109 (point-min-marker)))) 7110 (end (save-excursion 7111 (if (re-search-forward vhdl-align-group-separate nil t) 7112 (point-marker) 7113 (point-max-marker))))) 7114 (vhdl-indent-region beg end nil))) 7115 7116(defun vhdl-indent-sexp (&optional endpos) 7117 "Indent each line of the list starting just after point. 7118If optional arg ENDPOS is given, indent each line, stopping when 7119ENDPOS is encountered." 7120 (interactive) 7121 (save-excursion 7122 (let ((beg (point)) 7123 (end (progn (vhdl-forward-sexp nil endpos) (point)))) 7124 (indent-region beg end nil)))) 7125 7126;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7127;; Miscellaneous commands 7128 7129(defun vhdl-show-syntactic-information () 7130 "Show syntactic information for current line." 7131 (interactive) 7132 (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) 7133 (vhdl-keep-region-active)) 7134 7135;; Verification and regression functions: 7136 7137(defun vhdl-regress-line (&optional arg) 7138 "Check syntactic information for current line." 7139 (interactive "P") 7140 (let ((expected (save-excursion 7141 (end-of-line) 7142 (when (search-backward " -- ((" (vhdl-point 'bol) t) 7143 (forward-char 4) 7144 (read (current-buffer))))) 7145 (actual (vhdl-get-syntactic-context)) 7146 (expurgated)) 7147 ;; remove the library unit symbols 7148 (mapcar 7149 (function 7150 (lambda (elt) 7151 (if (memq (car elt) '(entity configuration package 7152 package-body architecture)) 7153 nil 7154 (setq expurgated (append expurgated (list elt)))))) 7155 actual) 7156 (if (and (not arg) expected (listp expected)) 7157 (if (not (equal expected expurgated)) 7158 (error "ERROR: Should be: %s, is: %s" expected expurgated)) 7159 (save-excursion 7160 (beginning-of-line) 7161 (when (not (looking-at "^\\s-*\\(--.*\\)?$")) 7162 (end-of-line) 7163 (if (search-backward " -- ((" (vhdl-point 'bol) t) 7164 (delete-region (point) (line-end-position))) 7165 (insert " -- ") 7166 (insert (format "%s" expurgated)))))) 7167 (vhdl-keep-region-active)) 7168 7169 7170;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7171;;; Alignment, whitespace fixup, beautifying 7172;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7173 7174(defconst vhdl-align-alist 7175 '( 7176 ;; after some keywords 7177 (vhdl-mode "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)[ \t]" 7178 "^\\s-*\\(constant\\|quantity\\|signal\\|subtype\\|terminal\\|type\\|variable\\)\\([ \t]+\\)" 2) 7179 ;; before ':' 7180 (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") 7181 ;; after direction specifications 7182 (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" 7183 ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) 7184 ;; before "==", ":=", "=>", and "<=" 7185 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "<= ... =>" can occur 7186 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7187 (vhdl-mode "[<:=]=" "\\([ \t]*\\)[<:=]=" 1) ; since "=> ... <=" can occur 7188 ;; before some keywords 7189 (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) 7190 (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) 7191 (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) 7192 ;; before "=>" since "when/else ... =>" can occur 7193 (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) 7194 ) 7195 "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). 7196It is searched in order. If REGEXP is found anywhere in the first 7197line of a region to be aligned, ALIGN-PATTERN will be used for that 7198region. ALIGN-PATTERN must include the whitespace to be expanded or 7199contracted. It may also provide regexps for the text surrounding the 7200whitespace. SUBEXP specifies which sub-expression of 7201ALIGN-PATTERN matches the white space to be expanded/contracted.") 7202 7203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7204;; Align code 7205 7206(defvar vhdl-align-try-all-clauses t 7207 "If REGEXP is not found on the first line of the region that clause 7208is ignored. If this variable is non-nil, then the clause is tried anyway.") 7209 7210(defun vhdl-do-group (function &optional spacing) 7211 "Apply FUNCTION on group of lines between empty lines." 7212 (let 7213 ;; search for group beginning 7214 ((beg (save-excursion 7215 (if (re-search-backward vhdl-align-group-separate nil t) 7216 (progn (beginning-of-line 2) (back-to-indentation) (point)) 7217 (point-min)))) 7218 ;; search for group end 7219 (end (save-excursion 7220 (if (re-search-forward vhdl-align-group-separate nil t) 7221 (progn (beginning-of-line) (point)) 7222 (point-max))))) 7223 ;; run FUNCTION 7224 (funcall function beg end spacing))) 7225 7226(defun vhdl-do-list (function &optional spacing) 7227 "Apply FUNCTION to the lines of a list surrounded by a balanced group of 7228parentheses." 7229 (let (beg end) 7230 (save-excursion 7231 ;; search for beginning of balanced group of parentheses 7232 (setq beg (vhdl-re-search-backward "[()]" nil t)) 7233 (while (looking-at ")") 7234 (forward-char) (backward-sexp) 7235 (setq beg (vhdl-re-search-backward "[()]" nil t))) 7236 ;; search for end of balanced group of parentheses 7237 (when beg 7238 (forward-list) 7239 (setq end (point)) 7240 (goto-char (1+ beg)) 7241 (skip-chars-forward " \t\n") 7242 (setq beg (point)))) 7243 ;; run FUNCTION 7244 (if beg 7245 (funcall function beg end spacing) 7246 (error "ERROR: Not within a list enclosed by a pair of parentheses")))) 7247 7248(defun vhdl-do-same-indent (function &optional spacing) 7249 "Apply FUNCTION to block of lines with same indent." 7250 (let ((indent (current-indentation)) 7251 beg end) 7252 ;; search for first line with same indent 7253 (save-excursion 7254 (while (and (not (bobp)) 7255 (or (looking-at "^\\s-*\\(--.*\\)?$") 7256 (= (current-indentation) indent))) 7257 (unless (looking-at "^\\s-*$") 7258 (back-to-indentation) (setq beg (point))) 7259 (beginning-of-line -0))) 7260 ;; search for last line with same indent 7261 (save-excursion 7262 (while (and (not (eobp)) 7263 (or (looking-at "^\\s-*\\(--.*\\)?$") 7264 (= (current-indentation) indent))) 7265 (if (looking-at "^\\s-*$") 7266 (beginning-of-line 2) 7267 (beginning-of-line 2) 7268 (setq end (point))))) 7269 ;; run FUNCTION 7270 (funcall function beg end spacing))) 7271 7272(defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) 7273 "Attempt to align a range of lines based on the content of the 7274lines. The definition of `alignment-list' determines the matching 7275order and the manner in which the lines are aligned. If ALIGNMENT-LIST 7276is not specified `vhdl-align-alist' is used. If INDENT is non-nil, 7277indentation is done before aligning." 7278 (interactive "r\np") 7279 (setq alignment-list (or alignment-list vhdl-align-alist)) 7280 (setq spacing (or spacing 1)) 7281 (save-excursion 7282 (let (bol indent) 7283 (goto-char end) 7284 (setq end (point-marker)) 7285 (goto-char begin) 7286 (setq bol (setq begin (progn (beginning-of-line) (point)))) 7287; (untabify bol end) 7288 (when indent 7289 (indent-region bol end nil)))) 7290 (let ((copy (copy-alist alignment-list))) 7291 (vhdl-prepare-search-2 7292 (while copy 7293 (save-excursion 7294 (goto-char begin) 7295 (let (element 7296 (eol (save-excursion (progn (end-of-line) (point))))) 7297 (setq element (nth 0 copy)) 7298 (when (and (or (and (listp (car element)) 7299 (memq major-mode (car element))) 7300 (eq major-mode (car element))) 7301 (or vhdl-align-try-all-clauses 7302 (re-search-forward (car (cdr element)) eol t))) 7303 (vhdl-align-region-2 begin end (car (cdr (cdr element))) 7304 (car (cdr (cdr (cdr element)))) spacing)) 7305 (setq copy (cdr copy)))))))) 7306 7307(defun vhdl-align-region-2 (begin end match &optional substr spacing) 7308 "Align a range of lines from BEGIN to END. The regular expression 7309MATCH must match exactly one field: the whitespace to be 7310contracted/expanded. The alignment column will equal the 7311rightmost column of the widest whitespace block. SPACING is 7312the amount of extra spaces to add to the calculated maximum required. 7313SPACING defaults to 1 so that at least one space is inserted after 7314the token in MATCH." 7315 (setq spacing (or spacing 1)) 7316 (setq substr (or substr 1)) 7317 (save-excursion 7318 (let (distance (max 0) (lines 0) bol eol width) 7319 ;; Determine the greatest whitespace distance to the alignment 7320 ;; character 7321 (goto-char begin) 7322 (setq eol (progn (end-of-line) (point)) 7323 bol (setq begin (progn (beginning-of-line) (point)))) 7324 (while (< bol end) 7325 (save-excursion 7326 (when (and (re-search-forward match eol t) 7327 (not (vhdl-in-literal))) 7328 (setq distance (- (match-beginning substr) bol)) 7329 (when (> distance max) 7330 (setq max distance)))) 7331 (forward-line) 7332 (setq bol (point) 7333 eol (save-excursion (end-of-line) (point))) 7334 (setq lines (1+ lines))) 7335 ;; Now insert enough maxs to push each assignment operator to 7336 ;; the same column. We need to use 'lines' as a counter, since 7337 ;; the location of the mark may change 7338 (goto-char (setq bol begin)) 7339 (setq eol (save-excursion (end-of-line) (point))) 7340 (while (> lines 0) 7341 (when (and (re-search-forward match eol t) 7342 (not (vhdl-in-literal))) 7343 (setq width (- (match-end substr) (match-beginning substr))) 7344 (setq distance (- (match-beginning substr) bol)) 7345 (goto-char (match-beginning substr)) 7346 (delete-char width) 7347 (insert-char ? (+ (- max distance) spacing))) 7348 (beginning-of-line) 7349 (forward-line) 7350 (setq bol (point) 7351 eol (save-excursion (end-of-line) (point))) 7352 (setq lines (1- lines)))))) 7353 7354(defun vhdl-align-region-groups (beg end &optional spacing 7355 no-message no-comments) 7356 "Align region, treat groups of lines separately." 7357 (interactive "r\nP") 7358 (save-excursion 7359 (let (orig pos) 7360 (goto-char beg) 7361 (beginning-of-line) 7362 (setq orig (point-marker)) 7363 (setq beg (point)) 7364 (goto-char end) 7365 (setq end (point-marker)) 7366 (untabify beg end) 7367 (unless no-message 7368 (when vhdl-progress-interval 7369 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7370 (count-lines (point-min) end) 0)))) 7371 (vhdl-fixup-whitespace-region beg end t) 7372 (goto-char beg) 7373 (if (not vhdl-align-groups) 7374 ;; align entire region 7375 (progn (vhdl-align-region-1 beg end spacing) 7376 (unless no-comments 7377 (vhdl-align-inline-comment-region-1 beg end))) 7378 ;; align groups 7379 (while (and (< beg end) 7380 (re-search-forward vhdl-align-group-separate end t)) 7381 (setq pos (point-marker)) 7382 (vhdl-align-region-1 beg pos spacing) 7383 (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) 7384 (vhdl-update-progress-info "Aligning" (vhdl-current-line)) 7385 (setq beg (1+ pos)) 7386 (goto-char beg)) 7387 ;; align last group 7388 (when (< beg end) 7389 (vhdl-align-region-1 beg end spacing) 7390 (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) 7391 (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) 7392 (when vhdl-indent-tabs-mode 7393 (tabify orig end)) 7394 (unless no-message 7395 (when vhdl-progress-interval (message "Aligning...done")) 7396 (setq vhdl-progress-info nil))))) 7397 7398(defun vhdl-align-region (beg end &optional spacing) 7399 "Align region, treat blocks with same indent and argument lists separately." 7400 (interactive "r\nP") 7401 (if (not vhdl-align-same-indent) 7402 ;; align entire region 7403 (vhdl-align-region-groups beg end spacing) 7404 ;; align blocks with same indent and argument lists 7405 (save-excursion 7406 (let ((cur-beg beg) 7407 indent cur-end) 7408 (when vhdl-progress-interval 7409 (setq vhdl-progress-info (vector (count-lines (point-min) beg) 7410 (count-lines (point-min) end) 0))) 7411 (goto-char end) 7412 (setq end (point-marker)) 7413 (goto-char cur-beg) 7414 (while (< (point) end) 7415 ;; is argument list opening? 7416 (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp 7417 (point) (vhdl-point 'eol))))) 7418 ;; determine region for argument list 7419 (progn (goto-char cur-beg) 7420 (forward-sexp) 7421 (setq cur-end (point)) 7422 (beginning-of-line 2)) 7423 ;; determine region with same indent 7424 (setq indent (current-indentation)) 7425 (setq cur-beg (point)) 7426 (setq cur-end (vhdl-point 'bonl)) 7427 (beginning-of-line 2) 7428 (while (and (< (point) end) 7429 (or (looking-at "^\\s-*\\(--.*\\)?$") 7430 (= (current-indentation) indent)) 7431 (<= (save-excursion 7432 (nth 0 (parse-partial-sexp 7433 (point) (vhdl-point 'eol)))) 0)) 7434 (unless (looking-at "^\\s-*$") 7435 (setq cur-end (vhdl-point 'bonl))) 7436 (beginning-of-line 2))) 7437 ;; align region 7438 (vhdl-align-region-groups cur-beg cur-end spacing t t)) 7439 (vhdl-align-inline-comment-region beg end spacing noninteractive) 7440 (when vhdl-progress-interval (message "Aligning...done")) 7441 (setq vhdl-progress-info nil))))) 7442 7443(defun vhdl-align-group (&optional spacing) 7444 "Align group of lines between empty lines." 7445 (interactive) 7446 (vhdl-do-group 'vhdl-align-region spacing)) 7447 7448(defun vhdl-align-list (&optional spacing) 7449 "Align the lines of a list surrounded by a balanced group of parentheses." 7450 (interactive) 7451 (vhdl-do-list 'vhdl-align-region-groups spacing)) 7452 7453(defun vhdl-align-same-indent (&optional spacing) 7454 "Align block of lines with same indent." 7455 (interactive) 7456 (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) 7457 7458(defun vhdl-align-declarations (&optional spacing) 7459 "Align the lines within the declarative part of a design unit." 7460 (interactive) 7461 (let (beg end) 7462 (vhdl-prepare-search-2 7463 (save-excursion 7464 ;; search for declarative part 7465 (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t) 7466 (not (member (upcase (match-string 1)) '("BEGIN" "END")))) 7467 (setq beg (point)) 7468 (re-search-forward "^\\(begin\\|end\\)\\>" nil t) 7469 (setq end (point))))) 7470 (if beg 7471 (vhdl-align-region-groups beg end spacing) 7472 (error "ERROR: Not within the declarative part of a design unit")))) 7473 7474(defun vhdl-align-buffer () 7475 "Align buffer." 7476 (interactive) 7477 (vhdl-align-region (point-min) (point-max))) 7478 7479;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7480;; Align inline comments 7481 7482(defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) 7483 "Align inline comments in region." 7484 (save-excursion 7485 (let ((start-max comment-column) 7486 (length-max 0) 7487 comment-list start-list tmp-list start length 7488 cur-start prev-start no-code) 7489 (setq spacing (or spacing 2)) 7490 (vhdl-prepare-search-2 7491 (goto-char beg) 7492 ;; search for comment start positions and lengths 7493 (while (< (point) end) 7494 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7495 (looking-at "^\\(.*[^ \t\n-]+\\)\\s-*\\(--.*\\)$") 7496 (not (save-excursion (goto-char (match-beginning 2)) 7497 (vhdl-in-literal)))) 7498 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7499 (setq length (- (match-end 2) (match-beginning 2))) 7500 (setq start-max (max start start-max)) 7501 (setq length-max (max length length-max)) 7502 (setq comment-list (cons (cons start length) comment-list))) 7503 (beginning-of-line 2)) 7504 (setq comment-list 7505 (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) 7506 ;; reduce start positions 7507 (setq start-list (list (caar comment-list))) 7508 (setq comment-list (cdr comment-list)) 7509 (while comment-list 7510 (unless (or (= (caar comment-list) (car start-list)) 7511 (<= (+ (car start-list) (cdar comment-list)) 7512 end-comment-column)) 7513 (setq start-list (cons (caar comment-list) start-list))) 7514 (setq comment-list (cdr comment-list))) 7515 ;; align lines as nicely as possible 7516 (goto-char beg) 7517 (while (< (point) end) 7518 (setq cur-start nil) 7519 (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) 7520 (or (and (looking-at "^\\(.*[^ \t\n-]+\\)\\(\\s-*\\)\\(--.*\\)$") 7521 (not (save-excursion 7522 (goto-char (match-beginning 3)) 7523 (vhdl-in-literal)))) 7524 (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") 7525 (>= (- (match-end 2) (match-beginning 2)) 7526 comment-column)))) 7527 (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) 7528 (setq length (- (match-end 3) (match-beginning 3))) 7529 (setq no-code (= (match-beginning 1) (match-end 1))) 7530 ;; insert minimum whitespace 7531 (goto-char (match-end 2)) 7532 (delete-region (match-beginning 2) (match-end 2)) 7533 (insert-char ?\ spacing) 7534 (setq tmp-list start-list) 7535 ;; insert additional whitespace to align 7536 (setq cur-start 7537 (cond 7538 ;; align comment-only line to inline comment of previous line 7539 ((and no-code prev-start 7540 (<= length (- end-comment-column prev-start))) 7541 prev-start) 7542 ;; align all comments at `start-max' if this is possible 7543 ((<= (+ start-max length-max) end-comment-column) 7544 start-max) 7545 ;; align at `comment-column' if possible 7546 ((and (<= start comment-column) 7547 (<= length (- end-comment-column comment-column))) 7548 comment-column) 7549 ;; align at left-most possible start position otherwise 7550 (t 7551 (while (and tmp-list (< (car tmp-list) start)) 7552 (setq tmp-list (cdr tmp-list))) 7553 (car tmp-list)))) 7554 (indent-to cur-start)) 7555 (setq prev-start cur-start) 7556 (beginning-of-line 2)))))) 7557 7558(defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) 7559 "Align inline comments within a region. Groups of code lines separated by 7560empty lines are aligned individually, if `vhdl-align-groups' is non-nil." 7561 (interactive "r\nP") 7562 (save-excursion 7563 (let (orig pos) 7564 (goto-char beg) 7565 (beginning-of-line) 7566 (setq orig (point-marker)) 7567 (setq beg (point)) 7568 (goto-char end) 7569 (setq end (point-marker)) 7570 (untabify beg end) 7571 (unless no-message (message "Aligning inline comments...")) 7572 (goto-char beg) 7573 (if (not vhdl-align-groups) 7574 ;; align entire region 7575 (vhdl-align-inline-comment-region-1 beg end spacing) 7576 ;; align groups 7577 (while (and (< beg end) 7578 (re-search-forward vhdl-align-group-separate end t)) 7579 (setq pos (point-marker)) 7580 (vhdl-align-inline-comment-region-1 beg pos spacing) 7581 (setq beg (1+ pos)) 7582 (goto-char beg)) 7583 ;; align last group 7584 (when (< beg end) 7585 (vhdl-align-inline-comment-region-1 beg end spacing))) 7586 (when vhdl-indent-tabs-mode 7587 (tabify orig end)) 7588 (unless no-message (message "Aligning inline comments...done"))))) 7589 7590(defun vhdl-align-inline-comment-group (&optional spacing) 7591 "Align inline comments within a group of lines between empty lines." 7592 (interactive) 7593 (save-excursion 7594 (let ((start (point)) 7595 beg end) 7596 (setq end (if (re-search-forward vhdl-align-group-separate nil t) 7597 (point-marker) (point-max))) 7598 (goto-char start) 7599 (setq beg (if (re-search-backward vhdl-align-group-separate nil t) 7600 (point) (point-min))) 7601 (untabify beg end) 7602 (message "Aligning inline comments...") 7603 (vhdl-align-inline-comment-region-1 beg end) 7604 (when vhdl-indent-tabs-mode 7605 (tabify beg end)) 7606 (message "Aligning inline comments...done")))) 7607 7608(defun vhdl-align-inline-comment-buffer () 7609 "Align inline comments within buffer. Groups of code lines separated by 7610empty lines are aligned individually, if `vhdl-align-groups' is non-nil." 7611 (interactive) 7612 (vhdl-align-inline-comment-region (point-min) (point-max))) 7613 7614;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7615;; Fixup whitespace 7616 7617(defun vhdl-fixup-whitespace-region (beg end &optional no-message) 7618 "Fixup whitespace in region. Surround operator symbols by one space, 7619eliminate multiple spaces (except at beginning of line), eliminate spaces at 7620end of line, do nothing in comments and strings." 7621 (interactive "r") 7622 (unless no-message (message "Fixing up whitespace...")) 7623 (save-excursion 7624 (goto-char end) 7625 (setq end (point-marker)) 7626 ;; have no space before and one space after `,' and ';' 7627 (goto-char beg) 7628 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) 7629 (if (match-string 1) 7630 (goto-char (match-end 1)) 7631 (replace-match "\\3 " nil nil nil 3))) 7632 ;; have no space after `(' 7633 (goto-char beg) 7634 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\((\\)\\s-+" end t) 7635 (if (match-string 1) 7636 (goto-char (match-end 1)) 7637 (replace-match "\\2"))) 7638 ;; have no space before `)' 7639 (goto-char beg) 7640 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) 7641 (if (match-string 1) 7642 (goto-char (match-end 1)) 7643 (replace-match "\\2"))) 7644 ;; surround operator symbols by one space 7645 (goto-char beg) 7646 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\)\\|\\(\\([^/:<>=]\\)\\(:\\|=\\|<\\|>\\|:=\\|<=\\|>=\\|=>\\|/=\\)\\([^=>]\\|$\\)\\)" end t) 7647 (if (match-string 1) 7648 (goto-char (match-end 1)) 7649 (replace-match "\\3 \\4 \\5") 7650 (goto-char (match-end 2)))) 7651 ;; eliminate multiple spaces and spaces at end of line 7652 (goto-char beg) 7653 (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) 7654 (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) 7655 (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) 7656 (progn (replace-match "" nil nil) t)) 7657 (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) 7658 (progn (replace-match ";" nil nil) t)) 7659 (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) 7660 (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) 7661 (progn (replace-match " " nil nil) t)) 7662 (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) 7663 (progn (replace-match " " nil nil) t)) 7664; (re-search-forward "[^ \t-]+" end t)))) 7665 (re-search-forward "[^ \t\"-]+" end t)))) 7666 (unless no-message (message "Fixing up whitespace...done"))) 7667 7668(defun vhdl-fixup-whitespace-buffer () 7669 "Fixup whitespace in buffer. Surround operator symbols by one space, 7670eliminate multiple spaces (except at beginning of line), eliminate spaces at 7671end of line, do nothing in comments." 7672 (interactive) 7673 (vhdl-fixup-whitespace-region (point-min) (point-max))) 7674 7675;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7676;; Beautify 7677 7678(defun vhdl-beautify-region (beg end) 7679 "Beautify region by applying indentation, whitespace fixup, alignment, and 7680case fixing to a region. Calls functions `vhdl-indent-buffer', 7681`vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and 7682`vhdl-fix-case-buffer'." 7683 (interactive "r") 7684 (setq end (save-excursion (goto-char end) (point-marker))) 7685 (vhdl-indent-region beg end nil) 7686 (let ((vhdl-align-groups t)) 7687 (vhdl-align-region beg end)) 7688 (vhdl-fix-case-region beg end)) 7689 7690(defun vhdl-beautify-buffer () 7691 "Beautify buffer by applying indentation, whitespace fixup, alignment, and 7692case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire 7693buffer." 7694 (interactive) 7695 (vhdl-beautify-region (point-min) (point-max)) 7696 (when noninteractive (save-buffer))) 7697 7698;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7699;; Code filling 7700 7701(defun vhdl-fill-region (beg end &optional arg) 7702 "Fill lines for a region of code." 7703 (interactive "r\np") 7704 (save-excursion 7705 (goto-char beg) 7706 (let ((margin (if arg (current-indentation) (current-column)))) 7707 (goto-char end) 7708 (setq end (point-marker)) 7709 ;; remove inline comments, newlines and whitespace 7710 (vhdl-comment-kill-region beg end) 7711 (vhdl-comment-kill-inline-region beg end) 7712 (subst-char-in-region beg (1- end) ?\n ?\ ) 7713 (vhdl-fixup-whitespace-region beg end) 7714 ;; wrap and end-comment-column 7715 (goto-char beg) 7716 (while (re-search-forward "\\s-" end t) 7717 (when(> (current-column) vhdl-end-comment-column) 7718 (backward-char) 7719 (when (re-search-backward "\\s-" beg t) 7720 (replace-match "\n") 7721 (indent-to margin))))))) 7722 7723(defun vhdl-fill-group () 7724 "Fill group of lines between empty lines." 7725 (interactive) 7726 (vhdl-do-group 'vhdl-fill-region)) 7727 7728(defun vhdl-fill-list () 7729 "Fill the lines of a list surrounded by a balanced group of parentheses." 7730 (interactive) 7731 (vhdl-do-list 'vhdl-fill-region)) 7732 7733(defun vhdl-fill-same-indent () 7734 "Fill the lines of block of lines with same indent." 7735 (interactive) 7736 (vhdl-do-same-indent 'vhdl-fill-region)) 7737 7738 7739;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7740;;; Code updating/fixing 7741;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7742 7743;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7744;; Sensitivity list update 7745 7746;; Strategy: 7747;; - no sensitivity list is generated for processes with wait statements 7748;; - otherwise, do the following: 7749;; 1. scan for all local signals (ports, signals declared in arch./blocks) 7750;; 2. scan for all signals already in the sensitivity list (in order to catch 7751;; manually entered global signals) 7752;; 3. signals from 1. and 2. form the list of visible signals 7753;; 4. search for if/elsif conditions containing an event (sequential code) 7754;; 5. scan for strings that are within syntactical regions where signals are 7755;; read but not within sequential code, and that correspond to visible 7756;; signals 7757;; 6. replace sensitivity list by list of signals from 5. 7758 7759(defun vhdl-update-sensitivity-list-process () 7760 "Update sensitivity list of current process." 7761 (interactive) 7762 (save-excursion 7763 (vhdl-prepare-search-2 7764 (end-of-line) 7765 ;; look whether in process 7766 (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) 7767 (equal (upcase (match-string 2)) "PROCESS") 7768 (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) 7769 (error "ERROR: Not within a process") 7770 (message "Updating sensitivity list...") 7771 (vhdl-update-sensitivity-list) 7772 (message "Updating sensitivity list...done"))))) 7773 7774(defun vhdl-update-sensitivity-list-buffer () 7775 "Update sensitivity list of all processes in current buffer." 7776 (interactive) 7777 (save-excursion 7778 (vhdl-prepare-search-2 7779 (goto-char (point-min)) 7780 (message "Updating sensitivity lists...") 7781 (while (re-search-forward "^\\s-*\\(\\w+[ \t\n]*:[ \t\n]*\\)?process\\>" nil t) 7782 (goto-char (match-beginning 0)) 7783 (condition-case nil (vhdl-update-sensitivity-list) (error ""))) 7784 (message "Updating sensitivity lists...done")))) 7785 7786(defun vhdl-update-sensitivity-list () 7787 "Update sensitivity list." 7788 (let ((proc-beg (point)) 7789 (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 7790 (proc-mid (re-search-backward "^\\s-*begin\\>" nil t)) 7791 seq-region-list) 7792 (cond 7793 ;; search for wait statement (no sensitivity list allowed) 7794 ((progn (goto-char proc-mid) 7795 (vhdl-re-search-forward "\\<wait\\>" proc-end t)) 7796 (error "ERROR: Process with wait statement, sensitivity list not generated")) 7797 ;; combinational process (update sensitivity list) 7798 (t 7799 (let 7800 ;; scan for visible signals 7801 ((visible-list (vhdl-get-visible-signals)) 7802 ;; define syntactic regions where signals are read 7803 (scan-regions-list 7804 '(;; right-hand side of signal/variable assignment 7805 ;; (special case: "<=" is relational operator in a condition) 7806 ((re-search-forward "[<:]=" proc-end t) 7807 (re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) 7808 ;; if condition 7809 ((re-search-forward "^\\s-*if\\>" proc-end t) 7810 (re-search-forward "\\<then\\>" proc-end t)) 7811 ;; elsif condition 7812 ((re-search-forward "\\<elsif\\>" proc-end t) 7813 (re-search-forward "\\<then\\>" proc-end t)) 7814 ;; while loop condition 7815 ((re-search-forward "^\\s-*while\\>" proc-end t) 7816 (re-search-forward "\\<loop\\>" proc-end t)) 7817 ;; exit/next condition 7818 ((re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) 7819 (re-search-forward ";" proc-end t)) 7820 ;; assert condition 7821 ((re-search-forward "\\<assert\\>" proc-end t) 7822 (re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) 7823 ;; case expression 7824 ((re-search-forward "^\\s-*case\\>" proc-end t) 7825 (re-search-forward "\\<is\\>" proc-end t)) 7826 ;; parameter list of procedure call 7827 ((and (re-search-forward "^\\s-*\\w+[ \t\n]*(" proc-end t) 7828 (1- (point))) 7829 (progn (backward-char) (forward-sexp) 7830 (while (looking-at "(") (forward-sexp)) (point))))) 7831 name read-list sens-list signal-list 7832 sens-beg sens-end beg end margin) 7833 ;; scan for signals in old sensitivity list 7834 (goto-char proc-beg) 7835 (re-search-forward "\\<process\\>" proc-mid t) 7836 (if (not (looking-at "[ \t\n]*(")) 7837 (setq sens-beg (point)) 7838 (setq sens-beg (re-search-forward "\\([ \t\n]*\\)([ \t\n]*" nil t)) 7839 (goto-char (match-end 1)) 7840 (forward-sexp) 7841 (setq sens-end (1- (point))) 7842 (goto-char sens-beg) 7843 (while (and (re-search-forward "\\(\\w+\\)" sens-end t) 7844 (setq sens-list 7845 (cons (downcase (match-string 0)) sens-list)) 7846 (re-search-forward "\\s-*,\\s-*" sens-end t)))) 7847 (setq signal-list (append visible-list sens-list)) 7848 ;; search for sequential parts 7849 (goto-char proc-mid) 7850 (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) 7851 (setq end (re-search-forward "\\<then\\>" proc-end t)) 7852 (when (re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) 7853 (goto-char end) 7854 (backward-word 1) 7855 (vhdl-forward-sexp) 7856 (setq seq-region-list (cons (cons end (point)) seq-region-list)) 7857 (beginning-of-line))) 7858 ;; scan for signals read in process 7859 (while scan-regions-list 7860 (goto-char proc-mid) 7861 (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) 7862 (setq end (eval (nth 1 (car scan-regions-list))))) 7863 (goto-char beg) 7864 (unless (or (vhdl-in-literal) 7865 (and seq-region-list 7866 (let ((tmp-list seq-region-list)) 7867 (while (and tmp-list 7868 (< (point) (caar tmp-list))) 7869 (setq tmp-list (cdr tmp-list))) 7870 (and tmp-list (< (point) (cdar tmp-list)))))) 7871 (while (vhdl-re-search-forward "[^'\"]\\<\\([a-zA-Z]\\w*\\)\\>[ \t\n]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) 7872 (setq name (match-string 1)) 7873 (when (and (not (match-string 4)) ; not when formal parameter 7874 (not (and (match-string 3) ; not event attribute 7875 (not (member (downcase (match-string 3)) 7876 '("event" "last_event" "transaction"))))) 7877 (member (downcase name) signal-list)) 7878 (unless (member-ignore-case name read-list) 7879 (setq read-list (cons name read-list)))) 7880 (goto-char (match-end 1))))) 7881 (setq scan-regions-list (cdr scan-regions-list))) 7882 ;; update sensitivity list 7883 (goto-char sens-beg) 7884 (if sens-end 7885 (delete-region sens-beg sens-end) 7886 (when read-list 7887 (insert " ()") (backward-char))) 7888 (setq read-list (sort read-list 'string<)) 7889 (when read-list 7890 (setq margin (current-column)) 7891 (insert (car read-list)) 7892 (setq read-list (cdr read-list)) 7893 (while read-list 7894 (insert ",") 7895 (if (<= (+ (current-column) (length (car read-list)) 2) 7896 end-comment-column) 7897 (insert " ") 7898 (insert "\n") (indent-to margin)) 7899 (insert (car read-list)) 7900 (setq read-list (cdr read-list))))))))) 7901 7902(defun vhdl-get-visible-signals () 7903 "Get all signals visible in the current block." 7904 (let (beg end signal-list entity-name file-name) 7905 (vhdl-prepare-search-2 7906 ;; get entity name 7907 (save-excursion 7908 (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 7909 (not (equal "END" (upcase (match-string 1)))) 7910 (setq entity-name (match-string 2))) 7911 (error "ERROR: Not within an architecture"))) 7912 ;; search for signals declared in entity port clause 7913 (save-excursion 7914 (goto-char (point-min)) 7915 (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) 7916 (setq file-name 7917 (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) 7918 "." (file-name-extension (buffer-file-name))))) 7919 (vhdl-visit-file 7920 file-name t 7921 (vhdl-prepare-search-2 7922 (goto-char (point-min)) 7923 (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) 7924 (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) 7925 (when (setq beg (re-search-forward 7926 "^\\s-*port[ \t\n]*(" 7927 (save-excursion 7928 (re-search-forward "^end\\>" nil t)) t)) 7929 (setq end (save-excursion 7930 (backward-char) (forward-sexp) (point))) 7931 (vhdl-forward-syntactic-ws) 7932 (while (< (point) end) 7933 (when (looking-at "signal[ \t\n]+") 7934 (goto-char (match-end 0))) 7935 (while (looking-at "\\(\\w+\\)[ \t\n,]+") 7936 (setq signal-list 7937 (cons (downcase (match-string 1)) signal-list)) 7938 (goto-char (match-end 0)) 7939 (vhdl-forward-syntactic-ws)) 7940 (re-search-forward ";" end 1) 7941 (vhdl-forward-syntactic-ws))))))) 7942 ;; search for signals declared in architecture declarative part 7943 (save-excursion 7944 (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) 7945 (not (equal "END" (upcase (match-string 1)))) 7946 (setq end (re-search-forward "^begin\\>" nil t)))) 7947 (error "ERROR: No architecture declarative part found") 7948 ;; scan for all declared signal and alias names 7949 (goto-char beg) 7950 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 7951 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 7952 (if (match-string 2) 7953 ;; scan signal name 7954 (while (looking-at "[ \t\n,]+\\(\\w+\\)") 7955 (setq signal-list 7956 (cons (downcase (match-string 1)) signal-list)) 7957 (goto-char (match-end 0))) 7958 ;; scan alias name, check is alias of (declared) signal 7959 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") 7960 (member (downcase (match-string 2)) signal-list)) 7961 (setq signal-list 7962 (cons (downcase (match-string 1)) signal-list)) 7963 (goto-char (match-end 0)))) 7964 (setq beg (point)))))) 7965 ;; search for signals declared in surrounding block declarative parts 7966 (save-excursion 7967 (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*block\\|\\(end\\)\\s-+block\\)\\>" nil t)) 7968 (match-string 2)) 7969 (goto-char (match-end 2)) 7970 (vhdl-backward-sexp) 7971 (re-search-backward "^\\s-*\\w+\\s-*:\\s-*block\\>" nil t)) 7972 beg) 7973 (setq end (re-search-forward "^\\s-*begin\\>" nil t))) 7974 ;; scan for all declared signal names 7975 (goto-char beg) 7976 (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) 7977 (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) 7978 (if (match-string 2) 7979 ;; scan signal name 7980 (while (looking-at "[ \t\n,]+\\(\\w+\\)") 7981 (setq signal-list 7982 (cons (downcase (match-string 1)) signal-list)) 7983 (goto-char (match-end 0))) 7984 ;; scan alias name, check is alias of (declared) signal 7985 (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") 7986 (member (downcase (match-string 2)) signal-list)) 7987 (setq signal-list 7988 (cons (downcase (match-string 1)) signal-list)) 7989 (goto-char (match-end 0)))))) 7990 (goto-char beg))) 7991 signal-list))) 7992 7993;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7994;; Generic/port clause fixing 7995 7996(defun vhdl-fix-clause () 7997 "Fix closing parenthesis within generic/port clause." 7998 (interactive) 7999 (save-excursion 8000 (vhdl-prepare-search-2 8001 (let ((pos (point)) 8002 beg end) 8003 (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n]*(" nil t)) 8004 (error "ERROR: Not within a generic/port clause") 8005 ;; search for end of clause 8006 (goto-char (match-end 0)) 8007 (setq beg (1- (point))) 8008 (vhdl-forward-syntactic-ws) 8009 (while (looking-at "\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*[ \t\n]*:[ \t\n]*\\w+[^;]*;") 8010 (goto-char (1- (match-end 0))) 8011 (setq end (point-marker)) 8012 (forward-char) 8013 (vhdl-forward-syntactic-ws)) 8014 (goto-char end) 8015 (when (> pos (save-excursion (end-of-line) (point))) 8016 (error "ERROR: Not within a generic/port clause")) 8017 ;; delete closing parenthesis on separate line (not supported style) 8018 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) 8019 (vhdl-line-kill) 8020 (vhdl-backward-syntactic-ws) 8021 (setq end (point-marker)) 8022 (insert ";")) 8023 ;; delete superfluous parentheses 8024 (while (progn (goto-char beg) 8025 (condition-case () (forward-sexp) 8026 (error (goto-char (point-max)))) 8027 (< (point) end)) 8028 (delete-backward-char 1)) 8029 ;; add closing parenthesis 8030 (when (> (point) end) 8031 (goto-char end) 8032 (insert ")"))))))) 8033 8034;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8035;; Miscellaneous 8036 8037(defun vhdl-remove-trailing-spaces () 8038 "Remove trailing spaces in the whole buffer." 8039 (interactive) 8040 (save-match-data 8041 (save-excursion 8042 (goto-char (point-min)) 8043 (while (re-search-forward "[ \t]+$" (point-max) t) 8044 (unless (vhdl-in-literal) 8045 (replace-match "" nil nil)))))) 8046 8047 8048;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8049;;; Electrification 8050;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8051 8052(defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" 8053 "Syntax of prompt inserted by template generators.") 8054 8055(defvar vhdl-template-invoked-by-hook nil 8056 "Indicates whether a template has been invoked by a hook or by key or menu. 8057Used for undoing after template abortion.") 8058 8059;; correct different behavior of function `unread-command-events' in XEmacs 8060(defun vhdl-character-to-event (arg)) 8061(defalias 'vhdl-character-to-event 8062 (if (fboundp 'character-to-event) 'character-to-event 'identity)) 8063 8064(defun vhdl-work-library () 8065 "Return the working library name of the current project or \"work\" if no 8066project is defined." 8067 (vhdl-resolve-env-variable 8068 (or (nth 6 (aget vhdl-project-alist vhdl-project)) vhdl-default-library))) 8069 8070;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8071;; Enabling/disabling 8072 8073(defun vhdl-mode-line-update () 8074 "Update the modeline string for VHDL major mode." 8075 (setq mode-name (concat "VHDL" 8076 (and (or vhdl-electric-mode vhdl-stutter-mode) "/") 8077 (and vhdl-electric-mode "e") 8078 (and vhdl-stutter-mode "s"))) 8079 (force-mode-line-update t)) 8080 8081(defun vhdl-electric-mode (arg) 8082 "Toggle VHDL electric mode. 8083Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." 8084 (interactive "P") 8085 (setq vhdl-electric-mode 8086 (cond ((or (not arg) (zerop arg)) (not vhdl-electric-mode)) 8087 ((> arg 0) t) (t nil))) 8088 (vhdl-mode-line-update)) 8089 8090(defun vhdl-stutter-mode (arg) 8091 "Toggle VHDL stuttering mode. 8092Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." 8093 (interactive "P") 8094 (setq vhdl-stutter-mode 8095 (cond ((or (not arg) (zerop arg)) (not vhdl-stutter-mode)) 8096 ((> arg 0) t) (t nil))) 8097 (vhdl-mode-line-update)) 8098 8099;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8100;; Stuttering 8101 8102(defun vhdl-electric-dash (count) 8103 "-- starts a comment, --- draws a horizontal line, 8104---- starts a display comment." 8105 (interactive "p") 8106 (if (and vhdl-stutter-mode (not (vhdl-in-literal))) 8107 (cond 8108 ((and abbrev-start-location (= abbrev-start-location (point))) 8109 (setq abbrev-start-location nil) 8110 (goto-char last-abbrev-location) 8111 (beginning-of-line nil) 8112 (vhdl-comment-display)) 8113 ((/= (preceding-char) ?-) ; standard dash (minus) 8114 (self-insert-command count)) 8115 (t (self-insert-command count) 8116 (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment") 8117 (let ((next-input (read-char))) 8118 (if (= next-input ?-) ; triple dash 8119 (progn 8120 (vhdl-comment-display-line) 8121 (message 8122 "Enter '-' for display comment, else continue coding") 8123 (let ((next-input (read-char))) 8124 (if (= next-input ?-) ; four dashes 8125 (vhdl-comment-display t) 8126 (setq unread-command-events ; pushback the char 8127 (list (vhdl-character-to-event next-input)))))) 8128 (setq unread-command-events ; pushback the char 8129 (list (vhdl-character-to-event next-input))) 8130 (vhdl-comment-insert))))) 8131 (self-insert-command count))) 8132 8133(defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['" 8134 (interactive "p") 8135 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8136 (if (= (preceding-char) ?\() 8137 (progn (delete-char -1) (insert-char ?\[ 1)) 8138 (insert-char ?\( 1)) 8139 (self-insert-command count))) 8140 8141(defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'" 8142 (interactive "p") 8143 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8144 (progn 8145 (if (= (preceding-char) ?\)) 8146 (progn (delete-char -1) (insert-char ?\] 1)) 8147 (insert-char ?\) 1)) 8148 (blink-matching-open)) 8149 (self-insert-command count))) 8150 8151(defun vhdl-electric-quote (count) "'' --> \"" 8152 (interactive "p") 8153 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8154 (if (= (preceding-char) last-input-char) 8155 (progn (delete-backward-char 1) (insert-char ?\" 1)) 8156 (insert-char ?\' 1)) 8157 (self-insert-command count))) 8158 8159(defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" 8160 (interactive "p") 8161 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8162 (cond ((= (preceding-char) last-input-char) 8163 (progn (delete-char -1) 8164 (unless (eq (preceding-char) ? ) (insert " ")) 8165 (insert ": ") 8166 (setq this-command 'vhdl-electric-colon))) 8167 ((and 8168 (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) 8169 (progn (delete-char -1) (insert "= "))) 8170 (t (insert-char ?\; 1))) 8171 (self-insert-command count))) 8172 8173(defun vhdl-electric-comma (count) "',,' --> ' <= '" 8174 (interactive "p") 8175 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8176 (cond ((= (preceding-char) last-input-char) 8177 (progn (delete-char -1) 8178 (unless (eq (preceding-char) ? ) (insert " ")) 8179 (insert "<= "))) 8180 (t (insert-char ?\, 1))) 8181 (self-insert-command count))) 8182 8183(defun vhdl-electric-period (count) "'..' --> ' => '" 8184 (interactive "p") 8185 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8186 (cond ((= (preceding-char) last-input-char) 8187 (progn (delete-char -1) 8188 (unless (eq (preceding-char) ? ) (insert " ")) 8189 (insert "=> "))) 8190 (t (insert-char ?\. 1))) 8191 (self-insert-command count))) 8192 8193(defun vhdl-electric-equal (count) "'==' --> ' == '" 8194 (interactive "p") 8195 (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) 8196 (cond ((= (preceding-char) last-input-char) 8197 (progn (delete-char -1) 8198 (unless (eq (preceding-char) ? ) (insert " ")) 8199 (insert "== "))) 8200 (t (insert-char ?\= 1))) 8201 (self-insert-command count))) 8202 8203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8204;; VHDL templates 8205 8206(defun vhdl-template-paired-parens () 8207 "Insert a pair of round parentheses, placing point between them." 8208 (interactive) 8209 (insert "()") 8210 (backward-char)) 8211 8212(defun vhdl-template-alias () 8213 "Insert alias declaration." 8214 (interactive) 8215 (let ((start (point))) 8216 (vhdl-insert-keyword "ALIAS ") 8217 (when (vhdl-template-field "name" nil t start (point)) 8218 (insert " : ") 8219 (unless (vhdl-template-field 8220 (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") 8221 nil t) 8222 (delete-backward-char 3)) 8223 (vhdl-insert-keyword " IS ") 8224 (vhdl-template-field "name" ";") 8225 (vhdl-comment-insert-inline)))) 8226 8227(defun vhdl-template-architecture () 8228 "Insert architecture." 8229 (interactive) 8230 (let ((margin (current-indentation)) 8231 (start (point)) 8232 arch-name) 8233 (vhdl-insert-keyword "ARCHITECTURE ") 8234 (when (setq arch-name 8235 (vhdl-template-field "name" nil t start (point))) 8236 (vhdl-insert-keyword " OF ") 8237 (if (save-excursion 8238 (vhdl-prepare-search-1 8239 (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) 8240 (insert (match-string 1)) 8241 (vhdl-template-field "entity name")) 8242 (vhdl-insert-keyword " IS\n") 8243 (vhdl-template-begin-end 8244 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin 8245 (memq vhdl-insert-empty-lines '(unit all)))))) 8246 8247(defun vhdl-template-array (kind &optional secondary) 8248 "Insert array type definition." 8249 (interactive) 8250 (let ((start (point))) 8251 (vhdl-insert-keyword "ARRAY (") 8252 (when (or (vhdl-template-field "range" nil (not secondary) start (point)) 8253 secondary) 8254 (vhdl-insert-keyword ") OF ") 8255 (vhdl-template-field (if (eq kind 'type) "type" "nature")) 8256 (vhdl-insert-keyword ";")))) 8257 8258(defun vhdl-template-assert () 8259 "Insert an assertion statement." 8260 (interactive) 8261 (let ((start (point))) 8262 (vhdl-insert-keyword "ASSERT ") 8263 (when vhdl-conditions-in-parenthesis (insert "(")) 8264 (when (vhdl-template-field "condition (negated)" nil t start (point)) 8265 (when vhdl-conditions-in-parenthesis (insert ")")) 8266 (setq start (point)) 8267 (vhdl-insert-keyword " REPORT ") 8268 (unless (vhdl-template-field "string expression" nil nil nil nil t) 8269 (delete-region start (point))) 8270 (setq start (point)) 8271 (vhdl-insert-keyword " SEVERITY ") 8272 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 8273 (delete-region start (point))) 8274 (insert ";")))) 8275 8276(defun vhdl-template-attribute () 8277 "Insert an attribute declaration or specification." 8278 (interactive) 8279 (if (eq (vhdl-decision-query 8280 "attribute" "(d)eclaration or (s)pecification?" t) ?s) 8281 (vhdl-template-attribute-spec) 8282 (vhdl-template-attribute-decl))) 8283 8284(defun vhdl-template-attribute-decl () 8285 "Insert an attribute declaration." 8286 (interactive) 8287 (let ((start (point))) 8288 (vhdl-insert-keyword "ATTRIBUTE ") 8289 (when (vhdl-template-field "name" " : " t start (point)) 8290 (vhdl-template-field "type" ";") 8291 (vhdl-comment-insert-inline)))) 8292 8293(defun vhdl-template-attribute-spec () 8294 "Insert an attribute specification." 8295 (interactive) 8296 (let ((start (point))) 8297 (vhdl-insert-keyword "ATTRIBUTE ") 8298 (when (vhdl-template-field "name" nil t start (point)) 8299 (vhdl-insert-keyword " OF ") 8300 (vhdl-template-field "entity names | OTHERS | ALL" " : ") 8301 (vhdl-template-field "entity class") 8302 (vhdl-insert-keyword " IS ") 8303 (vhdl-template-field "expression" ";")))) 8304 8305(defun vhdl-template-block () 8306 "Insert a block." 8307 (interactive) 8308 (let ((margin (current-indentation)) 8309 (start (point)) 8310 label) 8311 (vhdl-insert-keyword ": BLOCK ") 8312 (goto-char start) 8313 (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) 8314 (forward-word 1) 8315 (forward-char 1) 8316 (insert "(") 8317 (if (vhdl-template-field "[guard expression]" nil t) 8318 (insert ")") 8319 (delete-char -2)) 8320 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 8321 (insert "\n") 8322 (vhdl-template-begin-end "BLOCK" label margin) 8323 (vhdl-comment-block)))) 8324 8325(defun vhdl-template-block-configuration () 8326 "Insert a block configuration statement." 8327 (interactive) 8328 (let ((margin (current-indentation)) 8329 (start (point))) 8330 (vhdl-insert-keyword "FOR ") 8331 (when (vhdl-template-field "block name" nil t start (point)) 8332 (vhdl-insert-keyword "\n\n") 8333 (indent-to margin) 8334 (vhdl-insert-keyword "END FOR;") 8335 (end-of-line 0) 8336 (indent-to (+ margin vhdl-basic-offset))))) 8337 8338(defun vhdl-template-break () 8339 "Insert a break statement." 8340 (interactive) 8341 (let (position) 8342 (vhdl-insert-keyword "BREAK") 8343 (setq position (point)) 8344 (insert " ") 8345 (while (or 8346 (progn (vhdl-insert-keyword "FOR ") 8347 (if (vhdl-template-field "[quantity name]" " USE " t) 8348 (progn (vhdl-template-field "quantity name" " => ") t) 8349 (delete-region (point) 8350 (progn (forward-word -1) (point))) 8351 nil)) 8352 (vhdl-template-field "[quantity name]" " => " t)) 8353 (vhdl-template-field "expression") 8354 (setq position (point)) 8355 (insert ", ")) 8356 (delete-region position (point)) 8357 (unless (vhdl-sequential-statement-p) 8358 (vhdl-insert-keyword " ON ") 8359 (if (vhdl-template-field "[sensitivity list]" nil t) 8360 (setq position (point)) 8361 (delete-region position (point)))) 8362 (vhdl-insert-keyword " WHEN ") 8363 (when vhdl-conditions-in-parenthesis (insert "(")) 8364 (if (vhdl-template-field "[condition]" nil t) 8365 (when vhdl-conditions-in-parenthesis (insert ")")) 8366 (delete-region position (point))) 8367 (insert ";"))) 8368 8369(defun vhdl-template-case (&optional kind) 8370 "Insert a case statement." 8371 (interactive) 8372 (let ((margin (current-indentation)) 8373 (start (point)) 8374 label) 8375 (unless kind (setq kind (if (vhdl-sequential-statement-p) 'is 'use))) 8376 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 8377 (vhdl-insert-keyword "CASE ") 8378 (vhdl-insert-keyword ": CASE ") 8379 (goto-char start) 8380 (setq label (vhdl-template-field "[label]" nil t)) 8381 (unless label (delete-char 2)) 8382 (forward-word 1) 8383 (forward-char 1)) 8384 (when (vhdl-template-field "expression" nil t start (point)) 8385 (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) 8386 (indent-to margin) 8387 (vhdl-insert-keyword "END CASE") 8388 (when label (insert " " label)) 8389 (insert ";") 8390 (forward-line -1) 8391 (indent-to (+ margin vhdl-basic-offset)) 8392 (vhdl-insert-keyword "WHEN ") 8393 (let ((position (point))) 8394 (insert " => ;\n") 8395 (indent-to (+ margin vhdl-basic-offset)) 8396 (vhdl-insert-keyword "WHEN OTHERS => null;") 8397 (goto-char position))))) 8398 8399(defun vhdl-template-case-is () 8400 "Insert a sequential case statement." 8401 (interactive) 8402 (vhdl-template-case 'is)) 8403 8404(defun vhdl-template-case-use () 8405 "Insert a simultaneous case statement." 8406 (interactive) 8407 (vhdl-template-case 'use)) 8408 8409(defun vhdl-template-component () 8410 "Insert a component declaration." 8411 (interactive) 8412 (vhdl-template-component-decl)) 8413 8414(defun vhdl-template-component-conf () 8415 "Insert a component configuration (uses `vhdl-template-configuration-spec' 8416since these are almost equivalent)." 8417 (interactive) 8418 (let ((margin (current-indentation)) 8419 (result (vhdl-template-configuration-spec t))) 8420 (when result 8421 (insert "\n") 8422 (indent-to margin) 8423 (vhdl-insert-keyword "END FOR;") 8424 (when (eq result 'no-use) 8425 (end-of-line -0))))) 8426 8427(defun vhdl-template-component-decl () 8428 "Insert a component declaration." 8429 (interactive) 8430 (let ((margin (current-indentation)) 8431 (start (point)) 8432 name end-column) 8433 (vhdl-insert-keyword "COMPONENT ") 8434 (when (setq name (vhdl-template-field "name" nil t start (point))) 8435 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 8436 (insert "\n\n") 8437 (indent-to margin) 8438 (vhdl-insert-keyword "END COMPONENT") 8439 (unless (vhdl-standard-p '87) (insert " " name)) 8440 (insert ";") 8441 (setq end-column (current-column)) 8442 (end-of-line -0) 8443 (indent-to (+ margin vhdl-basic-offset)) 8444 (vhdl-template-generic-list t t) 8445 (insert "\n") 8446 (indent-to (+ margin vhdl-basic-offset)) 8447 (vhdl-template-port-list t) 8448 (beginning-of-line 2) 8449 (forward-char end-column)))) 8450 8451(defun vhdl-template-component-inst () 8452 "Insert a component instantiation statement." 8453 (interactive) 8454 (let ((margin (current-indentation)) 8455 (start (point)) 8456 unit position) 8457 (when (vhdl-template-field "instance label" nil t start (point)) 8458 (insert ": ") 8459 (if (not (vhdl-use-direct-instantiation)) 8460 (vhdl-template-field "component name") 8461 ;; direct instantiation 8462 (setq unit (vhdl-template-field 8463 "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) 8464 (setq unit (upcase (or unit ""))) 8465 (cond ((equal unit "ENTITY") 8466 (vhdl-template-field "library name" "." nil nil nil nil 8467 (vhdl-work-library)) 8468 (vhdl-template-field "entity name" "(") 8469 (if (vhdl-template-field "[architecture name]" nil t) 8470 (insert ")") 8471 (delete-char -1))) 8472 ((equal unit "CONFIGURATION") 8473 (vhdl-template-field "library name" "." nil nil nil nil 8474 (vhdl-work-library)) 8475 (vhdl-template-field "configuration name")) 8476 (t (vhdl-template-field "component name")))) 8477 (insert "\n") 8478 (indent-to (+ margin vhdl-basic-offset)) 8479 (setq position (point)) 8480 (vhdl-insert-keyword "GENERIC ") 8481 (when (vhdl-template-map position t t) 8482 (insert "\n") 8483 (indent-to (+ margin vhdl-basic-offset))) 8484 (setq position (point)) 8485 (vhdl-insert-keyword "PORT ") 8486 (unless (vhdl-template-map position t t) 8487 (delete-region (line-beginning-position) (point)) 8488 (delete-char -1)) 8489 (insert ";")))) 8490 8491(defun vhdl-template-conditional-signal-asst () 8492 "Insert a conditional signal assignment." 8493 (interactive) 8494 (when (vhdl-template-field "target signal") 8495 (insert " <= ") 8496; (if (not (equal (vhdl-template-field "[GUARDED] [TRANSPORT]") "")) 8497; (insert " ")) 8498 (let ((margin (current-column)) 8499 (start (point)) 8500 position) 8501 (vhdl-template-field "waveform") 8502 (setq position (point)) 8503 (vhdl-insert-keyword " WHEN ") 8504 (when vhdl-conditions-in-parenthesis (insert "(")) 8505 (while (and (vhdl-template-field "[condition]" nil t) 8506 (progn 8507 (when vhdl-conditions-in-parenthesis (insert ")")) 8508 (setq position (point)) 8509 (vhdl-insert-keyword " ELSE") 8510 (insert "\n") 8511 (indent-to margin) 8512 (vhdl-template-field "[waveform]" nil t))) 8513 (setq position (point)) 8514 (vhdl-insert-keyword " WHEN ") 8515 (when vhdl-conditions-in-parenthesis (insert "("))) 8516 (delete-region position (point)) 8517 (insert ";") 8518 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 8519 8520(defun vhdl-template-configuration () 8521 "Insert a configuration specification if within an architecture, 8522a block or component configuration if within a configuration declaration, 8523a configuration declaration if not within a design unit." 8524 (interactive) 8525 (vhdl-prepare-search-1 8526 (cond 8527 ((and (save-excursion ; architecture body 8528 (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) 8529 (equal "ARCHITECTURE" (upcase (match-string 1)))) 8530 (vhdl-template-configuration-spec)) 8531 ((and (save-excursion ; configuration declaration 8532 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 8533 (equal "CONFIGURATION" (upcase (match-string 1)))) 8534 (if (eq (vhdl-decision-query 8535 "configuration" "(b)lock or (c)omponent configuration?" t) ?c) 8536 (vhdl-template-component-conf) 8537 (vhdl-template-block-configuration))) 8538 (t (vhdl-template-configuration-decl))))) ; otherwise 8539 8540(defun vhdl-template-configuration-spec (&optional optional-use) 8541 "Insert a configuration specification." 8542 (interactive) 8543 (let ((margin (current-indentation)) 8544 (start (point)) 8545 aspect position) 8546 (vhdl-insert-keyword "FOR ") 8547 (when (vhdl-template-field "instance names | OTHERS | ALL" " : " 8548 t start (point)) 8549 (vhdl-template-field "component name" "\n") 8550 (indent-to (+ margin vhdl-basic-offset)) 8551 (setq start (point)) 8552 (vhdl-insert-keyword "USE ") 8553 (if (and optional-use 8554 (not (setq aspect (vhdl-template-field 8555 "[ENTITY | CONFIGURATION | OPEN]" " " t)))) 8556 (progn (delete-region start (point)) 'no-use) 8557 (unless optional-use 8558 (setq aspect (vhdl-template-field 8559 "ENTITY | CONFIGURATION | OPEN" " "))) 8560 (setq aspect (upcase (or aspect ""))) 8561 (cond ((equal aspect "ENTITY") 8562 (vhdl-template-field "library name" "." nil nil nil nil 8563 (vhdl-work-library)) 8564 (vhdl-template-field "entity name" "(") 8565 (if (vhdl-template-field "[architecture name]" nil t) 8566 (insert ")") 8567 (delete-char -1)) 8568 (insert "\n") 8569 (indent-to (+ margin (* 2 vhdl-basic-offset))) 8570 (setq position (point)) 8571 (vhdl-insert-keyword "GENERIC ") 8572 (when (vhdl-template-map position t t) 8573 (insert "\n") 8574 (indent-to (+ margin (* 2 vhdl-basic-offset)))) 8575 (setq position (point)) 8576 (vhdl-insert-keyword "PORT ") 8577 (unless (vhdl-template-map position t t) 8578 (delete-region (line-beginning-position) (point)) 8579 (delete-char -1)) 8580 (insert ";") 8581 t) 8582 ((equal aspect "CONFIGURATION") 8583 (vhdl-template-field "library name" "." nil nil nil nil 8584 (vhdl-work-library)) 8585 (vhdl-template-field "configuration name" ";")) 8586 (t (delete-backward-char 1) (insert ";") t)))))) 8587 8588 8589(defun vhdl-template-configuration-decl () 8590 "Insert a configuration declaration." 8591 (interactive) 8592 (let ((margin (current-indentation)) 8593 (start (point)) 8594 entity-exists string name position) 8595 (vhdl-insert-keyword "CONFIGURATION ") 8596 (when (setq name (vhdl-template-field "name" nil t start (point))) 8597 (vhdl-insert-keyword " OF ") 8598 (save-excursion 8599 (vhdl-prepare-search-1 8600 (setq entity-exists (vhdl-re-search-backward 8601 "\\<entity \\(\\w*\\) is\\>" nil t)) 8602 (setq string (match-string 1)))) 8603 (if (and entity-exists (not (equal string ""))) 8604 (insert string) 8605 (vhdl-template-field "entity name")) 8606 (vhdl-insert-keyword " IS\n") 8607 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 8608 (indent-to (+ margin vhdl-basic-offset)) 8609 (setq position (point)) 8610 (insert "\n") 8611 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 8612 (indent-to margin) 8613 (vhdl-insert-keyword "END ") 8614 (unless (vhdl-standard-p '87) 8615 (vhdl-insert-keyword "CONFIGURATION ")) 8616 (insert name ";") 8617 (goto-char position)))) 8618 8619(defun vhdl-template-constant () 8620 "Insert a constant declaration." 8621 (interactive) 8622 (let ((start (point)) 8623 (in-arglist (vhdl-in-argument-list-p))) 8624 (vhdl-insert-keyword "CONSTANT ") 8625 (when (vhdl-template-field "name" nil t start (point)) 8626 (insert " : ") 8627 (when in-arglist (vhdl-insert-keyword "IN ")) 8628 (vhdl-template-field "type") 8629 (if in-arglist 8630 (progn (insert ";") 8631 (vhdl-comment-insert-inline)) 8632 (let ((position (point))) 8633 (insert " := ") 8634 (unless (vhdl-template-field "[initialization]" nil t) 8635 (delete-region position (point))) 8636 (insert ";") 8637 (vhdl-comment-insert-inline)))))) 8638 8639(defun vhdl-template-default () 8640 "Insert nothing." 8641 (interactive) 8642 (insert " ") 8643 (unexpand-abbrev) 8644 (backward-word 1) 8645 (vhdl-case-word 1) 8646 (forward-char 1)) 8647 8648(defun vhdl-template-default-indent () 8649 "Insert nothing and indent." 8650 (interactive) 8651 (insert " ") 8652 (unexpand-abbrev) 8653 (backward-word 1) 8654 (vhdl-case-word 1) 8655 (forward-char 1) 8656 (indent-according-to-mode)) 8657 8658(defun vhdl-template-disconnect () 8659 "Insert a disconnect statement." 8660 (interactive) 8661 (let ((start (point))) 8662 (vhdl-insert-keyword "DISCONNECT ") 8663 (when (vhdl-template-field "signal names | OTHERS | ALL" 8664 " : " t start (point)) 8665 (vhdl-template-field "type") 8666 (vhdl-insert-keyword " AFTER ") 8667 (vhdl-template-field "time expression" ";")))) 8668 8669(defun vhdl-template-else () 8670 "Insert an else statement." 8671 (interactive) 8672 (let (margin) 8673 (vhdl-prepare-search-1 8674 (vhdl-insert-keyword "ELSE") 8675 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t)) 8676 (equal "WHEN" (upcase (match-string 1)))) 8677 (insert " ") 8678 (indent-according-to-mode) 8679 (setq margin (current-indentation)) 8680 (insert "\n") 8681 (indent-to (+ margin vhdl-basic-offset)))))) 8682 8683(defun vhdl-template-elsif () 8684 "Insert an elsif statement." 8685 (interactive) 8686 (let ((start (point)) 8687 margin) 8688 (vhdl-insert-keyword "ELSIF ") 8689 (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams)) 8690 (when vhdl-conditions-in-parenthesis (insert "(")) 8691 (when (vhdl-template-field "condition" nil t start (point)) 8692 (when vhdl-conditions-in-parenthesis (insert ")")) 8693 (indent-according-to-mode) 8694 (setq margin (current-indentation)) 8695 (vhdl-insert-keyword 8696 (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n")) 8697 (indent-to (+ margin vhdl-basic-offset)))))) 8698 8699(defun vhdl-template-entity () 8700 "Insert an entity." 8701 (interactive) 8702 (let ((margin (current-indentation)) 8703 (start (point)) 8704 name end-column) 8705 (vhdl-insert-keyword "ENTITY ") 8706 (when (setq name (vhdl-template-field "name" nil t start (point))) 8707 (vhdl-insert-keyword " IS\n\n") 8708 (indent-to margin) 8709 (vhdl-insert-keyword "END ") 8710 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 8711 (insert name ";") 8712 (setq end-column (current-column)) 8713 (end-of-line -0) 8714 (indent-to (+ margin vhdl-basic-offset)) 8715 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 8716 (indent-to (+ margin vhdl-basic-offset)) 8717 (when (vhdl-template-generic-list t) 8718 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 8719 (insert "\n") 8720 (indent-to (+ margin vhdl-basic-offset)) 8721 (when (vhdl-template-port-list t) 8722 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) 8723 (beginning-of-line 2) 8724 (forward-char end-column)))) 8725 8726(defun vhdl-template-exit () 8727 "Insert an exit statement." 8728 (interactive) 8729 (let ((start (point))) 8730 (vhdl-insert-keyword "EXIT ") 8731 (if (vhdl-template-field "[loop label]" nil t start (point)) 8732 (let ((position (point))) 8733 (vhdl-insert-keyword " WHEN ") 8734 (when vhdl-conditions-in-parenthesis (insert "(")) 8735 (if (vhdl-template-field "[condition]" nil t) 8736 (when vhdl-conditions-in-parenthesis (insert ")")) 8737 (delete-region position (point)))) 8738 (delete-char -1)) 8739 (insert ";"))) 8740 8741(defun vhdl-template-file () 8742 "Insert a file declaration." 8743 (interactive) 8744 (let ((start (point))) 8745 (vhdl-insert-keyword "FILE ") 8746 (when (vhdl-template-field "name" nil t start (point)) 8747 (insert " : ") 8748 (vhdl-template-field "type") 8749 (unless (vhdl-standard-p '87) 8750 (vhdl-insert-keyword " OPEN ") 8751 (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" 8752 nil t) 8753 (delete-backward-char 6))) 8754 (vhdl-insert-keyword " IS ") 8755 (when (vhdl-standard-p '87) 8756 (vhdl-template-field "[IN | OUT]" " " t)) 8757 (vhdl-template-field "filename-string" nil nil nil nil t) 8758 (insert ";") 8759 (vhdl-comment-insert-inline)))) 8760 8761(defun vhdl-template-for () 8762 "Insert a block or component configuration if within a configuration 8763declaration, a configuration specification if within an architecture 8764declarative part (and not within a subprogram), a for-loop if within a 8765sequential statement part (subprogram or process), and a for-generate 8766otherwise." 8767 (interactive) 8768 (vhdl-prepare-search-1 8769 (cond 8770 ((vhdl-sequential-statement-p) ; sequential statement 8771 (vhdl-template-for-loop)) 8772 ((and (save-excursion ; configuration declaration 8773 (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) 8774 (equal "CONFIGURATION" (upcase (match-string 1)))) 8775 (if (eq (vhdl-decision-query 8776 "for" "(b)lock or (c)omponent configuration?" t) ?c) 8777 (vhdl-template-component-conf) 8778 (vhdl-template-block-configuration))) 8779 ((and (save-excursion 8780 (re-search-backward ; architecture declarative part 8781 "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) 8782 (equal "ARCHITECTURE" (upcase (match-string 1)))) 8783 (vhdl-template-configuration-spec)) 8784 (t (vhdl-template-for-generate))))) ; concurrent statement 8785 8786(defun vhdl-template-for-generate () 8787 "Insert a for-generate." 8788 (interactive) 8789 (let ((margin (current-indentation)) 8790 (start (point)) 8791 label position) 8792 (vhdl-insert-keyword ": FOR ") 8793 (setq position (point-marker)) 8794 (goto-char start) 8795 (when (setq label (vhdl-template-field "label" nil t start position)) 8796 (goto-char position) 8797 (vhdl-template-field "loop variable") 8798 (vhdl-insert-keyword " IN ") 8799 (vhdl-template-field "range") 8800 (vhdl-template-generate-body margin label)))) 8801 8802(defun vhdl-template-for-loop () 8803 "Insert a for loop." 8804 (interactive) 8805 (let ((margin (current-indentation)) 8806 (start (point)) 8807 label index) 8808 (if (not (eq vhdl-optional-labels 'all)) 8809 (vhdl-insert-keyword "FOR ") 8810 (vhdl-insert-keyword ": FOR ") 8811 (goto-char start) 8812 (setq label (vhdl-template-field "[label]" nil t)) 8813 (unless label (delete-char 2)) 8814 (forward-word 1) 8815 (forward-char 1)) 8816 (when (setq index (vhdl-template-field "loop variable" 8817 nil t start (point))) 8818 (vhdl-insert-keyword " IN ") 8819 (vhdl-template-field "range") 8820 (vhdl-insert-keyword " LOOP\n\n") 8821 (indent-to margin) 8822 (vhdl-insert-keyword "END LOOP") 8823 (if label 8824 (insert " " label ";") 8825 (insert ";") 8826 (when vhdl-self-insert-comments (insert " -- " index))) 8827 (forward-line -1) 8828 (indent-to (+ margin vhdl-basic-offset))))) 8829 8830(defun vhdl-template-function (&optional kind) 8831 "Insert a function declaration or body." 8832 (interactive) 8833 (let ((margin (current-indentation)) 8834 (start (point)) 8835 name) 8836 (vhdl-insert-keyword "FUNCTION ") 8837 (when (setq name (vhdl-template-field "name" nil t start (point))) 8838 (vhdl-template-argument-list t) 8839 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 8840 (end-of-line) 8841 (insert "\n") 8842 (indent-to (+ margin vhdl-basic-offset)) 8843 (vhdl-insert-keyword "RETURN ") 8844 (vhdl-template-field "type") 8845 (if (if kind (eq kind 'body) 8846 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 8847 (progn (vhdl-insert-keyword " IS\n") 8848 (vhdl-template-begin-end 8849 (unless (vhdl-standard-p '87) "FUNCTION") name margin) 8850 (vhdl-comment-block)) 8851 (insert ";"))))) 8852 8853(defun vhdl-template-function-decl () 8854 "Insert a function declaration." 8855 (interactive) 8856 (vhdl-template-function 'decl)) 8857 8858(defun vhdl-template-function-body () 8859 "Insert a function declaration." 8860 (interactive) 8861 (vhdl-template-function 'body)) 8862 8863(defun vhdl-template-generate () 8864 "Insert a generation scheme." 8865 (interactive) 8866 (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) 8867 (vhdl-template-if-generate) 8868 (vhdl-template-for-generate))) 8869 8870(defun vhdl-template-generic () 8871 "Insert generic declaration, or generic map in instantiation statements." 8872 (interactive) 8873 (let ((start (point))) 8874 (vhdl-prepare-search-1 8875 (cond 8876 ((and (save-excursion ; entity declaration 8877 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 8878 (equal "ENTITY" (upcase (match-string 1)))) 8879 (vhdl-template-generic-list nil)) 8880 ((or (save-excursion 8881 (or (beginning-of-line) 8882 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 8883 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 8884 (vhdl-insert-keyword "GENERIC ") 8885 (vhdl-template-map start)) 8886 (t (vhdl-template-generic-list nil t)))))) 8887 8888(defun vhdl-template-group () 8889 "Insert group or group template declaration." 8890 (interactive) 8891 (let ((start (point))) 8892 (if (eq (vhdl-decision-query 8893 "group" "(d)eclaration or (t)emplate declaration?" t) ?t) 8894 (vhdl-template-group-template) 8895 (vhdl-template-group-decl)))) 8896 8897(defun vhdl-template-group-decl () 8898 "Insert group declaration." 8899 (interactive) 8900 (let ((start (point))) 8901 (vhdl-insert-keyword "GROUP ") 8902 (when (vhdl-template-field "name" " : " t start (point)) 8903 (vhdl-template-field "template name" " (") 8904 (vhdl-template-field "constituent list" ");") 8905 (vhdl-comment-insert-inline)))) 8906 8907(defun vhdl-template-group-template () 8908 "Insert group template declaration." 8909 (interactive) 8910 (let ((start (point))) 8911 (vhdl-insert-keyword "GROUP ") 8912 (when (vhdl-template-field "template name" nil t start (point)) 8913 (vhdl-insert-keyword " IS (") 8914 (vhdl-template-field "entity class list" ");") 8915 (vhdl-comment-insert-inline)))) 8916 8917(defun vhdl-template-if () 8918 "Insert a sequential if statement or an if-generate statement." 8919 (interactive) 8920 (if (vhdl-sequential-statement-p) 8921 (vhdl-template-if-then) 8922 (if (and (vhdl-standard-p 'ams) 8923 (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) 8924 (vhdl-template-if-use) 8925 (vhdl-template-if-generate)))) 8926 8927(defun vhdl-template-if-generate () 8928 "Insert an if-generate." 8929 (interactive) 8930 (let ((margin (current-indentation)) 8931 (start (point)) 8932 label position) 8933 (vhdl-insert-keyword ": IF ") 8934 (setq position (point-marker)) 8935 (goto-char start) 8936 (when (setq label (vhdl-template-field "label" nil t start position)) 8937 (goto-char position) 8938 (when vhdl-conditions-in-parenthesis (insert "(")) 8939 (vhdl-template-field "condition") 8940 (when vhdl-conditions-in-parenthesis (insert ")")) 8941 (vhdl-template-generate-body margin label)))) 8942 8943(defun vhdl-template-if-then-use (kind) 8944 "Insert a sequential if statement." 8945 (interactive) 8946 (let ((margin (current-indentation)) 8947 (start (point)) 8948 label) 8949 (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) 8950 (vhdl-insert-keyword "IF ") 8951 (vhdl-insert-keyword ": IF ") 8952 (goto-char start) 8953 (setq label (vhdl-template-field "[label]" nil t)) 8954 (unless label (delete-char 2)) 8955 (forward-word 1) 8956 (forward-char 1)) 8957 (when vhdl-conditions-in-parenthesis (insert "(")) 8958 (when (vhdl-template-field "condition" nil t start (point)) 8959 (when vhdl-conditions-in-parenthesis (insert ")")) 8960 (vhdl-insert-keyword 8961 (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) 8962 (indent-to margin) 8963 (vhdl-insert-keyword "END IF") 8964 (when label (insert " " label)) 8965 (insert ";") 8966 (forward-line -1) 8967 (indent-to (+ margin vhdl-basic-offset))))) 8968 8969(defun vhdl-template-if-then () 8970 "Insert a sequential if statement." 8971 (interactive) 8972 (vhdl-template-if-then-use 'then)) 8973 8974(defun vhdl-template-if-use () 8975 "Insert a simultaneous if statement." 8976 (interactive) 8977 (vhdl-template-if-then-use 'use)) 8978 8979(defun vhdl-template-instance () 8980 "Insert a component instantiation statement." 8981 (interactive) 8982 (vhdl-template-component-inst)) 8983 8984(defun vhdl-template-library () 8985 "Insert a library specification." 8986 (interactive) 8987 (let ((margin (current-indentation)) 8988 (start (point)) 8989 name end-pos) 8990 (vhdl-insert-keyword "LIBRARY ") 8991 (when (setq name (vhdl-template-field "names" nil t start (point))) 8992 (insert ";") 8993 (unless (string-match "," name) 8994 (setq end-pos (point)) 8995 (insert "\n") 8996 (indent-to margin) 8997 (vhdl-insert-keyword "USE ") 8998 (insert name) 8999 (vhdl-insert-keyword "..ALL;") 9000 (backward-char 5) 9001 (if (vhdl-template-field "package name") 9002 (forward-char 5) 9003 (delete-region end-pos (+ (point) 5))))))) 9004 9005(defun vhdl-template-limit () 9006 "Insert a limit." 9007 (interactive) 9008 (let ((start (point))) 9009 (vhdl-insert-keyword "LIMIT ") 9010 (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " 9011 t start (point)) 9012 (vhdl-template-field "type") 9013 (vhdl-insert-keyword " WITH ") 9014 (vhdl-template-field "real expression" ";")))) 9015 9016(defun vhdl-template-loop () 9017 "Insert a loop." 9018 (interactive) 9019 (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) 9020 (cond ((eq char ?w) 9021 (vhdl-template-while-loop)) 9022 ((eq char ?f) 9023 (vhdl-template-for-loop)) 9024 (t (vhdl-template-bare-loop))))) 9025 9026(defun vhdl-template-bare-loop () 9027 "Insert a loop." 9028 (interactive) 9029 (let ((margin (current-indentation)) 9030 (start (point)) 9031 label) 9032 (if (not (eq vhdl-optional-labels 'all)) 9033 (vhdl-insert-keyword "LOOP ") 9034 (vhdl-insert-keyword ": LOOP ") 9035 (goto-char start) 9036 (setq label (vhdl-template-field "[label]" nil t)) 9037 (unless label (delete-char 2)) 9038 (forward-word 1) 9039 (delete-char 1)) 9040 (insert "\n\n") 9041 (indent-to margin) 9042 (vhdl-insert-keyword "END LOOP") 9043 (insert (if label (concat " " label ";") ";")) 9044 (forward-line -1) 9045 (indent-to (+ margin vhdl-basic-offset)))) 9046 9047(defun vhdl-template-map (&optional start optional secondary) 9048 "Insert a map specification with association list." 9049 (interactive) 9050 (let ((start (or start (point))) 9051 margin end-pos) 9052 (vhdl-insert-keyword "MAP (") 9053 (if (not vhdl-association-list-with-formals) 9054 (if (vhdl-template-field 9055 (concat (and optional "[") "association list" (and optional "]")) 9056 ")" (or (not secondary) optional) 9057 (and (not secondary) start) (point)) 9058 t 9059 (if (and optional secondary) (delete-region start (point))) 9060 nil) 9061 (if vhdl-argument-list-indent 9062 (setq margin (current-column)) 9063 (setq margin (+ (current-indentation) vhdl-basic-offset)) 9064 (insert "\n") 9065 (indent-to margin)) 9066 (if (vhdl-template-field 9067 (concat (and optional "[") "formal" (and optional "]")) 9068 " => " (or (not secondary) optional) 9069 (and (not secondary) start) (point)) 9070 (progn 9071 (vhdl-template-field "actual" ",") 9072 (setq end-pos (point)) 9073 (insert "\n") 9074 (indent-to margin) 9075 (while (vhdl-template-field "[formal]" " => " t) 9076 (vhdl-template-field "actual" ",") 9077 (setq end-pos (point)) 9078 (insert "\n") 9079 (indent-to margin)) 9080 (delete-region end-pos (point)) 9081 (delete-backward-char 1) 9082 (insert ")") 9083 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9084 t) 9085 (when (and optional secondary) (delete-region start (point))) 9086 nil)))) 9087 9088(defun vhdl-template-modify (&optional noerror) 9089 "Actualize modification date." 9090 (interactive) 9091 (vhdl-prepare-search-2 9092 (save-excursion 9093 (goto-char (point-min)) 9094 (if (re-search-forward vhdl-modify-date-prefix-string nil t) 9095 (progn (delete-region (point) (progn (end-of-line) (point))) 9096 (vhdl-template-insert-date)) 9097 (unless noerror 9098 (error (concat "ERROR: Modification date prefix string \"" 9099 vhdl-modify-date-prefix-string "\" not found"))))))) 9100 9101(defun vhdl-template-modify-noerror () 9102 "Call `vhdl-template-modify' with NOERROR non-nil." 9103 (vhdl-template-modify t)) 9104 9105(defun vhdl-template-nature () 9106 "Insert a nature declaration." 9107 (interactive) 9108 (let ((start (point)) 9109 name mid-pos end-pos) 9110 (vhdl-insert-keyword "NATURE ") 9111 (when (setq name (vhdl-template-field "name" nil t start (point))) 9112 (vhdl-insert-keyword " IS ") 9113 (let ((definition 9114 (upcase 9115 (or (vhdl-template-field 9116 "across type | ARRAY | RECORD") 9117 "")))) 9118 (cond ((equal definition "") 9119 (insert ";")) 9120 ((equal definition "ARRAY") 9121 (delete-region (point) (progn (forward-word -1) (point))) 9122 (vhdl-template-array 'nature t)) 9123 ((equal definition "RECORD") 9124 (setq mid-pos (point-marker)) 9125 (delete-region (point) (progn (forward-word -1) (point))) 9126 (vhdl-template-record 'nature name t)) 9127 (t 9128 (vhdl-insert-keyword " ACROSS ") 9129 (vhdl-template-field "through type") 9130 (vhdl-insert-keyword " THROUGH ") 9131 (vhdl-template-field "reference name") 9132 (vhdl-insert-keyword " REFERENCE;"))) 9133 (when mid-pos 9134 (setq end-pos (point-marker)) 9135 (goto-char mid-pos) 9136 (end-of-line)) 9137 (vhdl-comment-insert-inline) 9138 (when end-pos (goto-char end-pos)))))) 9139 9140(defun vhdl-template-next () 9141 "Insert a next statement." 9142 (interactive) 9143 (let ((start (point))) 9144 (vhdl-insert-keyword "NEXT ") 9145 (if (vhdl-template-field "[loop label]" nil t start (point)) 9146 (let ((position (point))) 9147 (vhdl-insert-keyword " WHEN ") 9148 (when vhdl-conditions-in-parenthesis (insert "(")) 9149 (if (vhdl-template-field "[condition]" nil t) 9150 (when vhdl-conditions-in-parenthesis (insert ")")) 9151 (delete-region position (point)))) 9152 (delete-char -1)) 9153 (insert ";"))) 9154 9155(defun vhdl-template-others () 9156 "Insert an others aggregate." 9157 (interactive) 9158 (let ((start (point))) 9159 (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) 9160 (progn (unless vhdl-template-invoked-by-hook (insert "(")) 9161 (vhdl-insert-keyword "OTHERS => '") 9162 (when (vhdl-template-field "value" nil t start (point)) 9163 (insert "')"))) 9164 (vhdl-insert-keyword "OTHERS ")))) 9165 9166(defun vhdl-template-package (&optional kind) 9167 "Insert a package specification or body." 9168 (interactive) 9169 (let ((margin (current-indentation)) 9170 (start (point)) 9171 name body position) 9172 (vhdl-insert-keyword "PACKAGE ") 9173 (setq body (if kind (eq kind 'body) 9174 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) 9175 (when body 9176 (vhdl-insert-keyword "BODY ") 9177 (when (save-excursion 9178 (vhdl-prepare-search-1 9179 (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) 9180 (insert (setq name (match-string 1))))) 9181 (when (or name 9182 (setq name (vhdl-template-field "name" nil t start (point)))) 9183 (vhdl-insert-keyword " IS\n") 9184 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9185 (indent-to (+ margin vhdl-basic-offset)) 9186 (setq position (point)) 9187 (insert "\n") 9188 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 9189 (indent-to margin) 9190 (vhdl-insert-keyword "END ") 9191 (unless (vhdl-standard-p '87) 9192 (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) 9193 (insert (or name "") ";") 9194 (goto-char position)))) 9195 9196(defun vhdl-template-package-decl () 9197 "Insert a package specification." 9198 (interactive) 9199 (vhdl-template-package 'decl)) 9200 9201(defun vhdl-template-package-body () 9202 "Insert a package body." 9203 (interactive) 9204 (vhdl-template-package 'body)) 9205 9206(defun vhdl-template-port () 9207 "Insert a port declaration, or port map in instantiation statements." 9208 (interactive) 9209 (let ((start (point))) 9210 (vhdl-prepare-search-1 9211 (cond 9212 ((and (save-excursion ; entity declaration 9213 (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) 9214 (equal "ENTITY" (upcase (match-string 1)))) 9215 (vhdl-template-port-list nil)) 9216 ((or (save-excursion 9217 (or (beginning-of-line) 9218 (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) 9219 (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) 9220 (vhdl-insert-keyword "PORT ") 9221 (vhdl-template-map start)) 9222 (t (vhdl-template-port-list nil)))))) 9223 9224(defun vhdl-template-procedural () 9225 "Insert a procedural." 9226 (interactive) 9227 (let ((margin (current-indentation)) 9228 (start (point)) 9229 (case-fold-search t) 9230 label) 9231 (vhdl-insert-keyword "PROCEDURAL ") 9232 (when (memq vhdl-optional-labels '(process all)) 9233 (goto-char start) 9234 (insert ": ") 9235 (goto-char start) 9236 (setq label (vhdl-template-field "[label]" nil t)) 9237 (unless label (delete-char 2)) 9238 (forward-word 1) 9239 (forward-char 1)) 9240 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) 9241 (insert "\n") 9242 (vhdl-template-begin-end "PROCEDURAL" label margin) 9243 (vhdl-comment-block))) 9244 9245(defun vhdl-template-procedure (&optional kind) 9246 "Insert a procedure declaration or body." 9247 (interactive) 9248 (let ((margin (current-indentation)) 9249 (start (point)) 9250 name) 9251 (vhdl-insert-keyword "PROCEDURE ") 9252 (when (setq name (vhdl-template-field "name" nil t start (point))) 9253 (vhdl-template-argument-list) 9254 (if (if kind (eq kind 'body) 9255 (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) 9256 (progn (vhdl-insert-keyword " IS") 9257 (when vhdl-auto-align 9258 (vhdl-align-region-groups start (point) 1)) 9259 (end-of-line) (insert "\n") 9260 (vhdl-template-begin-end 9261 (unless (vhdl-standard-p '87) "PROCEDURE") 9262 name margin) 9263 (vhdl-comment-block)) 9264 (insert ";") 9265 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 9266 (end-of-line))))) 9267 9268(defun vhdl-template-procedure-decl () 9269 "Insert a procedure declaration." 9270 (interactive) 9271 (vhdl-template-procedure 'decl)) 9272 9273(defun vhdl-template-procedure-body () 9274 "Insert a procedure body." 9275 (interactive) 9276 (vhdl-template-procedure 'body)) 9277 9278(defun vhdl-template-process (&optional kind) 9279 "Insert a process." 9280 (interactive) 9281 (let ((margin (current-indentation)) 9282 (start (point)) 9283 label seq input-signals clock reset final-pos) 9284 (setq seq (if kind (eq kind 'seq) 9285 (eq (vhdl-decision-query 9286 "process" "(c)ombinational or (s)equential?" t) ?s))) 9287 (vhdl-insert-keyword "PROCESS ") 9288 (when (memq vhdl-optional-labels '(process all)) 9289 (goto-char start) 9290 (insert ": ") 9291 (goto-char start) 9292 (setq label (vhdl-template-field "[label]" nil t)) 9293 (unless label (delete-char 2)) 9294 (forward-word 1) 9295 (forward-char 1)) 9296 (insert "(") 9297 (if (not seq) 9298 (unless (setq input-signals 9299 (vhdl-template-field "[sensitivity list]" ")" t)) 9300 (setq input-signals "") 9301 (delete-char -2)) 9302 (setq clock (or (and (not (equal "" vhdl-clock-name)) 9303 (progn (insert vhdl-clock-name) vhdl-clock-name)) 9304 (vhdl-template-field "clock name") "<clock>")) 9305 (when (eq vhdl-reset-kind 'async) 9306 (insert ", ") 9307 (setq reset (or (and (not (equal "" vhdl-reset-name)) 9308 (progn (insert vhdl-reset-name) vhdl-reset-name)) 9309 (vhdl-template-field "reset name") "<reset>"))) 9310 (insert ")")) 9311 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) 9312 (insert "\n") 9313 (vhdl-template-begin-end "PROCESS" label margin) 9314 (when seq (setq reset (vhdl-template-seq-process clock reset))) 9315 (when vhdl-prompt-for-comments 9316 (setq final-pos (point-marker)) 9317 (vhdl-prepare-search-2 9318 (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) 9319 (vhdl-re-search-backward "\\<process\\>" nil t)) 9320 (end-of-line -0) 9321 (if (bobp) 9322 (progn (insert "\n") (forward-line -1)) 9323 (insert "\n")) 9324 (indent-to margin) 9325 (insert "-- purpose: ") 9326 (if (not (vhdl-template-field "[description]" nil t)) 9327 (vhdl-line-kill-entire) 9328 (insert "\n") 9329 (indent-to margin) 9330 (insert "-- type : ") 9331 (insert (if seq "sequential" "combinational") "\n") 9332 (indent-to margin) 9333 (insert "-- inputs : ") 9334 (if (not seq) 9335 (insert input-signals) 9336 (insert clock ", ") 9337 (when reset (insert reset ", ")) 9338 (unless (vhdl-template-field "[signal names]" nil t) 9339 (delete-char -2))) 9340 (insert "\n") 9341 (indent-to margin) 9342 (insert "-- outputs: ") 9343 (vhdl-template-field "[signal names]" nil t)))) 9344 (goto-char final-pos)))) 9345 9346(defun vhdl-template-process-comb () 9347 "Insert a combinational process." 9348 (interactive) 9349 (vhdl-template-process 'comb)) 9350 9351(defun vhdl-template-process-seq () 9352 "Insert a sequential process." 9353 (interactive) 9354 (vhdl-template-process 'seq)) 9355 9356(defun vhdl-template-quantity () 9357 "Insert a quantity declaration." 9358 (interactive) 9359 (if (vhdl-in-argument-list-p) 9360 (let ((start (point))) 9361 (vhdl-insert-keyword "QUANTITY ") 9362 (when (vhdl-template-field "names" nil t start (point)) 9363 (insert " : ") 9364 (vhdl-template-field "[IN | OUT]" " " t) 9365 (vhdl-template-field "type") 9366 (insert ";") 9367 (vhdl-comment-insert-inline))) 9368 (let ((char (vhdl-decision-query 9369 "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) 9370 (cond ((eq char ?f) (vhdl-template-quantity-free)) 9371 ((eq char ?b) (vhdl-template-quantity-branch)) 9372 ((eq char ?s) (vhdl-template-quantity-source)) 9373 (t (vhdl-template-undo (point) (point))))))) 9374 9375(defun vhdl-template-quantity-free () 9376 "Insert a free quantity declaration." 9377 (interactive) 9378 (vhdl-insert-keyword "QUANTITY ") 9379 (vhdl-template-field "names") 9380 (insert " : ") 9381 (vhdl-template-field "type") 9382 (let ((position (point))) 9383 (insert " := ") 9384 (unless (vhdl-template-field "[initialization]" nil t) 9385 (delete-region position (point))) 9386 (insert ";") 9387 (vhdl-comment-insert-inline))) 9388 9389(defun vhdl-template-quantity-branch () 9390 "Insert a branch quantity declaration." 9391 (interactive) 9392 (let (position) 9393 (vhdl-insert-keyword "QUANTITY ") 9394 (when (vhdl-template-field "[across names]" " " t) 9395 (vhdl-insert-keyword "ACROSS ")) 9396 (when (vhdl-template-field "[through names]" " " t) 9397 (vhdl-insert-keyword "THROUGH ")) 9398 (vhdl-template-field "plus terminal name") 9399 (setq position (point)) 9400 (vhdl-insert-keyword " TO ") 9401 (unless (vhdl-template-field "[minus terminal name]" nil t) 9402 (delete-region position (point))) 9403 (insert ";") 9404 (vhdl-comment-insert-inline))) 9405 9406(defun vhdl-template-quantity-source () 9407 "Insert a source quantity declaration." 9408 (interactive) 9409 (vhdl-insert-keyword "QUANTITY ") 9410 (vhdl-template-field "names") 9411 (insert " : ") 9412 (vhdl-template-field "type" " ") 9413 (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) 9414 (progn (vhdl-insert-keyword "NOISE ") 9415 (vhdl-template-field "power expression")) 9416 (vhdl-insert-keyword "SPECTRUM ") 9417 (vhdl-template-field "magnitude expression" ", ") 9418 (vhdl-template-field "phase expression")) 9419 (insert ";") 9420 (vhdl-comment-insert-inline)) 9421 9422(defun vhdl-template-record (kind &optional name secondary) 9423 "Insert a record type declaration." 9424 (interactive) 9425 (let ((margin (current-column)) 9426 (start (point)) 9427 (first t)) 9428 (vhdl-insert-keyword "RECORD\n") 9429 (indent-to (+ margin vhdl-basic-offset)) 9430 (when (or (vhdl-template-field "element names" 9431 nil (not secondary) start (point)) 9432 secondary) 9433 (while (or first (vhdl-template-field "[element names]" nil t)) 9434 (insert " : ") 9435 (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") 9436 (vhdl-comment-insert-inline) 9437 (insert "\n") 9438 (indent-to (+ margin vhdl-basic-offset)) 9439 (setq first nil)) 9440 (delete-region (line-beginning-position) (point)) 9441 (indent-to margin) 9442 (vhdl-insert-keyword "END RECORD") 9443 (unless (vhdl-standard-p '87) (and name (insert " " name))) 9444 (insert ";") 9445 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 9446 9447(defun vhdl-template-report () 9448 "Insert a report statement." 9449 (interactive) 9450 (let ((start (point))) 9451 (vhdl-insert-keyword "REPORT ") 9452 (if (equal "\"\"" (vhdl-template-field 9453 "string expression" nil t start (point) t)) 9454 (delete-backward-char 2) 9455 (setq start (point)) 9456 (vhdl-insert-keyword " SEVERITY ") 9457 (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) 9458 (delete-region start (point))) 9459 (insert ";")))) 9460 9461(defun vhdl-template-return () 9462 "Insert a return statement." 9463 (interactive) 9464 (let ((start (point))) 9465 (vhdl-insert-keyword "RETURN ") 9466 (unless (vhdl-template-field "[expression]" nil t start (point)) 9467 (delete-char -1)) 9468 (insert ";"))) 9469 9470(defun vhdl-template-selected-signal-asst () 9471 "Insert a selected signal assignment." 9472 (interactive) 9473 (let ((margin (current-indentation)) 9474 (start (point)) 9475 (choices t)) 9476 (let ((position (point))) 9477 (vhdl-insert-keyword " SELECT ") 9478 (goto-char position)) 9479 (vhdl-insert-keyword "WITH ") 9480 (when (vhdl-template-field "selector expression" 9481 nil t start (+ (point) 7)) 9482 (forward-word 1) 9483 (delete-char 1) 9484 (insert "\n") 9485 (indent-to (+ margin vhdl-basic-offset)) 9486 (vhdl-template-field "target signal" " <= ") 9487; (vhdl-template-field "[GUARDED] [TRANSPORT]") 9488 (insert "\n") 9489 (indent-to (+ margin vhdl-basic-offset)) 9490 (vhdl-template-field "waveform") 9491 (vhdl-insert-keyword " WHEN ") 9492 (vhdl-template-field "choices" ",") 9493 (insert "\n") 9494 (indent-to (+ margin vhdl-basic-offset)) 9495 (while (and choices (vhdl-template-field "[waveform]" nil t)) 9496 (vhdl-insert-keyword " WHEN ") 9497 (if (setq choices (vhdl-template-field "[choices]" "," t)) 9498 (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 9499 (vhdl-insert-keyword "OTHERS"))) 9500 (when choices 9501 (fixup-whitespace) 9502 (delete-char -2)) 9503 (insert ";") 9504 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 9505 9506(defun vhdl-template-signal () 9507 "Insert a signal declaration." 9508 (interactive) 9509 (let ((start (point)) 9510 (in-arglist (vhdl-in-argument-list-p))) 9511 (vhdl-insert-keyword "SIGNAL ") 9512 (when (vhdl-template-field "names" nil t start (point)) 9513 (insert " : ") 9514 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 9515 (vhdl-template-field "type") 9516 (if in-arglist 9517 (progn (insert ";") 9518 (vhdl-comment-insert-inline)) 9519 (let ((position (point))) 9520 (insert " := ") 9521 (unless (vhdl-template-field "[initialization]" nil t) 9522 (delete-region position (point))) 9523 (insert ";") 9524 (vhdl-comment-insert-inline)))))) 9525 9526(defun vhdl-template-subnature () 9527 "Insert a subnature declaration." 9528 (interactive) 9529 (let ((start (point)) 9530 position) 9531 (vhdl-insert-keyword "SUBNATURE ") 9532 (when (vhdl-template-field "name" nil t start (point)) 9533 (vhdl-insert-keyword " IS ") 9534 (vhdl-template-field "nature" " (") 9535 (if (vhdl-template-field "[index range]" nil t) 9536 (insert ")") 9537 (delete-char -2)) 9538 (setq position (point)) 9539 (vhdl-insert-keyword " TOLERANCE ") 9540 (if (equal "\"\"" (vhdl-template-field "[string expression]" 9541 nil t nil nil t)) 9542 (delete-region position (point)) 9543 (vhdl-insert-keyword " ACROSS ") 9544 (vhdl-template-field "string expression" nil nil nil nil t) 9545 (vhdl-insert-keyword " THROUGH")) 9546 (insert ";") 9547 (vhdl-comment-insert-inline)))) 9548 9549(defun vhdl-template-subprogram-body () 9550 "Insert a subprogram body." 9551 (interactive) 9552 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 9553 (vhdl-template-function-body) 9554 (vhdl-template-procedure-body))) 9555 9556(defun vhdl-template-subprogram-decl () 9557 "Insert a subprogram declaration." 9558 (interactive) 9559 (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) 9560 (vhdl-template-function-decl) 9561 (vhdl-template-procedure-decl))) 9562 9563(defun vhdl-template-subtype () 9564 "Insert a subtype declaration." 9565 (interactive) 9566 (let ((start (point))) 9567 (vhdl-insert-keyword "SUBTYPE ") 9568 (when (vhdl-template-field "name" nil t start (point)) 9569 (vhdl-insert-keyword " IS ") 9570 (vhdl-template-field "type" " ") 9571 (unless 9572 (vhdl-template-field "[RANGE value range | ( index range )]" nil t) 9573 (delete-char -1)) 9574 (insert ";") 9575 (vhdl-comment-insert-inline)))) 9576 9577(defun vhdl-template-terminal () 9578 "Insert a terminal declaration." 9579 (interactive) 9580 (let ((start (point))) 9581 (vhdl-insert-keyword "TERMINAL ") 9582 (when (vhdl-template-field "names" nil t start (point)) 9583 (insert " : ") 9584 (vhdl-template-field "nature") 9585 (insert ";") 9586 (vhdl-comment-insert-inline)))) 9587 9588(defun vhdl-template-type () 9589 "Insert a type declaration." 9590 (interactive) 9591 (let ((start (point)) 9592 name mid-pos end-pos) 9593 (vhdl-insert-keyword "TYPE ") 9594 (when (setq name (vhdl-template-field "name" nil t start (point))) 9595 (vhdl-insert-keyword " IS ") 9596 (let ((definition 9597 (upcase 9598 (or (vhdl-template-field 9599 "[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t) 9600 "")))) 9601 (cond ((equal definition "") 9602 (delete-backward-char 4) 9603 (insert ";")) 9604 ((equal definition "ARRAY") 9605 (delete-region (point) (progn (forward-word -1) (point))) 9606 (vhdl-template-array 'type t)) 9607 ((equal definition "RECORD") 9608 (setq mid-pos (point-marker)) 9609 (delete-region (point) (progn (forward-word -1) (point))) 9610 (vhdl-template-record 'type name t)) 9611 ((equal definition "ACCESS") 9612 (insert " ") 9613 (vhdl-template-field "type" ";")) 9614 ((equal definition "FILE") 9615 (vhdl-insert-keyword " OF ") 9616 (vhdl-template-field "type" ";")) 9617 (t (insert ";"))) 9618 (when mid-pos 9619 (setq end-pos (point-marker)) 9620 (goto-char mid-pos) 9621 (end-of-line)) 9622 (vhdl-comment-insert-inline) 9623 (when end-pos (goto-char end-pos)))))) 9624 9625(defun vhdl-template-use () 9626 "Insert a use clause." 9627 (interactive) 9628 (let ((start (point))) 9629 (vhdl-prepare-search-1 9630 (vhdl-insert-keyword "USE ") 9631 (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) 9632 (vhdl-insert-keyword "..ALL;") 9633 (backward-char 6) 9634 (when (vhdl-template-field "library name" nil t start (+ (point) 6)) 9635 (forward-char 1) 9636 (vhdl-template-field "package name") 9637 (forward-char 5)))))) 9638 9639(defun vhdl-template-variable () 9640 "Insert a variable declaration." 9641 (interactive) 9642 (let ((start (point)) 9643 (in-arglist (vhdl-in-argument-list-p))) 9644 (vhdl-prepare-search-2 9645 (if (or (save-excursion 9646 (and (vhdl-re-search-backward 9647 "\\<function\\|procedure\\|process\\|procedural\\|end\\>" 9648 nil t) 9649 (not (progn (backward-word 1) (looking-at "\\<end\\>"))))) 9650 (save-excursion (backward-word 1) (looking-at "\\<shared\\>"))) 9651 (vhdl-insert-keyword "VARIABLE ") 9652 (vhdl-insert-keyword "SHARED VARIABLE "))) 9653 (when (vhdl-template-field "names" nil t start (point)) 9654 (insert " : ") 9655 (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) 9656 (vhdl-template-field "type") 9657 (if in-arglist 9658 (progn (insert ";") 9659 (vhdl-comment-insert-inline)) 9660 (let ((position (point))) 9661 (insert " := ") 9662 (unless (vhdl-template-field "[initialization]" nil t) 9663 (delete-region position (point))) 9664 (insert ";") 9665 (vhdl-comment-insert-inline)))))) 9666 9667(defun vhdl-template-wait () 9668 "Insert a wait statement." 9669 (interactive) 9670 (vhdl-insert-keyword "WAIT ") 9671 (unless (vhdl-template-field 9672 "[ON sensitivity list] [UNTIL condition] [FOR time expression]" 9673 nil t) 9674 (delete-char -1)) 9675 (insert ";")) 9676 9677(defun vhdl-template-when () 9678 "Indent correctly if within a case statement." 9679 (interactive) 9680 (let ((position (point)) 9681 margin) 9682 (vhdl-prepare-search-2 9683 (if (and (= (current-column) (current-indentation)) 9684 (vhdl-re-search-forward "\\<end\\>" nil t) 9685 (looking-at "\\s-*\\<case\\>")) 9686 (progn 9687 (setq margin (current-indentation)) 9688 (goto-char position) 9689 (delete-horizontal-space) 9690 (indent-to (+ margin vhdl-basic-offset))) 9691 (goto-char position))) 9692 (vhdl-insert-keyword "WHEN "))) 9693 9694(defun vhdl-template-while-loop () 9695 "Insert a while loop." 9696 (interactive) 9697 (let* ((margin (current-indentation)) 9698 (start (point)) 9699 label) 9700 (if (not (eq vhdl-optional-labels 'all)) 9701 (vhdl-insert-keyword "WHILE ") 9702 (vhdl-insert-keyword ": WHILE ") 9703 (goto-char start) 9704 (setq label (vhdl-template-field "[label]" nil t)) 9705 (unless label (delete-char 2)) 9706 (forward-word 1) 9707 (forward-char 1)) 9708 (when vhdl-conditions-in-parenthesis (insert "(")) 9709 (when (vhdl-template-field "condition" nil t start (point)) 9710 (when vhdl-conditions-in-parenthesis (insert ")")) 9711 (vhdl-insert-keyword " LOOP\n\n") 9712 (indent-to margin) 9713 (vhdl-insert-keyword "END LOOP") 9714 (insert (if label (concat " " label ";") ";")) 9715 (forward-line -1) 9716 (indent-to (+ margin vhdl-basic-offset))))) 9717 9718(defun vhdl-template-with () 9719 "Insert a with statement (i.e. selected signal assignment)." 9720 (interactive) 9721 (vhdl-prepare-search-1 9722 (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) 9723 (equal ";" (match-string 1))) 9724 (vhdl-template-selected-signal-asst) 9725 (vhdl-insert-keyword "WITH ")))) 9726 9727;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9728;; Special templates 9729 9730(defun vhdl-template-clocked-wait () 9731 "Insert a wait statement for rising/falling clock edge." 9732 (interactive) 9733 (let ((start (point)) 9734 clock) 9735 (vhdl-insert-keyword "WAIT UNTIL ") 9736 (when (setq clock 9737 (or (and (not (equal "" vhdl-clock-name)) 9738 (progn (insert vhdl-clock-name) vhdl-clock-name)) 9739 (vhdl-template-field "clock name" nil t start (point)))) 9740 (insert "'event") 9741 (vhdl-insert-keyword " AND ") 9742 (insert clock) 9743 (insert 9744 " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") 9745 (vhdl-comment-insert-inline 9746 (concat (if vhdl-clock-rising-edge "rising" "falling") 9747 " clock edge"))))) 9748 9749(defun vhdl-template-seq-process (clock reset) 9750 "Insert a template for the body of a sequential process." 9751 (let ((margin (current-indentation)) 9752 position) 9753 (vhdl-insert-keyword "IF ") 9754 (when (eq vhdl-reset-kind 'async) 9755 (insert reset " = " 9756 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 9757 (vhdl-insert-keyword " THEN") 9758 (vhdl-comment-insert-inline 9759 (concat "asynchronous reset (active " 9760 (if vhdl-reset-active-high "high" "low") ")")) 9761 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 9762 (setq position (point)) 9763 (insert "\n") (indent-to margin) 9764 (vhdl-insert-keyword "ELSIF ")) 9765 (if (eq vhdl-clock-edge-condition 'function) 9766 (insert (if vhdl-clock-rising-edge "rising" "falling") 9767 "_edge(" clock ")") 9768 (insert clock "'event") 9769 (vhdl-insert-keyword " AND ") 9770 (insert clock " = " 9771 (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) 9772 (vhdl-insert-keyword " THEN") 9773 (vhdl-comment-insert-inline 9774 (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) 9775 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 9776 (when (eq vhdl-reset-kind 'sync) 9777 (vhdl-insert-keyword "IF ") 9778 (setq reset (or (and (not (equal "" vhdl-reset-name)) 9779 (progn (insert vhdl-reset-name) vhdl-reset-name)) 9780 (vhdl-template-field "reset name") "<reset>")) 9781 (insert " = " 9782 (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) 9783 (vhdl-insert-keyword " THEN") 9784 (vhdl-comment-insert-inline 9785 (concat "synchronous reset (active " 9786 (if vhdl-reset-active-high "high" "low") ")")) 9787 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 9788 (setq position (point)) 9789 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 9790 (vhdl-insert-keyword "ELSE") 9791 (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) 9792 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 9793 (vhdl-insert-keyword "END IF;")) 9794 (when (eq vhdl-reset-kind 'none) 9795 (setq position (point))) 9796 (insert "\n") (indent-to margin) 9797 (vhdl-insert-keyword "END IF;") 9798 (goto-char position) 9799 reset)) 9800 9801(defun vhdl-template-standard-package (library package) 9802 "Insert specification of a standard package. Include a library 9803specification, if not already there." 9804 (let ((margin (current-indentation))) 9805 (unless (equal library "std") 9806 (unless (or (save-excursion 9807 (vhdl-prepare-search-1 9808 (and (not (bobp)) 9809 (re-search-backward 9810 (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" 9811 library "\\|end\\)\\>") nil t) 9812 (match-string 2)))) 9813 (equal (downcase library) "work")) 9814 (vhdl-insert-keyword "LIBRARY ") 9815 (insert library ";") 9816 (when package 9817 (insert "\n") 9818 (indent-to margin))) 9819 (when package 9820 (vhdl-insert-keyword "USE ") 9821 (insert library "." package) 9822 (vhdl-insert-keyword ".ALL;"))))) 9823 9824(defun vhdl-template-package-math-complex () 9825 "Insert specification of `math_complex' package." 9826 (interactive) 9827 (vhdl-template-standard-package "ieee" "math_complex")) 9828 9829(defun vhdl-template-package-math-real () 9830 "Insert specification of `math_real' package." 9831 (interactive) 9832 (vhdl-template-standard-package "ieee" "math_real")) 9833 9834(defun vhdl-template-package-numeric-bit () 9835 "Insert specification of `numeric_bit' package." 9836 (interactive) 9837 (vhdl-template-standard-package "ieee" "numeric_bit")) 9838 9839(defun vhdl-template-package-numeric-std () 9840 "Insert specification of `numeric_std' package." 9841 (interactive) 9842 (vhdl-template-standard-package "ieee" "numeric_std")) 9843 9844(defun vhdl-template-package-std-logic-1164 () 9845 "Insert specification of `std_logic_1164' package." 9846 (interactive) 9847 (vhdl-template-standard-package "ieee" "std_logic_1164")) 9848 9849(defun vhdl-template-package-std-logic-arith () 9850 "Insert specification of `std_logic_arith' package." 9851 (interactive) 9852 (vhdl-template-standard-package "ieee" "std_logic_arith")) 9853 9854(defun vhdl-template-package-std-logic-misc () 9855 "Insert specification of `std_logic_misc' package." 9856 (interactive) 9857 (vhdl-template-standard-package "ieee" "std_logic_misc")) 9858 9859(defun vhdl-template-package-std-logic-signed () 9860 "Insert specification of `std_logic_signed' package." 9861 (interactive) 9862 (vhdl-template-standard-package "ieee" "std_logic_signed")) 9863 9864(defun vhdl-template-package-std-logic-textio () 9865 "Insert specification of `std_logic_textio' package." 9866 (interactive) 9867 (vhdl-template-standard-package "ieee" "std_logic_textio")) 9868 9869(defun vhdl-template-package-std-logic-unsigned () 9870 "Insert specification of `std_logic_unsigned' package." 9871 (interactive) 9872 (vhdl-template-standard-package "ieee" "std_logic_unsigned")) 9873 9874(defun vhdl-template-package-textio () 9875 "Insert specification of `textio' package." 9876 (interactive) 9877 (vhdl-template-standard-package "std" "textio")) 9878 9879(defun vhdl-template-directive (directive) 9880 "Insert directive." 9881 (unless (= (current-indentation) (current-column)) 9882 (delete-horizontal-space) 9883 (insert " ")) 9884 (insert "-- pragma " directive)) 9885 9886(defun vhdl-template-directive-translate-on () 9887 "Insert directive 'translate_on'." 9888 (interactive) 9889 (vhdl-template-directive "translate_on")) 9890 9891(defun vhdl-template-directive-translate-off () 9892 "Insert directive 'translate_off'." 9893 (interactive) 9894 (vhdl-template-directive "translate_off")) 9895 9896(defun vhdl-template-directive-synthesis-on () 9897 "Insert directive 'synthesis_on'." 9898 (interactive) 9899 (vhdl-template-directive "synthesis_on")) 9900 9901(defun vhdl-template-directive-synthesis-off () 9902 "Insert directive 'synthesis_off'." 9903 (interactive) 9904 (vhdl-template-directive "synthesis_off")) 9905 9906;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 9907;; Header and footer templates 9908 9909(defun vhdl-template-header (&optional file-title) 9910 "Insert a VHDL file header." 9911 (interactive) 9912 (unless (equal vhdl-file-header "") 9913 (let (pos) 9914 (save-excursion 9915 (goto-char (point-min)) 9916 (vhdl-insert-string-or-file vhdl-file-header) 9917 (setq pos (point-marker))) 9918 (vhdl-template-replace-header-keywords 9919 (point-min-marker) pos file-title)))) 9920 9921(defun vhdl-template-footer () 9922 "Insert a VHDL file footer." 9923 (interactive) 9924 (unless (equal vhdl-file-footer "") 9925 (let (pos) 9926 (save-excursion 9927 (goto-char (point-max)) 9928 (setq pos (point-marker)) 9929 (vhdl-insert-string-or-file vhdl-file-footer) 9930 (unless (= (preceding-char) ?\n) 9931 (insert "\n"))) 9932 (vhdl-template-replace-header-keywords pos (point-max-marker))))) 9933 9934(defun vhdl-template-replace-header-keywords (beg end &optional file-title 9935 is-model) 9936 "Replace keywords in header and footer." 9937 (let ((project-title (or (nth 0 (aget vhdl-project-alist vhdl-project)) "")) 9938 (project-desc (or (nth 9 (aget vhdl-project-alist vhdl-project)) "")) 9939 pos) 9940 (vhdl-prepare-search-2 9941 (save-excursion 9942 (goto-char beg) 9943 (while (search-forward "<projectdesc>" end t) 9944 (replace-match project-desc t t)) 9945 (goto-char beg) 9946 (while (search-forward "<filename>" end t) 9947 (replace-match (buffer-name) t t)) 9948 (goto-char beg) 9949 (while (search-forward "<copyright>" end t) 9950 (replace-match vhdl-copyright-string t t)) 9951 (goto-char beg) 9952 (while (search-forward "<author>" end t) 9953 (replace-match "" t t) 9954 (insert (user-full-name)) 9955 (when user-mail-address (insert " <" user-mail-address ">"))) 9956 (goto-char beg) 9957 (while (search-forward "<login>" end t) 9958 (replace-match (user-login-name) t t)) 9959 (goto-char beg) 9960 (while (search-forward "<project>" end t) 9961 (replace-match project-title t t)) 9962 (goto-char beg) 9963 (while (search-forward "<company>" end t) 9964 (replace-match vhdl-company-name t t)) 9965 (goto-char beg) 9966 (while (search-forward "<platform>" end t) 9967 (replace-match vhdl-platform-spec t t)) 9968 (goto-char beg) 9969 (while (search-forward "<standard>" end t) 9970 (replace-match 9971 (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") 9972 ((vhdl-standard-p '93) "'93")) 9973 (when (vhdl-standard-p 'ams) ", VHDL-AMS") 9974 (when (vhdl-standard-p 'math) ", Math Packages")) t t)) 9975 (goto-char beg) 9976 ;; Replace <RCS> with $, so that RCS for the source is 9977 ;; not over-enthusiastic with replacements 9978 (while (search-forward "<RCS>" end t) 9979 (replace-match "$" nil t)) 9980 (goto-char beg) 9981 (while (search-forward "<date>" end t) 9982 (replace-match "" t t) 9983 (vhdl-template-insert-date)) 9984 (goto-char beg) 9985 (while (search-forward "<year>" end t) 9986 (replace-match (format-time-string "%Y" nil) t t)) 9987 (goto-char beg) 9988 (when file-title 9989 (while (search-forward "<title string>" end t) 9990 (replace-match file-title t t)) 9991 (goto-char beg)) 9992 (let (string) 9993 (while 9994 (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) 9995 (setq string (read-string (concat (match-string 1) ": "))) 9996 (replace-match string t t))) 9997 (goto-char beg) 9998 (when (and (not is-model) (search-forward "<cursor>" end t)) 9999 (replace-match "" t t) 10000 (setq pos (point)))) 10001 (when pos (goto-char pos)) 10002 (unless is-model 10003 (when (or (not project-title) (equal project-title "")) 10004 (message "You can specify a project title in user option `vhdl-project-alist'")) 10005 (when (or (not project-desc) (equal project-desc "")) 10006 (message "You can specify a project description in user option `vhdl-project-alist'")) 10007 (when (equal vhdl-platform-spec "") 10008 (message "You can specify a platform in user option `vhdl-platform-spec'")) 10009 (when (equal vhdl-company-name "") 10010 (message "You can specify a company name in user option `vhdl-company-name'")))))) 10011 10012;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10013;; Comment templates and functions 10014 10015(defun vhdl-comment-indent () 10016 "Indent comments." 10017 (let* ((position (point)) 10018 (col 10019 (progn 10020 (forward-line -1) 10021 (if (re-search-forward "--" position t) 10022 (- (current-column) 2) ; existing comment at bol stays there 10023 (goto-char position) 10024 (skip-chars-backward " \t") 10025 (max comment-column ; else indent to comment column 10026 (1+ (current-column))))))) ; except leave at least one space 10027 (goto-char position) 10028 col)) 10029 10030(defun vhdl-comment-insert () 10031 "Start a comment at the end of the line. 10032If on line with code, indent at least `comment-column'. 10033If starting after end-comment-column, start a new line." 10034 (interactive) 10035 (when (> (current-column) end-comment-column) (newline-and-indent)) 10036 (if (or (looking-at "\\s-*$") ; end of line 10037 (and (not unread-command-events) ; called with key binding or menu 10038 (not (end-of-line)))) 10039 (let (margin) 10040 (while (= (preceding-char) ?-) (delete-char -1)) 10041 (setq margin (current-column)) 10042 (delete-horizontal-space) 10043 (if (bolp) 10044 (progn (indent-to margin) (insert "--")) 10045 (insert " ") 10046 (indent-to comment-column) 10047 (insert "--")) 10048 (if (not unread-command-events) (insert " "))) 10049 ;; else code following current point implies commenting out code 10050 (let (next-input code) 10051 (while (= (preceding-char) ?-) (delete-char -2)) 10052 (while (= (setq next-input (read-char)) 13) ; CR 10053 (insert "--") ; or have a space after it? 10054 (forward-char -2) 10055 (forward-line 1) 10056 (message "Enter CR if commenting out a line of code.") 10057 (setq code t)) 10058 (unless code 10059 (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? 10060 (setq unread-command-events 10061 (list (vhdl-character-to-event next-input)))))) ; pushback the char 10062 10063(defun vhdl-comment-display (&optional line-exists) 10064 "Add 2 comment lines at the current indent, making a display comment." 10065 (interactive) 10066 (let ((margin (current-indentation))) 10067 (unless line-exists (vhdl-comment-display-line)) 10068 (insert "\n") (indent-to margin) 10069 (insert "\n") (indent-to margin) 10070 (vhdl-comment-display-line) 10071 (end-of-line -0) 10072 (insert "-- "))) 10073 10074(defun vhdl-comment-display-line () 10075 "Displays one line of dashes." 10076 (interactive) 10077 (while (= (preceding-char) ?-) (delete-char -2)) 10078 (let* ((col (current-column)) 10079 (len (- end-comment-column col))) 10080 (insert-char ?- len))) 10081 10082(defun vhdl-comment-append-inline () 10083 "Append empty inline comment to current line." 10084 (interactive) 10085 (end-of-line) 10086 (delete-horizontal-space) 10087 (insert " ") 10088 (indent-to comment-column) 10089 (insert "-- ")) 10090 10091(defun vhdl-comment-insert-inline (&optional string always-insert) 10092 "Insert inline comment." 10093 (when (or (and string (or vhdl-self-insert-comments always-insert)) 10094 (and (not string) vhdl-prompt-for-comments)) 10095 (let ((position (point))) 10096 (insert " ") 10097 (indent-to comment-column) 10098 (insert "-- ") 10099 (if (not (or (and string (progn (insert string) t)) 10100 (vhdl-template-field "[comment]" nil t))) 10101 (delete-region position (point)) 10102 (while (= (preceding-char) ? ) (delete-backward-char 1)) 10103; (when (> (current-column) end-comment-column) 10104; (setq position (point-marker)) 10105; (re-search-backward "-- ") 10106; (insert "\n") 10107; (indent-to comment-column) 10108; (goto-char position)) 10109 )))) 10110 10111(defun vhdl-comment-block () 10112 "Insert comment for code block." 10113 (when vhdl-prompt-for-comments 10114 (let ((final-pos (point-marker))) 10115 (vhdl-prepare-search-2 10116 (when (and (re-search-backward "^\\s-*begin\\>" nil t) 10117 (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) 10118 (let (margin) 10119 (back-to-indentation) 10120 (setq margin (current-column)) 10121 (end-of-line -0) 10122 (if (bobp) 10123 (progn (insert "\n") (forward-line -1)) 10124 (insert "\n")) 10125 (indent-to margin) 10126 (insert "-- purpose: ") 10127 (unless (vhdl-template-field "[description]" nil t) 10128 (vhdl-line-kill-entire))))) 10129 (goto-char final-pos)))) 10130 10131(defun vhdl-comment-uncomment-region (beg end &optional arg) 10132 "Comment out region if not commented out, uncomment otherwise." 10133 (interactive "r\nP") 10134 (save-excursion 10135 (goto-char (1- end)) 10136 (end-of-line) 10137 (setq end (point-marker)) 10138 (goto-char beg) 10139 (beginning-of-line) 10140 (setq beg (point)) 10141 (if (looking-at comment-start) 10142 (comment-region beg end '(4)) 10143 (comment-region beg end)))) 10144 10145(defun vhdl-comment-uncomment-line (&optional arg) 10146 "Comment out line if not commented out, uncomment otherwise." 10147 (interactive "p") 10148 (save-excursion 10149 (beginning-of-line) 10150 (let ((position (point))) 10151 (forward-line (or arg 1)) 10152 (vhdl-comment-uncomment-region position (point))))) 10153 10154(defun vhdl-comment-kill-region (beg end) 10155 "Kill comments in region." 10156 (interactive "r") 10157 (save-excursion 10158 (goto-char end) 10159 (setq end (point-marker)) 10160 (goto-char beg) 10161 (beginning-of-line) 10162 (while (< (point) end) 10163 (if (looking-at "^\\(\\s-*--.*\n\\)") 10164 (progn (delete-region (match-beginning 1) (match-end 1))) 10165 (beginning-of-line 2))))) 10166 10167(defun vhdl-comment-kill-inline-region (beg end) 10168 "Kill inline comments in region." 10169 (interactive "r") 10170 (save-excursion 10171 (goto-char end) 10172 (setq end (point-marker)) 10173 (goto-char beg) 10174 (beginning-of-line) 10175 (while (< (point) end) 10176 (when (looking-at "^.*[^ \t\n-]+\\(\\s-*--.*\\)$") 10177 (delete-region (match-beginning 1) (match-end 1))) 10178 (beginning-of-line 2)))) 10179 10180;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10181;; Subtemplates 10182 10183(defun vhdl-template-begin-end (construct name margin &optional empty-lines) 10184 "Insert a begin ... end pair with optional name after the end. 10185Point is left between them." 10186 (let (position) 10187 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10188 (indent-to margin) 10189 (vhdl-insert-keyword "BEGIN") 10190 (when (and (or construct name) vhdl-self-insert-comments) 10191 (insert " --") 10192 (when construct (insert " ") (vhdl-insert-keyword construct)) 10193 (when name (insert " " name))) 10194 (insert "\n") 10195 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10196 (indent-to (+ margin vhdl-basic-offset)) 10197 (setq position (point)) 10198 (insert "\n") 10199 (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) 10200 (indent-to margin) 10201 (vhdl-insert-keyword "END") 10202 (when construct (insert " ") (vhdl-insert-keyword construct)) 10203 (insert (if name (concat " " name) "") ";") 10204 (goto-char position))) 10205 10206(defun vhdl-template-argument-list (&optional is-function) 10207 "Read from user a procedure or function argument list." 10208 (insert " (") 10209 (let ((margin (current-column)) 10210 (start (point)) 10211 (end-pos (point)) 10212 not-empty interface semicolon-pos) 10213 (unless vhdl-argument-list-indent 10214 (setq margin (+ (current-indentation) vhdl-basic-offset)) 10215 (insert "\n") 10216 (indent-to margin)) 10217 (setq interface (vhdl-template-field 10218 (concat "[CONSTANT | SIGNAL" 10219 (unless is-function " | VARIABLE") "]") " " t)) 10220 (while (vhdl-template-field "[names]" nil t) 10221 (setq not-empty t) 10222 (insert " : ") 10223 (unless is-function 10224 (if (and interface (equal (upcase interface) "CONSTANT")) 10225 (vhdl-insert-keyword "IN ") 10226 (vhdl-template-field "[IN | OUT | INOUT]" " " t))) 10227 (vhdl-template-field "type") 10228 (setq semicolon-pos (point)) 10229 (insert ";") 10230 (vhdl-comment-insert-inline) 10231 (setq end-pos (point)) 10232 (insert "\n") 10233 (indent-to margin) 10234 (setq interface (vhdl-template-field 10235 (concat "[CONSTANT | SIGNAL" 10236 (unless is-function " | VARIABLE") "]") " " t))) 10237 (delete-region end-pos (point)) 10238 (when semicolon-pos (goto-char semicolon-pos)) 10239 (if not-empty 10240 (progn (delete-char 1) (insert ")")) 10241 (delete-backward-char 2)))) 10242 10243(defun vhdl-template-generic-list (optional &optional no-value) 10244 "Read from user a generic spec argument list." 10245 (let (margin 10246 (start (point))) 10247 (vhdl-insert-keyword "GENERIC (") 10248 (setq margin (current-column)) 10249 (unless vhdl-argument-list-indent 10250 (let ((position (point))) 10251 (back-to-indentation) 10252 (setq margin (+ (current-column) vhdl-basic-offset)) 10253 (goto-char position) 10254 (insert "\n") 10255 (indent-to margin))) 10256 (let ((vhdl-generics (vhdl-template-field 10257 (concat (and optional "[") "name" 10258 (and no-value "s") (and optional "]")) 10259 nil optional))) 10260 (if (not vhdl-generics) 10261 (if optional 10262 (progn (vhdl-line-kill-entire) (end-of-line -0) 10263 (unless vhdl-argument-list-indent 10264 (vhdl-line-kill-entire) (end-of-line -0))) 10265 (vhdl-template-undo start (point)) 10266 nil ) 10267 (insert " : ") 10268 (let (semicolon-pos end-pos) 10269 (while vhdl-generics 10270 (vhdl-template-field "type") 10271 (if no-value 10272 (progn (setq semicolon-pos (point)) 10273 (insert ";")) 10274 (insert " := ") 10275 (unless (vhdl-template-field "[value]" nil t) 10276 (delete-char -4)) 10277 (setq semicolon-pos (point)) 10278 (insert ";")) 10279 (vhdl-comment-insert-inline) 10280 (setq end-pos (point)) 10281 (insert "\n") 10282 (indent-to margin) 10283 (setq vhdl-generics (vhdl-template-field 10284 (concat "[name" (and no-value "s") "]") 10285 " : " t))) 10286 (delete-region end-pos (point)) 10287 (goto-char semicolon-pos) 10288 (insert ")") 10289 (end-of-line) 10290 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) 10291 t))))) 10292 10293(defun vhdl-template-port-list (optional) 10294 "Read from user a port spec argument list." 10295 (let ((start (point)) 10296 margin vhdl-ports object) 10297 (vhdl-insert-keyword "PORT (") 10298 (setq margin (current-column)) 10299 (unless vhdl-argument-list-indent 10300 (let ((position (point))) 10301 (back-to-indentation) 10302 (setq margin (+ (current-column) vhdl-basic-offset)) 10303 (goto-char position) 10304 (insert "\n") 10305 (indent-to margin))) 10306 (when (vhdl-standard-p 'ams) 10307 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 10308 " " t))) 10309 (setq vhdl-ports (vhdl-template-field 10310 (concat (and optional "[") "names" (and optional "]")) 10311 nil optional)) 10312 (if (not vhdl-ports) 10313 (if optional 10314 (progn (vhdl-line-kill-entire) (end-of-line -0) 10315 (unless vhdl-argument-list-indent 10316 (vhdl-line-kill-entire) (end-of-line -0))) 10317 (vhdl-template-undo start (point)) 10318 nil) 10319 (insert " : ") 10320 (let (semicolon-pos end-pos) 10321 (while vhdl-ports 10322 (cond ((or (null object) (equal "SIGNAL" (upcase object))) 10323 (vhdl-template-field "IN | OUT | INOUT" " ")) 10324 ((equal "QUANTITY" (upcase object)) 10325 (vhdl-template-field "[IN | OUT]" " " t))) 10326 (vhdl-template-field 10327 (if (and object (equal "TERMINAL" (upcase object))) 10328 "nature" "type")) 10329 (setq semicolon-pos (point)) 10330 (insert ";") 10331 (vhdl-comment-insert-inline) 10332 (setq end-pos (point)) 10333 (insert "\n") 10334 (indent-to margin) 10335 (when (vhdl-standard-p 'ams) 10336 (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" 10337 " " t))) 10338 (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) 10339 (delete-region end-pos (point)) 10340 (goto-char semicolon-pos) 10341 (insert ")") 10342 (end-of-line) 10343 (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) 10344 t)))) 10345 10346(defun vhdl-template-generate-body (margin label) 10347 "Insert body for generate template." 10348 (vhdl-insert-keyword " GENERATE") 10349; (if (not (vhdl-standard-p '87)) 10350; (vhdl-template-begin-end "GENERATE" label margin) 10351 (insert "\n\n") 10352 (indent-to margin) 10353 (vhdl-insert-keyword "END GENERATE ") 10354 (insert label ";") 10355 (end-of-line 0) 10356 (indent-to (+ margin vhdl-basic-offset))) 10357 10358(defun vhdl-template-insert-date () 10359 "Insert date in appropriate format." 10360 (interactive) 10361 (insert 10362 (cond 10363 ;; 'american, 'european, 'scientific kept for backward compatibility 10364 ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) 10365 ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) 10366 ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) 10367 (t (format-time-string vhdl-date-format nil))))) 10368 10369;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10370;; Help functions 10371 10372(defun vhdl-electric-space (count) 10373 "Expand abbreviations and self-insert space(s), do indent-new-comment-line 10374if in comment and past end-comment-column." 10375 (interactive "p") 10376 (cond ((vhdl-in-comment-p) 10377 (self-insert-command count) 10378 (cond ((>= (current-column) (+ 2 end-comment-column)) 10379 (backward-char 1) 10380 (skip-chars-backward "^ \t\n") 10381 (indent-new-comment-line) 10382 (skip-chars-forward "^ \t\n") 10383 (forward-char 1)) 10384 ((>= (current-column) end-comment-column) 10385 (indent-new-comment-line)) 10386 (t nil))) 10387 ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) 10388 (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) 10389 (vhdl-prepare-search-1 10390 (or (expand-abbrev) (vhdl-fix-case-word -1))) 10391 (self-insert-command count)) 10392 (t (self-insert-command count)))) 10393 10394(defun vhdl-template-field (prompt &optional follow-string optional 10395 begin end is-string default) 10396 "Prompt for string and insert it in buffer with optional FOLLOW-STRING. 10397If OPTIONAL is nil, the prompt is left if an empty string is inserted. If 10398an empty string is inserted, return nil and call `vhdl-template-undo' for 10399the region between BEGIN and END. IS-STRING indicates whether a string 10400with double-quotes is to be inserted. DEFAULT specifies a default string." 10401 (let ((position (point)) 10402 string) 10403 (insert "<" prompt ">") 10404 (setq string 10405 (condition-case () 10406 (read-from-minibuffer (concat prompt ": ") 10407 (or (and is-string '("\"\"" . 2)) default) 10408 vhdl-minibuffer-local-map) 10409 (quit (if (and optional begin end) 10410 (progn (beep) "") 10411 (keyboard-quit))))) 10412 (when (or (not (equal string "")) optional) 10413 (delete-region position (point))) 10414 (when (and (equal string "") optional begin end) 10415 (vhdl-template-undo begin end) 10416 (message "Template aborted")) 10417 (unless (equal string "") 10418 (insert string) 10419 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords 10420 vhdl-keywords-regexp) 10421 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types 10422 vhdl-types-regexp) 10423 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes 10424 (concat "'" vhdl-attributes-regexp)) 10425 (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values 10426 vhdl-enum-values-regexp)) 10427 (when (or (not (equal string "")) (not optional)) 10428 (insert (or follow-string ""))) 10429 (if (equal string "") nil string))) 10430 10431(defun vhdl-decision-query (string prompt &optional optional) 10432 "Query a decision from the user." 10433 (let ((start (point))) 10434 (when string (vhdl-insert-keyword (concat string " "))) 10435 (message prompt) 10436 (let ((char (read-char))) 10437 (delete-region start (point)) 10438 (if (and optional (eq char ?\r)) 10439 (progn (insert " ") 10440 (unexpand-abbrev) 10441 (throw 'abort "ERROR: Template aborted")) 10442 char)))) 10443 10444(defun vhdl-insert-keyword (keyword) 10445 "Insert KEYWORD and adjust case." 10446 (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) 10447 10448(defun vhdl-case-keyword (keyword) 10449 "Adjust case of KEYWORD." 10450 (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) 10451 10452(defun vhdl-case-word (num) 10453 "Adjust case of following NUM words." 10454 (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) 10455 10456(defun vhdl-minibuffer-tab (&optional prefix-arg) 10457 "If preceeding character is part of a word or a paren then hippie-expand, 10458else insert tab (used for word completion in VHDL minibuffer)." 10459 (interactive "P") 10460 (cond 10461 ;; expand word 10462 ((= (char-syntax (preceding-char)) ?w) 10463 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 10464 (case-replace nil) 10465 (hippie-expand-only-buffers 10466 (or (and (boundp 'hippie-expand-only-buffers) 10467 hippie-expand-only-buffers) 10468 '(vhdl-mode)))) 10469 (vhdl-expand-abbrev prefix-arg))) 10470 ;; expand parenthesis 10471 ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) 10472 (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) 10473 (case-replace nil)) 10474 (vhdl-expand-paren prefix-arg))) 10475 ;; insert tab 10476 (t (insert-tab)))) 10477 10478(defun vhdl-template-search-prompt () 10479 "Search for left out template prompts and query again." 10480 (interactive) 10481 (vhdl-prepare-search-2 10482 (when (or (re-search-forward 10483 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) 10484 (re-search-backward 10485 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) 10486 (let ((string (match-string 1))) 10487 (replace-match "") 10488 (vhdl-template-field string))))) 10489 10490(defun vhdl-template-undo (begin end) 10491 "Undo aborted template by deleting region and unexpanding the keyword." 10492 (cond (vhdl-template-invoked-by-hook 10493 (goto-char end) 10494 (insert " ") 10495 (delete-region begin end) 10496 (unexpand-abbrev)) 10497 (t (delete-region begin end)))) 10498 10499(defun vhdl-insert-string-or-file (string) 10500 "Insert STRING or file contents if STRING is an existing file name." 10501 (unless (equal string "") 10502 (let ((file-name 10503 (progn (string-match "^\\([^\n]+\\)" string) 10504 (vhdl-resolve-env-variable (match-string 1 string))))) 10505 (if (file-exists-p file-name) 10506 (forward-char (cadr (insert-file-contents file-name))) 10507 (insert string))))) 10508 10509(defun vhdl-beginning-of-block () 10510 "Move cursor to the beginning of the enclosing block." 10511 (let (pos) 10512 (save-excursion 10513 (beginning-of-line) 10514 ;; search backward for block beginning or end 10515 (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t)) 10516 ;; not consider subprogram declarations 10517 (or (and (match-string 5) 10518 (save-match-data 10519 (save-excursion 10520 (goto-char (match-end 5)) 10521 (forward-word 1) 10522 (vhdl-forward-syntactic-ws) 10523 (when (looking-at "(") 10524 (forward-sexp)) 10525 (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 10526 (match-string 1))) 10527 ;; not consider configuration specifications 10528 (and (match-string 6) 10529 (save-match-data 10530 (save-excursion 10531 (vhdl-end-of-block) 10532 (beginning-of-line) 10533 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 10534 (match-string 2)) 10535 ;; skip subblock if block end found 10536 (vhdl-beginning-of-block))) 10537 (when pos (goto-char pos)))) 10538 10539(defun vhdl-end-of-block () 10540 "Move cursor to the end of the enclosing block." 10541 (let (pos) 10542 (save-excursion 10543 (end-of-line) 10544 ;; search forward for block beginning or end 10545 (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t)) 10546 ;; not consider subprogram declarations 10547 (or (and (match-string 5) 10548 (save-match-data 10549 (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) 10550 (match-string 1))) 10551 ;; not consider configuration specifications 10552 (and (match-string 6) 10553 (save-match-data 10554 (save-excursion 10555 (vhdl-end-of-block) 10556 (beginning-of-line) 10557 (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) 10558 (not (match-string 2))) 10559 ;; skip subblock if block beginning found 10560 (vhdl-end-of-block))) 10561 (when pos (goto-char pos)))) 10562 10563(defun vhdl-sequential-statement-p () 10564 "Check if point is within sequential statement part." 10565 (let ((start (point))) 10566 (save-excursion 10567 (vhdl-prepare-search-2 10568 ;; is sequential statement if ... 10569 (and (re-search-backward "^\\s-*begin\\>" nil t) 10570 ;; ... point is between "begin" and "end" of ... 10571 (progn (vhdl-end-of-block) 10572 (< start (point))) 10573 ;; ... a sequential block 10574 (progn (vhdl-beginning-of-block) 10575 (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>"))))))) 10576 10577(defun vhdl-in-argument-list-p () 10578 "Check if within an argument list." 10579 (save-excursion 10580 (vhdl-prepare-search-2 10581 (or (string-match "arglist" 10582 (format "%s" (caar (vhdl-get-syntactic-context)))) 10583 (progn (beginning-of-line) 10584 (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) 10585 10586;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10587;; Abbrev hooks 10588 10589(defun vhdl-hooked-abbrev (func) 10590 "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, 10591but not if inside a comment or quote." 10592 (if (or (vhdl-in-literal) 10593 (save-excursion 10594 (forward-word -1) 10595 (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) 10596 (progn 10597 (insert " ") 10598 (unexpand-abbrev) 10599 (delete-char -1)) 10600 (if (not vhdl-electric-mode) 10601 (progn 10602 (insert " ") 10603 (unexpand-abbrev) 10604 (backward-word 1) 10605 (vhdl-case-word 1) 10606 (delete-char 1)) 10607 (let ((invoke-char last-command-char) 10608 (abbrev-mode -1) 10609 (vhdl-template-invoked-by-hook t)) 10610 (let ((caught (catch 'abort 10611 (funcall func)))) 10612 (when (stringp caught) (message "%s" caught))) 10613 (when (= invoke-char ?-) (setq abbrev-start-location (point))) 10614 ;; delete CR which is still in event queue 10615 (if (fboundp 'enqueue-eval-event) 10616 (enqueue-eval-event 'delete-char -1) 10617 (setq unread-command-events ; push back a delete char 10618 (list (vhdl-character-to-event ?\177)))))))) 10619 10620(defun vhdl-template-alias-hook () 10621 (vhdl-hooked-abbrev 'vhdl-template-alias)) 10622(defun vhdl-template-architecture-hook () 10623 (vhdl-hooked-abbrev 'vhdl-template-architecture)) 10624(defun vhdl-template-assert-hook () 10625 (vhdl-hooked-abbrev 'vhdl-template-assert)) 10626(defun vhdl-template-attribute-hook () 10627 (vhdl-hooked-abbrev 'vhdl-template-attribute)) 10628(defun vhdl-template-block-hook () 10629 (vhdl-hooked-abbrev 'vhdl-template-block)) 10630(defun vhdl-template-break-hook () 10631 (vhdl-hooked-abbrev 'vhdl-template-break)) 10632(defun vhdl-template-case-hook () 10633 (vhdl-hooked-abbrev 'vhdl-template-case)) 10634(defun vhdl-template-component-hook () 10635 (vhdl-hooked-abbrev 'vhdl-template-component)) 10636(defun vhdl-template-instance-hook () 10637 (vhdl-hooked-abbrev 'vhdl-template-instance)) 10638(defun vhdl-template-conditional-signal-asst-hook () 10639 (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) 10640(defun vhdl-template-configuration-hook () 10641 (vhdl-hooked-abbrev 'vhdl-template-configuration)) 10642(defun vhdl-template-constant-hook () 10643 (vhdl-hooked-abbrev 'vhdl-template-constant)) 10644(defun vhdl-template-disconnect-hook () 10645 (vhdl-hooked-abbrev 'vhdl-template-disconnect)) 10646(defun vhdl-template-display-comment-hook () 10647 (vhdl-hooked-abbrev 'vhdl-comment-display)) 10648(defun vhdl-template-else-hook () 10649 (vhdl-hooked-abbrev 'vhdl-template-else)) 10650(defun vhdl-template-elsif-hook () 10651 (vhdl-hooked-abbrev 'vhdl-template-elsif)) 10652(defun vhdl-template-entity-hook () 10653 (vhdl-hooked-abbrev 'vhdl-template-entity)) 10654(defun vhdl-template-exit-hook () 10655 (vhdl-hooked-abbrev 'vhdl-template-exit)) 10656(defun vhdl-template-file-hook () 10657 (vhdl-hooked-abbrev 'vhdl-template-file)) 10658(defun vhdl-template-for-hook () 10659 (vhdl-hooked-abbrev 'vhdl-template-for)) 10660(defun vhdl-template-function-hook () 10661 (vhdl-hooked-abbrev 'vhdl-template-function)) 10662(defun vhdl-template-generic-hook () 10663 (vhdl-hooked-abbrev 'vhdl-template-generic)) 10664(defun vhdl-template-group-hook () 10665 (vhdl-hooked-abbrev 'vhdl-template-group)) 10666(defun vhdl-template-library-hook () 10667 (vhdl-hooked-abbrev 'vhdl-template-library)) 10668(defun vhdl-template-limit-hook () 10669 (vhdl-hooked-abbrev 'vhdl-template-limit)) 10670(defun vhdl-template-if-hook () 10671 (vhdl-hooked-abbrev 'vhdl-template-if)) 10672(defun vhdl-template-bare-loop-hook () 10673 (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) 10674(defun vhdl-template-map-hook () 10675 (vhdl-hooked-abbrev 'vhdl-template-map)) 10676(defun vhdl-template-nature-hook () 10677 (vhdl-hooked-abbrev 'vhdl-template-nature)) 10678(defun vhdl-template-next-hook () 10679 (vhdl-hooked-abbrev 'vhdl-template-next)) 10680(defun vhdl-template-others-hook () 10681 (vhdl-hooked-abbrev 'vhdl-template-others)) 10682(defun vhdl-template-package-hook () 10683 (vhdl-hooked-abbrev 'vhdl-template-package)) 10684(defun vhdl-template-port-hook () 10685 (vhdl-hooked-abbrev 'vhdl-template-port)) 10686(defun vhdl-template-procedural-hook () 10687 (vhdl-hooked-abbrev 'vhdl-template-procedural)) 10688(defun vhdl-template-procedure-hook () 10689 (vhdl-hooked-abbrev 'vhdl-template-procedure)) 10690(defun vhdl-template-process-hook () 10691 (vhdl-hooked-abbrev 'vhdl-template-process)) 10692(defun vhdl-template-quantity-hook () 10693 (vhdl-hooked-abbrev 'vhdl-template-quantity)) 10694(defun vhdl-template-report-hook () 10695 (vhdl-hooked-abbrev 'vhdl-template-report)) 10696(defun vhdl-template-return-hook () 10697 (vhdl-hooked-abbrev 'vhdl-template-return)) 10698(defun vhdl-template-selected-signal-asst-hook () 10699 (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) 10700(defun vhdl-template-signal-hook () 10701 (vhdl-hooked-abbrev 'vhdl-template-signal)) 10702(defun vhdl-template-subnature-hook () 10703 (vhdl-hooked-abbrev 'vhdl-template-subnature)) 10704(defun vhdl-template-subtype-hook () 10705 (vhdl-hooked-abbrev 'vhdl-template-subtype)) 10706(defun vhdl-template-terminal-hook () 10707 (vhdl-hooked-abbrev 'vhdl-template-terminal)) 10708(defun vhdl-template-type-hook () 10709 (vhdl-hooked-abbrev 'vhdl-template-type)) 10710(defun vhdl-template-use-hook () 10711 (vhdl-hooked-abbrev 'vhdl-template-use)) 10712(defun vhdl-template-variable-hook () 10713 (vhdl-hooked-abbrev 'vhdl-template-variable)) 10714(defun vhdl-template-wait-hook () 10715 (vhdl-hooked-abbrev 'vhdl-template-wait)) 10716(defun vhdl-template-when-hook () 10717 (vhdl-hooked-abbrev 'vhdl-template-when)) 10718(defun vhdl-template-while-loop-hook () 10719 (vhdl-hooked-abbrev 'vhdl-template-while-loop)) 10720(defun vhdl-template-with-hook () 10721 (vhdl-hooked-abbrev 'vhdl-template-with)) 10722(defun vhdl-template-and-hook () 10723 (vhdl-hooked-abbrev 'vhdl-template-and)) 10724(defun vhdl-template-or-hook () 10725 (vhdl-hooked-abbrev 'vhdl-template-or)) 10726(defun vhdl-template-nand-hook () 10727 (vhdl-hooked-abbrev 'vhdl-template-nand)) 10728(defun vhdl-template-nor-hook () 10729 (vhdl-hooked-abbrev 'vhdl-template-nor)) 10730(defun vhdl-template-xor-hook () 10731 (vhdl-hooked-abbrev 'vhdl-template-xor)) 10732(defun vhdl-template-xnor-hook () 10733 (vhdl-hooked-abbrev 'vhdl-template-xnor)) 10734(defun vhdl-template-not-hook () 10735 (vhdl-hooked-abbrev 'vhdl-template-not)) 10736 10737(defun vhdl-template-default-hook () 10738 (vhdl-hooked-abbrev 'vhdl-template-default)) 10739(defun vhdl-template-default-indent-hook () 10740 (vhdl-hooked-abbrev 'vhdl-template-default-indent)) 10741 10742;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10743;; Template insertion from completion list 10744 10745(defun vhdl-template-insert-construct (name) 10746 "Insert the built-in construct template with NAME." 10747 (interactive 10748 (list (let ((completion-ignore-case t)) 10749 (completing-read "Construct name: " 10750 vhdl-template-construct-alist nil t)))) 10751 (vhdl-template-insert-fun 10752 (cadr (assoc name vhdl-template-construct-alist)))) 10753 10754(defun vhdl-template-insert-package (name) 10755 "Insert the built-in package template with NAME." 10756 (interactive 10757 (list (let ((completion-ignore-case t)) 10758 (completing-read "Package name: " 10759 vhdl-template-package-alist nil t)))) 10760 (vhdl-template-insert-fun 10761 (cadr (assoc name vhdl-template-package-alist)))) 10762 10763(defun vhdl-template-insert-directive (name) 10764 "Insert the built-in directive template with NAME." 10765 (interactive 10766 (list (let ((completion-ignore-case t)) 10767 (completing-read "Directive name: " 10768 vhdl-template-directive-alist nil t)))) 10769 (vhdl-template-insert-fun 10770 (cadr (assoc name vhdl-template-directive-alist)))) 10771 10772(defun vhdl-template-insert-fun (fun) 10773 "Call FUN to insert a built-in template." 10774 (let ((caught (catch 'abort (when fun (funcall fun))))) 10775 (when (stringp caught) (message "%s" caught)))) 10776 10777 10778;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10779;;; Models 10780;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10781 10782(defun vhdl-model-insert (model-name) 10783 "Insert the user model with name MODEL-NAME." 10784 (interactive 10785 (let ((completion-ignore-case t)) 10786 (list (completing-read "Model name: " vhdl-model-alist)))) 10787 (indent-according-to-mode) 10788 (let ((start (point-marker)) 10789 (margin (current-indentation)) 10790 model position prompt string end) 10791 (vhdl-prepare-search-2 10792 (when (setq model (assoc model-name vhdl-model-alist)) 10793 ;; insert model 10794 (beginning-of-line) 10795 (delete-horizontal-space) 10796 (goto-char start) 10797 (vhdl-insert-string-or-file (nth 1 model)) 10798 (setq end (point-marker)) 10799 ;; indent code 10800 (goto-char start) 10801 (beginning-of-line) 10802 (while (< (point) end) 10803 (unless (looking-at "^$") 10804 (insert-char ? margin)) 10805 (beginning-of-line 2)) 10806 (goto-char start) 10807 ;; insert clock 10808 (unless (equal "" vhdl-clock-name) 10809 (while (re-search-forward "<clock>" end t) 10810 (replace-match vhdl-clock-name))) 10811 (goto-char start) 10812 ;; insert reset 10813 (unless (equal "" vhdl-reset-name) 10814 (while (re-search-forward "<reset>" end t) 10815 (replace-match vhdl-reset-name))) 10816 ;; replace header prompts 10817 (vhdl-template-replace-header-keywords start end nil t) 10818 (goto-char start) 10819 ;; query other prompts 10820 (while (re-search-forward 10821 (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) 10822 (unless (equal "cursor" (match-string 1)) 10823 (setq position (match-beginning 1)) 10824 (setq prompt (match-string 1)) 10825 (replace-match "") 10826 (setq string (vhdl-template-field prompt nil t)) 10827 ;; replace occurrences of same prompt 10828 (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) 10829 (replace-match (or string ""))) 10830 (goto-char position))) 10831 (goto-char start) 10832 ;; goto final position 10833 (if (re-search-forward "<cursor>" end t) 10834 (replace-match "") 10835 (goto-char end)))))) 10836 10837(defun vhdl-model-defun () 10838 "Define help and hook functions for user models." 10839 (let ((model-alist vhdl-model-alist) 10840 model-name model-keyword) 10841 (while model-alist 10842 ;; define functions for user models that can be invoked from menu and key 10843 ;; bindings and which themselves call `vhdl-model-insert' with the model 10844 ;; name as argument 10845 (setq model-name (nth 0 (car model-alist))) 10846 (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () 10847 ,(concat "Insert model for \"" model-name "\".") 10848 (interactive) 10849 (vhdl-model-insert ,model-name))) 10850 ;; define hooks for user models that are invoked from keyword abbrevs 10851 (setq model-keyword (nth 3 (car model-alist))) 10852 (unless (equal model-keyword "") 10853 (eval `(defun 10854 ,(vhdl-function-name 10855 "vhdl-model" model-name "hook") () 10856 (vhdl-hooked-abbrev 10857 ',(vhdl-function-name "vhdl-model" model-name))))) 10858 (setq model-alist (cdr model-alist))))) 10859 10860(vhdl-model-defun) 10861 10862 10863;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10864;;; Port translation 10865;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 10866 10867(defvar vhdl-port-list nil 10868 "Variable to hold last port map parsed.") 10869;; structure: (parenthesised expression means list of such entries) 10870;; (ent-name 10871;; ((generic-names) generic-type generic-init generic-comment group-comment) 10872;; ((port-names) port-object port-direct port-type port-comment group-comment) 10873;; (lib-name pack-key)) 10874 10875(defun vhdl-parse-string (string &optional optional) 10876 "Check that the text following point matches the regexp in STRING." 10877 (if (looking-at string) 10878 (goto-char (match-end 0)) 10879 (unless optional 10880 (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" 10881 (vhdl-current-line) string))) 10882 nil)) 10883 10884(defun vhdl-replace-string (regexp-cons string &optional adjust-case) 10885 "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." 10886 (vhdl-prepare-search-1 10887 (if (string-match (car regexp-cons) string) 10888 (if adjust-case 10889 (funcall vhdl-file-name-case 10890 (replace-match (cdr regexp-cons) t nil string)) 10891 (replace-match (cdr regexp-cons) t nil string)) 10892 string))) 10893 10894(defun vhdl-parse-group-comment () 10895 "Parse comment and empty lines between groups of lines." 10896 (let ((start (point)) 10897 string) 10898 (vhdl-forward-comment (point-max)) 10899 (setq string (buffer-substring-no-properties start (point))) 10900 (vhdl-forward-syntactic-ws) 10901 ;; strip off leading blanks and first newline 10902 (while (string-match "^\\(\\s-+\\)" string) 10903 (setq string (concat (substring string 0 (match-beginning 1)) 10904 (substring string (match-end 1))))) 10905 (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) 10906 (substring string 1) 10907 string))) 10908 10909(defun vhdl-paste-group-comment (string indent) 10910 "Paste comment and empty lines from STRING between groups of lines 10911with INDENT." 10912 (let ((pos (point-marker))) 10913 (when (> indent 0) 10914 (while (string-match "^\\(--\\)" string) 10915 (setq string (concat (substring string 0 (match-beginning 1)) 10916 (make-string indent ? ) 10917 (substring string (match-beginning 1)))))) 10918 (beginning-of-line) 10919 (insert string) 10920 (goto-char pos))) 10921 10922(defvar vhdl-port-flattened nil 10923 "Indicates whether a port has been flattened.") 10924 10925(defun vhdl-port-flatten (&optional as-alist) 10926 "Flatten port list so that only one generic/port exists per line. 10927This operation is performed on an internally stored port and is only 10928reflected in a subsequent paste operation." 10929 (interactive) 10930 (if (not vhdl-port-list) 10931 (error "ERROR: No port has been read") 10932 (message "Flattening port for next paste...") 10933 (let ((new-vhdl-port-list (list (car vhdl-port-list))) 10934 (old-vhdl-port-list (cdr vhdl-port-list)) 10935 old-port-list new-port-list old-port new-port names) 10936 ;; traverse port list and flatten entries 10937 (while (cdr old-vhdl-port-list) 10938 (setq old-port-list (car old-vhdl-port-list)) 10939 (setq new-port-list nil) 10940 (while old-port-list 10941 (setq old-port (car old-port-list)) 10942 (setq names (car old-port)) 10943 (while names 10944 (setq new-port (cons (if as-alist (car names) (list (car names))) 10945 (cdr old-port))) 10946 (setq new-port-list (append new-port-list (list new-port))) 10947 (setq names (cdr names))) 10948 (setq old-port-list (cdr old-port-list))) 10949 (setq old-vhdl-port-list (cdr old-vhdl-port-list)) 10950 (setq new-vhdl-port-list (append new-vhdl-port-list 10951 (list new-port-list)))) 10952 (setq vhdl-port-list 10953 (append new-vhdl-port-list (list old-vhdl-port-list)) 10954 vhdl-port-flattened t) 10955 (message "Flattening port for next paste...done")))) 10956 10957(defvar vhdl-port-reversed-direction nil 10958 "Indicates whether port directions are reversed.") 10959 10960(defun vhdl-port-reverse-direction () 10961 "Reverse direction for all ports (useful in testbenches). 10962This operation is performed on an internally stored port and is only 10963reflected in a subsequent paste operation." 10964 (interactive) 10965 (if (not vhdl-port-list) 10966 (error "ERROR: No port has been read") 10967 (message "Reversing port directions for next paste...") 10968 (let ((port-list (nth 2 vhdl-port-list)) 10969 port-dir-car port-dir) 10970 ;; traverse port list and reverse directions 10971 (while port-list 10972 (setq port-dir-car (cddr (car port-list)) 10973 port-dir (car port-dir-car)) 10974 (setcar port-dir-car 10975 (cond ((equal port-dir "in") "out") 10976 ((equal port-dir "out") "in") 10977 (t port-dir))) 10978 (setq port-list (cdr port-list))) 10979 (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) 10980 (message "Reversing port directions for next paste...done")))) 10981 10982(defun vhdl-port-copy () 10983 "Get generic and port information from an entity or component declaration." 10984 (interactive) 10985 (save-excursion 10986 (let (parse-error end-of-list 10987 decl-type name generic-list port-list context-clause 10988 object names direct type init comment group-comment) 10989 (vhdl-prepare-search-2 10990 (setq 10991 parse-error 10992 (catch 'parse 10993 ;; check if within entity or component declaration 10994 (end-of-line) 10995 (when (or (not (re-search-backward 10996 "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) 10997 (equal "END" (upcase (match-string 1)))) 10998 (throw 'parse "ERROR: Not within an entity or component declaration")) 10999 (setq decl-type (downcase (match-string-no-properties 1))) 11000 (forward-word 1) 11001 (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") 11002 (setq name (match-string-no-properties 1)) 11003 (message "Reading port of %s \"%s\"..." decl-type name) 11004 (vhdl-forward-syntactic-ws) 11005 ;; parse generic clause 11006 (when (vhdl-parse-string "generic[ \t\n]*(" t) 11007 ;; parse group comment and spacing 11008 (setq group-comment (vhdl-parse-group-comment)) 11009 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t)) 11010 (while (not end-of-list) 11011 ;; parse names (accept extended identifiers) 11012 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") 11013 (setq names (list (match-string-no-properties 1))) 11014 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t) 11015 (setq names 11016 (append names (list (match-string-no-properties 1))))) 11017 ;; parse type 11018 (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)") 11019 (setq type (match-string-no-properties 1)) 11020 (setq comment nil) 11021 (while (looking-at "(") 11022 (setq type 11023 (concat type 11024 (buffer-substring-no-properties 11025 (point) (progn (forward-sexp) (point))) 11026 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 11027 (match-string-no-properties 1))))) 11028 ;; special case: closing parenthesis is on separate line 11029 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11030 (setq comment (substring type (match-beginning 2))) 11031 (setq type (substring type 0 (match-beginning 1)))) 11032 ;; strip of trailing group-comment 11033 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11034 (setq type (substring type 0 (match-end 1))) 11035 ;; parse initialization expression 11036 (setq init nil) 11037 (when (vhdl-parse-string ":=[ \t\n]*" t) 11038 (vhdl-parse-string "\\([^();\n]*\\)") 11039 (setq init (match-string-no-properties 1)) 11040 (while (looking-at "(") 11041 (setq init 11042 (concat init 11043 (buffer-substring-no-properties 11044 (point) (progn (forward-sexp) (point))) 11045 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11046 (match-string-no-properties 1)))))) 11047 ;; special case: closing parenthesis is on separate line 11048 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 11049 (setq comment (substring init (match-beginning 2))) 11050 (setq init (substring init 0 (match-beginning 1))) 11051 (vhdl-forward-syntactic-ws)) 11052 (skip-chars-forward " \t") 11053 ;; parse inline comment, special case: as above, no initial. 11054 (unless comment 11055 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11056 (match-string-no-properties 1)))) 11057 (vhdl-forward-syntactic-ws) 11058 (setq end-of-list (vhdl-parse-string ")" t)) 11059 (vhdl-parse-string "\\s-*;\\s-*") 11060 ;; parse inline comment 11061 (unless comment 11062 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11063 (match-string-no-properties 1)))) 11064 ;; save everything in list 11065 (setq generic-list (append generic-list 11066 (list (list names type init 11067 comment group-comment)))) 11068 ;; parse group comment and spacing 11069 (setq group-comment (vhdl-parse-group-comment)))) 11070 ;; parse port clause 11071 (when (vhdl-parse-string "port[ \t\n]*(" t) 11072 ;; parse group comment and spacing 11073 (setq group-comment (vhdl-parse-group-comment)) 11074 (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t)) 11075 (while (not end-of-list) 11076 ;; parse object 11077 (setq object 11078 (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n]*" t) 11079 (match-string-no-properties 1))) 11080 ;; parse names (accept extended identifiers) 11081 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") 11082 (setq names (list (match-string-no-properties 1))) 11083 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t) 11084 (setq names (append names (list (match-string-no-properties 1))))) 11085 ;; parse direction 11086 (vhdl-parse-string ":[ \t\n]*") 11087 (setq direct 11088 (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n]+" t) 11089 (match-string-no-properties 1))) 11090 ;; parse type 11091 (vhdl-parse-string "\\([^();\n]+\\)") 11092 (setq type (match-string-no-properties 1)) 11093 (setq comment nil) 11094 (while (looking-at "(") 11095 (setq type (concat type 11096 (buffer-substring-no-properties 11097 (point) (progn (forward-sexp) (point))) 11098 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11099 (match-string-no-properties 1))))) 11100 ;; special case: closing parenthesis is on separate line 11101 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11102 (setq comment (substring type (match-beginning 2))) 11103 (setq type (substring type 0 (match-beginning 1)))) 11104 ;; strip of trailing group-comment 11105 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11106 (setq type (substring type 0 (match-end 1))) 11107 (vhdl-forward-syntactic-ws) 11108 (setq end-of-list (vhdl-parse-string ")" t)) 11109 (vhdl-parse-string "\\s-*;\\s-*") 11110 ;; parse inline comment 11111 (unless comment 11112 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11113 (match-string-no-properties 1)))) 11114 ;; save everything in list 11115 (setq port-list (append port-list 11116 (list (list names object direct type 11117 comment group-comment)))) 11118 ;; parse group comment and spacing 11119 (setq group-comment (vhdl-parse-group-comment)))) 11120; (vhdl-parse-string "end\\>") 11121 ;; parse context clause 11122 (setq context-clause (vhdl-scan-context-clause)) 11123; ;; add surrounding package to context clause 11124; (when (and (equal decl-type "component") 11125; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) 11126; (setq context-clause 11127; (append context-clause 11128; (list (cons (vhdl-work-library) 11129; (match-string-no-properties 1)))))) 11130 (message "Reading port of %s \"%s\"...done" decl-type name) 11131 nil))) 11132 ;; finish parsing 11133 (if parse-error 11134 (error parse-error) 11135 (setq vhdl-port-list (list name generic-list port-list context-clause) 11136 vhdl-port-reversed-direction nil 11137 vhdl-port-flattened nil))))) 11138 11139(defun vhdl-port-paste-context-clause (&optional exclude-pack-name) 11140 "Paste a context clause." 11141 (let ((margin (current-indentation)) 11142 (clause-list (nth 3 vhdl-port-list)) 11143 clause) 11144 (while clause-list 11145 (setq clause (car clause-list)) 11146 (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) 11147 (downcase exclude-pack-name))) 11148 (save-excursion 11149 (re-search-backward 11150 (concat "^\\s-*use\\s-+" (car clause) 11151 "\." (cdr clause) "\\>") nil t))) 11152 (vhdl-template-standard-package (car clause) (cdr clause)) 11153 (insert "\n")) 11154 (setq clause-list (cdr clause-list))))) 11155 11156(defun vhdl-port-paste-generic (&optional no-init) 11157 "Paste a generic clause." 11158 (let ((margin (current-indentation)) 11159 (generic-list (nth 1 vhdl-port-list)) 11160 list-margin start names generic) 11161 ;; paste generic clause 11162 (when generic-list 11163 (setq start (point)) 11164 (vhdl-insert-keyword "GENERIC (") 11165 (unless vhdl-argument-list-indent 11166 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11167 (setq list-margin (current-column)) 11168 (while generic-list 11169 (setq generic (car generic-list)) 11170 ;; paste group comment and spacing 11171 (when (memq vhdl-include-group-comments '(decl always)) 11172 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 11173 ;; paste names 11174 (setq names (nth 0 generic)) 11175 (while names 11176 (insert (car names)) 11177 (setq names (cdr names)) 11178 (when names (insert ", "))) 11179 ;; paste type 11180 (insert " : " (nth 1 generic)) 11181 ;; paste initialization 11182 (when (and (not no-init) (nth 2 generic)) 11183 (insert " := " (nth 2 generic))) 11184 (unless (cdr generic-list) (insert ")")) 11185 (insert ";") 11186 ;; paste comment 11187 (when (and vhdl-include-port-comments (nth 3 generic)) 11188 (vhdl-comment-insert-inline (nth 3 generic) t)) 11189 (setq generic-list (cdr generic-list)) 11190 (when generic-list (insert "\n") (indent-to list-margin))) 11191 ;; align generic clause 11192 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) 11193 11194(defun vhdl-port-paste-port () 11195 "Paste a port clause." 11196 (let ((margin (current-indentation)) 11197 (port-list (nth 2 vhdl-port-list)) 11198 list-margin start names port) 11199 ;; paste port clause 11200 (when port-list 11201 (setq start (point)) 11202 (vhdl-insert-keyword "PORT (") 11203 (unless vhdl-argument-list-indent 11204 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11205 (setq list-margin (current-column)) 11206 (while port-list 11207 (setq port (car port-list)) 11208 ;; paste group comment and spacing 11209 (when (memq vhdl-include-group-comments '(decl always)) 11210 (vhdl-paste-group-comment (nth 5 port) list-margin)) 11211 ;; paste object 11212 (when (nth 1 port) (insert (nth 1 port) " ")) 11213 ;; paste names 11214 (setq names (nth 0 port)) 11215 (while names 11216 (insert (car names)) 11217 (setq names (cdr names)) 11218 (when names (insert ", "))) 11219 ;; paste direction 11220 (insert " : ") 11221 (when (nth 2 port) (insert (nth 2 port) " ")) 11222 ;; paste type 11223 (insert (nth 3 port)) 11224 (unless (cdr port-list) (insert ")")) 11225 (insert ";") 11226 ;; paste comment 11227 (when (and vhdl-include-port-comments (nth 4 port)) 11228 (vhdl-comment-insert-inline (nth 4 port) t)) 11229 (setq port-list (cdr port-list)) 11230 (when port-list (insert "\n") (indent-to list-margin))) 11231 ;; align port clause 11232 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) 11233 11234(defun vhdl-port-paste-declaration (kind &optional no-indent) 11235 "Paste as an entity or component declaration." 11236 (unless no-indent (indent-according-to-mode)) 11237 (let ((margin (current-indentation)) 11238 (name (nth 0 vhdl-port-list))) 11239 (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) 11240 (insert name) 11241 (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) 11242 (vhdl-insert-keyword " IS")) 11243 ;; paste generic and port clause 11244 (when (nth 1 vhdl-port-list) 11245 (insert "\n") 11246 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11247 (insert "\n")) 11248 (indent-to (+ margin vhdl-basic-offset)) 11249 (vhdl-port-paste-generic (eq kind 'component))) 11250 (when (nth 2 vhdl-port-list) 11251 (insert "\n") 11252 (when (and (memq vhdl-insert-empty-lines '(unit all)) 11253 (eq kind 'entity)) 11254 (insert "\n")) 11255 (indent-to (+ margin vhdl-basic-offset))) 11256 (vhdl-port-paste-port) 11257 (insert "\n") 11258 (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) 11259 (insert "\n")) 11260 (indent-to margin) 11261 (vhdl-insert-keyword "END") 11262 (if (eq kind 'entity) 11263 (progn 11264 (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) 11265 (insert " " name)) 11266 (vhdl-insert-keyword " COMPONENT") 11267 (unless (vhdl-standard-p '87) (insert " " name))) 11268 (insert ";"))) 11269 11270(defun vhdl-port-paste-entity (&optional no-indent) 11271 "Paste as an entity declaration." 11272 (interactive) 11273 (if (not vhdl-port-list) 11274 (error "ERROR: No port read") 11275 (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) 11276 (vhdl-port-paste-declaration 'entity no-indent) 11277 (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) 11278 11279(defun vhdl-port-paste-component (&optional no-indent) 11280 "Paste as a component declaration." 11281 (interactive) 11282 (if (not vhdl-port-list) 11283 (error "ERROR: No port read") 11284 (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) 11285 (vhdl-port-paste-declaration 'component no-indent) 11286 (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) 11287 11288(defun vhdl-port-paste-generic-map (&optional secondary no-constants) 11289 "Paste as a generic map." 11290 (interactive) 11291 (unless secondary (indent-according-to-mode)) 11292 (let ((margin (current-indentation)) 11293 list-margin start generic 11294 (generic-list (nth 1 vhdl-port-list))) 11295 (when generic-list 11296 (setq start (point)) 11297 (vhdl-insert-keyword "GENERIC MAP (") 11298 (if (not vhdl-association-list-with-formals) 11299 ;; paste list of actual generics 11300 (while generic-list 11301 (insert (if no-constants 11302 (car (nth 0 (car generic-list))) 11303 (or (nth 2 (car generic-list)) " "))) 11304 (setq generic-list (cdr generic-list)) 11305 (insert (if generic-list ", " ")")) 11306 (when (and (not generic-list) secondary 11307 (null (nth 2 vhdl-port-list))) 11308 (insert ";"))) 11309 (unless vhdl-argument-list-indent 11310 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11311 (setq list-margin (current-column)) 11312 (while generic-list 11313 (setq generic (car generic-list)) 11314 ;; paste group comment and spacing 11315 (when (eq vhdl-include-group-comments 'always) 11316 (vhdl-paste-group-comment (nth 4 generic) list-margin)) 11317 ;; paste formal and actual generic 11318 (insert (car (nth 0 generic)) " => " 11319 (if no-constants 11320 (car (nth 0 generic)) 11321 (or (nth 2 generic) ""))) 11322 (setq generic-list (cdr generic-list)) 11323 (insert (if generic-list "," ")")) 11324 (when (and (not generic-list) secondary 11325 (null (nth 2 vhdl-port-list))) 11326 (insert ";")) 11327 ;; paste comment 11328 (when (or vhdl-include-type-comments 11329 (and vhdl-include-port-comments (nth 3 generic))) 11330 (vhdl-comment-insert-inline 11331 (concat 11332 (when vhdl-include-type-comments 11333 (concat "[" (nth 1 generic) "] ")) 11334 (when vhdl-include-port-comments (nth 3 generic))) t)) 11335 (when generic-list (insert "\n") (indent-to list-margin))) 11336 ;; align generic map 11337 (when vhdl-auto-align 11338 (vhdl-align-region-groups start (point) 1 t)))))) 11339 11340(defun vhdl-port-paste-port-map () 11341 "Paste as a port map." 11342 (let ((margin (current-indentation)) 11343 list-margin start port 11344 (port-list (nth 2 vhdl-port-list))) 11345 (when port-list 11346 (setq start (point)) 11347 (vhdl-insert-keyword "PORT MAP (") 11348 (if (not vhdl-association-list-with-formals) 11349 ;; paste list of actual ports 11350 (while port-list 11351 (insert (vhdl-replace-string vhdl-actual-port-name 11352 (car (nth 0 (car port-list))))) 11353 (setq port-list (cdr port-list)) 11354 (insert (if port-list ", " ")"))) 11355 (unless vhdl-argument-list-indent 11356 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11357 (setq list-margin (current-column)) 11358 (while port-list 11359 (setq port (car port-list)) 11360 ;; paste group comment and spacing 11361 (when (eq vhdl-include-group-comments 'always) 11362 (vhdl-paste-group-comment (nth 5 port) list-margin)) 11363 ;; paste formal and actual port 11364 (insert (car (nth 0 port)) " => ") 11365 (insert (vhdl-replace-string vhdl-actual-port-name 11366 (car (nth 0 port)))) 11367 (setq port-list (cdr port-list)) 11368 (insert (if port-list "," ");")) 11369 ;; paste comment 11370 (when (or vhdl-include-direction-comments 11371 vhdl-include-type-comments 11372 (and vhdl-include-port-comments (nth 4 port))) 11373 (vhdl-comment-insert-inline 11374 (concat 11375 (cond ((and vhdl-include-direction-comments 11376 vhdl-include-type-comments) 11377 (concat "[" (format "%-4s" (concat (nth 2 port) " ")) 11378 (nth 3 port) "] ")) 11379 ((and vhdl-include-direction-comments (nth 2 port)) 11380 (format "%-6s" (concat "[" (nth 2 port) "] "))) 11381 (vhdl-include-direction-comments " ") 11382 (vhdl-include-type-comments 11383 (concat "[" (nth 3 port) "] "))) 11384 (when vhdl-include-port-comments (nth 4 port))) t)) 11385 (when port-list (insert "\n") (indent-to list-margin))) 11386 ;; align port clause 11387 (when vhdl-auto-align 11388 (vhdl-align-region-groups start (point) 1)))))) 11389 11390(defun vhdl-port-paste-instance (&optional name no-indent title) 11391 "Paste as an instantiation." 11392 (interactive) 11393 (if (not vhdl-port-list) 11394 (error "ERROR: No port read") 11395 (let ((orig-vhdl-port-list vhdl-port-list)) 11396 ;; flatten local copy of port list (must be flat for port mapping) 11397 (vhdl-port-flatten) 11398 (unless no-indent (indent-according-to-mode)) 11399 (let ((margin (current-indentation))) 11400 ;; paste instantiation 11401 (cond (name 11402 (insert name)) 11403 ((equal (cdr vhdl-instance-name) "") 11404 (setq name (vhdl-template-field "instance name"))) 11405 ((string-match "\%d" (cdr vhdl-instance-name)) 11406 (let ((n 1)) 11407 (while (save-excursion 11408 (setq name (format (vhdl-replace-string 11409 vhdl-instance-name 11410 (nth 0 vhdl-port-list)) n)) 11411 (goto-char (point-min)) 11412 (vhdl-re-search-forward name nil t)) 11413 (setq n (1+ n))) 11414 (insert name))) 11415 (t (insert (vhdl-replace-string vhdl-instance-name 11416 (nth 0 vhdl-port-list))))) 11417 (message "Pasting port as instantiation \"%s\"..." name) 11418 (insert ": ") 11419 (when title 11420 (save-excursion 11421 (beginning-of-line) 11422 (indent-to vhdl-basic-offset) 11423 (insert "-- instance \"" name "\"\n"))) 11424 (if (not (vhdl-use-direct-instantiation)) 11425 (insert (nth 0 vhdl-port-list)) 11426 (vhdl-insert-keyword "ENTITY ") 11427 (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) 11428 (when (nth 1 vhdl-port-list) 11429 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 11430 (vhdl-port-paste-generic-map t t)) 11431 (when (nth 2 vhdl-port-list) 11432 (insert "\n") (indent-to (+ margin vhdl-basic-offset)) 11433 (vhdl-port-paste-port-map)) 11434 (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) 11435 (insert ";")) 11436 (message "Pasting port as instantiation \"%s\"...done" name)) 11437 (setq vhdl-port-list orig-vhdl-port-list)))) 11438 11439(defun vhdl-port-paste-constants (&optional no-indent) 11440 "Paste generics as constants." 11441 (interactive) 11442 (if (not vhdl-port-list) 11443 (error "ERROR: No port read") 11444 (let ((orig-vhdl-port-list vhdl-port-list)) 11445 (message "Pasting port as constants...") 11446 ;; flatten local copy of port list (must be flat for constant initial.) 11447 (vhdl-port-flatten) 11448 (unless no-indent (indent-according-to-mode)) 11449 (let ((margin (current-indentation)) 11450 start generic name 11451 (generic-list (nth 1 vhdl-port-list))) 11452 (when generic-list 11453 (setq start (point)) 11454 (while generic-list 11455 (setq generic (car generic-list)) 11456 ;; paste group comment and spacing 11457 (when (memq vhdl-include-group-comments '(decl always)) 11458 (vhdl-paste-group-comment (nth 4 generic) margin)) 11459 (vhdl-insert-keyword "CONSTANT ") 11460 ;; paste generic constants 11461 (setq name (nth 0 generic)) 11462 (when name 11463 (insert (car name)) 11464 ;; paste type 11465 (insert " : " (nth 1 generic)) 11466 ;; paste initialization 11467 (when (nth 2 generic) 11468 (insert " := " (nth 2 generic))) 11469 (insert ";") 11470 ;; paste comment 11471 (when (and vhdl-include-port-comments (nth 3 generic)) 11472 (vhdl-comment-insert-inline (nth 3 generic) t)) 11473 (setq generic-list (cdr generic-list)) 11474 (when generic-list (insert "\n") (indent-to margin)))) 11475 ;; align signal list 11476 (when vhdl-auto-align 11477 (vhdl-align-region-groups start (point) 1)))) 11478 (message "Pasting port as constants...done") 11479 (setq vhdl-port-list orig-vhdl-port-list)))) 11480 11481(defun vhdl-port-paste-signals (&optional initialize no-indent) 11482 "Paste ports as internal signals." 11483 (interactive) 11484 (if (not vhdl-port-list) 11485 (error "ERROR: No port read") 11486 (message "Pasting port as signals...") 11487 (unless no-indent (indent-according-to-mode)) 11488 (let ((margin (current-indentation)) 11489 start port names 11490 (port-list (nth 2 vhdl-port-list))) 11491 (when port-list 11492 (setq start (point)) 11493 (while port-list 11494 (setq port (car port-list)) 11495 ;; paste group comment and spacing 11496 (when (memq vhdl-include-group-comments '(decl always)) 11497 (vhdl-paste-group-comment (nth 5 port) margin)) 11498 ;; paste object 11499 (if (nth 1 port) 11500 (insert (nth 1 port) " ") 11501 (vhdl-insert-keyword "SIGNAL ")) 11502 ;; paste actual port signals 11503 (setq names (nth 0 port)) 11504 (while names 11505 (insert (vhdl-replace-string vhdl-actual-port-name (car names))) 11506 (setq names (cdr names)) 11507 (when names (insert ", "))) 11508 ;; paste type 11509 (insert " : " (nth 3 port)) 11510 ;; paste initialization (inputs only) 11511 (when (and initialize (equal "IN" (upcase (nth 2 port)))) 11512 (insert " := " (if (string-match "(.+)" (nth 3 port)) 11513 "(others => '0')" "'0'"))) 11514 (insert ";") 11515 ;; paste comment 11516 (when (or vhdl-include-direction-comments 11517 (and vhdl-include-port-comments (nth 4 port))) 11518 (vhdl-comment-insert-inline 11519 (concat 11520 (cond ((and vhdl-include-direction-comments (nth 2 port)) 11521 (format "%-6s" (concat "[" (nth 2 port) "] "))) 11522 (vhdl-include-direction-comments " ")) 11523 (when vhdl-include-port-comments (nth 4 port))) t)) 11524 (setq port-list (cdr port-list)) 11525 (when port-list (insert "\n") (indent-to margin))) 11526 ;; align signal list 11527 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 11528 (message "Pasting port as signals...done"))) 11529 11530(defun vhdl-port-paste-initializations (&optional no-indent) 11531 "Paste ports as signal initializations." 11532 (interactive) 11533 (if (not vhdl-port-list) 11534 (error "ERROR: No port read") 11535 (let ((orig-vhdl-port-list vhdl-port-list)) 11536 (message "Pasting port as initializations...") 11537 ;; flatten local copy of port list (must be flat for signal initial.) 11538 (vhdl-port-flatten) 11539 (unless no-indent (indent-according-to-mode)) 11540 (let ((margin (current-indentation)) 11541 start port name 11542 (port-list (nth 2 vhdl-port-list))) 11543 (when port-list 11544 (setq start (point)) 11545 (while port-list 11546 (setq port (car port-list)) 11547 ;; paste actual port signal (inputs only) 11548 (when (equal "IN" (upcase (nth 2 port))) 11549 (setq name (car (nth 0 port))) 11550 (insert (vhdl-replace-string vhdl-actual-port-name name)) 11551 ;; paste initialization 11552 (insert " <= " (if (string-match "(.+)" (nth 3 port)) 11553 "(others => '0')" "'0'") ";")) 11554 (setq port-list (cdr port-list)) 11555 (when (and port-list 11556 (equal "IN" (upcase (nth 2 (car port-list))))) 11557 (insert "\n") (indent-to margin))) 11558 ;; align signal list 11559 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) 11560 (message "Pasting port as initializations...done") 11561 (setq vhdl-port-list orig-vhdl-port-list)))) 11562 11563(defun vhdl-port-paste-testbench () 11564 "Paste as a bare-bones testbench." 11565 (interactive) 11566 (if (not vhdl-port-list) 11567 (error "ERROR: No port read") 11568 (let ((case-fold-search t) 11569 (ent-name (vhdl-replace-string vhdl-testbench-entity-name 11570 (nth 0 vhdl-port-list))) 11571 (source-buffer (current-buffer)) 11572 arch-name config-name ent-file-name arch-file-name 11573 ent-buffer arch-buffer position) 11574 ;; open entity file 11575 (unless (eq vhdl-testbench-create-files 'none) 11576 (setq ent-file-name 11577 (concat (vhdl-replace-string vhdl-testbench-entity-file-name 11578 ent-name t) 11579 "." (file-name-extension (buffer-file-name)))) 11580 (if (file-exists-p ent-file-name) 11581 (if (y-or-n-p 11582 (concat "File \"" ent-file-name "\" exists; overwrite? ")) 11583 (progn (find-file ent-file-name) 11584 (erase-buffer) 11585 (set-buffer-modified-p nil)) 11586 (if (eq vhdl-testbench-create-files 'separate) 11587 (setq ent-file-name nil) 11588 (error "ERROR: Pasting port as testbench...aborted"))) 11589 (find-file ent-file-name))) 11590 (unless (and (eq vhdl-testbench-create-files 'separate) 11591 (null ent-file-name)) 11592 ;; paste entity header 11593 (if vhdl-testbench-include-header 11594 (progn (vhdl-template-header 11595 (concat "Testbench for design \"" 11596 (nth 0 vhdl-port-list) "\"")) 11597 (goto-char (point-max))) 11598 (vhdl-comment-display-line) (insert "\n\n")) 11599 ;; paste std_logic_1164 package 11600 (when vhdl-testbench-include-library 11601 (vhdl-template-package-std-logic-1164) 11602 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) 11603 ;; paste entity declaration 11604 (vhdl-insert-keyword "ENTITY ") 11605 (insert ent-name) 11606 (vhdl-insert-keyword " IS") 11607 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 11608 (insert "\n") 11609 (vhdl-insert-keyword "END ") 11610 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 11611 (insert ent-name ";") 11612 (insert "\n\n") 11613 (vhdl-comment-display-line) (insert "\n")) 11614 ;; get architecture name 11615 (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") 11616 (read-from-minibuffer "architecture name: " 11617 nil vhdl-minibuffer-local-map) 11618 (vhdl-replace-string vhdl-testbench-architecture-name 11619 (nth 0 vhdl-port-list)))) 11620 (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) 11621 ;; open architecture file 11622 (if (not (eq vhdl-testbench-create-files 'separate)) 11623 (insert "\n") 11624 (setq ent-buffer (current-buffer)) 11625 (setq arch-file-name 11626 (concat (vhdl-replace-string vhdl-testbench-architecture-file-name 11627 (concat ent-name " " arch-name) t) 11628 "." (file-name-extension (buffer-file-name)))) 11629 (when (and (file-exists-p arch-file-name) 11630 (not (y-or-n-p (concat "File \"" arch-file-name 11631 "\" exists; overwrite? ")))) 11632 (error "ERROR: Pasting port as testbench...aborted")) 11633 (find-file arch-file-name) 11634 (erase-buffer) 11635 (set-buffer-modified-p nil) 11636 ;; paste architecture header 11637 (if vhdl-testbench-include-header 11638 (progn (vhdl-template-header 11639 (concat "Testbench architecture for design \"" 11640 (nth 0 vhdl-port-list) "\"")) 11641 (goto-char (point-max))) 11642 (vhdl-comment-display-line) (insert "\n\n"))) 11643 ;; paste architecture body 11644 (vhdl-insert-keyword "ARCHITECTURE ") 11645 (insert arch-name) 11646 (vhdl-insert-keyword " OF ") 11647 (insert ent-name) 11648 (vhdl-insert-keyword " IS") 11649 (insert "\n\n") (indent-to vhdl-basic-offset) 11650 ;; paste component declaration 11651 (unless (vhdl-use-direct-instantiation) 11652 (vhdl-port-paste-component t) 11653 (insert "\n\n") (indent-to vhdl-basic-offset)) 11654 ;; paste constants 11655 (when (nth 1 vhdl-port-list) 11656 (insert "-- component generics\n") (indent-to vhdl-basic-offset) 11657 (vhdl-port-paste-constants t) 11658 (insert "\n\n") (indent-to vhdl-basic-offset)) 11659 ;; paste internal signals 11660 (insert "-- component ports\n") (indent-to vhdl-basic-offset) 11661 (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) 11662 (insert "\n") 11663 ;; paste custom declarations 11664 (unless (equal "" vhdl-testbench-declarations) 11665 (insert "\n") 11666 (vhdl-insert-string-or-file vhdl-testbench-declarations)) 11667 (setq position (point)) 11668 (insert "\n\n") 11669 (vhdl-comment-display-line) (insert "\n") 11670 (when vhdl-testbench-include-configuration 11671 (setq config-name (vhdl-replace-string 11672 vhdl-testbench-configuration-name 11673 (concat ent-name " " arch-name))) 11674 (insert "\n") 11675 (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) 11676 (vhdl-insert-keyword " OF ") (insert ent-name) 11677 (vhdl-insert-keyword " IS\n") 11678 (indent-to vhdl-basic-offset) 11679 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 11680 (indent-to vhdl-basic-offset) 11681 (vhdl-insert-keyword "END FOR;\n") 11682 (vhdl-insert-keyword "END ") (insert config-name ";\n\n") 11683 (vhdl-comment-display-line) (insert "\n")) 11684 (goto-char position) 11685 (vhdl-template-begin-end 11686 (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) 11687 ;; paste instantiation 11688 (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) 11689 (vhdl-port-paste-instance 11690 (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) 11691 (insert "\n") 11692 ;; paste custom statements 11693 (unless (equal "" vhdl-testbench-statements) 11694 (insert "\n") 11695 (vhdl-insert-string-or-file vhdl-testbench-statements)) 11696 (insert "\n") 11697 (indent-to vhdl-basic-offset) 11698 (unless (eq vhdl-testbench-create-files 'none) 11699 (setq arch-buffer (current-buffer)) 11700 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 11701 (set-buffer arch-buffer) (save-buffer)) 11702 (message "%s" 11703 (concat (format "Pasting port as testbench \"%s(%s)\"...done" 11704 ent-name arch-name) 11705 (and ent-file-name 11706 (format "\n File created: \"%s\"" ent-file-name)) 11707 (and arch-file-name 11708 (format "\n File created: \"%s\"" arch-file-name))))))) 11709 11710 11711;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11712;;; Subprogram interface translation 11713;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11714 11715(defvar vhdl-subprog-list nil 11716 "Variable to hold last subprogram interface parsed.") 11717;; structure: (parenthesised expression means list of such entries) 11718;; (subprog-name kind 11719;; ((names) object direct type init comment group-comment) 11720;; return-type return-comment group-comment) 11721 11722(defvar vhdl-subprog-flattened nil 11723 "Indicates whether an subprogram interface has been flattened.") 11724 11725(defun vhdl-subprog-flatten () 11726 "Flatten interface list so that only one parameter exists per line." 11727 (interactive) 11728 (if (not vhdl-subprog-list) 11729 (error "ERROR: No subprogram interface has been read") 11730 (message "Flattening subprogram interface...") 11731 (let ((old-subprog-list (nth 2 vhdl-subprog-list)) 11732 new-subprog-list old-subprog new-subprog names) 11733 ;; traverse parameter list and flatten entries 11734 (while old-subprog-list 11735 (setq old-subprog (car old-subprog-list)) 11736 (setq names (car old-subprog)) 11737 (while names 11738 (setq new-subprog (cons (list (car names)) (cdr old-subprog))) 11739 (setq new-subprog-list (append new-subprog-list (list new-subprog))) 11740 (setq names (cdr names))) 11741 (setq old-subprog-list (cdr old-subprog-list))) 11742 (setq vhdl-subprog-list 11743 (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) 11744 new-subprog-list (nth 3 vhdl-subprog-list) 11745 (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) 11746 vhdl-subprog-flattened t) 11747 (message "Flattening subprogram interface...done")))) 11748 11749(defun vhdl-subprog-copy () 11750 "Get interface information from a subprogram specification." 11751 (interactive) 11752 (save-excursion 11753 (let (parse-error pos end-of-list 11754 name kind param-list object names direct type init 11755 comment group-comment 11756 return-type return-comment return-group-comment) 11757 (vhdl-prepare-search-2 11758 (setq 11759 parse-error 11760 (catch 'parse 11761 ;; check if within function declaration 11762 (setq pos (point)) 11763 (end-of-line) 11764 (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) 11765 (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) 11766 (goto-char (match-end 0)) 11767 (save-excursion (backward-char) 11768 (forward-sexp) 11769 (<= pos (point)))) 11770 (throw 'parse "ERROR: Not within a subprogram specification")) 11771 (setq name (match-string-no-properties 5)) 11772 (setq kind (if (match-string 2) 'procedure 'function)) 11773 (setq end-of-list (not (match-string 7))) 11774 (message "Reading interface of subprogram \"%s\"..." name) 11775 ;; parse parameter list 11776 (setq group-comment (vhdl-parse-group-comment)) 11777 (setq end-of-list (or end-of-list 11778 (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) 11779 (while (not end-of-list) 11780 ;; parse object 11781 (setq object 11782 (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t) 11783 (match-string-no-properties 1))) 11784 ;; parse names (accept extended identifiers) 11785 (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*") 11786 (setq names (list (match-string-no-properties 1))) 11787 (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t) 11788 (setq names (append names (list (match-string-no-properties 1))))) 11789 ;; parse direction 11790 (vhdl-parse-string ":[ \t\n]*") 11791 (setq direct 11792 (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t) 11793 (match-string-no-properties 1))) 11794 ;; parse type 11795 (vhdl-parse-string "\\([^():;\n]+\\)") 11796 (setq type (match-string-no-properties 1)) 11797 (setq comment nil) 11798 (while (looking-at "(") 11799 (setq type 11800 (concat type 11801 (buffer-substring-no-properties 11802 (point) (progn (forward-sexp) (point))) 11803 (and (vhdl-parse-string "\\([^():;\n]*\\)" t) 11804 (match-string-no-properties 1))))) 11805 ;; special case: closing parenthesis is on separate line 11806 (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) 11807 (setq comment (substring type (match-beginning 2))) 11808 (setq type (substring type 0 (match-beginning 1)))) 11809 ;; strip off trailing group-comment 11810 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) 11811 (setq type (substring type 0 (match-end 1))) 11812 ;; parse initialization expression 11813 (setq init nil) 11814 (when (vhdl-parse-string ":=[ \t\n]*" t) 11815 (vhdl-parse-string "\\([^();\n]*\\)") 11816 (setq init (match-string-no-properties 1)) 11817 (while (looking-at "(") 11818 (setq init 11819 (concat init 11820 (buffer-substring-no-properties 11821 (point) (progn (forward-sexp) (point))) 11822 (and (vhdl-parse-string "\\([^();\n]*\\)" t) 11823 (match-string-no-properties 1)))))) 11824 ;; special case: closing parenthesis is on separate line 11825 (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) 11826 (setq comment (substring init (match-beginning 2))) 11827 (setq init (substring init 0 (match-beginning 1))) 11828 (vhdl-forward-syntactic-ws)) 11829 (skip-chars-forward " \t") 11830 ;; parse inline comment, special case: as above, no initial. 11831 (unless comment 11832 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11833 (match-string-no-properties 1)))) 11834 (vhdl-forward-syntactic-ws) 11835 (setq end-of-list (vhdl-parse-string ")\\s-*" t)) 11836 ;; parse inline comment 11837 (unless comment 11838 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11839 (match-string-no-properties 1)))) 11840 (setq return-group-comment (vhdl-parse-group-comment)) 11841 (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") 11842 ;; parse return type 11843 (when (match-string 3) 11844 (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*") 11845 (setq return-type (match-string-no-properties 1)) 11846 (when (and return-type 11847 (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) 11848 (setq return-comment (substring return-type (match-beginning 2))) 11849 (setq return-type (substring return-type 0 (match-beginning 1)))) 11850 ;; strip of trailing group-comment 11851 (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) 11852 (setq return-type (substring return-type 0 (match-end 1))) 11853 ;; parse return comment 11854 (unless return-comment 11855 (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11856 (match-string-no-properties 1))))) 11857 ;; parse inline comment 11858 (unless comment 11859 (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) 11860 (match-string-no-properties 1)))) 11861 ;; save everything in list 11862 (setq param-list (append param-list 11863 (list (list names object direct type init 11864 comment group-comment)))) 11865 ;; parse group comment and spacing 11866 (setq group-comment (vhdl-parse-group-comment))) 11867 (message "Reading interface of subprogram \"%s\"...done" name) 11868 nil))) 11869 ;; finish parsing 11870 (if parse-error 11871 (error parse-error) 11872 (setq vhdl-subprog-list 11873 (list name kind param-list return-type return-comment 11874 return-group-comment) 11875 vhdl-subprog-flattened nil))))) 11876 11877(defun vhdl-subprog-paste-specification (kind) 11878 "Paste as a subprogram specification." 11879 (indent-according-to-mode) 11880 (let ((margin (current-column)) 11881 (param-list (nth 2 vhdl-subprog-list)) 11882 list-margin start names param) 11883 ;; paste keyword and name 11884 (vhdl-insert-keyword 11885 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) 11886 (insert (nth 0 vhdl-subprog-list)) 11887 (if (not param-list) 11888 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 11889 (setq start (point)) 11890 ;; paste parameter list 11891 (insert " (") 11892 (unless vhdl-argument-list-indent 11893 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11894 (setq list-margin (current-column)) 11895 (while param-list 11896 (setq param (car param-list)) 11897 ;; paste group comment and spacing 11898 (when (memq vhdl-include-group-comments (list kind 'always)) 11899 (vhdl-paste-group-comment (nth 6 param) list-margin)) 11900 ;; paste object 11901 (when (nth 1 param) (insert (nth 1 param) " ")) 11902 ;; paste names 11903 (setq names (nth 0 param)) 11904 (while names 11905 (insert (car names)) 11906 (setq names (cdr names)) 11907 (when names (insert ", "))) 11908 ;; paste direction 11909 (insert " : ") 11910 (when (nth 2 param) (insert (nth 2 param) " ")) 11911 ;; paste type 11912 (insert (nth 3 param)) 11913 ;; paste initialization 11914 (when (nth 4 param) (insert " := " (nth 4 param))) 11915 ;; terminate line 11916 (if (cdr param-list) 11917 (insert ";") 11918 (insert ")") 11919 (when (null (nth 3 vhdl-subprog-list)) 11920 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) 11921 ;; paste comment 11922 (when (and vhdl-include-port-comments (nth 5 param)) 11923 (vhdl-comment-insert-inline (nth 5 param) t)) 11924 (setq param-list (cdr param-list)) 11925 (when param-list (insert "\n") (indent-to list-margin))) 11926 (when (nth 3 vhdl-subprog-list) 11927 (insert "\n") (indent-to list-margin) 11928 ;; paste group comment and spacing 11929 (when (memq vhdl-include-group-comments (list kind 'always)) 11930 (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) 11931 ;; paste return type 11932 (insert "return " (nth 3 vhdl-subprog-list)) 11933 (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) 11934 (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) 11935 (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) 11936 ;; align parameter list 11937 (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) 11938 ;; paste body 11939 (when (eq kind 'body) 11940 (insert "\n") 11941 (vhdl-template-begin-end 11942 (unless (vhdl-standard-p '87) 11943 (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) 11944 (nth 0 vhdl-subprog-list) margin)))) 11945 11946(defun vhdl-subprog-paste-declaration () 11947 "Paste as a subprogram declaration." 11948 (interactive) 11949 (if (not vhdl-subprog-list) 11950 (error "ERROR: No subprogram interface read") 11951 (message "Pasting interface as subprogram declaration \"%s\"..." 11952 (car vhdl-subprog-list)) 11953 ;; paste specification 11954 (vhdl-subprog-paste-specification 'decl) 11955 (message "Pasting interface as subprogram declaration \"%s\"...done" 11956 (car vhdl-subprog-list)))) 11957 11958(defun vhdl-subprog-paste-body () 11959 "Paste as a subprogram body." 11960 (interactive) 11961 (if (not vhdl-subprog-list) 11962 (error "ERROR: No subprogram interface read") 11963 (message "Pasting interface as subprogram body \"%s\"..." 11964 (car vhdl-subprog-list)) 11965 ;; paste specification and body 11966 (vhdl-subprog-paste-specification 'body) 11967 (message "Pasting interface as subprogram body \"%s\"...done" 11968 (car vhdl-subprog-list)))) 11969 11970(defun vhdl-subprog-paste-call () 11971 "Paste as a subprogram call." 11972 (interactive) 11973 (if (not vhdl-subprog-list) 11974 (error "ERROR: No subprogram interface read") 11975 (let ((orig-vhdl-subprog-list vhdl-subprog-list) 11976 param-list margin list-margin param start) 11977 ;; flatten local copy of interface list (must be flat for parameter mapping) 11978 (vhdl-subprog-flatten) 11979 (setq param-list (nth 2 vhdl-subprog-list)) 11980 (indent-according-to-mode) 11981 (setq margin (current-indentation)) 11982 (message "Pasting interface as subprogram call \"%s\"..." 11983 (car vhdl-subprog-list)) 11984 ;; paste name 11985 (insert (nth 0 vhdl-subprog-list)) 11986 (if (not param-list) 11987 (insert ";") 11988 (setq start (point)) 11989 ;; paste parameter list 11990 (insert " (") 11991 (unless vhdl-argument-list-indent 11992 (insert "\n") (indent-to (+ margin vhdl-basic-offset))) 11993 (setq list-margin (current-column)) 11994 (while param-list 11995 (setq param (car param-list)) 11996 ;; paste group comment and spacing 11997 (when (eq vhdl-include-group-comments 'always) 11998 (vhdl-paste-group-comment (nth 6 param) list-margin)) 11999 ;; paste formal port 12000 (insert (car (nth 0 param)) " => ") 12001 (setq param-list (cdr param-list)) 12002 (insert (if param-list "," ");")) 12003 ;; paste comment 12004 (when (and vhdl-include-port-comments (nth 5 param)) 12005 (vhdl-comment-insert-inline (nth 5 param))) 12006 (when param-list (insert "\n") (indent-to list-margin))) 12007 ;; align parameter list 12008 (when vhdl-auto-align 12009 (vhdl-align-region-groups start (point) 1))) 12010 (message "Pasting interface as subprogram call \"%s\"...done" 12011 (car vhdl-subprog-list)) 12012 (setq vhdl-subprog-list orig-vhdl-subprog-list)))) 12013 12014 12015;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12016;;; Miscellaneous 12017;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12018 12019;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12020;; Hippie expand customization 12021 12022(defvar vhdl-expand-upper-case nil) 12023 12024(defun vhdl-try-expand-abbrev (old) 12025 "Try expanding abbreviations from `vhdl-abbrev-list'." 12026 (unless old 12027 (he-init-string (he-dabbrev-beg) (point)) 12028 (setq he-expand-list 12029 (let ((abbrev-list vhdl-abbrev-list) 12030 (sel-abbrev-list '())) 12031 (while abbrev-list 12032 (when (or (not (stringp (car abbrev-list))) 12033 (string-match 12034 (concat "^" he-search-string) (car abbrev-list))) 12035 (setq sel-abbrev-list 12036 (cons (car abbrev-list) sel-abbrev-list))) 12037 (setq abbrev-list (cdr abbrev-list))) 12038 (nreverse sel-abbrev-list)))) 12039 (while (and he-expand-list 12040 (or (not (stringp (car he-expand-list))) 12041 (he-string-member (car he-expand-list) he-tried-table t))) 12042; (equal (car he-expand-list) he-search-string))) 12043 (unless (stringp (car he-expand-list)) 12044 (setq vhdl-expand-upper-case (car he-expand-list))) 12045 (setq he-expand-list (cdr he-expand-list))) 12046 (if (null he-expand-list) 12047 (progn (when old (he-reset-string)) 12048 nil) 12049 (he-substitute-string 12050 (if vhdl-expand-upper-case 12051 (upcase (car he-expand-list)) 12052 (car he-expand-list)) 12053 t) 12054 (setq he-expand-list (cdr he-expand-list)) 12055 t)) 12056 12057(defun vhdl-he-list-beg () 12058 "Also looks at the word before `(' in order to better match parenthesized 12059expressions (e.g. for index ranges of types and signals)." 12060 (save-excursion 12061 (condition-case () 12062 (progn (backward-up-list 1) 12063 (skip-syntax-backward "w_")) ; crashes in `viper-mode' 12064 (error ())) 12065 (point))) 12066 12067;; override `he-list-beg' from `hippie-exp' 12068(unless (and (boundp 'viper-mode) viper-mode) 12069 (defalias 'he-list-beg 'vhdl-he-list-beg)) 12070 12071;; function for expanding abbrevs and dabbrevs 12072(defun vhdl-expand-abbrev (arg)) 12073(fset 'vhdl-expand-abbrev (make-hippie-expand-function 12074 '(try-expand-dabbrev 12075 try-expand-dabbrev-all-buffers 12076 vhdl-try-expand-abbrev))) 12077 12078;; function for expanding parenthesis 12079(defun vhdl-expand-paren (arg)) 12080(fset 'vhdl-expand-paren (make-hippie-expand-function 12081 '(try-expand-list 12082 try-expand-list-all-buffers))) 12083 12084;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12085;; Case fixing 12086 12087(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) 12088 "Convert all words matching WORD-REGEXP in region to lower or upper case, 12089depending on parameter UPPER-CASE." 12090 (let ((case-replace nil) 12091 (last-update 0)) 12092 (vhdl-prepare-search-2 12093 (save-excursion 12094 (goto-char end) 12095 (setq end (point-marker)) 12096 (goto-char beg) 12097 (while (re-search-forward word-regexp end t) 12098 (or (vhdl-in-literal) 12099 (if upper-case 12100 (upcase-word -1) 12101 (downcase-word -1))) 12102 (when (and count vhdl-progress-interval (not noninteractive) 12103 (< vhdl-progress-interval 12104 (- (nth 1 (current-time)) last-update))) 12105 (message "Fixing case... (%2d%s)" 12106 (+ (* count 25) (/ (* 25 (- (point) beg)) (- end beg))) 12107 "%") 12108 (setq last-update (nth 1 (current-time))))) 12109 (goto-char end))))) 12110 12111(defun vhdl-fix-case-region (beg end &optional arg) 12112 "Convert all VHDL words in region to lower or upper case, depending on 12113options vhdl-upper-case-{keywords,types,attributes,enum-values}." 12114 (interactive "r\nP") 12115 (vhdl-fix-case-region-1 12116 beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) 12117 (vhdl-fix-case-region-1 12118 beg end vhdl-upper-case-types vhdl-types-regexp 1) 12119 (vhdl-fix-case-region-1 12120 beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) 12121 (vhdl-fix-case-region-1 12122 beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) 12123 (when vhdl-progress-interval (message "Fixing case...done"))) 12124 12125(defun vhdl-fix-case-buffer () 12126 "Convert all VHDL words in buffer to lower or upper case, depending on 12127options vhdl-upper-case-{keywords,types,attributes,enum-values}." 12128 (interactive) 12129 (vhdl-fix-case-region (point-min) (point-max))) 12130 12131(defun vhdl-fix-case-word (&optional arg) 12132 "Convert word after cursor to upper case if necessary." 12133 (interactive "p") 12134 (save-excursion 12135 (when arg (backward-word 1)) 12136 (vhdl-prepare-search-1 12137 (when (and vhdl-upper-case-keywords 12138 (looking-at vhdl-keywords-regexp)) 12139 (upcase-word 1)) 12140 (when (and vhdl-upper-case-types 12141 (looking-at vhdl-types-regexp)) 12142 (upcase-word 1)) 12143 (when (and vhdl-upper-case-attributes 12144 (looking-at vhdl-attributes-regexp)) 12145 (upcase-word 1)) 12146 (when (and vhdl-upper-case-enum-values 12147 (looking-at vhdl-enum-values-regexp)) 12148 (upcase-word 1))))) 12149 12150;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12151;; Line handling functions 12152 12153(defun vhdl-current-line () 12154 "Return the line number of the line containing point." 12155 (save-restriction 12156 (widen) 12157 (save-excursion 12158 (beginning-of-line) 12159 (1+ (count-lines 1 (point)))))) 12160 12161(defun vhdl-line-kill-entire (&optional arg) 12162 "Delete entire line." 12163 (interactive "p") 12164 (beginning-of-line) 12165 (kill-line (or arg 1))) 12166 12167(defun vhdl-line-kill (&optional arg) 12168 "Kill current line." 12169 (interactive "p") 12170 (vhdl-line-kill-entire arg)) 12171 12172(defun vhdl-line-copy (&optional arg) 12173 "Copy current line." 12174 (interactive "p") 12175 (save-excursion 12176 (beginning-of-line) 12177 (let ((position (point))) 12178 (forward-line (or arg 1)) 12179 (copy-region-as-kill position (point))))) 12180 12181(defun vhdl-line-yank () 12182 "Yank entire line." 12183 (interactive) 12184 (beginning-of-line) 12185 (yank)) 12186 12187(defun vhdl-line-expand (&optional prefix-arg) 12188 "Hippie-expand current line." 12189 (interactive "P") 12190 (let ((case-fold-search t) (case-replace nil) 12191 (hippie-expand-try-functions-list 12192 '(try-expand-line try-expand-line-all-buffers))) 12193 (hippie-expand prefix-arg))) 12194 12195(defun vhdl-line-transpose-next (&optional arg) 12196 "Interchange this line with next line." 12197 (interactive "p") 12198 (forward-line 1) 12199 (transpose-lines (or arg 1)) 12200 (forward-line -1)) 12201 12202(defun vhdl-line-transpose-previous (&optional arg) 12203 "Interchange this line with previous line." 12204 (interactive "p") 12205 (forward-line 1) 12206 (transpose-lines (- 0 (or arg 0))) 12207 (forward-line -1)) 12208 12209(defun vhdl-line-open () 12210 "Open a new line and indent." 12211 (interactive) 12212 (end-of-line -0) 12213 (newline-and-indent)) 12214 12215(defun vhdl-delete-indentation () 12216 "Join lines. That is, call `delete-indentation' with `fill-prefix' so that 12217it works within comments too." 12218 (interactive) 12219 (let ((fill-prefix "-- ")) 12220 (delete-indentation))) 12221 12222;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12223;; Move functions 12224 12225(defun vhdl-forward-same-indent () 12226 "Move forward to next line with same indent." 12227 (interactive) 12228 (let ((pos (point)) 12229 (indent (current-indentation))) 12230 (beginning-of-line 2) 12231 (while (and (not (eobp)) 12232 (or (looking-at "^\\s-*\\(--.*\\)?$") 12233 (> (current-indentation) indent))) 12234 (beginning-of-line 2)) 12235 (if (= (current-indentation) indent) 12236 (back-to-indentation) 12237 (message "No following line with same indent found in this block") 12238 (goto-char pos) 12239 nil))) 12240 12241(defun vhdl-backward-same-indent () 12242 "Move backward to previous line with same indent." 12243 (interactive) 12244 (let ((pos (point)) 12245 (indent (current-indentation))) 12246 (beginning-of-line -0) 12247 (while (and (not (bobp)) 12248 (or (looking-at "^\\s-*\\(--.*\\)?$") 12249 (> (current-indentation) indent))) 12250 (beginning-of-line -0)) 12251 (if (= (current-indentation) indent) 12252 (back-to-indentation) 12253 (message "No preceding line with same indent found in this block") 12254 (goto-char pos) 12255 nil))) 12256 12257;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12258;; Statistics 12259 12260(defun vhdl-statistics-buffer () 12261 "Get some file statistics." 12262 (interactive) 12263 (let ((no-stats 0) 12264 (no-code-lines 0) 12265 (no-lines (count-lines (point-min) (point-max)))) 12266 (save-excursion 12267 ;; count statements 12268 (goto-char (point-min)) 12269 (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) 12270 (if (match-string 1) 12271 (goto-char (match-end 1)) 12272 (setq no-stats (1+ no-stats)))) 12273 ;; count code lines 12274 (goto-char (point-min)) 12275 (while (not (eobp)) 12276 (unless (looking-at "^\\s-*\\(--.*\\)?$") 12277 (setq no-code-lines (1+ no-code-lines))) 12278 (beginning-of-line 2))) 12279 ;; print results 12280 (message "\n\ 12281File statistics: \"%s\"\n\ 12282---------------------\n\ 12283# statements : %5d\n\ 12284# code lines : %5d\n\ 12285# total lines : %5d\n\ " 12286 (buffer-file-name) no-stats no-code-lines no-lines) 12287 (unless vhdl-emacs-21 (vhdl-show-messages)))) 12288 12289;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12290;; Help functions 12291 12292(defun vhdl-re-search-forward (regexp &optional bound noerror count) 12293 "Like `re-search-forward', but does not match within literals." 12294 (let (pos) 12295 (save-excursion 12296 (while (and (setq pos (re-search-forward regexp bound noerror count)) 12297 (vhdl-in-literal)))) 12298 (when pos (goto-char pos)) 12299 pos)) 12300 12301(defun vhdl-re-search-backward (regexp &optional bound noerror count) 12302 "Like `re-search-backward', but does not match within literals." 12303 (let (pos) 12304 (save-excursion 12305 (while (and (setq pos (re-search-backward regexp bound noerror count)) 12306 (vhdl-in-literal)))) 12307 (when pos (goto-char pos)) 12308 pos)) 12309 12310 12311;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12312;;; Project 12313;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12314 12315(defun vhdl-set-project (name) 12316 "Set current project to NAME." 12317 (interactive 12318 (list (let ((completion-ignore-case t)) 12319 (completing-read "Project name: " vhdl-project-alist nil t)))) 12320 (cond ((equal name "") 12321 (setq vhdl-project nil) 12322 (message "Current VHDL project: None")) 12323 ((assoc name vhdl-project-alist) 12324 (setq vhdl-project name) 12325 (message "Current VHDL project: \"%s\"" name)) 12326 (t 12327 (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) 12328 (vhdl-speedbar-update-current-project)) 12329 12330(defun vhdl-set-default-project () 12331 "Set current project as default on startup." 12332 (interactive) 12333 (customize-set-variable 'vhdl-project vhdl-project) 12334 (customize-save-customized)) 12335 12336(defun vhdl-toggle-project (name token indent) 12337 "Set current project to NAME or unset if NAME is current project." 12338 (vhdl-set-project (if (equal name vhdl-project) "" name))) 12339 12340(defun vhdl-export-project (file-name) 12341 "Write project setup for current project." 12342 (interactive 12343 (let ((name (vhdl-resolve-env-variable 12344 (vhdl-replace-string 12345 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 12346 (concat (subst-char-in-string 12347 ? ?_ (or (vhdl-project-p) 12348 (error "ERROR: No current project"))) 12349 " " (user-login-name)))))) 12350 (list (read-file-name 12351 "Write project file: " 12352 (when (file-name-absolute-p name) "") nil nil name)))) 12353 (setq file-name (abbreviate-file-name file-name)) 12354 (let ((orig-buffer (current-buffer))) 12355 (unless (file-exists-p (file-name-directory file-name)) 12356 (make-directory (file-name-directory file-name) t)) 12357 (if (not (file-writable-p file-name)) 12358 (error "ERROR: File not writable: \"%s\"" file-name) 12359 (set-buffer (find-file-noselect file-name t t)) 12360 (erase-buffer) 12361 (insert ";; -*- Emacs-Lisp -*-\n\n" 12362 ";;; " (file-name-nondirectory file-name) 12363 " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" 12364 ";; Project : " vhdl-project "\n" 12365 ";; Saved : " (format-time-string "%Y-%m-%d %T ") 12366 (user-login-name) "\n\n\n" 12367 ";; project name\n" 12368 "(setq vhdl-project \"" vhdl-project "\")\n\n" 12369 ";; project setup\n" 12370 "(aput 'vhdl-project-alist vhdl-project\n'") 12371 (pp (aget vhdl-project-alist vhdl-project) (current-buffer)) 12372 (insert ")\n") 12373 (save-buffer) 12374 (kill-buffer (current-buffer)) 12375 (set-buffer orig-buffer)))) 12376 12377(defun vhdl-import-project (file-name &optional auto not-make-current) 12378 "Read project setup and set current project." 12379 (interactive 12380 (let ((name (vhdl-resolve-env-variable 12381 (vhdl-replace-string 12382 (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) 12383 (concat "" " " (user-login-name)))))) 12384 (list (read-file-name 12385 "Read project file: " (when (file-name-absolute-p name) "") nil t 12386 (file-name-directory name))))) 12387 (when (file-exists-p file-name) 12388 (condition-case () 12389 (let ((current-project vhdl-project)) 12390 (load-file file-name) 12391 (when (/= (length (aget vhdl-project-alist vhdl-project t)) 10) 12392 (adelete 'vhdl-project-alist vhdl-project) 12393 (error "")) 12394 (when not-make-current 12395 (setq vhdl-project current-project)) 12396 (vhdl-update-mode-menu) 12397 (vhdl-speedbar-refresh) 12398 (unless not-make-current 12399 (message "Current VHDL project: \"%s\"%s" 12400 vhdl-project (if auto " (auto-loaded)" "")))) 12401 (error (vhdl-warning 12402 (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) 12403 12404(defun vhdl-duplicate-project () 12405 "Duplicate setup of current project." 12406 (interactive) 12407 (let ((new-name (read-from-minibuffer "New project name: ")) 12408 (project-entry (aget vhdl-project-alist vhdl-project t))) 12409 (setq vhdl-project-alist 12410 (append vhdl-project-alist 12411 (list (cons new-name project-entry)))) 12412 (vhdl-update-mode-menu))) 12413 12414(defun vhdl-auto-load-project () 12415 "Automatically load project setup at startup." 12416 (let ((file-name-list vhdl-project-file-name) 12417 file-list list-length) 12418 (while file-name-list 12419 (setq file-list 12420 (append file-list 12421 (file-expand-wildcards 12422 (vhdl-resolve-env-variable 12423 (vhdl-replace-string 12424 (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) 12425 (concat "\*" " " (user-login-name))))))) 12426 (setq list-length (or list-length (length file-list))) 12427 (setq file-name-list (cdr file-name-list))) 12428 (while file-list 12429 (vhdl-import-project (expand-file-name (car file-list)) t 12430 (not (> list-length 0))) 12431 (setq list-length (1- list-length)) 12432 (setq file-list (cdr file-list))))) 12433 12434;; automatically load project setup when idle after startup 12435(when (memq 'startup vhdl-project-auto-load) 12436 (if noninteractive 12437 (vhdl-auto-load-project) 12438 (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project))) 12439 12440 12441;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12442;;; Hideshow 12443;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12444;; (using `hideshow.el') 12445 12446(defconst vhdl-hs-start-regexp 12447 (concat 12448 "\\(^\\)\\s-*\\(" 12449 ;; generic/port clause 12450 "\\(generic\\|port\\)[ \t\n]*(\\|" 12451 ;; component 12452 "component\\>\\|" 12453 ;; component instantiation 12454 "\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*" 12455 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?" 12456 "\\(\\w\\|\\s_\\)+\\([ \t\n]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n]*" 12457 "\\(generic\\|port\\)[ \t\n]+map[ \t\n]*(\\|" 12458 ;; subprogram 12459 "\\(function\\|procedure\\)\\>\\|" 12460 ;; process, block 12461 "\\(\\(\\w\\|\\s_\\)+[ \t\n]*:[ \t\n]*\\)?\\(process\\|block\\)\\>\\|" 12462 ;; configuration declaration 12463 "configuration\\>" 12464 "\\)") 12465 "Regexp to match start of construct to hide.") 12466 12467(defun vhdl-hs-forward-sexp-func (count) 12468 "Find end of construct to hide (for hideshow). Only searches forward." 12469 (let ((pos (point))) 12470 (vhdl-prepare-search-2 12471 (beginning-of-line) 12472 (cond 12473 ;; generic/port clause 12474 ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n]*(") 12475 (goto-char (match-end 0)) 12476 (backward-char) 12477 (forward-sexp)) 12478 ;; component declaration 12479 ((looking-at "^\\s-*component\\>") 12480 (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) 12481 ;; component instantiation 12482 ((looking-at 12483 (concat 12484 "^\\s-*\\w+\\s-*:[ \t\n]*" 12485 "\\(\\(component\\|configuration\\|entity\\)[ \t\n]+\\)?" 12486 "\\w+\\(\\s-*(\\w+)\\)?[ \t\n]*" 12487 "\\(generic\\|port\\)\\s-+map[ \t\n]*(")) 12488 (goto-char (match-end 0)) 12489 (backward-char) 12490 (forward-sexp) 12491 (setq pos (point)) 12492 (vhdl-forward-syntactic-ws) 12493 (when (looking-at "port\\s-+map[ \t\n]*(") 12494 (goto-char (match-end 0)) 12495 (backward-char) 12496 (forward-sexp) 12497 (setq pos (point))) 12498 (goto-char pos)) 12499 ;; subprogram declaration/body 12500 ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") 12501 (goto-char (match-end 0)) 12502 (vhdl-forward-syntactic-ws) 12503 (when (looking-at "(") 12504 (forward-sexp)) 12505 (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) 12506 (vhdl-in-literal))) 12507 ;; subprogram body 12508 (when (match-string 2) 12509 (re-search-forward "^\\s-*\\<begin\\>" nil t) 12510 (backward-word 1) 12511 (vhdl-forward-sexp))) 12512 ;; block (recursive) 12513 ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") 12514 (goto-char (match-end 0)) 12515 (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) 12516 (match-beginning 2)) 12517 (vhdl-hs-forward-sexp-func count))) 12518 ;; process 12519 ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") 12520 (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) 12521 ;; configuration declaration 12522 ((looking-at "^\\s-*configuration\\>") 12523 (forward-word 4) 12524 (vhdl-forward-sexp)) 12525 (t (goto-char pos)))))) 12526 12527(defun vhdl-hideshow-init () 12528 "Initialize `hideshow'." 12529 (when vhdl-hideshow-menu 12530 (vhdl-hs-minor-mode 1))) 12531 12532(defun vhdl-hs-minor-mode (&optional arg) 12533 "Toggle hideshow minor mode and update menu bar." 12534 (interactive "P") 12535 (require 'hideshow) 12536 ;; check for hideshow version 5.x 12537 (if (not (boundp 'hs-block-start-mdata-select)) 12538 (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") 12539 ;; initialize hideshow 12540 (unless (assoc 'vhdl-mode hs-special-modes-alist) 12541 (setq hs-special-modes-alist 12542 (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" 12543 'vhdl-hs-forward-sexp-func nil) 12544 hs-special-modes-alist))) 12545 (make-local-variable 'hs-minor-mode-hook) 12546 (if vhdl-hide-all-init 12547 (add-hook 'hs-minor-mode-hook 'hs-hide-all) 12548 (remove-hook 'hs-minor-mode-hook 'hs-hide-all)) 12549 (hs-minor-mode arg) 12550 (vhdl-mode-line-update))) ; hack to update menu bar 12551 12552 12553;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12554;;; Font locking 12555;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12556;; (using `font-lock.el') 12557 12558;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12559;; Help functions 12560 12561(defun vhdl-within-translate-off () 12562 "Return point if within translate-off region, else nil." 12563 (and (save-excursion 12564 (re-search-backward 12565 "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) 12566 (equal "off" (match-string 1)) 12567 (point))) 12568 12569(defun vhdl-start-translate-off (limit) 12570 "Return point before translate-off pragma if before LIMIT, else nil." 12571 (when (re-search-forward 12572 "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) 12573 (match-beginning 0))) 12574 12575(defun vhdl-end-translate-off (limit) 12576 "Return point after translate-on pragma if before LIMIT, else nil." 12577 (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) 12578 12579(defun vhdl-match-translate-off (limit) 12580 "Match a translate-off block, setting match-data and returning t, else nil." 12581 (when (< (point) limit) 12582 (let ((start (or (vhdl-within-translate-off) 12583 (vhdl-start-translate-off limit))) 12584 (case-fold-search t)) 12585 (when start 12586 (let ((end (or (vhdl-end-translate-off limit) limit))) 12587 (set-match-data (list start end)) 12588 (goto-char end)))))) 12589 12590(defun vhdl-font-lock-match-item (limit) 12591 "Match, and move over, any declaration item after point. Adapted from 12592`font-lock-match-c-style-declaration-item-and-skip-to-next'." 12593 (condition-case nil 12594 (save-restriction 12595 (narrow-to-region (point-min) limit) 12596 ;; match item 12597 (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") 12598 (save-match-data 12599 (goto-char (match-end 1)) 12600 ;; move to next item 12601 (if (looking-at "\\(\\s-*,\\)") 12602 (goto-char (match-end 1)) 12603 (end-of-line) t)))) 12604 (error t))) 12605 12606;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12607;; Syntax definitions 12608 12609(defconst vhdl-font-lock-syntactic-keywords 12610 '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\')))) 12611 "Mark single quotes as having string quote syntax in 'c' instances.") 12612 12613(defvar vhdl-font-lock-keywords nil 12614 "Regular expressions to highlight in VHDL Mode.") 12615 12616(defvar vhdl-font-lock-keywords-0 12617 ;; set in `vhdl-font-lock-init' because dependent on user options 12618 "For consideration as a value of `vhdl-font-lock-keywords'. 12619This does highlighting of template prompts and directives (pragmas).") 12620 12621(defvar vhdl-font-lock-keywords-1 nil 12622 ;; set in `vhdl-font-lock-init' because dependent on user options 12623 "For consideration as a value of `vhdl-font-lock-keywords'. 12624This does highlighting of keywords and standard identifiers.") 12625 12626(defconst vhdl-font-lock-keywords-2 12627 (list 12628 ;; highlight names of units, subprograms, and components when declared 12629 (list 12630 (concat 12631 "^\\s-*\\(" 12632 "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|" 12633 "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" 12634 "\\)\\s-+\\(\\w+\\)") 12635 5 'font-lock-function-name-face) 12636 12637 ;; highlight entity names of architectures and configurations 12638 (list 12639 "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" 12640 2 'font-lock-function-name-face) 12641 12642 ;; highlight labels of common constructs 12643 (list 12644 (concat 12645 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\(" 12646 "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" 12647 "postponed\\|process\\|" 12648 (when (vhdl-standard-p 'ams) "procedural\\|") 12649 "with\\|while" 12650 "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") 12651 1 'font-lock-function-name-face) 12652 12653 ;; highlight label and component name of component instantiations 12654 (list 12655 (concat 12656 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*\\(\\w+\\)" 12657 "\\(\\s-*\\(--[^\n]*\\)?$\\|\\s-+\\(generic\\|port\\)\\s-+map\\>\\)") 12658 '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) 12659 12660 ;; highlight label and instantiated unit of component instantiations 12661 (list 12662 (concat 12663 "^\\s-*\\(\\w+\\)\\s-*:[ \t\n]*" 12664 "\\(component\\|configuration\\|entity\\)\\s-+" 12665 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") 12666 '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) 12667 '(5 font-lock-function-name-face nil t) 12668 '(7 font-lock-function-name-face nil t)) 12669 12670 ;; highlight names and labels at end of constructs 12671 (list 12672 (concat 12673 "^\\s-*end\\s-+\\(\\(" 12674 "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|" 12675 "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|" 12676 "procedure\\|\\(postponed\\s-+\\)?process\\|" 12677 (when (vhdl-standard-p 'ams) "procedural\\|") 12678 "units" 12679 "\\)\\s-+\\)?\\(\\w*\\)") 12680 5 'font-lock-function-name-face) 12681 12682 ;; highlight labels in exit and next statements 12683 (list 12684 (concat 12685 "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") 12686 3 'font-lock-function-name-face) 12687 12688 ;; highlight entity name in attribute specifications 12689 (list 12690 (concat 12691 "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") 12692 1 'font-lock-function-name-face) 12693 12694 ;; highlight labels in block and component specifications 12695 (list 12696 (concat 12697 "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" 12698 "\\(:[ \t\n]*\\(\\w+\\)\\|[^i \t]\\)") 12699 '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) 12700 12701 ;; highlight names in library clauses 12702 (list "^\\s-*library\\>" 12703 '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) 12704 12705 ;; highlight names in use clauses 12706 (list 12707 (concat 12708 "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" 12709 "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") 12710 '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t) 12711 '(7 font-lock-function-name-face nil t)) 12712 12713 ;; highlight attribute name in attribute declarations/specifications 12714 (list 12715 (concat 12716 "^\\s-*attribute\\s-+\\(\\w+\\)") 12717 1 'vhdl-font-lock-attribute-face) 12718 12719 ;; highlight type/nature name in (sub)type/(sub)nature declarations 12720 (list 12721 (concat 12722 "^\\s-*\\(sub\\)?\\(nature\\|type\\)\\s-+\\(\\w+\\)") 12723 3 'font-lock-type-face) 12724 12725 ;; highlight signal/variable/constant declaration names 12726 (list "\\(:[^=]\\)" 12727 '(vhdl-font-lock-match-item 12728 (progn (goto-char (match-beginning 1)) 12729 (skip-syntax-backward " ") 12730 (skip-syntax-backward "w_") 12731 (skip-syntax-backward " ") 12732 (while (= (preceding-char) ?,) 12733 (backward-char 1) 12734 (skip-syntax-backward " ") 12735 (skip-syntax-backward "w_") 12736 (skip-syntax-backward " "))) 12737; (skip-chars-backward "^-(\n\";") 12738 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 12739 12740 ;; highlight formal parameters in component instantiations and subprogram 12741 ;; calls 12742 (list "\\(=>\\)" 12743 '(vhdl-font-lock-match-item 12744 (progn (goto-char (match-beginning 1)) 12745 (skip-syntax-backward " ") 12746 (while (= (preceding-char) ?\)) (backward-sexp)) 12747 (skip-syntax-backward "w_") 12748 (skip-syntax-backward " ") 12749 (when (memq (preceding-char) '(?n ?N ?|)) 12750 (goto-char (point-max)))) 12751 (goto-char (match-end 1)) (1 font-lock-variable-name-face))) 12752 12753 ;; highlight alias/group/quantity declaration names and for-loop/-generate 12754 ;; variables 12755 (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" 12756 '(vhdl-font-lock-match-item 12757 (progn (goto-char (match-end 1)) (match-beginning 2)) 12758 nil (1 font-lock-variable-name-face))) 12759 ) 12760 "For consideration as a value of `vhdl-font-lock-keywords'. 12761This does context sensitive highlighting of names and labels.") 12762 12763(defvar vhdl-font-lock-keywords-3 nil 12764 ;; set in `vhdl-font-lock-init' because dependent on user options 12765 "For consideration as a value of `vhdl-font-lock-keywords'. 12766This does highlighting of words with special syntax.") 12767 12768(defvar vhdl-font-lock-keywords-4 nil 12769 ;; set in `vhdl-font-lock-init' because dependent on user options 12770 "For consideration as a value of `vhdl-font-lock-keywords'. 12771This does highlighting of additional reserved words.") 12772 12773(defconst vhdl-font-lock-keywords-5 12774 ;; background highlight translate-off regions 12775 '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) 12776 "For consideration as a value of `vhdl-font-lock-keywords'. 12777This does background highlighting of translate-off regions.") 12778 12779;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12780;; Font and color definitions 12781 12782(defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face 12783 "Face name to use for prompts.") 12784 12785(defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face 12786 "Face name to use for standardized attributes.") 12787 12788(defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face 12789 "Face name to use for standardized enumeration values.") 12790 12791(defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face 12792 "Face name to use for standardized functions and packages.") 12793 12794(defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face 12795 "Face name to use for directives.") 12796 12797(defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face 12798 "Face name to use for additional reserved words.") 12799 12800(defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face 12801 "Face name to use for translate-off regions.") 12802 12803;; face names to use for words with special syntax. 12804(let ((syntax-alist vhdl-special-syntax-alist) 12805 name) 12806 (while syntax-alist 12807 (setq name (vhdl-function-name 12808 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 12809 (eval `(defvar ,name ',name 12810 ,(concat "Face name to use for " 12811 (nth 0 (car syntax-alist)) "."))) 12812 (setq syntax-alist (cdr syntax-alist)))) 12813 12814(defgroup vhdl-highlight-faces nil 12815 "Faces for highlighting." 12816 :group 'vhdl-highlight) 12817 12818;; add faces used from `font-lock' 12819(custom-add-to-group 12820 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) 12821(custom-add-to-group 12822 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) 12823(custom-add-to-group 12824 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) 12825(custom-add-to-group 12826 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) 12827(custom-add-to-group 12828 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) 12829(custom-add-to-group 12830 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) 12831 12832(defface vhdl-font-lock-prompt-face 12833 '((((min-colors 88) (class color) (background light)) 12834 (:foreground "Red1" :bold t)) 12835 (((class color) (background light)) (:foreground "Red" :bold t)) 12836 (((class color) (background dark)) (:foreground "Pink" :bold t)) 12837 (t (:inverse-video t))) 12838 "Font lock mode face used to highlight prompts." 12839 :group 'vhdl-highlight-faces) 12840 12841(defface vhdl-font-lock-attribute-face 12842 '((((class color) (background light)) (:foreground "Orchid")) 12843 (((class color) (background dark)) (:foreground "LightSteelBlue")) 12844 (t (:italic t :bold t))) 12845 "Font lock mode face used to highlight standardized attributes." 12846 :group 'vhdl-highlight-faces) 12847 12848(defface vhdl-font-lock-enumvalue-face 12849 '((((class color) (background light)) (:foreground "SaddleBrown")) 12850 (((class color) (background dark)) (:foreground "BurlyWood")) 12851 (t (:italic t :bold t))) 12852 "Font lock mode face used to highlight standardized enumeration values." 12853 :group 'vhdl-highlight-faces) 12854 12855(defface vhdl-font-lock-function-face 12856 '((((class color) (background light)) (:foreground "Cyan4")) 12857 (((class color) (background dark)) (:foreground "Orchid1")) 12858 (t (:italic t :bold t))) 12859 "Font lock mode face used to highlight standardized functions and packages." 12860 :group 'vhdl-highlight-faces) 12861 12862(defface vhdl-font-lock-directive-face 12863 '((((class color) (background light)) (:foreground "CadetBlue")) 12864 (((class color) (background dark)) (:foreground "Aquamarine")) 12865 (t (:italic t :bold t))) 12866 "Font lock mode face used to highlight directives." 12867 :group 'vhdl-highlight-faces) 12868 12869(defface vhdl-font-lock-reserved-words-face 12870 '((((class color) (background light)) (:foreground "Orange" :bold t)) 12871 (((min-colors 88) (class color) (background dark)) 12872 (:foreground "Yellow1" :bold t)) 12873 (((class color) (background dark)) (:foreground "Yellow" :bold t)) 12874 (t ())) 12875 "Font lock mode face used to highlight additional reserved words." 12876 :group 'vhdl-highlight-faces) 12877 12878(defface vhdl-font-lock-translate-off-face 12879 '((((class color) (background light)) (:background "LightGray")) 12880 (((class color) (background dark)) (:background "DimGray")) 12881 (t ())) 12882 "Font lock mode face used to background highlight translate-off regions." 12883 :group 'vhdl-highlight-faces) 12884 12885;; font lock mode faces used to highlight words with special syntax. 12886(let ((syntax-alist vhdl-special-syntax-alist)) 12887 (while syntax-alist 12888 (eval `(defface ,(vhdl-function-name 12889 "vhdl-font-lock" (caar syntax-alist) "face") 12890 '((((class color) (background light)) 12891 (:foreground ,(nth 2 (car syntax-alist)))) 12892 (((class color) (background dark)) 12893 (:foreground ,(nth 3 (car syntax-alist)))) 12894 (t ())) 12895 ,(concat "Font lock mode face used to highlight " 12896 (nth 0 (car syntax-alist)) ".") 12897 :group 'vhdl-highlight-faces)) 12898 (setq syntax-alist (cdr syntax-alist)))) 12899 12900;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12901;; Font lock initialization 12902 12903(defun vhdl-font-lock-init () 12904 "Initialize fontification." 12905 ;; highlight template prompts and directives 12906 (setq vhdl-font-lock-keywords-0 12907 (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" 12908 vhdl-template-prompt-syntax ">\\)") 12909 2 'vhdl-font-lock-prompt-face t) 12910 (list (concat "--\\s-*" 12911 vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") 12912 2 'vhdl-font-lock-directive-face t) 12913 ;; highlight c-preprocessor directives 12914 (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" 12915 '(1 font-lock-builtin-face) 12916 '(3 font-lock-variable-name-face nil t)))) 12917 ;; highlight keywords and standardized types, attributes, enumeration 12918 ;; values, and subprograms 12919 (setq vhdl-font-lock-keywords-1 12920 (list 12921 (list (concat "'" vhdl-attributes-regexp) 12922 1 'vhdl-font-lock-attribute-face) 12923 (list vhdl-types-regexp 1 'font-lock-type-face) 12924 (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) 12925 (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) 12926 (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) 12927 (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) 12928 ;; highlight words with special syntax. 12929 (setq vhdl-font-lock-keywords-3 12930 (let ((syntax-alist vhdl-special-syntax-alist) 12931 keywords) 12932 (while syntax-alist 12933 (setq keywords 12934 (cons 12935 (cons (concat "\\<\\(" (nth 1 (car syntax-alist)) "\\)\\>") 12936 (vhdl-function-name 12937 "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) 12938 keywords)) 12939 (setq syntax-alist (cdr syntax-alist))) 12940 keywords)) 12941 ;; highlight additional reserved words 12942 (setq vhdl-font-lock-keywords-4 12943 (list (list vhdl-reserved-words-regexp 1 12944 'vhdl-font-lock-reserved-words-face))) 12945 ;; highlight everything together 12946 (setq vhdl-font-lock-keywords 12947 (append 12948 vhdl-font-lock-keywords-0 12949 (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) 12950 (when (or vhdl-highlight-forbidden-words 12951 vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) 12952 (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) 12953 (when vhdl-highlight-names vhdl-font-lock-keywords-2) 12954 (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) 12955 12956;; initialize fontification for VHDL Mode 12957(vhdl-font-lock-init) 12958 12959(defun vhdl-fontify-buffer () 12960 "Re-initialize fontification and fontify buffer." 12961 (interactive) 12962 (setq font-lock-defaults 12963 (list 12964 'vhdl-font-lock-keywords nil 12965 (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line 12966 '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) 12967 (when (fboundp 'font-lock-unset-defaults) 12968 (font-lock-unset-defaults)) ; not implemented in XEmacs 12969 (font-lock-set-defaults) 12970 (font-lock-mode nil) 12971 (font-lock-mode t)) 12972 12973;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12974;; Initialization for postscript printing 12975 12976(defun vhdl-ps-print-settings () 12977 "Initialize custom face and page settings for postscript printing." 12978 ;; define custom face settings 12979 (unless (or (not vhdl-print-customize-faces) 12980 ps-print-color-p) 12981 (set (make-local-variable 'ps-bold-faces) 12982 '(font-lock-keyword-face 12983 font-lock-type-face 12984 vhdl-font-lock-attribute-face 12985 vhdl-font-lock-enumvalue-face 12986 vhdl-font-lock-directive-face)) 12987 (set (make-local-variable 'ps-italic-faces) 12988 '(font-lock-comment-face 12989 font-lock-function-name-face 12990 font-lock-type-face 12991 vhdl-font-lock-attribute-face 12992 vhdl-font-lock-enumvalue-face 12993 vhdl-font-lock-directive-face)) 12994 (set (make-local-variable 'ps-underlined-faces) 12995 '(font-lock-string-face)) 12996 (setq ps-always-build-face-reference t)) 12997 ;; define page settings, so that a line containing 79 characters (default) 12998 ;; fits into one column 12999 (when vhdl-print-two-column 13000 (set (make-local-variable 'ps-landscape-mode) t) 13001 (set (make-local-variable 'ps-number-of-columns) 2) 13002 (set (make-local-variable 'ps-font-size) 7.0) 13003 (set (make-local-variable 'ps-header-title-font-size) 10.0) 13004 (set (make-local-variable 'ps-header-font-size) 9.0) 13005 (set (make-local-variable 'ps-header-offset) 12.0) 13006 (when (eq ps-paper-type 'letter) 13007 (set (make-local-variable 'ps-inter-column) 40.0) 13008 (set (make-local-variable 'ps-left-margin) 40.0) 13009 (set (make-local-variable 'ps-right-margin) 40.0)))) 13010 13011(defun vhdl-ps-print-init () 13012 "Initialize postscript printing." 13013 (if vhdl-xemacs 13014 (when (boundp 'ps-print-color-p) 13015 (vhdl-ps-print-settings)) 13016 (make-local-variable 'ps-print-hook) 13017 (add-hook 'ps-print-hook 'vhdl-ps-print-settings))) 13018 13019 13020;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13021;;; Hierarchy browser (using `speedbar.el') 13022;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13023;; Allows displaying the hierarchy of all VHDL design units contained in a 13024;; directory by using the speedbar. 13025 13026;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13027;; Variables 13028 13029(defvar vhdl-entity-alist nil 13030 "Cache with entities and corresponding architectures for each 13031project/directory.") 13032;; structure: (parenthesised expression means list of such entries) 13033;; (cache-key 13034;; (ent-key ent-name ent-file ent-line 13035;; (arch-key arch-name arch-file arch-line 13036;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key 13037;; inst-arch-key inst-conf-key inst-lib-key inst-path) 13038;; (lib-name pack-key)) 13039;; mra-key (lib-name pack-key)) 13040 13041(defvar vhdl-config-alist nil 13042 "Cache with configurations for each project/directory.") 13043;; structure: (parenthesised expression means list of such entries) 13044;; (cache-key 13045;; (conf-key conf-name conf-file conf-line ent-key arch-key 13046;; (inst-key inst-comp-name inst-ent-key inst-arch-key 13047;; inst-conf-key inst-lib-key) 13048;; (lib-name pack-key))) 13049 13050(defvar vhdl-package-alist nil 13051 "Cache with packages for each project/directory.") 13052;; structure: (parenthesised expression means list of such entries) 13053;; (cache-key 13054;; (pack-key pack-name pack-file pack-line 13055;; (comp-key comp-name comp-file comp-line) 13056;; (func-key func-name func-file func-line) 13057;; (lib-name pack-key) 13058;; pack-body-file pack-body-line 13059;; (func-key func-name func-body-file func-body-line) 13060;; (lib-name pack-key))) 13061 13062(defvar vhdl-ent-inst-alist nil 13063 "Cache with instantiated entities for each project/directory.") 13064;; structure: (parenthesised expression means list of such entries) 13065;; (cache-key (inst-ent-key)) 13066 13067(defvar vhdl-file-alist nil 13068 "Cache with design units in each file for each project/directory.") 13069;; structure: (parenthesised expression means list of such entries) 13070;; (cache-key 13071;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) 13072;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) 13073 13074(defvar vhdl-directory-alist nil 13075 "Cache with source directories for each project.") 13076;; structure: (parenthesised expression means list of such entries) 13077;; (cache-key (directory)) 13078 13079(defvar vhdl-speedbar-shown-unit-alist nil 13080 "Alist of design units simultaneously open in the current speedbar for each 13081directory and project.") 13082 13083(defvar vhdl-speedbar-shown-project-list nil 13084 "List of projects simultaneously open in the current speedbar.") 13085 13086(defvar vhdl-updated-project-list nil 13087 "List of projects and directories with updated files.") 13088 13089(defvar vhdl-modified-file-list nil 13090 "List of modified files to be rescanned for hierarchy updating.") 13091 13092(defvar vhdl-speedbar-hierarchy-depth 0 13093 "Depth of instantiation hierarchy to display.") 13094 13095(defvar vhdl-speedbar-show-projects nil 13096 "Non-nil means project hierarchy is displayed in speedbar, directory 13097hierarchy otherwise.") 13098 13099(defun vhdl-get-end-of-unit () 13100 "Return position of end of current unit." 13101 (let ((pos (point))) 13102 (save-excursion 13103 (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1) 13104 (save-excursion 13105 (goto-char (match-beginning 0)) 13106 (vhdl-backward-syntactic-ws) 13107 (and (/= (preceding-char) ?\;) (not (bobp)))))) 13108 (re-search-backward "^[ \t]*end\\>" pos 1) 13109 (point)))) 13110 13111(defun vhdl-match-string-downcase (num &optional string) 13112 "Like `match-string-no-properties' with down-casing." 13113 (let ((match (match-string-no-properties num string))) 13114 (and match (downcase match)))) 13115 13116 13117;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13118;; Scan functions 13119 13120(defun vhdl-scan-context-clause () 13121 "Scan the context clause that preceeds a design unit." 13122 (let (lib-alist) 13123 (save-excursion 13124 (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t) 13125 (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) 13126 (equal "USE" (upcase (match-string 1)))) 13127 (when (looking-at "^[ \t]*use[ \t\n]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") 13128 (setq lib-alist (cons (cons (match-string-no-properties 1) 13129 (vhdl-match-string-downcase 2)) 13130 lib-alist)))))) 13131 lib-alist)) 13132 13133(defun vhdl-scan-directory-contents (name &optional project update num-string 13134 non-final) 13135 "Scan contents of VHDL files in directory or file pattern NAME." 13136 (string-match "\\(.*[/\\]\\)\\(.*\\)" name) 13137; (unless (file-directory-p (match-string 1 name)) 13138; (message "No such directory: \"%s\"" (match-string 1 name))) 13139 (let* ((dir-name (match-string 1 name)) 13140 (file-pattern (match-string 2 name)) 13141 (is-directory (= 0 (length file-pattern))) 13142 (file-list 13143 (if update 13144 (list name) 13145 (if is-directory 13146 (vhdl-get-source-files t dir-name) 13147 (vhdl-directory-files 13148 dir-name t (wildcard-to-regexp file-pattern))))) 13149 (key (or project dir-name)) 13150 (file-exclude-regexp 13151 (or (nth 3 (aget vhdl-project-alist project)) "")) 13152 (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) 13153 (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) 13154 (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) 13155 ent-alist conf-alist pack-alist ent-inst-list file-alist 13156 tmp-list tmp-entry no-files files-exist big-files) 13157 (when (or project update) 13158 (setq ent-alist (aget vhdl-entity-alist key t) 13159 conf-alist (aget vhdl-config-alist key t) 13160 pack-alist (aget vhdl-package-alist key t) 13161 ent-inst-list (car (aget vhdl-ent-inst-alist key t)) 13162 file-alist (aget vhdl-file-alist key t))) 13163 (when (and (not is-directory) (null file-list)) 13164 (message "No such file: \"%s\"" name)) 13165 (setq files-exist file-list) 13166 (when file-list 13167 (setq no-files (length file-list)) 13168 (message "Scanning %s %s\"%s\"..." 13169 (if is-directory "directory" "files") (or num-string "") name) 13170 ;; exclude files 13171 (unless (equal file-exclude-regexp "") 13172 (let ((case-fold-search nil) 13173 file-tmp-list) 13174 (while file-list 13175 (unless (string-match file-exclude-regexp (car file-list)) 13176 (setq file-tmp-list (cons (car file-list) file-tmp-list))) 13177 (setq file-list (cdr file-list))) 13178 (setq file-list (nreverse file-tmp-list)))) 13179 ;; do for all files 13180 (while file-list 13181 (unless noninteractive 13182 (message "Scanning %s %s\"%s\"... (%2d%s)" 13183 (if is-directory "directory" "files") 13184 (or num-string "") name 13185 (/ (* 100 (- no-files (length file-list))) no-files) "%")) 13186 (let ((file-name (abbreviate-file-name (car file-list))) 13187 ent-list arch-list arch-ent-list conf-list 13188 pack-list pack-body-list inst-list inst-ent-list) 13189 ;; scan file 13190 (vhdl-visit-file 13191 file-name nil 13192 (vhdl-prepare-search-2 13193 (save-excursion 13194 ;; scan for design units 13195 (if (and limit-design-file-size 13196 (< limit-design-file-size (buffer-size))) 13197 (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) 13198 (setq big-files t)) 13199 ;; scan for entities 13200 (goto-char (point-min)) 13201 (while (re-search-forward "^[ \t]*entity[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 13202 (let* ((ent-name (match-string-no-properties 1)) 13203 (ent-key (downcase ent-name)) 13204 (ent-entry (aget ent-alist ent-key t)) 13205 (lib-alist (vhdl-scan-context-clause))) 13206 (if (nth 1 ent-entry) 13207 (vhdl-warning-when-idle 13208 "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13209 ent-name (nth 1 ent-entry) (nth 2 ent-entry) 13210 file-name (vhdl-current-line)) 13211 (setq ent-list (cons ent-key ent-list)) 13212 (aput 'ent-alist ent-key 13213 (list ent-name file-name (vhdl-current-line) 13214 (nth 3 ent-entry) (nth 4 ent-entry) 13215 lib-alist))))) 13216 ;; scan for architectures 13217 (goto-char (point-min)) 13218 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 13219 (let* ((arch-name (match-string-no-properties 1)) 13220 (arch-key (downcase arch-name)) 13221 (ent-name (match-string-no-properties 2)) 13222 (ent-key (downcase ent-name)) 13223 (ent-entry (aget ent-alist ent-key t)) 13224 (arch-alist (nth 3 ent-entry)) 13225 (arch-entry (aget arch-alist arch-key t)) 13226 (lib-arch-alist (vhdl-scan-context-clause))) 13227 (if arch-entry 13228 (vhdl-warning-when-idle 13229 "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13230 arch-name ent-name (nth 1 arch-entry) 13231 (nth 2 arch-entry) file-name (vhdl-current-line)) 13232 (setq arch-list (cons arch-key arch-list) 13233 arch-ent-list (cons ent-key arch-ent-list)) 13234 (aput 'arch-alist arch-key 13235 (list arch-name file-name (vhdl-current-line) nil 13236 lib-arch-alist)) 13237 (aput 'ent-alist ent-key 13238 (list (or (nth 0 ent-entry) ent-name) 13239 (nth 1 ent-entry) (nth 2 ent-entry) 13240 (vhdl-sort-alist arch-alist) 13241 arch-key (nth 5 ent-entry)))))) 13242 ;; scan for configurations 13243 (goto-char (point-min)) 13244 (while (re-search-forward "^[ \t]*configuration[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 13245 (let* ((conf-name (match-string-no-properties 1)) 13246 (conf-key (downcase conf-name)) 13247 (conf-entry (aget conf-alist conf-key t)) 13248 (ent-name (match-string-no-properties 2)) 13249 (ent-key (downcase ent-name)) 13250 (lib-alist (vhdl-scan-context-clause)) 13251 (conf-line (vhdl-current-line)) 13252 (end-of-unit (vhdl-get-end-of-unit)) 13253 arch-key comp-conf-list inst-key-list 13254 inst-comp-key inst-ent-key inst-arch-key 13255 inst-conf-key inst-lib-key) 13256 (when (vhdl-re-search-forward "\\<for[ \t\n]+\\(\\w+\\)") 13257 (setq arch-key (vhdl-match-string-downcase 1))) 13258 (if conf-entry 13259 (vhdl-warning-when-idle 13260 "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13261 conf-name ent-name (nth 1 conf-entry) 13262 (nth 2 conf-entry) file-name conf-line) 13263 (setq conf-list (cons conf-key conf-list)) 13264 ;; scan for subconfigurations and subentities 13265 (while (re-search-forward "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+" end-of-unit t) 13266 (setq inst-comp-key (vhdl-match-string-downcase 3) 13267 inst-key-list (split-string 13268 (vhdl-match-string-downcase 1) 13269 "[ \t\n]*,[ \t\n]*")) 13270 (vhdl-forward-syntactic-ws) 13271 (when (looking-at "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n]*\\((\\(\\w+\\))\\)?") 13272 (setq 13273 inst-lib-key (vhdl-match-string-downcase 3) 13274 inst-ent-key (and (match-string 2) 13275 (vhdl-match-string-downcase 4)) 13276 inst-arch-key (and (match-string 2) 13277 (vhdl-match-string-downcase 6)) 13278 inst-conf-key (and (not (match-string 2)) 13279 (vhdl-match-string-downcase 4))) 13280 (while inst-key-list 13281 (setq comp-conf-list 13282 (cons (list (car inst-key-list) 13283 inst-comp-key inst-ent-key 13284 inst-arch-key inst-conf-key 13285 inst-lib-key) 13286 comp-conf-list)) 13287 (setq inst-key-list (cdr inst-key-list))))) 13288 (aput 'conf-alist conf-key 13289 (list conf-name file-name conf-line ent-key 13290 arch-key comp-conf-list lib-alist))))) 13291 ;; scan for packages 13292 (goto-char (point-min)) 13293 (while (re-search-forward "^[ \t]*package[ \t\n]+\\(body[ \t\n]+\\)?\\(\\w+\\)[ \t\n]+is\\>" nil t) 13294 (let* ((pack-name (match-string-no-properties 2)) 13295 (pack-key (downcase pack-name)) 13296 (is-body (match-string-no-properties 1)) 13297 (pack-entry (aget pack-alist pack-key t)) 13298 (pack-line (vhdl-current-line)) 13299 (end-of-unit (vhdl-get-end-of-unit)) 13300 comp-name func-name comp-alist func-alist lib-alist) 13301 (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 13302 (vhdl-warning-when-idle 13303 "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" 13304 (if is-body " body" "") pack-name 13305 (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) 13306 (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) 13307 file-name (vhdl-current-line)) 13308 ;; scan for context clauses 13309 (setq lib-alist (vhdl-scan-context-clause)) 13310 ;; scan for component and subprogram declarations/bodies 13311 (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n]+\\(\\w+\\|\".*\"\\)" end-of-unit t) 13312 (if (equal (upcase (match-string 1)) "COMPONENT") 13313 (setq comp-name (match-string-no-properties 2) 13314 comp-alist 13315 (cons (list (downcase comp-name) comp-name 13316 file-name (vhdl-current-line)) 13317 comp-alist)) 13318 (setq func-name (match-string-no-properties 2) 13319 func-alist 13320 (cons (list (downcase func-name) func-name 13321 file-name (vhdl-current-line)) 13322 func-alist)))) 13323 (setq func-alist (nreverse func-alist)) 13324 (setq comp-alist (nreverse comp-alist)) 13325 (if is-body 13326 (setq pack-body-list (cons pack-key pack-body-list)) 13327 (setq pack-list (cons pack-key pack-list))) 13328 (aput 13329 'pack-alist pack-key 13330 (if is-body 13331 (list (or (nth 0 pack-entry) pack-name) 13332 (nth 1 pack-entry) (nth 2 pack-entry) 13333 (nth 3 pack-entry) (nth 4 pack-entry) 13334 (nth 5 pack-entry) 13335 file-name pack-line func-alist lib-alist) 13336 (list pack-name file-name pack-line 13337 comp-alist func-alist lib-alist 13338 (nth 6 pack-entry) (nth 7 pack-entry) 13339 (nth 8 pack-entry) (nth 9 pack-entry)))))))) 13340 ;; scan for hierarchy 13341 (if (and limit-hier-file-size 13342 (< limit-hier-file-size (buffer-size))) 13343 (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) 13344 (setq big-files t)) 13345 ;; scan for architectures 13346 (goto-char (point-min)) 13347 (while (re-search-forward "^[ \t]*architecture[ \t\n]+\\(\\w+\\)[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 13348 (let* ((ent-name (match-string-no-properties 2)) 13349 (ent-key (downcase ent-name)) 13350 (arch-name (match-string-no-properties 1)) 13351 (arch-key (downcase arch-name)) 13352 (ent-entry (aget ent-alist ent-key t)) 13353 (arch-alist (nth 3 ent-entry)) 13354 (arch-entry (aget arch-alist arch-key t)) 13355 (beg-of-unit (point)) 13356 (end-of-unit (vhdl-get-end-of-unit)) 13357 (inst-no 0) 13358 inst-alist inst-path) 13359 ;; scan for contained instantiations 13360 (while (and (re-search-forward 13361 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\(" 13362 "\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(generic\\|port\\)[ \t\n]+map\\>\\|" 13363 "component[ \t\n]+\\(\\w+\\)\\|" 13364 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?\\|" 13365 "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" 13366 "\\(^[ \t]*end[ \t\n]+\\(generate\\|block\\)\\>\\)") end-of-unit t) 13367 (or (not limit-hier-inst-no) 13368 (<= (setq inst-no (1+ inst-no)) 13369 limit-hier-inst-no))) 13370 (cond 13371 ;; block/generate beginning found 13372 ((match-string 14) 13373 (setq inst-path 13374 (cons (match-string-no-properties 1) inst-path))) 13375 ;; block/generate end found 13376 ((match-string 16) 13377 (setq inst-path (cdr inst-path))) 13378 ;; instantiation found 13379 (t 13380 (let* ((inst-name (match-string-no-properties 1)) 13381 (inst-key (downcase inst-name)) 13382 (inst-comp-name 13383 (or (match-string-no-properties 3) 13384 (match-string-no-properties 6))) 13385 (inst-ent-key 13386 (or (and (match-string 8) 13387 (vhdl-match-string-downcase 11)) 13388 (and inst-comp-name 13389 (downcase inst-comp-name)))) 13390 (inst-arch-key (vhdl-match-string-downcase 13)) 13391 (inst-conf-key 13392 (and (not (match-string 8)) 13393 (vhdl-match-string-downcase 11))) 13394 (inst-lib-key (vhdl-match-string-downcase 10))) 13395 (goto-char (match-end 1)) 13396 (setq inst-list (cons inst-key inst-list) 13397 inst-ent-list 13398 (cons inst-ent-key inst-ent-list)) 13399 (setq inst-alist 13400 (append 13401 inst-alist 13402 (list (list inst-key inst-name file-name 13403 (vhdl-current-line) inst-comp-name 13404 inst-ent-key inst-arch-key 13405 inst-conf-key inst-lib-key 13406 (reverse inst-path))))))))) 13407 ;; scan for contained configuration specifications 13408 (goto-char beg-of-unit) 13409 (while (re-search-forward 13410 (concat "^[ \t]*for[ \t\n]+\\(\\w+\\([ \t\n]*,[ \t\n]*\\w+\\)*\\)[ \t\n]*:[ \t\n]*\\(\\w+\\)[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*" 13411 "use[ \t\n]+\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?") end-of-unit t) 13412 (let* ((inst-comp-name (match-string-no-properties 3)) 13413 (inst-ent-key 13414 (and (match-string 6) 13415 (vhdl-match-string-downcase 9))) 13416 (inst-arch-key (vhdl-match-string-downcase 11)) 13417 (inst-conf-key 13418 (and (not (match-string 6)) 13419 (vhdl-match-string-downcase 9))) 13420 (inst-lib-key (vhdl-match-string-downcase 8)) 13421 (inst-key-list 13422 (split-string (vhdl-match-string-downcase 1) 13423 "[ \t\n]*,[ \t\n]*")) 13424 (tmp-inst-alist inst-alist) 13425 inst-entry) 13426 (while tmp-inst-alist 13427 (when (and (or (equal "all" (car inst-key-list)) 13428 (member (nth 0 (car tmp-inst-alist)) 13429 inst-key-list)) 13430 (equal 13431 (downcase 13432 (or (nth 4 (car tmp-inst-alist)) "")) 13433 (downcase inst-comp-name))) 13434 (setq inst-entry (car tmp-inst-alist)) 13435 (setq inst-ent-list 13436 (cons (or inst-ent-key (nth 5 inst-entry)) 13437 (vhdl-delete 13438 (nth 5 inst-entry) inst-ent-list))) 13439 (setq inst-entry 13440 (list (nth 0 inst-entry) (nth 1 inst-entry) 13441 (nth 2 inst-entry) (nth 3 inst-entry) 13442 (nth 4 inst-entry) 13443 (or inst-ent-key (nth 5 inst-entry)) 13444 (or inst-arch-key (nth 6 inst-entry)) 13445 inst-conf-key inst-lib-key)) 13446 (setcar tmp-inst-alist inst-entry)) 13447 (setq tmp-inst-alist (cdr tmp-inst-alist))))) 13448 ;; save in cache 13449 (aput 'arch-alist arch-key 13450 (list (nth 0 arch-entry) (nth 1 arch-entry) 13451 (nth 2 arch-entry) inst-alist 13452 (nth 4 arch-entry))) 13453 (aput 'ent-alist ent-key 13454 (list (nth 0 ent-entry) (nth 1 ent-entry) 13455 (nth 2 ent-entry) (vhdl-sort-alist arch-alist) 13456 (nth 4 ent-entry) (nth 5 ent-entry))) 13457 (when (and limit-hier-inst-no 13458 (> inst-no limit-hier-inst-no)) 13459 (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) 13460 (setq big-files t)) 13461 (goto-char end-of-unit)))) 13462 ;; remember design units for this file 13463 (aput 'file-alist file-name 13464 (list ent-list arch-list arch-ent-list conf-list 13465 pack-list pack-body-list inst-list inst-ent-list)) 13466 (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) 13467 (setq file-list (cdr file-list)))) 13468 (when (or (and (not project) files-exist) 13469 (and project (not non-final))) 13470 ;; consistency checks: 13471 ;; check whether each architecture has a corresponding entity 13472 (setq tmp-list ent-alist) 13473 (while tmp-list 13474 (when (null (nth 2 (car tmp-list))) 13475 (setq tmp-entry (car (nth 4 (car tmp-list)))) 13476 (vhdl-warning-when-idle 13477 "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 13478 (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) 13479 (nth 3 tmp-entry))) 13480 (setq tmp-list (cdr tmp-list))) 13481 ;; check whether configuration has a corresponding entity/architecture 13482 (setq tmp-list conf-alist) 13483 (while tmp-list 13484 (if (setq tmp-entry (aget ent-alist (nth 4 (car tmp-list)) t)) 13485 (unless (aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) 13486 (setq tmp-entry (car tmp-list)) 13487 (vhdl-warning-when-idle 13488 "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" 13489 (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) 13490 (nth 2 tmp-entry) (nth 3 tmp-entry))) 13491 (setq tmp-entry (car tmp-list)) 13492 (vhdl-warning-when-idle 13493 "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" 13494 (nth 1 tmp-entry) (nth 4 tmp-entry) 13495 (nth 2 tmp-entry) (nth 3 tmp-entry))) 13496 (setq tmp-list (cdr tmp-list))) 13497 ;; check whether each package body has a package declaration 13498 (setq tmp-list pack-alist) 13499 (while tmp-list 13500 (when (null (nth 2 (car tmp-list))) 13501 (setq tmp-entry (car tmp-list)) 13502 (vhdl-warning-when-idle 13503 "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" 13504 (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) 13505 (setq tmp-list (cdr tmp-list))) 13506 ;; sort lists 13507 (setq ent-alist (vhdl-sort-alist ent-alist)) 13508 (setq conf-alist (vhdl-sort-alist conf-alist)) 13509 (setq pack-alist (vhdl-sort-alist pack-alist)) 13510 ;; remember updated directory/project 13511 (add-to-list 'vhdl-updated-project-list (or project dir-name))) 13512 ;; clear directory alists 13513 (unless project 13514 (adelete 'vhdl-entity-alist key) 13515 (adelete 'vhdl-config-alist key) 13516 (adelete 'vhdl-package-alist key) 13517 (adelete 'vhdl-ent-inst-alist key) 13518 (adelete 'vhdl-file-alist key)) 13519 ;; put directory contents into cache 13520 (aput 'vhdl-entity-alist key ent-alist) 13521 (aput 'vhdl-config-alist key conf-alist) 13522 (aput 'vhdl-package-alist key pack-alist) 13523 (aput 'vhdl-ent-inst-alist key (list ent-inst-list)) 13524 (aput 'vhdl-file-alist key file-alist) 13525 ;; final messages 13526 (message "Scanning %s %s\"%s\"...done" 13527 (if is-directory "directory" "files") (or num-string "") name) 13528 (unless project (message "Scanning directory...done")) 13529 (when big-files 13530 (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) 13531 ;; save cache when scanned non-interactively 13532 (when (or (not project) (not non-final)) 13533 (when (and noninteractive vhdl-speedbar-save-cache) 13534 (vhdl-save-cache key))) 13535 t)) 13536 13537(defun vhdl-scan-project-contents (project) 13538 "Scan the contents of all VHDL files found in the directories and files 13539of PROJECT." 13540 (let ((dir-list (or (nth 2 (aget vhdl-project-alist project)) '(""))) 13541 (default-dir (vhdl-resolve-env-variable 13542 (nth 1 (aget vhdl-project-alist project)))) 13543 (file-exclude-regexp 13544 (or (nth 3 (aget vhdl-project-alist project)) "")) 13545 dir-list-tmp dir dir-name num-dir act-dir recursive) 13546 ;; clear project alists 13547 (adelete 'vhdl-entity-alist project) 13548 (adelete 'vhdl-config-alist project) 13549 (adelete 'vhdl-package-alist project) 13550 (adelete 'vhdl-ent-inst-alist project) 13551 (adelete 'vhdl-file-alist project) 13552 ;; expand directory names by default-directory 13553 (message "Collecting source files...") 13554 (while dir-list 13555 (setq dir (vhdl-resolve-env-variable (car dir-list))) 13556 (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) 13557 (setq recursive (match-string 1 dir) 13558 dir-name (match-string 3 dir)) 13559 (setq dir-list-tmp 13560 (cons (concat recursive 13561 (if (file-name-absolute-p dir-name) "" default-dir) 13562 dir-name) 13563 dir-list-tmp)) 13564 (setq dir-list (cdr dir-list))) 13565 ;; resolve path wildcards 13566 (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) 13567 ;; expand directories 13568 (while dir-list-tmp 13569 (setq dir (car dir-list-tmp)) 13570 ;; get subdirectories 13571 (if (string-match "-r \\(.*[/\\]\\)" dir) 13572 (setq dir-list (append dir-list (vhdl-get-subdirs 13573 (match-string 1 dir)))) 13574 (setq dir-list (append dir-list (list dir)))) 13575 (setq dir-list-tmp (cdr dir-list-tmp))) 13576 ;; exclude files 13577 (unless (equal file-exclude-regexp "") 13578 (let ((case-fold-search nil)) 13579 (while dir-list 13580 (unless (string-match file-exclude-regexp (car dir-list)) 13581 (setq dir-list-tmp (cons (car dir-list) dir-list-tmp))) 13582 (setq dir-list (cdr dir-list))) 13583 (setq dir-list (nreverse dir-list-tmp)))) 13584 (message "Collecting source files...done") 13585 ;; scan for design units for each directory in DIR-LIST 13586 (setq dir-list-tmp nil 13587 num-dir (length dir-list) 13588 act-dir 1) 13589 (while dir-list 13590 (setq dir-name (abbreviate-file-name 13591 (expand-file-name (car dir-list)))) 13592 (vhdl-scan-directory-contents dir-name project nil 13593 (format "(%s/%s) " act-dir num-dir) 13594 (cdr dir-list)) 13595 (add-to-list 'dir-list-tmp (file-name-directory dir-name)) 13596 (setq dir-list (cdr dir-list) 13597 act-dir (1+ act-dir))) 13598 (aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) 13599 (message "Scanning project \"%s\"...done" project))) 13600 13601(defun vhdl-update-file-contents (file-name) 13602 "Update hierarchy information by contents of current buffer." 13603 (setq file-name (abbreviate-file-name file-name)) 13604 (let* ((dir-name (file-name-directory file-name)) 13605 (directory-alist vhdl-directory-alist) 13606 updated) 13607 (while directory-alist 13608 (when (member dir-name (nth 1 (car directory-alist))) 13609 (let* ((vhdl-project (nth 0 (car directory-alist))) 13610 (project (vhdl-project-p)) 13611 (ent-alist (aget vhdl-entity-alist (or project dir-name) t)) 13612 (conf-alist (aget vhdl-config-alist (or project dir-name) t)) 13613 (pack-alist (aget vhdl-package-alist (or project dir-name) t)) 13614 (ent-inst-list (car (aget vhdl-ent-inst-alist 13615 (or project dir-name) t))) 13616 (file-alist (aget vhdl-file-alist (or project dir-name) t)) 13617 (file-entry (aget file-alist file-name t)) 13618 (ent-list (nth 0 file-entry)) 13619 (arch-list (nth 1 file-entry)) 13620 (arch-ent-list (nth 2 file-entry)) 13621 (conf-list (nth 3 file-entry)) 13622 (pack-list (nth 4 file-entry)) 13623 (pack-body-list (nth 5 file-entry)) 13624 (inst-ent-list (nth 7 file-entry)) 13625 (cache-key (or project dir-name)) 13626 arch-alist key ent-key entry) 13627 ;; delete design units previously contained in this file: 13628 ;; entities 13629 (while ent-list 13630 (setq key (car ent-list) 13631 entry (aget ent-alist key t)) 13632 (when (equal file-name (nth 1 entry)) 13633 (if (nth 3 entry) 13634 (aput 'ent-alist key 13635 (list (nth 0 entry) nil nil (nth 3 entry) nil)) 13636 (adelete 'ent-alist key))) 13637 (setq ent-list (cdr ent-list))) 13638 ;; architectures 13639 (while arch-list 13640 (setq key (car arch-list) 13641 ent-key (car arch-ent-list) 13642 entry (aget ent-alist ent-key t) 13643 arch-alist (nth 3 entry)) 13644 (when (equal file-name (nth 1 (aget arch-alist key t))) 13645 (adelete 'arch-alist key) 13646 (if (or (nth 1 entry) arch-alist) 13647 (aput 'ent-alist ent-key 13648 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 13649 arch-alist (nth 4 entry) (nth 5 entry))) 13650 (adelete 'ent-alist ent-key))) 13651 (setq arch-list (cdr arch-list) 13652 arch-ent-list (cdr arch-ent-list))) 13653 ;; configurations 13654 (while conf-list 13655 (setq key (car conf-list)) 13656 (when (equal file-name (nth 1 (aget conf-alist key t))) 13657 (adelete 'conf-alist key)) 13658 (setq conf-list (cdr conf-list))) 13659 ;; package declarations 13660 (while pack-list 13661 (setq key (car pack-list) 13662 entry (aget pack-alist key t)) 13663 (when (equal file-name (nth 1 entry)) 13664 (if (nth 6 entry) 13665 (aput 'pack-alist key 13666 (list (nth 0 entry) nil nil nil nil nil 13667 (nth 6 entry) (nth 7 entry) (nth 8 entry) 13668 (nth 9 entry))) 13669 (adelete 'pack-alist key))) 13670 (setq pack-list (cdr pack-list))) 13671 ;; package bodies 13672 (while pack-body-list 13673 (setq key (car pack-body-list) 13674 entry (aget pack-alist key t)) 13675 (when (equal file-name (nth 6 entry)) 13676 (if (nth 1 entry) 13677 (aput 'pack-alist key 13678 (list (nth 0 entry) (nth 1 entry) (nth 2 entry) 13679 (nth 3 entry) (nth 4 entry) (nth 5 entry) 13680 nil nil nil nil)) 13681 (adelete 'pack-alist key))) 13682 (setq pack-body-list (cdr pack-body-list))) 13683 ;; instantiated entities 13684 (while inst-ent-list 13685 (setq ent-inst-list 13686 (vhdl-delete (car inst-ent-list) ent-inst-list)) 13687 (setq inst-ent-list (cdr inst-ent-list))) 13688 ;; update caches 13689 (vhdl-aput 'vhdl-entity-alist cache-key ent-alist) 13690 (vhdl-aput 'vhdl-config-alist cache-key conf-alist) 13691 (vhdl-aput 'vhdl-package-alist cache-key pack-alist) 13692 (vhdl-aput 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) 13693 ;; scan file 13694 (vhdl-scan-directory-contents file-name project t) 13695 (when (or (and vhdl-speedbar-show-projects project) 13696 (and (not vhdl-speedbar-show-projects) (not project))) 13697 (vhdl-speedbar-refresh project)) 13698 (setq updated t))) 13699 (setq directory-alist (cdr directory-alist))) 13700 updated)) 13701 13702(defun vhdl-update-hierarchy () 13703 "Update directory and hierarchy information in speedbar." 13704 (let ((file-list (reverse vhdl-modified-file-list)) 13705 updated) 13706 (when (and vhdl-speedbar-update-on-saving file-list) 13707 (while file-list 13708 (setq updated 13709 (or (vhdl-update-file-contents (car file-list)) 13710 updated)) 13711 (setq file-list (cdr file-list))) 13712 (setq vhdl-modified-file-list nil) 13713 (vhdl-speedbar-update-current-unit) 13714 (when updated (message "Updating hierarchy...done"))))) 13715 13716;; structure (parenthesised expression means list of such entries) 13717;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker 13718;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker 13719;; comp-lib-name level) 13720(defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key 13721 conf-inst-alist level indent 13722 &optional include-top ent-hier) 13723 "Get instantiation hierarchy beginning in architecture ARCH-KEY of 13724entity ENT-KEY." 13725 (let* ((ent-entry (aget ent-alist ent-key t)) 13726 (arch-entry (if arch-key (aget (nth 3 ent-entry) arch-key t) 13727 (cdar (last (nth 3 ent-entry))))) 13728 (inst-alist (nth 3 arch-entry)) 13729 inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry 13730 hier-list subcomp-list tmp-list inst-key inst-comp-name 13731 inst-ent-key inst-arch-key inst-conf-key inst-lib-key) 13732 (when (= level 0) (message "Extract design hierarchy...")) 13733 (when include-top 13734 (setq level (1+ level))) 13735 (when (member ent-key ent-hier) 13736 (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) 13737 ;; check configured architecture (already checked during scanning) 13738; (unless (or (null conf-inst-alist) (assoc arch-key (nth 3 ent-entry))) 13739; (vhdl-warning-when-idle "Configuration for non-existing architecture used: \"%s\"" conf-key)) 13740 ;; process all instances 13741 (while inst-alist 13742 (setq inst-entry (car inst-alist) 13743 inst-key (nth 0 inst-entry) 13744 inst-comp-name (nth 4 inst-entry) 13745 inst-conf-key (nth 7 inst-entry)) 13746 ;; search entry in configuration's instantiations list 13747 (setq tmp-list conf-inst-alist) 13748 (while (and tmp-list 13749 (not (and (member (nth 0 (car tmp-list)) 13750 (list "all" inst-key)) 13751 (equal (nth 1 (car tmp-list)) 13752 (downcase (or inst-comp-name "")))))) 13753 (setq tmp-list (cdr tmp-list))) 13754 (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) 13755 (setq inst-conf-entry (aget conf-alist inst-conf-key t)) 13756 (when (and inst-conf-key (not inst-conf-entry)) 13757 (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) 13758 ;; determine entity 13759 (setq inst-ent-key 13760 (or (nth 2 (car tmp-list)) ; from configuration 13761 (nth 3 inst-conf-entry) ; from subconfiguration 13762 (nth 3 (aget conf-alist (nth 7 inst-entry) t)) 13763 ; from configuration spec. 13764 (nth 5 inst-entry))) ; from direct instantiation 13765 (setq inst-ent-entry (aget ent-alist inst-ent-key t)) 13766 ;; determine architecture 13767 (setq inst-arch-key 13768 (or (nth 3 (car tmp-list)) ; from configuration 13769 (nth 4 inst-conf-entry) ; from subconfiguration 13770 (nth 6 inst-entry) ; from direct instantiation 13771 (nth 4 (aget conf-alist (nth 7 inst-entry))) 13772 ; from configuration spec. 13773 (nth 4 inst-ent-entry) ; MRA 13774 (caar (nth 3 inst-ent-entry)))) ; first alphabetically 13775 (setq inst-arch-entry (aget (nth 3 inst-ent-entry) inst-arch-key t)) 13776 ;; set library 13777 (setq inst-lib-key 13778 (or (nth 5 (car tmp-list)) ; from configuration 13779 (nth 8 inst-entry))) ; from direct instantiation 13780 ;; gather information for this instance 13781 (setq comp-entry 13782 (list (nth 1 inst-entry) 13783 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 13784 (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) 13785 (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) 13786 (or (nth 0 inst-arch-entry) inst-arch-key) 13787 (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) 13788 (or (nth 0 inst-conf-entry) inst-conf-key) 13789 (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) 13790 inst-lib-key level)) 13791 ;; get subcomponent hierarchy 13792 (setq subcomp-list (vhdl-get-hierarchy 13793 ent-alist conf-alist 13794 inst-ent-key inst-arch-key inst-conf-key 13795 (nth 5 inst-conf-entry) 13796 (1+ level) indent nil (cons ent-key ent-hier))) 13797 ;; add to list 13798 (setq hier-list (append hier-list (list comp-entry) subcomp-list)) 13799 (setq inst-alist (cdr inst-alist))) 13800 (when include-top 13801 (setq hier-list 13802 (cons (list nil nil (nth 0 ent-entry) 13803 (cons (nth 1 ent-entry) (nth 2 ent-entry)) 13804 (nth 0 arch-entry) 13805 (cons (nth 1 arch-entry) (nth 2 arch-entry)) 13806 nil nil 13807 nil (1- level)) 13808 hier-list))) 13809 (when (or (= level 0) (and include-top (= level 1))) (message "")) 13810 hier-list)) 13811 13812(defun vhdl-get-instantiations (ent-key indent) 13813 "Get all instantiations of entity ENT-KEY." 13814 (let ((ent-alist (aget vhdl-entity-alist (vhdl-speedbar-line-key indent) t)) 13815 arch-alist inst-alist ent-inst-list 13816 ent-entry arch-entry inst-entry) 13817 (while ent-alist 13818 (setq ent-entry (car ent-alist)) 13819 (setq arch-alist (nth 4 ent-entry)) 13820 (while arch-alist 13821 (setq arch-entry (car arch-alist)) 13822 (setq inst-alist (nth 4 arch-entry)) 13823 (while inst-alist 13824 (setq inst-entry (car inst-alist)) 13825 (when (equal ent-key (nth 5 inst-entry)) 13826 (setq ent-inst-list 13827 (cons (list (nth 1 inst-entry) 13828 (cons (nth 2 inst-entry) (nth 3 inst-entry)) 13829 (nth 1 ent-entry) 13830 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 13831 (nth 1 arch-entry) 13832 (cons (nth 2 arch-entry) (nth 3 arch-entry))) 13833 ent-inst-list))) 13834 (setq inst-alist (cdr inst-alist))) 13835 (setq arch-alist (cdr arch-alist))) 13836 (setq ent-alist (cdr ent-alist))) 13837 (nreverse ent-inst-list))) 13838 13839;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13840;; Caching in file 13841 13842(defun vhdl-save-caches () 13843 "Save all updated hierarchy caches to file." 13844 (interactive) 13845 (condition-case nil 13846 (when vhdl-speedbar-save-cache 13847 ;; update hierarchy 13848 (vhdl-update-hierarchy) 13849 (let ((project-list vhdl-updated-project-list)) 13850 (message "Saving hierarchy caches...") 13851 ;; write updated project caches 13852 (while project-list 13853 (vhdl-save-cache (car project-list)) 13854 (setq project-list (cdr project-list))) 13855 (message "Saving hierarchy caches...done"))) 13856 (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") 13857 (sit-for 2))))) 13858 13859(defun vhdl-save-cache (key) 13860 "Save current hierarchy cache to file." 13861 (let* ((orig-buffer (current-buffer)) 13862 (vhdl-project key) 13863 (project (vhdl-project-p)) 13864 (default-directory key) 13865 (directory (abbreviate-file-name (vhdl-default-directory))) 13866 (file-name (vhdl-resolve-env-variable 13867 (vhdl-replace-string 13868 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 13869 (concat 13870 (subst-char-in-string ? ?_ (or project "dir")) 13871 " " (user-login-name))))) 13872 (file-dir-name (expand-file-name file-name directory)) 13873 (cache-key (or project directory)) 13874 (key (if project "project" "directory"))) 13875 (unless (file-exists-p (file-name-directory file-dir-name)) 13876 (make-directory (file-name-directory file-dir-name) t)) 13877 (if (not (file-writable-p file-dir-name)) 13878 (progn (vhdl-warning (format "File not writable: \"%s\"" 13879 (abbreviate-file-name file-dir-name))) 13880 (sit-for 2)) 13881 (message "Saving cache: \"%s\"" file-dir-name) 13882 (set-buffer (find-file-noselect file-dir-name t t)) 13883 (erase-buffer) 13884 (insert ";; -*- Emacs-Lisp -*-\n\n" 13885 ";;; " (file-name-nondirectory file-name) 13886 " - design hierarchy cache file for Emacs VHDL Mode " 13887 vhdl-version "\n") 13888 (insert "\n;; " (if project "Project " "Directory") " : ") 13889 (if project (insert project) (prin1 directory (current-buffer))) 13890 (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") 13891 (user-login-name) "\n\n" 13892 "\n;; version number\n" 13893 "(setq vhdl-cache-version \"" vhdl-version "\")\n" 13894 "\n;; " (if project "project" "directory") " name" 13895 "\n(setq " key " ") 13896 (prin1 (or project directory) (current-buffer)) 13897 (insert ")\n") 13898 (when (member 'hierarchy vhdl-speedbar-save-cache) 13899 (insert "\n;; entity and architecture cache\n" 13900 "(aput 'vhdl-entity-alist " key " '") 13901 (print (aget vhdl-entity-alist cache-key t) (current-buffer)) 13902 (insert ")\n\n;; configuration cache\n" 13903 "(aput 'vhdl-config-alist " key " '") 13904 (print (aget vhdl-config-alist cache-key t) (current-buffer)) 13905 (insert ")\n\n;; package cache\n" 13906 "(aput 'vhdl-package-alist " key " '") 13907 (print (aget vhdl-package-alist cache-key t) (current-buffer)) 13908 (insert ")\n\n;; instantiated entities cache\n" 13909 "(aput 'vhdl-ent-inst-alist " key " '") 13910 (print (aget vhdl-ent-inst-alist cache-key t) (current-buffer)) 13911 (insert ")\n\n;; design units per file cache\n" 13912 "(aput 'vhdl-file-alist " key " '") 13913 (print (aget vhdl-file-alist cache-key t) (current-buffer)) 13914 (when project 13915 (insert ")\n\n;; source directories in project cache\n" 13916 "(aput 'vhdl-directory-alist " key " '") 13917 (print (aget vhdl-directory-alist cache-key t) (current-buffer))) 13918 (insert ")\n")) 13919 (when (member 'display vhdl-speedbar-save-cache) 13920 (insert "\n;; shown design units cache\n" 13921 "(aput 'vhdl-speedbar-shown-unit-alist " key " '") 13922 (print (aget vhdl-speedbar-shown-unit-alist cache-key t) 13923 (current-buffer)) 13924 (insert ")\n")) 13925 (setq vhdl-updated-project-list 13926 (delete cache-key vhdl-updated-project-list)) 13927 (save-buffer) 13928 (kill-buffer (current-buffer)) 13929 (set-buffer orig-buffer)))) 13930 13931(defun vhdl-load-cache (key) 13932 "Load hierarchy cache information from file." 13933 (let* ((vhdl-project key) 13934 (default-directory key) 13935 (directory (vhdl-default-directory)) 13936 (file-name (vhdl-resolve-env-variable 13937 (vhdl-replace-string 13938 (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) 13939 (concat 13940 (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) 13941 " " (user-login-name))))) 13942 (file-dir-name (expand-file-name file-name directory)) 13943 vhdl-cache-version) 13944 (unless (memq 'vhdl-save-caches kill-emacs-hook) 13945 (add-hook 'kill-emacs-hook 'vhdl-save-caches)) 13946 (when (file-exists-p file-dir-name) 13947 (condition-case () 13948 (progn (load-file file-dir-name) 13949 (string< (mapconcat 13950 (lambda (a) (format "%3d" (string-to-number a))) 13951 (split-string "3.33" "\\.") "") 13952 (mapconcat 13953 (lambda (a) (format "%3d" (string-to-number a))) 13954 (split-string vhdl-cache-version "\\.") ""))) 13955 (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) 13956 nil)))))) 13957 13958(defun vhdl-require-hierarchy-info () 13959 "Make sure that hierarchy information is available. Load cache or scan files 13960if required." 13961 (if (vhdl-project-p) 13962 (unless (or (assoc vhdl-project vhdl-file-alist) 13963 (vhdl-load-cache vhdl-project)) 13964 (vhdl-scan-project-contents vhdl-project)) 13965 (let ((directory (abbreviate-file-name default-directory))) 13966 (unless (or (assoc directory vhdl-file-alist) 13967 (vhdl-load-cache directory)) 13968 (vhdl-scan-directory-contents directory))))) 13969 13970;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13971;; Add hierarchy browser functionality to speedbar 13972 13973(defvar vhdl-speedbar-key-map nil 13974 "Keymap used when in the VHDL hierarchy browser mode.") 13975 13976(defvar vhdl-speedbar-menu-items nil 13977 "Additional menu-items to add to speedbar frame.") 13978 13979(defun vhdl-speedbar-initialize () 13980 "Initialize speedbar." 13981 ;; general settings 13982; (set (make-local-variable 'speedbar-tag-hierarchy-method) nil) 13983 ;; VHDL file extensions (extracted from `auto-mode-alist') 13984 (let ((mode-alist auto-mode-alist)) 13985 (while mode-alist 13986 (when (eq (cdar mode-alist) 'vhdl-mode) 13987 (speedbar-add-supported-extension (caar mode-alist))) 13988 (setq mode-alist (cdr mode-alist)))) 13989 ;; hierarchy browser settings 13990 (when (boundp 'speedbar-mode-functions-list) 13991 ;; special functions 13992 (speedbar-add-mode-functions-list 13993 '("vhdl directory" 13994 (speedbar-item-info . vhdl-speedbar-item-info) 13995 (speedbar-line-directory . speedbar-files-line-path))) 13996 (speedbar-add-mode-functions-list 13997 '("vhdl project" 13998 (speedbar-item-info . vhdl-speedbar-item-info) 13999 (speedbar-line-directory . vhdl-speedbar-line-project))) 14000 ;; keymap 14001 (unless vhdl-speedbar-key-map 14002 (setq vhdl-speedbar-key-map (speedbar-make-specialized-keymap)) 14003 (define-key vhdl-speedbar-key-map "e" 'speedbar-edit-line) 14004 (define-key vhdl-speedbar-key-map "\C-m" 'speedbar-edit-line) 14005 (define-key vhdl-speedbar-key-map "+" 'speedbar-expand-line) 14006 (define-key vhdl-speedbar-key-map "=" 'speedbar-expand-line) 14007 (define-key vhdl-speedbar-key-map "-" 'vhdl-speedbar-contract-level) 14008 (define-key vhdl-speedbar-key-map "_" 'vhdl-speedbar-contract-all) 14009 (define-key vhdl-speedbar-key-map "C" 'vhdl-speedbar-port-copy) 14010 (define-key vhdl-speedbar-key-map "P" 'vhdl-speedbar-place-component) 14011 (define-key vhdl-speedbar-key-map "F" 'vhdl-speedbar-configuration) 14012 (define-key vhdl-speedbar-key-map "A" 'vhdl-speedbar-select-mra) 14013 (define-key vhdl-speedbar-key-map "K" 'vhdl-speedbar-make-design) 14014 (define-key vhdl-speedbar-key-map "R" 'vhdl-speedbar-rescan-hierarchy) 14015 (define-key vhdl-speedbar-key-map "S" 'vhdl-save-caches) 14016 (let ((key 0)) 14017 (while (<= key 9) 14018 (define-key vhdl-speedbar-key-map (int-to-string key) 14019 `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) 14020 (setq key (1+ key))))) 14021 (define-key speedbar-key-map "h" 14022 (lambda () (interactive) 14023 (speedbar-change-initial-expansion-list "vhdl directory"))) 14024 (define-key speedbar-key-map "H" 14025 (lambda () (interactive) 14026 (speedbar-change-initial-expansion-list "vhdl project"))) 14027 ;; menu 14028 (unless vhdl-speedbar-menu-items 14029 (setq 14030 vhdl-speedbar-menu-items 14031 `(["Edit" speedbar-edit-line t] 14032 ["Expand" speedbar-expand-line 14033 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))] 14034 ["Contract" vhdl-speedbar-contract-level t] 14035 ["Expand All" vhdl-speedbar-expand-all t] 14036 ["Contract All" vhdl-speedbar-contract-all t] 14037 ,(let ((key 0) (menu-list '("Hierarchy Depth"))) 14038 (while (<= key 9) 14039 (setq menu-list 14040 (cons `[,(if (= key 0) "All" (int-to-string key)) 14041 (vhdl-speedbar-set-depth ,key) 14042 :style radio 14043 :selected (= vhdl-speedbar-hierarchy-depth ,key) 14044 :keys ,(int-to-string key)] 14045 menu-list)) 14046 (setq key (1+ key))) 14047 (nreverse menu-list)) 14048 "--" 14049 ["Copy Port/Subprogram" vhdl-speedbar-port-copy 14050 (or (vhdl-speedbar-check-unit 'entity) 14051 (vhdl-speedbar-check-unit 'subprogram))] 14052 ["Place Component" vhdl-speedbar-place-component 14053 (vhdl-speedbar-check-unit 'entity)] 14054 ["Generate Configuration" vhdl-speedbar-configuration 14055 (vhdl-speedbar-check-unit 'architecture)] 14056 ["Select as MRA" vhdl-speedbar-select-mra 14057 (vhdl-speedbar-check-unit 'architecture)] 14058 ["Make" vhdl-speedbar-make-design 14059 (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] 14060 ["Generate Makefile" vhdl-speedbar-generate-makefile 14061 (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] 14062 ["Rescan Directory" vhdl-speedbar-rescan-hierarchy 14063 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) 14064 ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)] 14065 ["Rescan Project" vhdl-speedbar-rescan-hierarchy 14066 :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) 14067 ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects] 14068 ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) 14069 ;; hook-ups 14070 (speedbar-add-expansion-list 14071 '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-key-map 14072 vhdl-speedbar-display-directory)) 14073 (speedbar-add-expansion-list 14074 '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-key-map 14075 vhdl-speedbar-display-projects)) 14076 (setq speedbar-stealthy-function-list 14077 (append 14078 '(("vhdl directory" vhdl-speedbar-update-current-unit) 14079 ("vhdl project" vhdl-speedbar-update-current-project 14080 vhdl-speedbar-update-current-unit) 14081; ("files" (lambda () (setq speedbar-ignored-path-regexp 14082; (speedbar-extension-list-to-regex 14083; speedbar-ignored-path-expressions)))) 14084 ) 14085 speedbar-stealthy-function-list)) 14086 (when (eq vhdl-speedbar-display-mode 'directory) 14087 (setq speedbar-initial-expansion-list-name "vhdl directory")) 14088 (when (eq vhdl-speedbar-display-mode 'project) 14089 (setq speedbar-initial-expansion-list-name "vhdl project")) 14090 (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) 14091 14092(defun vhdl-speedbar (&optional arg) 14093 "Open/close speedbar." 14094 (interactive) 14095 (if (not (fboundp 'speedbar)) 14096 (error "WARNING: Speedbar is not available or not installed") 14097 (condition-case () 14098 (speedbar-frame-mode arg) 14099 (error (error "WARNING: An error occurred while opening speedbar"))))) 14100 14101;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14102;; Display functions 14103 14104(defvar vhdl-speedbar-last-selected-project nil 14105 "Name of last selected project.") 14106 14107;; macros must be defined in the file they are used (copied from `speedbar.el') 14108(defmacro speedbar-with-writable (&rest forms) 14109 "Allow the buffer to be writable and evaluate FORMS." 14110 (list 'let '((inhibit-read-only t)) 14111 (cons 'progn forms))) 14112(put 'speedbar-with-writable 'lisp-indent-function 0) 14113 14114(defun vhdl-speedbar-display-directory (directory depth &optional rescan) 14115 "Display directory and hierarchy information in speedbar." 14116 (setq vhdl-speedbar-show-projects nil) 14117 (setq speedbar-ignored-directory-regexp 14118 (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) 14119 (setq directory (abbreviate-file-name (file-name-as-directory directory))) 14120 (setq speedbar-last-selected-file nil) 14121 (speedbar-with-writable 14122 (condition-case nil 14123 (progn 14124 ;; insert directory path 14125 (speedbar-directory-buttons directory depth) 14126 ;; insert subdirectories 14127 (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth) 14128 ;; scan and insert hierarchy of current directory 14129 (vhdl-speedbar-insert-dir-hierarchy directory depth 14130 speedbar-power-click) 14131 ;; expand subdirectories 14132 (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) 14133 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) 14134 14135(defun vhdl-speedbar-display-projects (project depth &optional rescan) 14136 "Display projects and hierarchy information in speedbar." 14137 (setq vhdl-speedbar-show-projects t) 14138 (setq speedbar-ignored-directory-regexp ".") 14139 (setq speedbar-last-selected-file nil) 14140 (setq vhdl-speedbar-last-selected-project nil) 14141 (speedbar-with-writable 14142 (condition-case nil 14143 ;; insert projects 14144 (vhdl-speedbar-insert-projects) 14145 (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) 14146 (setq speedbar-full-text-cache nil)) ; prevent caching 14147 14148(defun vhdl-speedbar-insert-projects () 14149 "Insert all projects in speedbar." 14150 (vhdl-speedbar-make-title-line "Projects:") 14151 (let ((project-alist (if vhdl-project-sort 14152 (vhdl-sort-alist (copy-alist vhdl-project-alist)) 14153 vhdl-project-alist)) 14154 (vhdl-speedbar-update-current-unit nil)) 14155 ;; insert projects 14156 (while project-alist 14157 (speedbar-make-tag-line 14158 'angle ?+ 'vhdl-speedbar-expand-project 14159 (caar project-alist) (caar project-alist) 14160 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) 14161 (setq project-alist (cdr project-alist))) 14162 (setq project-alist vhdl-project-alist) 14163 ;; expand projects 14164 (while project-alist 14165 (when (member (caar project-alist) vhdl-speedbar-shown-project-list) 14166 (goto-char (point-min)) 14167 (when (re-search-forward 14168 (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) 14169 (goto-char (match-end 1)) 14170 (speedbar-do-function-pointer))) 14171 (setq project-alist (cdr project-alist)))) 14172; (vhdl-speedbar-update-current-project) 14173; (vhdl-speedbar-update-current-unit nil t) 14174 ) 14175 14176(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) 14177 "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, 14178otherwise use cached data." 14179 (when (or rescan (and (not (assoc project vhdl-file-alist)) 14180 (not (vhdl-load-cache project)))) 14181 (vhdl-scan-project-contents project)) 14182 ;; insert design hierarchy 14183 (vhdl-speedbar-insert-hierarchy 14184 (aget vhdl-entity-alist project t) 14185 (aget vhdl-config-alist project t) 14186 (aget vhdl-package-alist project t) 14187 (car (aget vhdl-ent-inst-alist project t)) indent) 14188 (insert (int-to-string indent) ":\n") 14189 (put-text-property (- (point) 3) (1- (point)) 'invisible t) 14190 (put-text-property (1- (point)) (point) 'invisible nil) 14191 ;; expand design units 14192 (vhdl-speedbar-expand-units project)) 14193 14194(defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) 14195 "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil, 14196otherwise use cached data." 14197 (when (or rescan (and (not (assoc directory vhdl-file-alist)) 14198 (not (vhdl-load-cache directory)))) 14199 (vhdl-scan-directory-contents directory)) 14200 ;; insert design hierarchy 14201 (vhdl-speedbar-insert-hierarchy 14202 (aget vhdl-entity-alist directory t) 14203 (aget vhdl-config-alist directory t) 14204 (aget vhdl-package-alist directory t) 14205 (car (aget vhdl-ent-inst-alist directory t)) depth) 14206 ;; expand design units 14207 (vhdl-speedbar-expand-units directory) 14208 (aput 'vhdl-directory-alist directory (list (list directory)))) 14209 14210(defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist 14211 ent-inst-list depth) 14212 "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." 14213 (if (not (or ent-alist conf-alist pack-alist)) 14214 (vhdl-speedbar-make-title-line "No VHDL design units!" depth) 14215 (let (ent-entry conf-entry pack-entry) 14216 ;; insert entities 14217 (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) 14218 (while ent-alist 14219 (setq ent-entry (car ent-alist)) 14220 (speedbar-make-tag-line 14221 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) 14222 (nth 1 ent-entry) 'vhdl-speedbar-find-file 14223 (cons (nth 2 ent-entry) (nth 3 ent-entry)) 14224 'vhdl-speedbar-entity-face depth) 14225 (unless (nth 2 ent-entry) 14226 (end-of-line 0) (insert "!") (forward-char 1)) 14227 (unless (member (nth 0 ent-entry) ent-inst-list) 14228 (end-of-line 0) (insert " (top)") (forward-char 1)) 14229 (setq ent-alist (cdr ent-alist))) 14230 ;; insert configurations 14231 (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) 14232 (while conf-alist 14233 (setq conf-entry (car conf-alist)) 14234 (speedbar-make-tag-line 14235 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) 14236 (nth 1 conf-entry) 'vhdl-speedbar-find-file 14237 (cons (nth 2 conf-entry) (nth 3 conf-entry)) 14238 'vhdl-speedbar-configuration-face depth) 14239 (setq conf-alist (cdr conf-alist))) 14240 ;; insert packages 14241 (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) 14242 (while pack-alist 14243 (setq pack-entry (car pack-alist)) 14244 (vhdl-speedbar-make-pack-line 14245 (nth 0 pack-entry) (nth 1 pack-entry) 14246 (cons (nth 2 pack-entry) (nth 3 pack-entry)) 14247 (cons (nth 7 pack-entry) (nth 8 pack-entry)) 14248 depth) 14249 (setq pack-alist (cdr pack-alist)))))) 14250 14251(defun vhdl-speedbar-rescan-hierarchy () 14252 "Rescan hierarchy for the directory or project under the cursor." 14253 (interactive) 14254 (let (key path) 14255 (cond 14256 ;; current project 14257 (vhdl-speedbar-show-projects 14258 (setq key (vhdl-speedbar-line-project)) 14259 (vhdl-scan-project-contents key)) 14260 ;; top-level directory 14261 ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) 14262 (re-search-forward "[0-9]+:" nil t) 14263 (vhdl-scan-directory-contents 14264 (abbreviate-file-name (speedbar-line-directory)))) 14265 ;; current directory 14266 (t (setq path (speedbar-line-directory)) 14267 (string-match "^\\(.+[/\\]\\)" path) 14268 (vhdl-scan-directory-contents 14269 (abbreviate-file-name (match-string 1 path))))) 14270 (vhdl-speedbar-refresh key))) 14271 14272(defun vhdl-speedbar-expand-dirs (directory) 14273 "Expand subdirectories in DIRECTORY according to 14274 `speedbar-shown-directories'." 14275 ;; (nicked from `speedbar-default-directory-list') 14276 (let ((sf (cdr (reverse speedbar-shown-directories))) 14277 (vhdl-speedbar-update-current-unit nil)) 14278 (setq speedbar-shown-directories 14279 (list (expand-file-name default-directory))) 14280 (while sf 14281 (when (speedbar-goto-this-file (car sf)) 14282 (beginning-of-line) 14283 (when (looking-at "[0-9]+:\\s-*<") 14284 (goto-char (match-end 0)) 14285 (speedbar-do-function-pointer))) 14286 (setq sf (cdr sf)))) 14287 (vhdl-speedbar-update-current-unit nil t)) 14288 14289(defun vhdl-speedbar-expand-units (key) 14290 "Expand design units in directory/project KEY according to 14291`vhdl-speedbar-shown-unit-alist'." 14292 (let ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) 14293 (vhdl-speedbar-update-current-unit nil) 14294 vhdl-updated-project-list) 14295 (adelete 'vhdl-speedbar-shown-unit-alist key) 14296 (vhdl-prepare-search-1 14297 (while unit-alist ; expand units 14298 (vhdl-speedbar-goto-this-unit key (caar unit-alist)) 14299 (beginning-of-line) 14300 (let ((arch-alist (nth 1 (car unit-alist))) 14301 position) 14302 (when (looking-at "^[0-9]+:\\s-*\\[") 14303 (goto-char (match-end 0)) 14304 (setq position (point)) 14305 (speedbar-do-function-pointer) 14306 (select-frame speedbar-frame) 14307 (while arch-alist ; expand architectures 14308 (goto-char position) 14309 (when (re-search-forward 14310 (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" 14311 (car arch-alist) "\\>\\)") nil t) 14312 (beginning-of-line) 14313 (when (looking-at "^[0-9]+:\\s-*{") 14314 (goto-char (match-end 0)) 14315 (speedbar-do-function-pointer) 14316 (select-frame speedbar-frame))) 14317 (setq arch-alist (cdr arch-alist)))) 14318 (setq unit-alist (cdr unit-alist)))))) 14319 (vhdl-speedbar-update-current-unit nil t)) 14320 14321(defun vhdl-speedbar-contract-level () 14322 "Contract current level in current directory/project." 14323 (interactive) 14324 (when (or (save-excursion 14325 (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) 14326 (and (save-excursion 14327 (beginning-of-line) (looking-at "^\\([0-9]+\\):")) 14328 (re-search-backward 14329 (format "^[0-%d]:\\s-*[[{<]-" 14330 (max (1- (string-to-number (match-string 1))) 0)) nil t))) 14331 (goto-char (match-end 0)) 14332 (speedbar-do-function-pointer) 14333 (speedbar-center-buffer-smartly))) 14334 14335(defun vhdl-speedbar-contract-all () 14336 "Contract all expanded design units in current directory/project." 14337 (interactive) 14338 (if (and vhdl-speedbar-show-projects 14339 (save-excursion (beginning-of-line) (looking-at "^0:"))) 14340 (progn (setq vhdl-speedbar-shown-project-list nil) 14341 (vhdl-speedbar-refresh)) 14342 (let ((key (vhdl-speedbar-line-key))) 14343 (adelete 'vhdl-speedbar-shown-unit-alist key) 14344 (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) 14345 (when (memq 'display vhdl-speedbar-save-cache) 14346 (add-to-list 'vhdl-updated-project-list key))))) 14347 14348(defun vhdl-speedbar-expand-all () 14349 "Expand all design units in current directory/project." 14350 (interactive) 14351 (let* ((key (vhdl-speedbar-line-key)) 14352 (ent-alist (aget vhdl-entity-alist key t)) 14353 (conf-alist (aget vhdl-config-alist key t)) 14354 (pack-alist (aget vhdl-package-alist key t)) 14355 arch-alist unit-alist subunit-alist) 14356 (add-to-list 'vhdl-speedbar-shown-project-list key) 14357 (while ent-alist 14358 (setq arch-alist (nth 4 (car ent-alist))) 14359 (setq subunit-alist nil) 14360 (while arch-alist 14361 (setq subunit-alist (cons (caar arch-alist) subunit-alist)) 14362 (setq arch-alist (cdr arch-alist))) 14363 (setq unit-alist (cons (list (caar ent-alist) subunit-alist) unit-alist)) 14364 (setq ent-alist (cdr ent-alist))) 14365 (while conf-alist 14366 (setq unit-alist (cons (list (caar conf-alist)) unit-alist)) 14367 (setq conf-alist (cdr conf-alist))) 14368 (while pack-alist 14369 (setq unit-alist (cons (list (caar pack-alist)) unit-alist)) 14370 (setq pack-alist (cdr pack-alist))) 14371 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 14372 (vhdl-speedbar-refresh) 14373 (when (memq 'display vhdl-speedbar-save-cache) 14374 (add-to-list 'vhdl-updated-project-list key)))) 14375 14376(defun vhdl-speedbar-expand-project (text token indent) 14377 "Expand/contract the project under the cursor." 14378 (cond 14379 ((string-match "+" text) ; expand project 14380 (speedbar-change-expand-button-char ?-) 14381 (unless (member token vhdl-speedbar-shown-project-list) 14382 (setq vhdl-speedbar-shown-project-list 14383 (cons token vhdl-speedbar-shown-project-list))) 14384 (speedbar-with-writable 14385 (save-excursion 14386 (end-of-line) (forward-char 1) 14387 (vhdl-speedbar-insert-project-hierarchy token (1+ indent) 14388 speedbar-power-click)))) 14389 ((string-match "-" text) ; contract project 14390 (speedbar-change-expand-button-char ?+) 14391 (setq vhdl-speedbar-shown-project-list 14392 (delete token vhdl-speedbar-shown-project-list)) 14393 (speedbar-delete-subblock indent)) 14394 (t (error "Nothing to display"))) 14395 (when (equal (selected-frame) speedbar-frame) 14396 (speedbar-center-buffer-smartly))) 14397 14398(defun vhdl-speedbar-expand-entity (text token indent) 14399 "Expand/contract the entity under the cursor." 14400 (cond 14401 ((string-match "+" text) ; expand entity 14402 (let* ((key (vhdl-speedbar-line-key indent)) 14403 (ent-alist (aget vhdl-entity-alist key t)) 14404 (ent-entry (aget ent-alist token t)) 14405 (arch-alist (nth 3 ent-entry)) 14406 (inst-alist (vhdl-get-instantiations token indent)) 14407 (subpack-alist (nth 5 ent-entry)) 14408 (multiple-arch (> (length arch-alist) 1)) 14409 arch-entry inst-entry) 14410 (if (not (or arch-alist inst-alist subpack-alist)) 14411 (speedbar-change-expand-button-char ??) 14412 (speedbar-change-expand-button-char ?-) 14413 ;; add entity to `vhdl-speedbar-shown-unit-alist' 14414 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14415 (aput 'unit-alist token nil) 14416 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 14417 (speedbar-with-writable 14418 (save-excursion 14419 (end-of-line) (forward-char 1) 14420 ;; insert architectures 14421 (when arch-alist 14422 (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) 14423 (while arch-alist 14424 (setq arch-entry (car arch-alist)) 14425 (speedbar-make-tag-line 14426 'curly ?+ 'vhdl-speedbar-expand-architecture 14427 (cons token (nth 0 arch-entry)) 14428 (nth 1 arch-entry) 'vhdl-speedbar-find-file 14429 (cons (nth 2 arch-entry) (nth 3 arch-entry)) 14430 'vhdl-speedbar-architecture-face (1+ indent)) 14431 (when (and multiple-arch 14432 (equal (nth 0 arch-entry) (nth 4 ent-entry))) 14433 (end-of-line 0) (insert " (mra)") (forward-char 1)) 14434 (setq arch-alist (cdr arch-alist))) 14435 ;; insert instantiations 14436 (when inst-alist 14437 (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) 14438 (while inst-alist 14439 (setq inst-entry (car inst-alist)) 14440 (vhdl-speedbar-make-inst-line 14441 (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) 14442 (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) 14443 nil nil nil (1+ indent) 0 " in ") 14444 (setq inst-alist (cdr inst-alist))) 14445 ;; insert required packages 14446 (vhdl-speedbar-insert-subpackages 14447 subpack-alist (1+ indent) indent))) 14448 (when (memq 'display vhdl-speedbar-save-cache) 14449 (add-to-list 'vhdl-updated-project-list key)) 14450 (vhdl-speedbar-update-current-unit t t)))) 14451 ((string-match "-" text) ; contract entity 14452 (speedbar-change-expand-button-char ?+) 14453 ;; remove entity from `vhdl-speedbar-shown-unit-alist' 14454 (let* ((key (vhdl-speedbar-line-key indent)) 14455 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14456 (adelete 'unit-alist token) 14457 (if unit-alist 14458 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 14459 (adelete 'vhdl-speedbar-shown-unit-alist key)) 14460 (speedbar-delete-subblock indent) 14461 (when (memq 'display vhdl-speedbar-save-cache) 14462 (add-to-list 'vhdl-updated-project-list key)))) 14463 (t (error "Nothing to display"))) 14464 (when (equal (selected-frame) speedbar-frame) 14465 (speedbar-center-buffer-smartly))) 14466 14467(defun vhdl-speedbar-expand-architecture (text token indent) 14468 "Expand/contract the architecture under the cursor." 14469 (cond 14470 ((string-match "+" text) ; expand architecture 14471 (let* ((key (vhdl-speedbar-line-key (1- indent))) 14472 (ent-alist (aget vhdl-entity-alist key t)) 14473 (conf-alist (aget vhdl-config-alist key t)) 14474 (hier-alist (vhdl-get-hierarchy 14475 ent-alist conf-alist (car token) (cdr token) nil nil 14476 0 (1- indent))) 14477 (ent-entry (aget ent-alist (car token) t)) 14478 (arch-entry (aget (nth 3 ent-entry) (cdr token) t)) 14479 (subpack-alist (nth 4 arch-entry)) 14480 entry) 14481 (if (not (or hier-alist subpack-alist)) 14482 (speedbar-change-expand-button-char ??) 14483 (speedbar-change-expand-button-char ?-) 14484 ;; add architecture to `vhdl-speedbar-shown-unit-alist' 14485 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) 14486 (arch-alist (nth 0 (aget unit-alist (car token) t)))) 14487 (aput 'unit-alist (car token) (list (cons (cdr token) arch-alist))) 14488 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 14489 (speedbar-with-writable 14490 (save-excursion 14491 (end-of-line) (forward-char 1) 14492 ;; insert instance hierarchy 14493 (when hier-alist 14494 (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" 14495 (1+ indent))) 14496 (while hier-alist 14497 (setq entry (car hier-alist)) 14498 (when (or (= vhdl-speedbar-hierarchy-depth 0) 14499 (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 14500 (vhdl-speedbar-make-inst-line 14501 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 14502 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 14503 (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) 14504 (setq hier-alist (cdr hier-alist))) 14505 ;; insert required packages 14506 (vhdl-speedbar-insert-subpackages 14507 subpack-alist (1+ indent) (1- indent)))) 14508 (when (memq 'display vhdl-speedbar-save-cache) 14509 (add-to-list 'vhdl-updated-project-list key)) 14510 (vhdl-speedbar-update-current-unit t t)))) 14511 ((string-match "-" text) ; contract architecture 14512 (speedbar-change-expand-button-char ?+) 14513 ;; remove architecture from `vhdl-speedbar-shown-unit-alist' 14514 (let* ((key (vhdl-speedbar-line-key (1- indent))) 14515 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t)) 14516 (arch-alist (nth 0 (aget unit-alist (car token) t)))) 14517 (aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) 14518 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 14519 (speedbar-delete-subblock indent) 14520 (when (memq 'display vhdl-speedbar-save-cache) 14521 (add-to-list 'vhdl-updated-project-list key)))) 14522 (t (error "Nothing to display"))) 14523 (when (equal (selected-frame) speedbar-frame) 14524 (speedbar-center-buffer-smartly))) 14525 14526(defun vhdl-speedbar-expand-config (text token indent) 14527 "Expand/contract the configuration under the cursor." 14528 (cond 14529 ((string-match "+" text) ; expand configuration 14530 (let* ((key (vhdl-speedbar-line-key indent)) 14531 (conf-alist (aget vhdl-config-alist key t)) 14532 (conf-entry (aget conf-alist token)) 14533 (ent-alist (aget vhdl-entity-alist key t)) 14534 (hier-alist (vhdl-get-hierarchy 14535 ent-alist conf-alist (nth 3 conf-entry) 14536 (nth 4 conf-entry) token (nth 5 conf-entry) 14537 0 indent t)) 14538 (subpack-alist (nth 6 conf-entry)) 14539 entry) 14540 (if (not (or hier-alist subpack-alist)) 14541 (speedbar-change-expand-button-char ??) 14542 (speedbar-change-expand-button-char ?-) 14543 ;; add configuration to `vhdl-speedbar-shown-unit-alist' 14544 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14545 (aput 'unit-alist token nil) 14546 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 14547 (speedbar-with-writable 14548 (save-excursion 14549 (end-of-line) (forward-char 1) 14550 ;; insert instance hierarchy 14551 (when hier-alist 14552 (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) 14553 (while hier-alist 14554 (setq entry (car hier-alist)) 14555 (when (or (= vhdl-speedbar-hierarchy-depth 0) 14556 (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) 14557 (vhdl-speedbar-make-inst-line 14558 (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) 14559 (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) 14560 (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) 14561 (setq hier-alist (cdr hier-alist))) 14562 ;; insert required packages 14563 (vhdl-speedbar-insert-subpackages 14564 subpack-alist (1+ indent) indent))) 14565 (when (memq 'display vhdl-speedbar-save-cache) 14566 (add-to-list 'vhdl-updated-project-list key)) 14567 (vhdl-speedbar-update-current-unit t t)))) 14568 ((string-match "-" text) ; contract configuration 14569 (speedbar-change-expand-button-char ?+) 14570 ;; remove configuration from `vhdl-speedbar-shown-unit-alist' 14571 (let* ((key (vhdl-speedbar-line-key indent)) 14572 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14573 (adelete 'unit-alist token) 14574 (if unit-alist 14575 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 14576 (adelete 'vhdl-speedbar-shown-unit-alist key)) 14577 (speedbar-delete-subblock indent) 14578 (when (memq 'display vhdl-speedbar-save-cache) 14579 (add-to-list 'vhdl-updated-project-list key)))) 14580 (t (error "Nothing to display"))) 14581 (when (equal (selected-frame) speedbar-frame) 14582 (speedbar-center-buffer-smartly))) 14583 14584(defun vhdl-speedbar-expand-package (text token indent) 14585 "Expand/contract the package under the cursor." 14586 (cond 14587 ((string-match "+" text) ; expand package 14588 (let* ((key (vhdl-speedbar-line-key indent)) 14589 (pack-alist (aget vhdl-package-alist key t)) 14590 (pack-entry (aget pack-alist token t)) 14591 (comp-alist (nth 3 pack-entry)) 14592 (func-alist (nth 4 pack-entry)) 14593 (func-body-alist (nth 8 pack-entry)) 14594 (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) 14595 comp-entry func-entry func-body-entry) 14596 (if (not (or comp-alist func-alist subpack-alist)) 14597 (speedbar-change-expand-button-char ??) 14598 (speedbar-change-expand-button-char ?-) 14599 ;; add package to `vhdl-speedbar-shown-unit-alist' 14600 (let* ((unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14601 (aput 'unit-alist token nil) 14602 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) 14603 (speedbar-with-writable 14604 (save-excursion 14605 (end-of-line) (forward-char 1) 14606 ;; insert components 14607 (when comp-alist 14608 (vhdl-speedbar-make-title-line "Components:" (1+ indent))) 14609 (while comp-alist 14610 (setq comp-entry (car comp-alist)) 14611 (speedbar-make-tag-line 14612 nil nil nil 14613 (cons token (nth 0 comp-entry)) 14614 (nth 1 comp-entry) 'vhdl-speedbar-find-file 14615 (cons (nth 2 comp-entry) (nth 3 comp-entry)) 14616 'vhdl-speedbar-entity-face (1+ indent)) 14617 (setq comp-alist (cdr comp-alist))) 14618 ;; insert subprograms 14619 (when func-alist 14620 (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) 14621 (while func-alist 14622 (setq func-entry (car func-alist) 14623 func-body-entry (aget func-body-alist (car func-entry) t)) 14624 (when (nth 2 func-entry) 14625 (vhdl-speedbar-make-subprogram-line 14626 (nth 1 func-entry) 14627 (cons (nth 2 func-entry) (nth 3 func-entry)) 14628 (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) 14629 (1+ indent))) 14630 (setq func-alist (cdr func-alist))) 14631 ;; insert required packages 14632 (vhdl-speedbar-insert-subpackages 14633 subpack-alist (1+ indent) indent))) 14634 (when (memq 'display vhdl-speedbar-save-cache) 14635 (add-to-list 'vhdl-updated-project-list key)) 14636 (vhdl-speedbar-update-current-unit t t)))) 14637 ((string-match "-" text) ; contract package 14638 (speedbar-change-expand-button-char ?+) 14639 ;; remove package from `vhdl-speedbar-shown-unit-alist' 14640 (let* ((key (vhdl-speedbar-line-key indent)) 14641 (unit-alist (aget vhdl-speedbar-shown-unit-alist key t))) 14642 (adelete 'unit-alist token) 14643 (if unit-alist 14644 (aput 'vhdl-speedbar-shown-unit-alist key unit-alist) 14645 (adelete 'vhdl-speedbar-shown-unit-alist key)) 14646 (speedbar-delete-subblock indent) 14647 (when (memq 'display vhdl-speedbar-save-cache) 14648 (add-to-list 'vhdl-updated-project-list key)))) 14649 (t (error "Nothing to display"))) 14650 (when (equal (selected-frame) speedbar-frame) 14651 (speedbar-center-buffer-smartly))) 14652 14653(defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) 14654 "Insert required packages." 14655 (let* ((pack-alist (aget vhdl-package-alist 14656 (vhdl-speedbar-line-key dir-indent) t)) 14657 pack-key lib-name pack-entry) 14658 (when subpack-alist 14659 (vhdl-speedbar-make-title-line "Packages Used:" indent)) 14660 (while subpack-alist 14661 (setq pack-key (cdar subpack-alist) 14662 lib-name (caar subpack-alist)) 14663 (setq pack-entry (aget pack-alist pack-key t)) 14664 (vhdl-speedbar-make-subpack-line 14665 (or (nth 0 pack-entry) pack-key) lib-name 14666 (cons (nth 1 pack-entry) (nth 2 pack-entry)) 14667 (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) 14668 (setq subpack-alist (cdr subpack-alist))))) 14669 14670;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 14671;; Display help functions 14672 14673(defvar vhdl-speedbar-update-current-unit t 14674 "Non-nil means to run `vhdl-speedbar-update-current-unit'.") 14675 14676(defun vhdl-speedbar-update-current-project () 14677 "Highlight project that is currently active." 14678 (when (and vhdl-speedbar-show-projects 14679 (not (equal vhdl-speedbar-last-selected-project vhdl-project)) 14680 (and (boundp 'speedbar-frame) 14681 (frame-live-p speedbar-frame))) 14682 (let ((last-frame (selected-frame)) 14683 (project-alist vhdl-project-alist) 14684 pos) 14685 (select-frame speedbar-frame) 14686 (speedbar-with-writable 14687 (save-excursion 14688 (while project-alist 14689 (goto-char (point-min)) 14690 (when (re-search-forward 14691 (concat "<.> \\(" (caar project-alist) "\\)$") nil t) 14692 (put-text-property (match-beginning 1) (match-end 1) 'face 14693 (if (equal (caar project-alist) vhdl-project) 14694 'speedbar-selected-face 14695 'speedbar-directory-face)) 14696 (when (equal (caar project-alist) vhdl-project) 14697 (setq pos (1- (match-beginning 1))))) 14698 (setq project-alist (cdr project-alist)))) 14699 (when pos (goto-char pos))) 14700 (select-frame last-frame) 14701 (setq vhdl-speedbar-last-selected-project vhdl-project))) 14702 t) 14703 14704(defun vhdl-speedbar-update-current-unit (&optional no-position always) 14705 "Highlight all design units that are contained in the current file. 14706NO-POSITION non-nil means do not re-position cursor." 14707 (let ((last-frame (selected-frame)) 14708 (project-list vhdl-speedbar-shown-project-list) 14709 file-alist pos file-name) 14710 ;; get current file name 14711 (if (fboundp 'speedbar-select-attached-frame) 14712 (speedbar-select-attached-frame) 14713 (select-frame speedbar-attached-frame)) 14714 (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) 14715 (when (and vhdl-speedbar-update-current-unit 14716 (or always (not (equal file-name speedbar-last-selected-file)))) 14717 (if vhdl-speedbar-show-projects 14718 (while project-list 14719 (setq file-alist (append file-alist (aget vhdl-file-alist 14720 (car project-list) t))) 14721 (setq project-list (cdr project-list))) 14722 (setq file-alist (aget vhdl-file-alist 14723 (abbreviate-file-name default-directory) t))) 14724 (select-frame speedbar-frame) 14725 (set-buffer speedbar-buffer) 14726 (speedbar-with-writable 14727 (vhdl-prepare-search-1 14728 (save-excursion 14729 ;; unhighlight last units 14730 (let* ((file-entry (aget file-alist speedbar-last-selected-file t))) 14731 (vhdl-speedbar-update-units 14732 "\\[.\\] " (nth 0 file-entry) 14733 speedbar-last-selected-file 'vhdl-speedbar-entity-face) 14734 (vhdl-speedbar-update-units 14735 "{.} " (nth 1 file-entry) 14736 speedbar-last-selected-file 'vhdl-speedbar-architecture-face) 14737 (vhdl-speedbar-update-units 14738 "\\[.\\] " (nth 3 file-entry) 14739 speedbar-last-selected-file 'vhdl-speedbar-configuration-face) 14740 (vhdl-speedbar-update-units 14741 "[]>] " (nth 4 file-entry) 14742 speedbar-last-selected-file 'vhdl-speedbar-package-face) 14743 (vhdl-speedbar-update-units 14744 "\\[.\\].+(" '("body") 14745 speedbar-last-selected-file 'vhdl-speedbar-package-face) 14746 (vhdl-speedbar-update-units 14747 "> " (nth 6 file-entry) 14748 speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) 14749 ;; highlight current units 14750 (let* ((file-entry (aget file-alist file-name t))) 14751 (setq 14752 pos (vhdl-speedbar-update-units 14753 "\\[.\\] " (nth 0 file-entry) 14754 file-name 'vhdl-speedbar-entity-selected-face pos) 14755 pos (vhdl-speedbar-update-units 14756 "{.} " (nth 1 file-entry) 14757 file-name 'vhdl-speedbar-architecture-selected-face pos) 14758 pos (vhdl-speedbar-update-units 14759 "\\[.\\] " (nth 3 file-entry) 14760 file-name 'vhdl-speedbar-configuration-selected-face pos) 14761 pos (vhdl-speedbar-update-units 14762 "[]>] " (nth 4 file-entry) 14763 file-name 'vhdl-speedbar-package-selected-face pos) 14764 pos (vhdl-speedbar-update-units 14765 "\\[.\\].+(" '("body") 14766 file-name 'vhdl-speedbar-package-selected-face pos) 14767 pos (vhdl-speedbar-update-units 14768 "> " (nth 6 file-entry) 14769 file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) 14770 ;; move speedbar so the first highlighted unit is visible 14771 (when (and pos (not no-position)) 14772 (goto-char pos) 14773 (speedbar-center-buffer-smartly) 14774 (speedbar-position-cursor-on-line)) 14775 (setq speedbar-last-selected-file file-name)) 14776 (select-frame last-frame) 14777 t)) 14778 14779(defun vhdl-speedbar-update-units (text unit-list file-name face 14780 &optional pos) 14781 "Help function to highlight design units." 14782 (while unit-list 14783 (goto-char (point-min)) 14784 (while (re-search-forward 14785 (concat text "\\(" (car unit-list) "\\)\\>") nil t) 14786 (when (equal file-name (car (get-text-property 14787 (match-beginning 1) 'speedbar-token))) 14788 (setq pos (or pos (point-marker))) 14789 (put-text-property (match-beginning 1) (match-end 1) 'face face))) 14790 (setq unit-list (cdr unit-list))) 14791 pos) 14792 14793(defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker 14794 ent-name ent-file-marker 14795 arch-name arch-file-marker 14796 conf-name conf-file-marker 14797 lib-name depth offset delimiter) 14798 "Insert instantiation entry." 14799 (let ((start (point)) 14800 visible-start) 14801 (insert (int-to-string depth) ":") 14802 (put-text-property start (point) 'invisible t) 14803 (setq visible-start (point)) 14804 (insert-char ? (* depth speedbar-indentation-width)) 14805 (while (> offset 0) 14806 (insert "|") 14807 (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) 14808 (setq offset (1- offset))) 14809 (put-text-property visible-start (point) 'invisible nil) 14810 (setq start (point)) 14811 (insert ">") 14812 (speedbar-make-button start (point) nil nil nil) 14813 (setq visible-start (point)) 14814 (insert " ") 14815 (setq start (point)) 14816 (if (not inst-name) 14817 (insert "(top)") 14818 (insert inst-name) 14819 (speedbar-make-button 14820 start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face 14821 'vhdl-speedbar-find-file inst-file-marker)) 14822 (insert delimiter) 14823 (when ent-name 14824 (setq start (point)) 14825 (insert ent-name) 14826 (speedbar-make-button 14827 start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face 14828 'vhdl-speedbar-find-file ent-file-marker) 14829 (when arch-name 14830 (insert " (") 14831 (setq start (point)) 14832 (insert arch-name) 14833 (speedbar-make-button 14834 start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face 14835 'vhdl-speedbar-find-file arch-file-marker) 14836 (insert ")")) 14837 (when conf-name 14838 (insert " (") 14839 (setq start (point)) 14840 (insert conf-name) 14841 (speedbar-make-button 14842 start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face 14843 'vhdl-speedbar-find-file conf-file-marker) 14844 (insert ")"))) 14845 (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) 14846 (setq start (point)) 14847 (insert " (" lib-name ")") 14848 (put-text-property (+ 2 start) (1- (point)) 'face 14849 'vhdl-speedbar-library-face)) 14850 (insert-char ?\n 1) 14851 (put-text-property visible-start (point) 'invisible nil))) 14852 14853(defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker 14854 body-file-marker depth) 14855 "Insert package entry." 14856 (let ((start (point)) 14857 visible-start) 14858 (insert (int-to-string depth) ":") 14859 (put-text-property start (point) 'invisible t) 14860 (setq visible-start (point)) 14861 (insert-char ? (* depth speedbar-indentation-width)) 14862 (put-text-property visible-start (point) 'invisible nil) 14863 (setq start (point)) 14864 (insert "[+]") 14865 (speedbar-make-button 14866 start (point) 'speedbar-button-face 'speedbar-highlight-face 14867 'vhdl-speedbar-expand-package pack-key) 14868 (setq visible-start (point)) 14869 (insert-char ? 1 nil) 14870 (setq start (point)) 14871 (insert pack-name) 14872 (speedbar-make-button 14873 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14874 'vhdl-speedbar-find-file pack-file-marker) 14875 (unless (car pack-file-marker) 14876 (insert "!")) 14877 (when (car body-file-marker) 14878 (insert " (") 14879 (setq start (point)) 14880 (insert "body") 14881 (speedbar-make-button 14882 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14883 'vhdl-speedbar-find-file body-file-marker) 14884 (insert ")")) 14885 (insert-char ?\n 1) 14886 (put-text-property visible-start (point) 'invisible nil))) 14887 14888(defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker 14889 pack-body-file-marker depth) 14890 "Insert used package entry." 14891 (let ((start (point)) 14892 visible-start) 14893 (insert (int-to-string depth) ":") 14894 (put-text-property start (point) 'invisible t) 14895 (setq visible-start (point)) 14896 (insert-char ? (* depth speedbar-indentation-width)) 14897 (put-text-property visible-start (point) 'invisible nil) 14898 (setq start (point)) 14899 (insert ">") 14900 (speedbar-make-button start (point) nil nil nil) 14901 (setq visible-start (point)) 14902 (insert " ") 14903 (setq start (point)) 14904 (insert pack-name) 14905 (speedbar-make-button 14906 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14907 'vhdl-speedbar-find-file pack-file-marker) 14908 (when (car pack-body-file-marker) 14909 (insert " (") 14910 (setq start (point)) 14911 (insert "body") 14912 (speedbar-make-button 14913 start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face 14914 'vhdl-speedbar-find-file pack-body-file-marker) 14915 (insert ")")) 14916 (setq start (point)) 14917 (insert " (" lib-name ")") 14918 (put-text-property (+ 2 start) (1- (point)) 'face 14919 'vhdl-speedbar-library-face) 14920 (insert-char ?\n 1) 14921 (put-text-property visible-start (point) 'invisible nil))) 14922 14923(defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker 14924 func-body-file-marker 14925 depth) 14926 "Insert subprogram entry." 14927 (let ((start (point)) 14928 visible-start) 14929 (insert (int-to-string depth) ":") 14930 (put-text-property start (point) 'invisible t) 14931 (setq visible-start (point)) 14932 (insert-char ? (* depth speedbar-indentation-width)) 14933 (put-text-property visible-start (point) 'invisible nil) 14934 (setq start (point)) 14935 (insert ">") 14936 (speedbar-make-button start (point) nil nil nil) 14937 (setq visible-start (point)) 14938 (insert " ") 14939 (setq start (point)) 14940 (insert func-name) 14941 (speedbar-make-button 14942 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 14943 'vhdl-speedbar-find-file func-file-marker) 14944 (when (car func-body-file-marker) 14945 (insert " (") 14946 (setq start (point)) 14947 (insert "body") 14948 (speedbar-make-button 14949 start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face 14950 'vhdl-speedbar-find-file func-body-file-marker) 14951 (insert ")")) 14952 (insert-char ?\n 1) 14953 (put-text-property visible-start (point) 'invisible nil))) 14954 14955(defun vhdl-speedbar-make-title-line (text &optional depth) 14956 "Insert design unit title entry." 14957 (let ((start (point)) 14958 visible-start) 14959 (when depth 14960 (insert (int-to-string depth) ":") 14961 (put-text-property start (point) 'invisible t)) 14962 (setq visible-start (point)) 14963 (insert-char ? (* (or depth 0) speedbar-indentation-width)) 14964 (setq start (point)) 14965 (insert text) 14966 (speedbar-make-button start (point) nil nil nil nil) 14967 (insert-char ?\n 1) 14968 (put-text-property visible-start (point) 'invisible nil))) 14969 14970(defun vhdl-speedbar-insert-dirs (files level) 14971 "Insert subdirectories." 14972 (let ((dirs (car files))) 14973 (while dirs 14974 (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) 14975 (car dirs) 'speedbar-dir-follow nil 14976 'speedbar-directory-face level) 14977 (setq dirs (cdr dirs))))) 14978 14979(defun vhdl-speedbar-dired (text token indent) 14980 "Speedbar click handler for directory expand button in hierarchy mode." 14981 (cond ((string-match "+" text) ; we have to expand this dir 14982 (setq speedbar-shown-directories 14983 (cons (expand-file-name 14984 (concat (speedbar-line-directory indent) token "/")) 14985 speedbar-shown-directories)) 14986 (speedbar-change-expand-button-char ?-) 14987 (speedbar-reset-scanners) 14988 (speedbar-with-writable 14989 (save-excursion 14990 (end-of-line) (forward-char 1) 14991 (vhdl-speedbar-insert-dirs 14992 (speedbar-file-lists 14993 (concat (speedbar-line-directory indent) token "/")) 14994 (1+ indent)) 14995 (speedbar-reset-scanners) 14996 (vhdl-speedbar-insert-dir-hierarchy 14997 (abbreviate-file-name 14998 (concat (speedbar-line-directory indent) token "/")) 14999 (1+ indent) speedbar-power-click))) 15000 (vhdl-speedbar-update-current-unit t t)) 15001 ((string-match "-" text) ; we have to contract this node 15002 (speedbar-reset-scanners) 15003 (let ((oldl speedbar-shown-directories) 15004 (newl nil) 15005 (td (expand-file-name 15006 (concat (speedbar-line-directory indent) token)))) 15007 (while oldl 15008 (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) 15009 (setq newl (cons (car oldl) newl))) 15010 (setq oldl (cdr oldl))) 15011 (setq speedbar-shown-directories (nreverse newl))) 15012 (speedbar-change-expand-button-char ?+) 15013 (speedbar-delete-subblock indent)) 15014 (t (error "Nothing to display"))) 15015 (when (equal (selected-frame) speedbar-frame) 15016 (speedbar-center-buffer-smartly))) 15017 15018(defun vhdl-speedbar-item-info () 15019 "Derive and display information about this line item." 15020 (save-excursion 15021 (beginning-of-line) 15022 ;; skip invisible number info 15023 (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) 15024 (cond 15025 ;; project/directory entry 15026 ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") 15027 (if vhdl-speedbar-show-projects 15028 (message "Project \"%s\"" (match-string-no-properties 1)) 15029 (speedbar-files-item-info))) 15030 ;; design unit entry 15031 ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") 15032 (goto-char (match-end 1)) 15033 (let ((face (get-text-property (point) 'face))) 15034 (message 15035 "%s \"%s\" in \"%s\"" 15036 ;; design unit kind 15037 (cond ((or (eq face 'vhdl-speedbar-entity-face) 15038 (eq face 'vhdl-speedbar-entity-selected-face)) 15039 (if (equal (match-string 2) ">") "Component" "Entity")) 15040 ((or (eq face 'vhdl-speedbar-architecture-face) 15041 (eq face 'vhdl-speedbar-architecture-selected-face)) 15042 "Architecture") 15043 ((or (eq face 'vhdl-speedbar-configuration-face) 15044 (eq face 'vhdl-speedbar-configuration-selected-face)) 15045 "Configuration") 15046 ((or (eq face 'vhdl-speedbar-package-face) 15047 (eq face 'vhdl-speedbar-package-selected-face)) 15048 "Package") 15049 ((or (eq face 'vhdl-speedbar-instantiation-face) 15050 (eq face 'vhdl-speedbar-instantiation-selected-face)) 15051 "Instantiation") 15052 ((eq face 'vhdl-speedbar-subprogram-face) 15053 "Subprogram") 15054 (t "")) 15055 ;; design unit name 15056 (buffer-substring-no-properties 15057 (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) 15058 (match-end 1)) 15059 ;; file name 15060 (file-relative-name 15061 (or (car (get-text-property (point) 'speedbar-token)) 15062 "?") 15063 (vhdl-default-directory))))) 15064 (t (message ""))))) 15065 15066(defun vhdl-speedbar-line-text () 15067 "Calls `speedbar-line-text' and removes text properties." 15068 (let ((string (speedbar-line-text))) 15069 (set-text-properties 0 (length string) nil string) 15070 string)) 15071 15072(defun vhdl-speedbar-higher-text () 15073 "Get speedbar-line-text of higher level." 15074 (let (depth string) 15075 (save-excursion 15076 (beginning-of-line) 15077 (looking-at "^\\([0-9]+\\):") 15078 (setq depth (string-to-number (match-string 1))) 15079 (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) 15080 (setq string (match-string 1)) 15081 (set-text-properties 0 (length string) nil string) 15082 string)))) 15083 15084;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15085;; Help functions 15086 15087(defun vhdl-speedbar-line-key (&optional indent) 15088 "Get currently displayed directory of project name." 15089 (if vhdl-speedbar-show-projects 15090 (vhdl-speedbar-line-project) 15091 (abbreviate-file-name 15092 (file-name-as-directory (speedbar-line-directory indent))))) 15093 15094(defun vhdl-speedbar-line-project (&optional indent) 15095 "Get currently displayed project name." 15096 (and vhdl-speedbar-show-projects 15097 (save-excursion 15098 (end-of-line) 15099 (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) 15100 (match-string-no-properties 1)))) 15101 15102(defun vhdl-add-modified-file () 15103 "Add file to `vhdl-modified-file-list'." 15104 (when vhdl-file-alist 15105 (add-to-list 'vhdl-modified-file-list (buffer-file-name))) 15106 nil) 15107 15108(defun vhdl-resolve-paths (path-list) 15109 "Resolve path wildcards in PATH-LIST." 15110 (let (path-list-1 path-list-2 path-beg path-end dir) 15111 ;; eliminate non-existent directories 15112 (while path-list 15113 (setq dir (car path-list)) 15114 (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) 15115 (if (file-directory-p (match-string 2 dir)) 15116 (setq path-list-1 (cons dir path-list-1)) 15117 (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) 15118 (setq path-list (cdr path-list))) 15119 ;; resolve path wildcards 15120 (while path-list-1 15121 (setq dir (car path-list-1)) 15122 (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) 15123 (progn 15124 (setq path-beg (match-string 1 dir) 15125 path-end (match-string 5 dir)) 15126 (setq path-list-1 15127 (append 15128 (mapcar 15129 (function 15130 (lambda (var) (concat path-beg var path-end))) 15131 (let ((all-list (vhdl-directory-files 15132 (match-string 2 dir) t 15133 (concat "\\<" (wildcard-to-regexp 15134 (match-string 4 dir))))) 15135 dir-list) 15136 (while all-list 15137 (when (file-directory-p (car all-list)) 15138 (setq dir-list (cons (car all-list) dir-list))) 15139 (setq all-list (cdr all-list))) 15140 dir-list)) 15141 (cdr path-list-1)))) 15142 (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) 15143 (when (file-directory-p (match-string 2 dir)) 15144 (setq path-list-2 (cons dir path-list-2))) 15145 (setq path-list-1 (cdr path-list-1)))) 15146 (nreverse path-list-2))) 15147 15148(defun vhdl-speedbar-goto-this-unit (directory unit) 15149 "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." 15150 (let ((dest (point))) 15151 (if (and (if vhdl-speedbar-show-projects 15152 (progn (goto-char (point-min)) t) 15153 (speedbar-goto-this-file directory)) 15154 (re-search-forward (concat "[]}] " unit "\\>") nil t)) 15155 (progn (speedbar-position-cursor-on-line) 15156 t) 15157 (goto-char dest) 15158 nil))) 15159 15160(defun vhdl-speedbar-find-file (text token indent) 15161 "When user clicks on TEXT, load file with name and position in TOKEN. 15162Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file 15163is already shown in a buffer." 15164 (if (not (car token)) 15165 (error "ERROR: File cannot be found") 15166 (let ((buffer (get-file-buffer (car token)))) 15167 (speedbar-find-file-in-frame (car token)) 15168 (when (or vhdl-speedbar-jump-to-unit buffer) 15169 (goto-line (cdr token)) 15170 (recenter)) 15171 (vhdl-speedbar-update-current-unit t t) 15172 (speedbar-set-timer speedbar-update-speed) 15173 (speedbar-maybee-jump-to-attached-frame)))) 15174 15175(defun vhdl-speedbar-port-copy () 15176 "Copy the port of the entity/component or subprogram under the cursor." 15177 (interactive) 15178 (let ((is-entity (vhdl-speedbar-check-unit 'entity))) 15179 (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) 15180 (error "ERROR: No entity/component or subprogram under cursor") 15181 (beginning-of-line) 15182 (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") 15183 (condition-case info 15184 (let ((token (get-text-property 15185 (match-beginning 3) 'speedbar-token))) 15186 (vhdl-visit-file (car token) t 15187 (progn (goto-line (cdr token)) 15188 (end-of-line) 15189 (if is-entity 15190 (vhdl-port-copy) 15191 (vhdl-subprog-copy))))) 15192 (error (error "ERROR: %s not scanned successfully\n (%s)" 15193 (if is-entity "Port" "Interface") (cadr info)))) 15194 (error "ERROR: No entity/component or subprogram on current line"))))) 15195 15196(defun vhdl-speedbar-place-component () 15197 "Place the entity/component under the cursor as component." 15198 (interactive) 15199 (if (not (vhdl-speedbar-check-unit 'entity)) 15200 (error "ERROR: No entity/component under cursor") 15201 (vhdl-speedbar-port-copy) 15202 (if (fboundp 'speedbar-select-attached-frame) 15203 (speedbar-select-attached-frame) 15204 (select-frame speedbar-attached-frame)) 15205 (vhdl-compose-place-component) 15206 (select-frame speedbar-frame))) 15207 15208(defun vhdl-speedbar-configuration () 15209 "Generate configuration for the architecture under the cursor." 15210 (interactive) 15211 (if (not (vhdl-speedbar-check-unit 'architecture)) 15212 (error "ERROR: No architecture under cursor") 15213 (let ((arch-name (vhdl-speedbar-line-text)) 15214 (ent-name (vhdl-speedbar-higher-text))) 15215 (if (fboundp 'speedbar-select-attached-frame) 15216 (speedbar-select-attached-frame) 15217 (select-frame speedbar-attached-frame)) 15218 (vhdl-compose-configuration ent-name arch-name)))) 15219 15220(defun vhdl-speedbar-select-mra () 15221 "Select the architecture under the cursor as MRA." 15222 (interactive) 15223 (if (not (vhdl-speedbar-check-unit 'architecture)) 15224 (error "ERROR: No architecture under cursor") 15225 (let* ((arch-key (downcase (vhdl-speedbar-line-text))) 15226 (ent-key (downcase (vhdl-speedbar-higher-text))) 15227 (ent-alist (aget vhdl-entity-alist 15228 (or (vhdl-project-p) default-directory) t)) 15229 (ent-entry (aget ent-alist ent-key t))) 15230 (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) 15231 (speedbar-refresh)))) 15232 15233(defun vhdl-speedbar-make-design () 15234 "Make (compile) design unit or directory/project under the cursor." 15235 (interactive) 15236 (if (not (save-excursion (beginning-of-line) 15237 (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) 15238 (error "ERROR: No primary design unit or directory/project under cursor") 15239 (let ((is-unit (match-string 2)) 15240 (unit-name (vhdl-speedbar-line-text)) 15241 (vhdl-project (vhdl-speedbar-line-project)) 15242 (directory (file-name-as-directory 15243 (or (speedbar-line-file) (speedbar-line-directory))))) 15244 (if (fboundp 'speedbar-select-attached-frame) 15245 (speedbar-select-attached-frame) 15246 (select-frame speedbar-attached-frame)) 15247 (let ((default-directory directory)) 15248 (vhdl-make (and is-unit unit-name)))))) 15249 15250(defun vhdl-speedbar-generate-makefile () 15251 "Generate Makefile for directory/project under the cursor." 15252 (interactive) 15253 (let ((vhdl-project (vhdl-speedbar-line-project)) 15254 (default-directory (file-name-as-directory 15255 (or (speedbar-line-file) (speedbar-line-directory))))) 15256 (vhdl-generate-makefile))) 15257 15258(defun vhdl-speedbar-check-unit (design-unit) 15259 "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its 15260expansion function)." 15261 (save-excursion 15262 (speedbar-position-cursor-on-line) 15263 (cond ((eq design-unit 'entity) 15264 (memq (get-text-property (match-end 0) 'face) 15265 '(vhdl-speedbar-entity-face 15266 vhdl-speedbar-entity-selected-face))) 15267 ((eq design-unit 'architecture) 15268 (memq (get-text-property (match-end 0) 'face) 15269 '(vhdl-speedbar-architecture-face 15270 vhdl-speedbar-architecture-selected-face))) 15271 ((eq design-unit 'subprogram) 15272 (eq (get-text-property (match-end 0) 'face) 15273 'vhdl-speedbar-subprogram-face)) 15274 (t nil)))) 15275 15276(defun vhdl-speedbar-set-depth (depth) 15277 "Set hierarchy display depth to DEPTH and refresh speedbar." 15278 (setq vhdl-speedbar-hierarchy-depth depth) 15279 (speedbar-refresh)) 15280 15281;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15282;; Fontification 15283 15284(defface vhdl-speedbar-entity-face 15285 '((((class color) (background light)) (:foreground "ForestGreen")) 15286 (((class color) (background dark)) (:foreground "PaleGreen"))) 15287 "Face used for displaying entity names." 15288 :group 'speedbar-faces) 15289 15290(defface vhdl-speedbar-architecture-face 15291 '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) 15292 (((class color) (background light)) (:foreground "Blue")) 15293 15294 (((class color) (background dark)) (:foreground "LightSkyBlue"))) 15295 "Face used for displaying architecture names." 15296 :group 'speedbar-faces) 15297 15298(defface vhdl-speedbar-configuration-face 15299 '((((class color) (background light)) (:foreground "DarkGoldenrod")) 15300 (((class color) (background dark)) (:foreground "Salmon"))) 15301 "Face used for displaying configuration names." 15302 :group 'speedbar-faces) 15303 15304(defface vhdl-speedbar-package-face 15305 '((((class color) (background light)) (:foreground "Grey50")) 15306 (((class color) (background dark)) (:foreground "Grey80"))) 15307 "Face used for displaying package names." 15308 :group 'speedbar-faces) 15309 15310(defface vhdl-speedbar-library-face 15311 '((((class color) (background light)) (:foreground "Purple")) 15312 (((class color) (background dark)) (:foreground "Orchid1"))) 15313 "Face used for displaying library names." 15314 :group 'speedbar-faces) 15315 15316(defface vhdl-speedbar-instantiation-face 15317 '((((class color) (background light)) (:foreground "Brown")) 15318 (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) 15319 (((class color) (background dark)) (:foreground "Yellow"))) 15320 "Face used for displaying instantiation names." 15321 :group 'speedbar-faces) 15322 15323(defface vhdl-speedbar-subprogram-face 15324 '((((class color) (background light)) (:foreground "Orchid4")) 15325 (((class color) (background dark)) (:foreground "BurlyWood2"))) 15326 "Face used for displaying subprogram names." 15327 :group 'speedbar-faces) 15328 15329(defface vhdl-speedbar-entity-selected-face 15330 '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) 15331 (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) 15332 "Face used for displaying entity names." 15333 :group 'speedbar-faces) 15334 15335(defface vhdl-speedbar-architecture-selected-face 15336 '((((min-colors 88) (class color) (background light)) (:foreground 15337 "Blue1" :underline t)) 15338 (((class color) (background light)) (:foreground "Blue" :underline t)) 15339 (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) 15340 "Face used for displaying architecture names." 15341 :group 'speedbar-faces) 15342 15343(defface vhdl-speedbar-configuration-selected-face 15344 '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) 15345 (((class color) (background dark)) (:foreground "Salmon" :underline t))) 15346 "Face used for displaying configuration names." 15347 :group 'speedbar-faces) 15348 15349(defface vhdl-speedbar-package-selected-face 15350 '((((class color) (background light)) (:foreground "Grey50" :underline t)) 15351 (((class color) (background dark)) (:foreground "Grey80" :underline t))) 15352 "Face used for displaying package names." 15353 :group 'speedbar-faces) 15354 15355(defface vhdl-speedbar-instantiation-selected-face 15356 '((((class color) (background light)) (:foreground "Brown" :underline t)) 15357 (((class color) (background dark)) (:foreground "Yellow" :underline t))) 15358 "Face used for displaying instantiation names." 15359 :group 'speedbar-faces) 15360 15361;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15362;; Initialization 15363 15364;; add speedbar 15365(when (fboundp 'speedbar) 15366 (condition-case () 15367 (when (and vhdl-speedbar-auto-open 15368 (not (and (boundp 'speedbar-frame) 15369 (frame-live-p speedbar-frame)))) 15370 (speedbar-frame-mode 1) 15371 (if (fboundp 'speedbar-select-attached-frame) 15372 (speedbar-select-attached-frame) 15373 (select-frame speedbar-attached-frame))) 15374 (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar")))) 15375 15376;; initialize speedbar 15377(if (not (boundp 'speedbar-frame)) 15378 (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize) 15379 (vhdl-speedbar-initialize) 15380 (when speedbar-frame (vhdl-speedbar-refresh))) 15381 15382 15383;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15384;;; Structural composition 15385;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15386 15387(defun vhdl-get-components-package-name () 15388 "Return the name of the components package." 15389 (let ((project (vhdl-project-p))) 15390 (if project 15391 (vhdl-replace-string (car vhdl-components-package-name) 15392 (subst-char-in-string ? ?_ project)) 15393 (cdr vhdl-components-package-name)))) 15394 15395(defun vhdl-compose-new-component () 15396 "Create entity and architecture for new component." 15397 (interactive) 15398 (let* ((case-fold-search t) 15399 (ent-name (read-from-minibuffer "entity name: " 15400 nil vhdl-minibuffer-local-map)) 15401 (arch-name 15402 (if (equal (cdr vhdl-compose-architecture-name) "") 15403 (read-from-minibuffer "architecture name: " 15404 nil vhdl-minibuffer-local-map) 15405 (vhdl-replace-string vhdl-compose-architecture-name ent-name))) 15406 ent-file-name arch-file-name ent-buffer arch-buffer project) 15407 (message "Creating component \"%s(%s)\"..." ent-name arch-name) 15408 ;; open entity file 15409 (unless (eq vhdl-compose-create-files 'none) 15410 (setq ent-file-name 15411 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 15412 "." (file-name-extension (buffer-file-name)))) 15413 (when (and (file-exists-p ent-file-name) 15414 (not (y-or-n-p (concat "File \"" ent-file-name 15415 "\" exists; overwrite? ")))) 15416 (error "ERROR: Creating component...aborted")) 15417 (find-file ent-file-name) 15418 (erase-buffer) 15419 (set-buffer-modified-p nil)) 15420 ;; insert header 15421 (if vhdl-compose-include-header 15422 (progn (vhdl-template-header) 15423 (goto-char (point-max))) 15424 (vhdl-comment-display-line) (insert "\n\n")) 15425 ;; insert library clause 15426 (vhdl-template-package-std-logic-1164) 15427 (when vhdl-use-components-package 15428 (insert "\n") 15429 (vhdl-template-standard-package (vhdl-work-library) 15430 (vhdl-get-components-package-name))) 15431 (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") 15432 ;; insert entity declaration 15433 (vhdl-insert-keyword "ENTITY ") (insert ent-name) 15434 (vhdl-insert-keyword " IS\n") 15435 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 15436 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") 15437 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 15438 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 15439 (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") 15440 (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") 15441 (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) 15442 (vhdl-insert-keyword "END ") 15443 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) 15444 (insert ent-name ";\n\n") 15445 (vhdl-comment-display-line) (insert "\n") 15446 ;; open architecture file 15447 (if (not (eq vhdl-compose-create-files 'separate)) 15448 (insert "\n") 15449 (setq ent-buffer (current-buffer)) 15450 (setq arch-file-name 15451 (concat (vhdl-replace-string vhdl-architecture-file-name 15452 (concat ent-name " " arch-name) t) 15453 "." (file-name-extension (buffer-file-name)))) 15454 (when (and (file-exists-p arch-file-name) 15455 (not (y-or-n-p (concat "File \"" arch-file-name 15456 "\" exists; overwrite? ")))) 15457 (error "ERROR: Creating component...aborted")) 15458 (find-file arch-file-name) 15459 (erase-buffer) 15460 (set-buffer-modified-p nil) 15461 ;; insert header 15462 (if vhdl-compose-include-header 15463 (progn (vhdl-template-header) 15464 (goto-char (point-max))) 15465 (vhdl-comment-display-line) (insert "\n\n"))) 15466 ;; insert architecture body 15467 (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) 15468 (vhdl-insert-keyword " OF ") (insert ent-name) 15469 (vhdl-insert-keyword " IS\n\n") 15470 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 15471 (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") 15472 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 15473 (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) 15474 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 15475 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 15476 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) 15477 (vhdl-insert-keyword "BEGIN") 15478 (when vhdl-self-insert-comments 15479 (insert " -- ") 15480 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 15481 (insert arch-name)) 15482 (insert "\n\n") 15483 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 15484 (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") 15485 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 15486 (vhdl-insert-keyword "END ") 15487 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) 15488 (insert arch-name ";\n\n") 15489 ;; insert footer and save 15490 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 15491 (vhdl-template-footer) 15492 (vhdl-comment-display-line) (insert "\n")) 15493 (goto-char (point-min)) 15494 (setq arch-buffer (current-buffer)) 15495 (when ent-buffer (set-buffer ent-buffer) (save-buffer)) 15496 (set-buffer arch-buffer) (save-buffer) 15497 (message "%s" 15498 (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) 15499 (and ent-file-name 15500 (format "\n File created: \"%s\"" ent-file-name)) 15501 (and arch-file-name 15502 (format "\n File created: \"%s\"" arch-file-name)))))) 15503 15504(defun vhdl-compose-place-component () 15505 "Place new component by pasting current port as component declaration and 15506component instantiation." 15507 (interactive) 15508 (if (not vhdl-port-list) 15509 (error "ERROR: No port has been read") 15510 (save-excursion 15511 (vhdl-prepare-search-2 15512 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 15513 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)) 15514 (error "ERROR: No architecture found")) 15515 (let* ((ent-name (match-string 1)) 15516 (ent-file-name 15517 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 15518 "." (file-name-extension (buffer-file-name)))) 15519 (orig-buffer (current-buffer))) 15520 (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) 15521 ;; place component declaration 15522 (unless (or vhdl-use-components-package 15523 (vhdl-use-direct-instantiation) 15524 (save-excursion 15525 (re-search-forward 15526 (concat "^\\s-*component\\s-+" 15527 (car vhdl-port-list) "\\>") nil t))) 15528 (re-search-forward "^begin\\>" nil) 15529 (beginning-of-line) 15530 (skip-chars-backward " \t\n") 15531 (insert "\n\n") (indent-to vhdl-basic-offset) 15532 (vhdl-port-paste-component t)) 15533 ;; place component instantiation 15534 (re-search-forward "^end\\>" nil) 15535 (beginning-of-line) 15536 (skip-chars-backward " \t\n") 15537 (insert "\n\n") (indent-to vhdl-basic-offset) 15538 (vhdl-port-paste-instance nil t t) 15539 ;; place use clause for used packages 15540 (when (nth 3 vhdl-port-list) 15541 ;; open entity file 15542 (when (file-exists-p ent-file-name) 15543 (find-file ent-file-name)) 15544 (goto-char (point-min)) 15545 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t) 15546 (error "ERROR: Entity not found: \"%s\"" ent-name)) 15547 (goto-char (match-beginning 0)) 15548 (if (and (save-excursion 15549 (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) 15550 (match-string 1)) 15551 (progn (goto-char (match-end 0)) 15552 (beginning-of-line 2)) 15553 (insert "\n") 15554 (backward-char)) 15555 (vhdl-port-paste-context-clause) 15556 (switch-to-buffer orig-buffer)) 15557 (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) 15558 15559(defun vhdl-compose-wire-components () 15560 "Connect components." 15561 (interactive) 15562 (save-excursion 15563 (vhdl-prepare-search-2 15564 (unless (or (re-search-backward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t) 15565 (re-search-forward "^architecture[ \t\n]+\\w+[ \t\n]+of[ \t\n]+\\(\\w+\\)[ \t\n]+is\\>" nil t)) 15566 (error "ERROR: No architecture found")) 15567 (let* ((ent-name (match-string 1)) 15568 (ent-file-name 15569 (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) 15570 "." (file-name-extension (buffer-file-name)))) 15571 (arch-decl-pos (point-marker)) 15572 (arch-stat-pos (re-search-forward "^begin\\>" nil)) 15573 (arch-end-pos (re-search-forward "^end\\>" nil)) 15574 (pack-name (vhdl-get-components-package-name)) 15575 (pack-file-name 15576 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 15577 "." (file-name-extension (buffer-file-name)))) 15578 inst-name comp-name comp-ent-name comp-ent-file-name has-generic 15579 port-alist generic-alist inst-alist 15580 signal-name signal-entry signal-alist local-list written-list 15581 single-in-list multi-in-list single-out-list multi-out-list 15582 constant-name constant-entry constant-alist single-list multi-list 15583 port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos 15584 generic-beg-pos generic-pos generic-inst-pos generic-end-pos 15585 signal-beg-pos signal-pos 15586 constant-temp-pos port-temp-pos signal-temp-pos) 15587 (message "Wiring components...") 15588 ;; process all instances 15589 (goto-char arch-stat-pos) 15590 (while (re-search-forward 15591 (concat "^[ \t]*\\(\\w+\\)[ \t\n]*:[ \t\n]*\\(" 15592 "\\(component[ \t\n]+\\)?\\(\\w+\\)" 15593 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\|" 15594 "\\(\\(entity\\)\\|configuration\\)[ \t\n]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n]*(\\(\\w+\\))\\)?" 15595 "[ \t\n]+\\(--[^\n]*\n[ \t\n]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n]+map\\)[ \t\n]*(") arch-end-pos t) 15596 (setq inst-name (match-string-no-properties 1) 15597 comp-name (match-string-no-properties 4) 15598 comp-ent-name (match-string-no-properties 12) 15599 has-generic (or (match-string 7) (match-string 17))) 15600 ;; get port ... 15601 (if comp-name 15602 ;; ... from component declaration 15603 (vhdl-visit-file 15604 (when vhdl-use-components-package pack-file-name) t 15605 (save-excursion 15606 (goto-char (point-min)) 15607 (unless (re-search-forward (concat "^\\s-*component[ \t\n]+" comp-name "\\>") nil t) 15608 (error "ERROR: Component declaration not found: \"%s\"" comp-name)) 15609 (vhdl-port-copy))) 15610 ;; ... from entity declaration (direct instantiation) 15611 (setq comp-ent-file-name 15612 (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) 15613 "." (file-name-extension (buffer-file-name)))) 15614 (vhdl-visit-file 15615 comp-ent-file-name t 15616 (save-excursion 15617 (goto-char (point-min)) 15618 (unless (re-search-forward (concat "^\\s-*entity[ \t\n]+" comp-ent-name "\\>") nil t) 15619 (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) 15620 (vhdl-port-copy)))) 15621 (vhdl-port-flatten t) 15622 (setq generic-alist (nth 1 vhdl-port-list) 15623 port-alist (nth 2 vhdl-port-list) 15624 vhdl-port-list nil) 15625 (setq constant-alist nil 15626 signal-alist nil) 15627 (when has-generic 15628 ;; process all constants in generic map 15629 (vhdl-forward-syntactic-ws) 15630 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t) 15631 (setq constant-name (match-string-no-properties 3)) 15632 (setq constant-entry 15633 (cons constant-name 15634 (if (match-string 1) 15635 (or (aget generic-alist (match-string 2) t) 15636 (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 15637 (cdar generic-alist)))) 15638 (setq constant-alist (cons constant-entry constant-alist)) 15639 (setq constant-name (downcase constant-name)) 15640 (if (or (member constant-name single-list) 15641 (member constant-name multi-list)) 15642 (progn (setq single-list (delete constant-name single-list)) 15643 (add-to-list 'multi-list constant-name)) 15644 (add-to-list 'single-list constant-name)) 15645 (unless (match-string 1) 15646 (setq generic-alist (cdr generic-alist))) 15647 (vhdl-forward-syntactic-ws)) 15648 (vhdl-re-search-forward "\\<port\\s-+map[ \t\n]*(" nil t)) 15649 ;; process all signals in port map 15650 (vhdl-forward-syntactic-ws) 15651 (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n]*=>[ \t\n]*\\)?\\(\\w+\\),?" t) 15652 (setq signal-name (match-string-no-properties 3)) 15653 (setq signal-entry (cons signal-name 15654 (if (match-string 1) 15655 (or (aget port-alist (match-string 2) t) 15656 (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) 15657 (cdar port-alist)))) 15658 (setq signal-alist (cons signal-entry signal-alist)) 15659 (setq signal-name (downcase signal-name)) 15660 (if (equal (upcase (nth 2 signal-entry)) "IN") 15661 ;; input signal 15662 (cond 15663 ((member signal-name local-list) 15664 nil) 15665 ((or (member signal-name single-out-list) 15666 (member signal-name multi-out-list)) 15667 (setq single-out-list (delete signal-name single-out-list)) 15668 (setq multi-out-list (delete signal-name multi-out-list)) 15669 (add-to-list 'local-list signal-name)) 15670 ((member signal-name single-in-list) 15671 (setq single-in-list (delete signal-name single-in-list)) 15672 (add-to-list 'multi-in-list signal-name)) 15673 ((not (member signal-name multi-in-list)) 15674 (add-to-list 'single-in-list signal-name))) 15675 ;; output signal 15676 (cond 15677 ((member signal-name local-list) 15678 nil) 15679 ((or (member signal-name single-in-list) 15680 (member signal-name multi-in-list)) 15681 (setq single-in-list (delete signal-name single-in-list)) 15682 (setq multi-in-list (delete signal-name multi-in-list)) 15683 (add-to-list 'local-list signal-name)) 15684 ((member signal-name single-out-list) 15685 (setq single-out-list (delete signal-name single-out-list)) 15686 (add-to-list 'multi-out-list signal-name)) 15687 ((not (member signal-name multi-out-list)) 15688 (add-to-list 'single-out-list signal-name)))) 15689 (unless (match-string 1) 15690 (setq port-alist (cdr port-alist))) 15691 (vhdl-forward-syntactic-ws)) 15692 (setq inst-alist (cons (list inst-name (nreverse constant-alist) 15693 (nreverse signal-alist)) inst-alist))) 15694 ;; prepare signal insertion 15695 (vhdl-goto-marker arch-decl-pos) 15696 (forward-line 1) 15697 (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n]*-*\n" arch-stat-pos t) 15698 (setq signal-pos (point-marker)) 15699 (while (progn (vhdl-forward-syntactic-ws) 15700 (looking-at "signal\\>")) 15701 (beginning-of-line 2) 15702 (delete-region signal-pos (point))) 15703 (setq signal-beg-pos signal-pos) 15704 ;; open entity file 15705 (when (file-exists-p ent-file-name) 15706 (find-file ent-file-name)) 15707 (goto-char (point-min)) 15708 (unless (re-search-forward (concat "^entity[ \t\n]+" ent-name "[ \t\n]+is\\>") nil t) 15709 (error "ERROR: Entity not found: \"%s\"" ent-name)) 15710 ;; prepare generic clause insertion 15711 (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n]*(\\)\\|^end\\>" nil t) 15712 (match-string 1)) 15713 (goto-char (match-beginning 0)) 15714 (indent-to vhdl-basic-offset) 15715 (insert "generic ();\n\n") 15716 (backward-char 4)) 15717 (backward-char) 15718 (setq generic-pos (point-marker)) 15719 (forward-sexp) (end-of-line) 15720 (delete-region generic-pos (point)) (delete-char 1) 15721 (insert "(\n") 15722 (when multi-list 15723 (insert "\n") 15724 (indent-to (* 2 vhdl-basic-offset)) 15725 (insert "-- global generics\n")) 15726 (setq generic-beg-pos (point-marker) generic-pos (point-marker) 15727 generic-inst-pos (point-marker) generic-end-pos (point-marker)) 15728 ;; prepare port clause insertion 15729 (unless (and (re-search-forward "\\(^\\s-*port[ \t\n]*(\\)\\|^end\\>" nil t) 15730 (match-string 1)) 15731 (goto-char (match-beginning 0)) 15732 (indent-to vhdl-basic-offset) 15733 (insert "port ();\n\n") 15734 (backward-char 4)) 15735 (backward-char) 15736 (setq port-in-pos (point-marker)) 15737 (forward-sexp) (end-of-line) 15738 (delete-region port-in-pos (point)) (delete-char 1) 15739 (insert "(\n") 15740 (when (or multi-in-list multi-out-list) 15741 (insert "\n") 15742 (indent-to (* 2 vhdl-basic-offset)) 15743 (insert "-- global ports\n")) 15744 (setq port-beg-pos (point-marker) port-in-pos (point-marker) 15745 port-out-pos (point-marker) port-inst-pos (point-marker) 15746 port-end-pos (point-marker)) 15747 ;; insert generics, ports and signals 15748 (setq inst-alist (nreverse inst-alist)) 15749 (while inst-alist 15750 (setq inst-name (nth 0 (car inst-alist)) 15751 constant-alist (nth 1 (car inst-alist)) 15752 signal-alist (nth 2 (car inst-alist)) 15753 constant-temp-pos generic-inst-pos 15754 port-temp-pos port-inst-pos 15755 signal-temp-pos signal-pos) 15756 ;; generics 15757 (while constant-alist 15758 (setq constant-name (downcase (caar constant-alist)) 15759 constant-entry (car constant-alist)) 15760 (cond ((member constant-name written-list) 15761 nil) 15762 ((member constant-name multi-list) 15763 (vhdl-goto-marker generic-pos) 15764 (setq generic-end-pos 15765 (vhdl-max-marker 15766 generic-end-pos 15767 (vhdl-compose-insert-generic constant-entry))) 15768 (setq generic-pos (point-marker)) 15769 (add-to-list 'written-list constant-name)) 15770 (t 15771 (vhdl-goto-marker 15772 (vhdl-max-marker generic-inst-pos generic-pos)) 15773 (setq generic-end-pos 15774 (vhdl-compose-insert-generic constant-entry)) 15775 (setq generic-inst-pos (point-marker)) 15776 (add-to-list 'written-list constant-name))) 15777 (setq constant-alist (cdr constant-alist))) 15778 (when (/= constant-temp-pos generic-inst-pos) 15779 (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) 15780 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 15781 (insert "-- generics for \"" inst-name "\"\n") 15782 (vhdl-goto-marker generic-inst-pos)) 15783 ;; ports and signals 15784 (while signal-alist 15785 (setq signal-name (downcase (caar signal-alist)) 15786 signal-entry (car signal-alist)) 15787 (cond ((member signal-name written-list) 15788 nil) 15789 ((member signal-name multi-in-list) 15790 (vhdl-goto-marker port-in-pos) 15791 (setq port-end-pos 15792 (vhdl-max-marker 15793 port-end-pos (vhdl-compose-insert-port signal-entry))) 15794 (setq port-in-pos (point-marker)) 15795 (add-to-list 'written-list signal-name)) 15796 ((member signal-name multi-out-list) 15797 (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) 15798 (setq port-end-pos 15799 (vhdl-max-marker 15800 port-end-pos (vhdl-compose-insert-port signal-entry))) 15801 (setq port-out-pos (point-marker)) 15802 (add-to-list 'written-list signal-name)) 15803 ((or (member signal-name single-in-list) 15804 (member signal-name single-out-list)) 15805 (vhdl-goto-marker 15806 (vhdl-max-marker 15807 port-inst-pos 15808 (vhdl-max-marker port-out-pos port-in-pos))) 15809 (setq port-end-pos (vhdl-compose-insert-port signal-entry)) 15810 (setq port-inst-pos (point-marker)) 15811 (add-to-list 'written-list signal-name)) 15812 ((equal (upcase (nth 2 signal-entry)) "OUT") 15813 (vhdl-goto-marker signal-pos) 15814 (vhdl-compose-insert-signal signal-entry) 15815 (setq signal-pos (point-marker)) 15816 (add-to-list 'written-list signal-name))) 15817 (setq signal-alist (cdr signal-alist))) 15818 (when (/= port-temp-pos port-inst-pos) 15819 (vhdl-goto-marker 15820 (vhdl-max-marker port-temp-pos 15821 (vhdl-max-marker port-in-pos port-out-pos))) 15822 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 15823 (insert "-- ports to \"" inst-name "\"\n") 15824 (vhdl-goto-marker port-inst-pos)) 15825 (when (/= signal-temp-pos signal-pos) 15826 (vhdl-goto-marker signal-temp-pos) 15827 (insert "\n") (indent-to vhdl-basic-offset) 15828 (insert "-- outputs of \"" inst-name "\"\n") 15829 (vhdl-goto-marker signal-pos)) 15830 (setq inst-alist (cdr inst-alist))) 15831 ;; finalize generic/port clause 15832 (vhdl-goto-marker generic-end-pos) (backward-char) 15833 (when (= generic-beg-pos generic-end-pos) 15834 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 15835 (insert ";") (backward-char)) 15836 (insert ")") 15837 (vhdl-goto-marker port-end-pos) (backward-char) 15838 (when (= port-beg-pos port-end-pos) 15839 (insert "\n") (indent-to (* 2 vhdl-basic-offset)) 15840 (insert ";") (backward-char)) 15841 (insert ")") 15842 ;; align everything 15843 (when vhdl-auto-align 15844 (vhdl-goto-marker generic-beg-pos) 15845 (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) 15846 (vhdl-align-region-groups port-beg-pos port-end-pos 1) 15847 (vhdl-goto-marker signal-beg-pos) 15848 (vhdl-align-region-groups signal-beg-pos signal-pos)) 15849 (switch-to-buffer (marker-buffer signal-beg-pos)) 15850 (message "Wiring components...done"))))) 15851 15852(defun vhdl-compose-insert-generic (entry) 15853 "Insert ENTRY as generic declaration." 15854 (let (pos) 15855 (indent-to (* 2 vhdl-basic-offset)) 15856 (insert (nth 0 entry) " : " (nth 1 entry)) 15857 (when (nth 2 entry) 15858 (insert " := " (nth 2 entry))) 15859 (insert ";") 15860 (setq pos (point-marker)) 15861 (when (and vhdl-include-port-comments (nth 3 entry)) 15862 (vhdl-comment-insert-inline (nth 3 entry) t)) 15863 (insert "\n") 15864 pos)) 15865 15866(defun vhdl-compose-insert-port (entry) 15867 "Insert ENTRY as port declaration." 15868 (let (pos) 15869 (indent-to (* 2 vhdl-basic-offset)) 15870 (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") 15871 (setq pos (point-marker)) 15872 (when (and vhdl-include-port-comments (nth 4 entry)) 15873 (vhdl-comment-insert-inline (nth 4 entry) t)) 15874 (insert "\n") 15875 pos)) 15876 15877(defun vhdl-compose-insert-signal (entry) 15878 "Insert ENTRY as signal declaration." 15879 (indent-to vhdl-basic-offset) 15880 (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") 15881 (when (and vhdl-include-port-comments (nth 4 entry)) 15882 (vhdl-comment-insert-inline (nth 4 entry) t)) 15883 (insert "\n")) 15884 15885(defun vhdl-compose-components-package () 15886 "Generate a package containing component declarations for all entities in the 15887current project/directory." 15888 (interactive) 15889 (vhdl-require-hierarchy-info) 15890 (let* ((project (vhdl-project-p)) 15891 (pack-name (vhdl-get-components-package-name)) 15892 (pack-file-name 15893 (concat (vhdl-replace-string vhdl-package-file-name pack-name t) 15894 "." (file-name-extension (buffer-file-name)))) 15895 (ent-alist (aget vhdl-entity-alist 15896 (or project default-directory) t)) 15897 (lazy-lock-minimum-size 0) 15898 clause-pos component-pos) 15899 (message "Generating components package \"%s\"..." pack-name) 15900 ;; open package file 15901 (when (and (file-exists-p pack-file-name) 15902 (not (y-or-n-p (concat "File \"" pack-file-name 15903 "\" exists; overwrite? ")))) 15904 (error "ERROR: Generating components package...aborted")) 15905 (find-file pack-file-name) 15906 (erase-buffer) 15907 ;; insert header 15908 (if vhdl-compose-include-header 15909 (progn (vhdl-template-header 15910 (concat "Components package (generated by Emacs VHDL Mode " 15911 vhdl-version ")")) 15912 (goto-char (point-max))) 15913 (vhdl-comment-display-line) (insert "\n\n")) 15914 ;; insert std_logic_1164 package 15915 (vhdl-template-package-std-logic-1164) 15916 (insert "\n") (setq clause-pos (point-marker)) 15917 (insert "\n") (vhdl-comment-display-line) (insert "\n\n") 15918 ;; insert package declaration 15919 (vhdl-insert-keyword "PACKAGE ") (insert pack-name) 15920 (vhdl-insert-keyword " IS\n\n") 15921 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") 15922 (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") 15923 (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") 15924 (indent-to vhdl-basic-offset) 15925 (setq component-pos (point-marker)) 15926 (insert "\n\n") (vhdl-insert-keyword "END ") 15927 (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) 15928 (insert pack-name ";\n\n") 15929 ;; insert footer 15930 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 15931 (vhdl-template-footer) 15932 (vhdl-comment-display-line) (insert "\n")) 15933 ;; insert component declarations 15934 (while ent-alist 15935 (vhdl-visit-file (nth 2 (car ent-alist)) nil 15936 (progn (goto-line (nth 3 (car ent-alist))) 15937 (end-of-line) 15938 (vhdl-port-copy))) 15939 (goto-char component-pos) 15940 (vhdl-port-paste-component t) 15941 (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) 15942 (setq component-pos (point-marker)) 15943 (goto-char clause-pos) 15944 (vhdl-port-paste-context-clause pack-name) 15945 (setq clause-pos (point-marker)) 15946 (setq ent-alist (cdr ent-alist))) 15947 (goto-char (point-min)) 15948 (save-buffer) 15949 (message "Generating components package \"%s\"...done\n File created: \"%s\"" 15950 pack-name pack-file-name))) 15951 15952(defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist 15953 &optional insert-conf) 15954 "Generate block configuration for architecture." 15955 (let ((margin (current-indentation)) 15956 (beg (save-excursion (beginning-of-line) (point))) 15957 ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) 15958 ;; insert block configuration (for architecture) 15959 (vhdl-insert-keyword "FOR ") (insert arch-name "\n") 15960 (setq margin (+ margin vhdl-basic-offset)) 15961 ;; process all instances 15962 (while inst-alist 15963 (setq inst-entry (car inst-alist)) 15964 ;; is component? 15965 (when (nth 4 inst-entry) 15966 (setq insert-conf t) 15967 (setq inst-path (nth 9 inst-entry)) 15968 ;; skip common path with previous instance 15969 (while (and inst-path (equal (car inst-path) (car inst-prev-path))) 15970 (setq inst-path (cdr inst-path) 15971 inst-prev-path (cdr inst-prev-path))) 15972 ;; insert block configuration end (for previous block/generate) 15973 (while inst-prev-path 15974 (setq margin (- margin vhdl-basic-offset)) 15975 (indent-to margin) 15976 (vhdl-insert-keyword "END FOR;\n") 15977 (setq inst-prev-path (cdr inst-prev-path))) 15978 ;; insert block configuration beginning (for current block/generate) 15979 (indent-to margin) 15980 (while inst-path 15981 (setq margin (+ margin vhdl-basic-offset)) 15982 (vhdl-insert-keyword "FOR ") 15983 (insert (car inst-path) "\n") 15984 (indent-to margin) 15985 (setq inst-path (cdr inst-path))) 15986 ;; insert component configuration beginning 15987 (vhdl-insert-keyword "FOR ") 15988 (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") 15989 ;; find subconfiguration 15990 (setq conf-key (nth 7 inst-entry)) 15991 (setq tmp-alist conf-alist) 15992 ;; use first configuration found for instance's entity 15993 (while (and tmp-alist (null conf-key)) 15994 (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) 15995 (setq conf-key (nth 0 (car tmp-alist)))) 15996 (setq tmp-alist (cdr tmp-alist))) 15997 (setq conf-entry (aget conf-alist conf-key t)) 15998 ;; insert binding indication ... 15999 ;; ... with subconfiguration (if exists) 16000 (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) 16001 (progn 16002 (indent-to (+ margin vhdl-basic-offset)) 16003 (vhdl-insert-keyword "USE CONFIGURATION ") 16004 (insert (vhdl-work-library) "." (nth 0 conf-entry)) 16005 (insert ";\n")) 16006 ;; ... with entity (if exists) 16007 (setq ent-entry (aget ent-alist (nth 5 inst-entry) t)) 16008 (when ent-entry 16009 (indent-to (+ margin vhdl-basic-offset)) 16010 (vhdl-insert-keyword "USE ENTITY ") 16011 (insert (vhdl-work-library) "." (nth 0 ent-entry)) 16012 ;; insert architecture name (if architecture exists) 16013 (when (nth 3 ent-entry) 16014 (setq arch-name 16015 ;; choose architecture name a) from configuration, 16016 ;; b) from mra, or c) from first architecture 16017 (or (nth 0 (aget (nth 3 ent-entry) 16018 (or (nth 6 inst-entry) 16019 (nth 4 ent-entry)) t)) 16020 (nth 1 (car (nth 3 ent-entry))))) 16021 (insert "(" arch-name ")")) 16022 (insert ";\n") 16023 ;; insert block configuration (for architecture of subcomponent) 16024 (when (and vhdl-compose-configuration-hierarchical 16025 (nth 3 ent-entry)) 16026 (indent-to (+ margin vhdl-basic-offset)) 16027 (vhdl-compose-configuration-architecture 16028 (nth 0 ent-entry) arch-name 16029 (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t)))))) 16030 ;; insert component configuration end 16031 (indent-to margin) 16032 (vhdl-insert-keyword "END FOR;\n") 16033 (setq inst-prev-path (nth 9 inst-entry))) 16034 (setq inst-alist (cdr inst-alist))) 16035 ;; insert block configuration end (for block/generate) 16036 (while inst-prev-path 16037 (setq margin (- margin vhdl-basic-offset)) 16038 (indent-to margin) 16039 (vhdl-insert-keyword "END FOR;\n") 16040 (setq inst-prev-path (cdr inst-prev-path))) 16041 (indent-to (- margin vhdl-basic-offset)) 16042 ;; insert block configuration end or remove beginning (for architecture) 16043 (if insert-conf 16044 (vhdl-insert-keyword "END FOR;\n") 16045 (delete-region beg (point))))) 16046 16047(defun vhdl-compose-configuration (&optional ent-name arch-name) 16048 "Generate configuration declaration." 16049 (interactive) 16050 (vhdl-require-hierarchy-info) 16051 (let ((ent-alist (aget vhdl-entity-alist 16052 (or (vhdl-project-p) default-directory) t)) 16053 (conf-alist (aget vhdl-config-alist 16054 (or (vhdl-project-p) default-directory) t)) 16055 (from-speedbar ent-name) 16056 inst-alist conf-name conf-file-name pos) 16057 (vhdl-prepare-search-2 16058 ;; get entity and architecture name 16059 (unless ent-name 16060 (save-excursion 16061 (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) 16062 (not (equal "END" (upcase (match-string 1)))) 16063 (setq ent-name (match-string-no-properties 3)) 16064 (setq arch-name (match-string-no-properties 2))) 16065 (error "ERROR: Not within an architecture")))) 16066 (setq conf-name (vhdl-replace-string 16067 vhdl-compose-configuration-name 16068 (concat ent-name " " arch-name))) 16069 (setq inst-alist 16070 (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t)) 16071 (downcase arch-name) t)))) 16072 (message "Generating configuration \"%s\"..." conf-name) 16073 (if vhdl-compose-configuration-create-file 16074 ;; open configuration file 16075 (progn 16076 (setq conf-file-name 16077 (concat (vhdl-replace-string vhdl-configuration-file-name 16078 conf-name t) 16079 "." (file-name-extension (buffer-file-name)))) 16080 (when (and (file-exists-p conf-file-name) 16081 (not (y-or-n-p (concat "File \"" conf-file-name 16082 "\" exists; overwrite? ")))) 16083 (error "ERROR: Creating configuration...aborted")) 16084 (find-file conf-file-name) 16085 (erase-buffer) 16086 (set-buffer-modified-p nil) 16087 ;; insert header 16088 (if vhdl-compose-include-header 16089 (progn (vhdl-template-header 16090 (concat "Configuration declaration for design \"" 16091 ent-name "(" arch-name ")\"")) 16092 (goto-char (point-max))) 16093 (vhdl-comment-display-line) (insert "\n\n"))) 16094 ;; goto end of architecture 16095 (unless from-speedbar 16096 (re-search-forward "^end\\>" nil) 16097 (end-of-line) (insert "\n\n") 16098 (vhdl-comment-display-line) (insert "\n\n"))) 16099 ;; insert library clause 16100 (setq pos (point)) 16101 (vhdl-template-standard-package (vhdl-work-library) nil) 16102 (when (/= pos (point)) 16103 (insert "\n\n")) 16104 ;; insert configuration 16105 (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) 16106 (vhdl-insert-keyword " OF ") (insert ent-name) 16107 (vhdl-insert-keyword " IS\n") 16108 (indent-to vhdl-basic-offset) 16109 ;; insert block configuration (for architecture) 16110 (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t) 16111 (vhdl-insert-keyword "END ") (insert conf-name ";") 16112 (when conf-file-name 16113 ;; insert footer and save 16114 (insert "\n\n") 16115 (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) 16116 (vhdl-template-footer) 16117 (vhdl-comment-display-line) (insert "\n")) 16118 (save-buffer)) 16119 (message "%s" 16120 (concat (format "Generating configuration \"%s\"...done" conf-name) 16121 (and conf-file-name 16122 (format "\n File created: \"%s\"" conf-file-name)))))) 16123 16124 16125;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16126;;; Compilation / Makefile generation 16127;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16128;; (using `compile.el') 16129 16130(defun vhdl-makefile-name () 16131 "Return the Makefile name of the current project or the current compiler if 16132no project is defined." 16133 (let ((project-alist (aget vhdl-project-alist vhdl-project)) 16134 (compiler-alist (aget vhdl-compiler-alist vhdl-compiler))) 16135 (vhdl-replace-string 16136 (cons "\\(.*\\)\n\\(.*\\)" 16137 (or (nth 8 project-alist) (nth 8 compiler-alist))) 16138 (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) 16139 16140(defun vhdl-compile-directory () 16141 "Return the directory where compilation/make should be run." 16142 (let* ((project (aget vhdl-project-alist (vhdl-project-p t))) 16143 (compiler (aget vhdl-compiler-alist vhdl-compiler)) 16144 (directory (vhdl-resolve-env-variable 16145 (if project 16146 (vhdl-replace-string 16147 (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) 16148 (nth 6 compiler))))) 16149 (file-name-as-directory 16150 (if (file-name-absolute-p directory) 16151 directory 16152 (expand-file-name directory (vhdl-default-directory)))))) 16153 16154(defun vhdl-uniquify (in-list) 16155 "Remove duplicate elements from IN-LIST." 16156 (let (out-list) 16157 (while in-list 16158 (add-to-list 'out-list (car in-list)) 16159 (setq in-list (cdr in-list))) 16160 out-list)) 16161 16162(defun vhdl-set-compiler (name) 16163 "Set current compiler to NAME." 16164 (interactive 16165 (list (let ((completion-ignore-case t)) 16166 (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) 16167 (if (assoc name vhdl-compiler-alist) 16168 (progn (setq vhdl-compiler name) 16169 (message "Current compiler: \"%s\"" vhdl-compiler)) 16170 (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) 16171 16172;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16173;; Compilation 16174 16175(defun vhdl-compile-init () 16176 "Initialize for compilation." 16177 (when (or (null compilation-error-regexp-alist) 16178 (not (assoc (car (nth 11 (car vhdl-compiler-alist))) 16179 compilation-error-regexp-alist))) 16180 ;; `compilation-error-regexp-alist' 16181 (let ((commands-alist vhdl-compiler-alist) 16182 regexp-alist sublist) 16183 (while commands-alist 16184 (setq sublist (nth 11 (car commands-alist))) 16185 (unless (or (equal "" (car sublist)) 16186 (assoc (car sublist) regexp-alist)) 16187 (setq regexp-alist (cons (list (nth 0 sublist) 16188 (if (= 0 (nth 1 sublist)) 16189 (if vhdl-xemacs 9 nil) 16190 (nth 1 sublist)) 16191 (nth 2 sublist) (nth 3 sublist)) 16192 regexp-alist))) 16193 (setq commands-alist (cdr commands-alist))) 16194 (setq compilation-error-regexp-alist 16195 (append compilation-error-regexp-alist (nreverse regexp-alist)))) 16196 ;; `compilation-file-regexp-alist' 16197 (let ((commands-alist vhdl-compiler-alist) 16198 regexp-alist sublist) 16199 ;; matches vhdl-mode file name output 16200 (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) 16201 (while commands-alist 16202 (setq sublist (nth 12 (car commands-alist))) 16203 (unless (or (equal "" (car sublist)) 16204 (assoc (car sublist) regexp-alist)) 16205 (setq regexp-alist (cons sublist regexp-alist))) 16206 (setq commands-alist (cdr commands-alist))) 16207 (setq compilation-file-regexp-alist 16208 (append compilation-file-regexp-alist (nreverse regexp-alist)))))) 16209 16210(defvar vhdl-compile-file-name nil 16211 "Name of file to be compiled.") 16212 16213(defun vhdl-compile-print-file-name () 16214 "Function called within `compile' to print out file name for compilers that 16215do not print any file names." 16216 (insert "Compiling \"" vhdl-compile-file-name "\"\n")) 16217 16218(defun vhdl-get-compile-options (project compiler file-name 16219 &optional file-options-only) 16220 "Get compiler options. Returning nil means do not compile this file." 16221 (let* ((compiler-options (nth 1 compiler)) 16222 (project-entry (aget (nth 4 project) vhdl-compiler)) 16223 (project-options (nth 0 project-entry)) 16224 (exception-list (and file-name (nth 2 project-entry))) 16225 (work-library (vhdl-work-library)) 16226 (case-fold-search nil) 16227 file-options) 16228 (while (and exception-list 16229 (not (string-match (caar exception-list) file-name))) 16230 (setq exception-list (cdr exception-list))) 16231 (if (and exception-list (not (cdar exception-list))) 16232 nil 16233 (if (and file-options-only (not exception-list)) 16234 'default 16235 (setq file-options (cdar exception-list)) 16236 ;; insert library name in compiler-specific options 16237 (setq compiler-options 16238 (vhdl-replace-string (cons "\\(.*\\)" compiler-options) 16239 work-library)) 16240 ;; insert compiler-specific options in project-specific options 16241 (when project-options 16242 (setq project-options 16243 (vhdl-replace-string 16244 (cons "\\(.*\\)\n\\(.*\\)" project-options) 16245 (concat work-library "\n" compiler-options)))) 16246 ;; insert project-specific options in file-specific options 16247 (when file-options 16248 (setq file-options 16249 (vhdl-replace-string 16250 (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) 16251 (concat work-library "\n" compiler-options "\n" 16252 project-options)))) 16253 ;; return options 16254 (or file-options project-options compiler-options))))) 16255 16256(defun vhdl-get-make-options (project compiler) 16257 "Get make options." 16258 (let* ((compiler-options (nth 3 compiler)) 16259 (project-entry (aget (nth 4 project) vhdl-compiler)) 16260 (project-options (nth 1 project-entry)) 16261 (makefile-name (vhdl-makefile-name))) 16262 ;; insert Makefile name in compiler-specific options 16263 (setq compiler-options 16264 (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) 16265 makefile-name)) 16266 ;; insert compiler-specific options in project-specific options 16267 (when project-options 16268 (setq project-options 16269 (vhdl-replace-string 16270 (cons "\\(.*\\)\n\\(.*\\)" project-options) 16271 (concat makefile-name "\n" compiler-options)))) 16272 ;; return options 16273 (or project-options compiler-options))) 16274 16275(defun vhdl-compile () 16276 "Compile current buffer using the VHDL compiler specified in 16277`vhdl-compiler'." 16278 (interactive) 16279 (vhdl-compile-init) 16280 (let* ((project (aget vhdl-project-alist vhdl-project)) 16281 (compiler (or (aget vhdl-compiler-alist vhdl-compiler nil) 16282 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 16283 (command (nth 0 compiler)) 16284 (file-name (buffer-file-name)) 16285 (options (vhdl-get-compile-options project compiler file-name)) 16286 (default-directory (vhdl-compile-directory)) 16287 compilation-process-setup-function) 16288 (unless (file-directory-p default-directory) 16289 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 16290 ;; put file name into quotes if it contains spaces 16291 (when (string-match " " file-name) 16292 (setq file-name (concat "\"" file-name "\""))) 16293 ;; print out file name if compiler does not 16294 (setq vhdl-compile-file-name (buffer-file-name)) 16295 (when (and (= 0 (nth 1 (nth 10 compiler))) 16296 (= 0 (nth 1 (nth 11 compiler)))) 16297 (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) 16298 ;; run compilation 16299 (if options 16300 (when command 16301 (compile (concat command " " options " " file-name))) 16302 (vhdl-warning "Your project settings tell me not to compile this file")))) 16303 16304(defvar vhdl-make-target "all" 16305 "Default target for `vhdl-make' command.") 16306 16307(defun vhdl-make (&optional target) 16308 "Call make command for compilation of all updated source files (requires 16309`Makefile'). Optional argument TARGET allows to compile the design 16310specified by a target." 16311 (interactive) 16312 (setq vhdl-make-target 16313 (or target (read-from-minibuffer "Target: " vhdl-make-target 16314 vhdl-minibuffer-local-map))) 16315 (vhdl-compile-init) 16316 (let* ((project (aget vhdl-project-alist vhdl-project)) 16317 (compiler (or (aget vhdl-compiler-alist vhdl-compiler) 16318 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 16319 (command (nth 2 compiler)) 16320 (options (vhdl-get-make-options project compiler)) 16321 (default-directory (vhdl-compile-directory))) 16322 (unless (file-directory-p default-directory) 16323 (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) 16324 ;; run make 16325 (compile (concat (if (equal command "") "make" command) 16326 " " options " " vhdl-make-target)))) 16327 16328;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16329;; Makefile generation 16330 16331(defun vhdl-generate-makefile () 16332 "Generate `Makefile'." 16333 (interactive) 16334 (let* ((compiler (or (aget vhdl-compiler-alist vhdl-compiler) 16335 (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) 16336 (command (nth 4 compiler))) 16337 ;; generate makefile 16338 (if command 16339 (let ((default-directory (vhdl-compile-directory))) 16340 (compile (vhdl-replace-string 16341 (cons "\\(.*\\) \\(.*\\)" command) 16342 (concat (vhdl-makefile-name) " " (vhdl-work-library))))) 16343 (vhdl-generate-makefile-1)))) 16344 16345(defun vhdl-get-packages (lib-alist work-library) 16346 "Get packages from LIB-ALIST that belong to WORK-LIBRARY." 16347 (let (pack-list) 16348 (while lib-alist 16349 (when (equal (downcase (caar lib-alist)) (downcase work-library)) 16350 (setq pack-list (cons (cdar lib-alist) pack-list))) 16351 (setq lib-alist (cdr lib-alist))) 16352 pack-list)) 16353 16354(defun vhdl-generate-makefile-1 () 16355 "Generate Makefile for current project or directory." 16356 ;; scan hierarchy if required 16357 (if (vhdl-project-p) 16358 (unless (or (assoc vhdl-project vhdl-file-alist) 16359 (vhdl-load-cache vhdl-project)) 16360 (vhdl-scan-project-contents vhdl-project)) 16361 (let ((directory (abbreviate-file-name default-directory))) 16362 (unless (or (assoc directory vhdl-file-alist) 16363 (vhdl-load-cache directory)) 16364 (vhdl-scan-directory-contents directory)))) 16365 (let* ((directory (abbreviate-file-name (vhdl-default-directory))) 16366 (project (vhdl-project-p)) 16367 (ent-alist (aget vhdl-entity-alist (or project directory) t)) 16368 (conf-alist (aget vhdl-config-alist (or project directory) t)) 16369 (pack-alist (aget vhdl-package-alist (or project directory) t)) 16370 (regexp-list (nth 12 (aget vhdl-compiler-alist vhdl-compiler))) 16371 (ent-regexp (cons "\\(.*\\)" (nth 0 regexp-list))) 16372 (arch-regexp (cons "\\(.*\\) \\(.*\\)" (nth 1 regexp-list))) 16373 (conf-regexp (cons "\\(.*\\)" (nth 2 regexp-list))) 16374 (pack-regexp (cons "\\(.*\\)" (nth 3 regexp-list))) 16375 (pack-body-regexp (cons "\\(.*\\)" (nth 4 regexp-list))) 16376 (adjust-case (nth 5 regexp-list)) 16377 (work-library (downcase (vhdl-work-library))) 16378 (compile-directory (expand-file-name (vhdl-compile-directory) 16379 default-directory)) 16380 (makefile-name (vhdl-makefile-name)) 16381 rule-alist arch-alist inst-alist 16382 target-list depend-list unit-list prim-list second-list subcomp-list 16383 lib-alist lib-body-alist pack-list all-pack-list 16384 ent-key ent-file-name arch-key arch-file-name ent-arch-key 16385 conf-key conf-file-name pack-key pack-file-name 16386 ent-entry arch-entry conf-entry pack-entry inst-entry 16387 pack-body-key pack-body-file-name inst-ent-key inst-conf-key 16388 tmp-key tmp-list rule) 16389 ;; check prerequisites 16390 (unless (file-exists-p compile-directory) 16391 (make-directory compile-directory t)) 16392 (unless regexp-list 16393 (error "Please contact the VHDL Mode maintainer for support of \"%s\"" 16394 vhdl-compiler)) 16395 (message "Generating makefile \"%s\"..." makefile-name) 16396 ;; rules for all entities 16397 (setq tmp-list ent-alist) 16398 (while ent-alist 16399 (setq ent-entry (car ent-alist) 16400 ent-key (nth 0 ent-entry)) 16401 (when (nth 2 ent-entry) 16402 (setq ent-file-name (file-relative-name 16403 (nth 2 ent-entry) compile-directory) 16404 arch-alist (nth 4 ent-entry) 16405 lib-alist (nth 6 ent-entry) 16406 rule (aget rule-alist ent-file-name) 16407 target-list (nth 0 rule) 16408 depend-list (nth 1 rule) 16409 second-list nil 16410 subcomp-list nil) 16411 (setq tmp-key (vhdl-replace-string 16412 ent-regexp (funcall adjust-case ent-key))) 16413 (setq unit-list (cons (cons ent-key tmp-key) unit-list)) 16414 ;; rule target for this entity 16415 (setq target-list (cons ent-key target-list)) 16416 ;; rule dependencies for all used packages 16417 (setq pack-list (vhdl-get-packages lib-alist work-library)) 16418 (setq depend-list (append depend-list pack-list)) 16419 (setq all-pack-list pack-list) 16420 ;; add rule 16421 (aput 'rule-alist ent-file-name (list target-list depend-list)) 16422 ;; rules for all corresponding architectures 16423 (while arch-alist 16424 (setq arch-entry (car arch-alist) 16425 arch-key (nth 0 arch-entry) 16426 ent-arch-key (concat ent-key "-" arch-key) 16427 arch-file-name (file-relative-name (nth 2 arch-entry) 16428 compile-directory) 16429 inst-alist (nth 4 arch-entry) 16430 lib-alist (nth 5 arch-entry) 16431 rule (aget rule-alist arch-file-name) 16432 target-list (nth 0 rule) 16433 depend-list (nth 1 rule)) 16434 (setq tmp-key (vhdl-replace-string 16435 arch-regexp 16436 (funcall adjust-case (concat arch-key " " ent-key)))) 16437 (setq unit-list 16438 (cons (cons ent-arch-key tmp-key) unit-list)) 16439 (setq second-list (cons ent-arch-key second-list)) 16440 ;; rule target for this architecture 16441 (setq target-list (cons ent-arch-key target-list)) 16442 ;; rule dependency for corresponding entity 16443 (setq depend-list (cons ent-key depend-list)) 16444 ;; rule dependencies for contained component instantiations 16445 (while inst-alist 16446 (setq inst-entry (car inst-alist)) 16447 (when (or (null (nth 8 inst-entry)) 16448 (equal (downcase (nth 8 inst-entry)) work-library)) 16449 (setq inst-ent-key (or (nth 7 inst-entry) 16450 (nth 5 inst-entry))) 16451 (setq depend-list (cons inst-ent-key depend-list) 16452 subcomp-list (cons inst-ent-key subcomp-list))) 16453 (setq inst-alist (cdr inst-alist))) 16454 ;; rule dependencies for all used packages 16455 (setq pack-list (vhdl-get-packages lib-alist work-library)) 16456 (setq depend-list (append depend-list pack-list)) 16457 (setq all-pack-list (append all-pack-list pack-list)) 16458 ;; add rule 16459 (aput 'rule-alist arch-file-name (list target-list depend-list)) 16460 (setq arch-alist (cdr arch-alist))) 16461 (setq prim-list (cons (list ent-key second-list 16462 (append subcomp-list all-pack-list)) 16463 prim-list))) 16464 (setq ent-alist (cdr ent-alist))) 16465 (setq ent-alist tmp-list) 16466 ;; rules for all configurations 16467 (setq tmp-list conf-alist) 16468 (while conf-alist 16469 (setq conf-entry (car conf-alist) 16470 conf-key (nth 0 conf-entry) 16471 conf-file-name (file-relative-name 16472 (nth 2 conf-entry) compile-directory) 16473 ent-key (nth 4 conf-entry) 16474 arch-key (nth 5 conf-entry) 16475 inst-alist (nth 6 conf-entry) 16476 lib-alist (nth 7 conf-entry) 16477 rule (aget rule-alist conf-file-name) 16478 target-list (nth 0 rule) 16479 depend-list (nth 1 rule) 16480 subcomp-list (list ent-key)) 16481 (setq tmp-key (vhdl-replace-string 16482 conf-regexp (funcall adjust-case conf-key))) 16483 (setq unit-list (cons (cons conf-key tmp-key) unit-list)) 16484 ;; rule target for this configuration 16485 (setq target-list (cons conf-key target-list)) 16486 ;; rule dependency for corresponding entity and architecture 16487 (setq depend-list 16488 (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) 16489 ;; rule dependencies for used packages 16490 (setq pack-list (vhdl-get-packages lib-alist work-library)) 16491 (setq depend-list (append depend-list pack-list)) 16492 ;; rule dependencies for contained component configurations 16493 (while inst-alist 16494 (setq inst-entry (car inst-alist)) 16495 (setq inst-ent-key (nth 2 inst-entry) 16496; comp-arch-key (nth 2 inst-entry)) 16497 inst-conf-key (nth 4 inst-entry)) 16498 (when (equal (downcase (nth 5 inst-entry)) work-library) 16499 (when inst-ent-key 16500 (setq depend-list (cons inst-ent-key depend-list) 16501 subcomp-list (cons inst-ent-key subcomp-list))) 16502; (when comp-arch-key 16503; (setq depend-list (cons (concat comp-ent-key "-" comp-arch-key) 16504; depend-list))) 16505 (when inst-conf-key 16506 (setq depend-list (cons inst-conf-key depend-list) 16507 subcomp-list (cons inst-conf-key subcomp-list)))) 16508 (setq inst-alist (cdr inst-alist))) 16509 ;; add rule 16510 (aput 'rule-alist conf-file-name (list target-list depend-list)) 16511 (setq prim-list (cons (list conf-key nil (append subcomp-list pack-list)) 16512 prim-list)) 16513 (setq conf-alist (cdr conf-alist))) 16514 (setq conf-alist tmp-list) 16515 ;; rules for all packages 16516 (setq tmp-list pack-alist) 16517 (while pack-alist 16518 (setq pack-entry (car pack-alist) 16519 pack-key (nth 0 pack-entry) 16520 pack-body-key nil) 16521 (when (nth 2 pack-entry) 16522 (setq pack-file-name (file-relative-name (nth 2 pack-entry) 16523 compile-directory) 16524 lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) 16525 rule (aget rule-alist pack-file-name) 16526 target-list (nth 0 rule) depend-list (nth 1 rule)) 16527 (setq tmp-key (vhdl-replace-string 16528 pack-regexp (funcall adjust-case pack-key))) 16529 (setq unit-list (cons (cons pack-key tmp-key) unit-list)) 16530 ;; rule target for this package 16531 (setq target-list (cons pack-key target-list)) 16532 ;; rule dependencies for all used packages 16533 (setq pack-list (vhdl-get-packages lib-alist work-library)) 16534 (setq depend-list (append depend-list pack-list)) 16535 (setq all-pack-list pack-list) 16536 ;; add rule 16537 (aput 'rule-alist pack-file-name (list target-list depend-list)) 16538 ;; rules for this package's body 16539 (when (nth 7 pack-entry) 16540 (setq pack-body-key (concat pack-key "-body") 16541 pack-body-file-name (file-relative-name (nth 7 pack-entry) 16542 compile-directory) 16543 rule (aget rule-alist pack-body-file-name) 16544 target-list (nth 0 rule) 16545 depend-list (nth 1 rule)) 16546 (setq tmp-key (vhdl-replace-string 16547 pack-body-regexp (funcall adjust-case pack-key))) 16548 (setq unit-list 16549 (cons (cons pack-body-key tmp-key) unit-list)) 16550 ;; rule target for this package's body 16551 (setq target-list (cons pack-body-key target-list)) 16552 ;; rule dependency for corresponding package declaration 16553 (setq depend-list (cons pack-key depend-list)) 16554 ;; rule dependencies for all used packages 16555 (setq pack-list (vhdl-get-packages lib-body-alist work-library)) 16556 (setq depend-list (append depend-list pack-list)) 16557 (setq all-pack-list (append all-pack-list pack-list)) 16558 ;; add rule 16559 (aput 'rule-alist pack-body-file-name 16560 (list target-list depend-list))) 16561 (setq prim-list 16562 (cons (list pack-key (when pack-body-key (list pack-body-key)) 16563 all-pack-list) 16564 prim-list))) 16565 (setq pack-alist (cdr pack-alist))) 16566 (setq pack-alist tmp-list) 16567 ;; generate Makefile 16568 (let* ((project (aget vhdl-project-alist project)) 16569 (compiler (aget vhdl-compiler-alist vhdl-compiler)) 16570 (compiler-id (nth 9 compiler)) 16571 (library-directory 16572 (vhdl-resolve-env-variable 16573 (vhdl-replace-string 16574 (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) 16575 compiler-id))) 16576 (makefile-path-name (expand-file-name 16577 makefile-name compile-directory)) 16578 (orig-buffer (current-buffer)) 16579 cell second-list subcomp-list options unit-key unit-name) 16580 ;; sort lists 16581 (setq unit-list (vhdl-sort-alist unit-list)) 16582 (setq prim-list (vhdl-sort-alist prim-list)) 16583 (setq tmp-list rule-alist) 16584 (while tmp-list ; pre-sort rule targets 16585 (setq cell (cdar tmp-list)) 16586 (setcar cell (sort (car cell) 'string<)) 16587 (setq tmp-list (cdr tmp-list))) 16588 (setq rule-alist ; sort by first rule target 16589 (sort rule-alist 16590 (function (lambda (a b) 16591 (string< (car (cadr a)) (car (cadr b))))))) 16592 ;; open and clear Makefile 16593 (set-buffer (find-file-noselect makefile-path-name t t)) 16594 (erase-buffer) 16595 (insert "# -*- Makefile -*-\n" 16596 "### " (file-name-nondirectory makefile-name) 16597 " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version 16598 "\n") 16599 (if project 16600 (insert "\n# Project : " (nth 0 project)) 16601 (insert "\n# Directory : \"" directory "\"")) 16602 (insert "\n# Platform : " vhdl-compiler 16603 "\n# Generated : " (format-time-string "%Y-%m-%d %T ") 16604 (user-login-name) "\n") 16605 ;; insert compile and option variable settings 16606 (insert "\n\n# Define compilation command and options\n" 16607 "\nCOMPILE = " (nth 0 compiler) 16608 "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) 16609 "\n") 16610 ;; insert library paths 16611 (setq library-directory 16612 (directory-file-name 16613 (if (file-name-absolute-p library-directory) 16614 library-directory 16615 (file-relative-name 16616 (expand-file-name library-directory directory) 16617 compile-directory)))) 16618 (insert "\n\n# Define library paths\n" 16619 "\nLIBRARY-" work-library " = " library-directory "\n") 16620 ;; insert variable definitions for all library unit files 16621 (insert "\n\n# Define library unit files\n") 16622 (setq tmp-list unit-list) 16623 (while unit-list 16624 (insert "\nUNIT-" work-library "-" (caar unit-list) 16625 " = \\\n\t$(LIBRARY-" work-library ")/" (cdar unit-list)) 16626 (setq unit-list (cdr unit-list))) 16627 ;; insert variable definition for list of all library unit files 16628 (insert "\n\n\n# Define list of all library unit files\n" 16629 "\nALL_UNITS =") 16630 (setq unit-list tmp-list) 16631 (while unit-list 16632 (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") 16633 (setq unit-list (cdr unit-list))) 16634 (insert "\n") 16635 (setq unit-list tmp-list) 16636 ;; insert `make all' rule 16637 (insert "\n\n\n# Rule for compiling entire design\n" 16638 "\nall :" 16639 " \\\n\t\tlibrary" 16640 " \\\n\t\t$(ALL_UNITS)\n") 16641 ;; insert `make clean' rule 16642 (insert "\n\n# Rule for cleaning entire design\n" 16643 "\nclean : " 16644 "\n\t-rm -f $(ALL_UNITS)\n") 16645 ;; insert `make library' rule 16646 (insert "\n\n# Rule for creating library directory\n" 16647 "\nlibrary :" 16648 " \\\n\t\t$(LIBRARY-" work-library ")\n" 16649 "\n$(LIBRARY-" work-library ") :" 16650 "\n\t" 16651 (vhdl-replace-string 16652 (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) 16653 (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) 16654 "\n") 16655 ;; insert rule for each library unit 16656 (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") 16657 (while prim-list 16658 (setq second-list (sort (nth 1 (car prim-list)) 'string<)) 16659 (setq subcomp-list 16660 (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) 16661 (setq unit-key (caar prim-list) 16662 unit-name (or (nth 0 (aget ent-alist unit-key t)) 16663 (nth 0 (aget conf-alist unit-key t)) 16664 (nth 0 (aget pack-alist unit-key t)))) 16665 (insert "\n" unit-key) 16666 (unless (equal unit-key unit-name) 16667 (insert " \\\n" unit-name)) 16668 (insert " :" 16669 " \\\n\t\tlibrary" 16670 " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") 16671 (while second-list 16672 (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") 16673 (setq second-list (cdr second-list))) 16674 (while subcomp-list 16675 (when (and (assoc (car subcomp-list) unit-list) 16676 (not (equal unit-key (car subcomp-list)))) 16677 (insert " \\\n\t\t" (car subcomp-list))) 16678 (setq subcomp-list (cdr subcomp-list))) 16679 (insert "\n") 16680 (setq prim-list (cdr prim-list))) 16681 ;; insert rule for each library unit file 16682 (insert "\n\n# Rules for compiling single library unit files\n") 16683 (while rule-alist 16684 (setq rule (car rule-alist)) 16685 ;; get compiler options for this file 16686 (setq options 16687 (vhdl-get-compile-options project compiler (nth 0 rule) t)) 16688 ;; insert rule if file is supposed to be compiled 16689 (setq target-list (nth 1 rule) 16690 depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) 16691 ;; insert targets 16692 (setq tmp-list target-list) 16693 (while target-list 16694 (insert "\n$(UNIT-" work-library "-" (car target-list) ")" 16695 (if (cdr target-list) " \\" " :")) 16696 (setq target-list (cdr target-list))) 16697 (setq target-list tmp-list) 16698 ;; insert file name as first dependency 16699 (insert " \\\n\t\t" (nth 0 rule)) 16700 ;; insert dependencies (except if also target or unit does not exist) 16701 (while depend-list 16702 (when (and (not (member (car depend-list) target-list)) 16703 (assoc (car depend-list) unit-list)) 16704 (insert " \\\n\t\t" 16705 "$(UNIT-" work-library "-" (car depend-list) ")")) 16706 (setq depend-list (cdr depend-list))) 16707 ;; insert compile command 16708 (if options 16709 (insert "\n\t$(COMPILE) " 16710 (if (eq options 'default) "$(OPTIONS)" options) " " 16711 (nth 0 rule) "\n") 16712 (setq tmp-list target-list) 16713 (while target-list 16714 (insert "\n\t@touch $(UNIT-" work-library "-" (car target-list) ")" 16715 (if (cdr target-list) " \\" "\n")) 16716 (setq target-list (cdr target-list))) 16717 (setq target-list tmp-list)) 16718 (setq rule-alist (cdr rule-alist))) 16719 (insert "\n\n### " makefile-name " ends here\n") 16720 ;; run Makefile generation hook 16721 (run-hooks 'vhdl-makefile-generation-hook) 16722 (message "Generating makefile \"%s\"...done" makefile-name) 16723 ;; save and close file 16724 (if (file-writable-p makefile-path-name) 16725 (progn (save-buffer) 16726 (kill-buffer (current-buffer)) 16727 (set-buffer orig-buffer) 16728 (add-to-history 'file-name-history makefile-path-name)) 16729 (vhdl-warning-when-idle 16730 (format "File not writable: \"%s\"" 16731 (abbreviate-file-name makefile-path-name))) 16732 (switch-to-buffer (current-buffer)))))) 16733 16734 16735;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16736;;; Bug reports 16737;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16738;; (using `reporter.el') 16739 16740(defconst vhdl-mode-help-address 16741 "Reto Zimmermann <reto@gnu.org>" 16742 "Address for VHDL Mode bug reports.") 16743 16744(defun vhdl-submit-bug-report () 16745 "Submit via mail a bug report on VHDL Mode." 16746 (interactive) 16747 ;; load in reporter 16748 (and 16749 (y-or-n-p "Do you want to submit a report on VHDL Mode? ") 16750 (let ((reporter-prompt-for-summary-p t)) 16751 (reporter-submit-bug-report 16752 vhdl-mode-help-address 16753 (concat "VHDL Mode " vhdl-version) 16754 (list 16755 ;; report all important user options 16756 'vhdl-offsets-alist 16757 'vhdl-comment-only-line-offset 16758 'tab-width 16759 'vhdl-electric-mode 16760 'vhdl-stutter-mode 16761 'vhdl-indent-tabs-mode 16762 'vhdl-project-alist 16763 'vhdl-project 16764 'vhdl-project-file-name 16765 'vhdl-project-auto-load 16766 'vhdl-project-sort 16767 'vhdl-compiler-alist 16768 'vhdl-compiler 16769 'vhdl-compile-use-local-error-regexp 16770 'vhdl-makefile-generation-hook 16771 'vhdl-default-library 16772 'vhdl-standard 16773 'vhdl-basic-offset 16774 'vhdl-upper-case-keywords 16775 'vhdl-upper-case-types 16776 'vhdl-upper-case-attributes 16777 'vhdl-upper-case-enum-values 16778 'vhdl-upper-case-constants 16779 'vhdl-use-direct-instantiation 16780 'vhdl-compose-configuration-name 16781 'vhdl-entity-file-name 16782 'vhdl-architecture-file-name 16783 'vhdl-configuration-file-name 16784 'vhdl-package-file-name 16785 'vhdl-file-name-case 16786 'vhdl-electric-keywords 16787 'vhdl-optional-labels 16788 'vhdl-insert-empty-lines 16789 'vhdl-argument-list-indent 16790 'vhdl-association-list-with-formals 16791 'vhdl-conditions-in-parenthesis 16792 'vhdl-zero-string 16793 'vhdl-one-string 16794 'vhdl-file-header 16795 'vhdl-file-footer 16796 'vhdl-company-name 16797 'vhdl-copyright-string 16798 'vhdl-platform-spec 16799 'vhdl-date-format 16800 'vhdl-modify-date-prefix-string 16801 'vhdl-modify-date-on-saving 16802 'vhdl-reset-kind 16803 'vhdl-reset-active-high 16804 'vhdl-clock-rising-edge 16805 'vhdl-clock-edge-condition 16806 'vhdl-clock-name 16807 'vhdl-reset-name 16808 'vhdl-model-alist 16809 'vhdl-include-port-comments 16810 'vhdl-include-direction-comments 16811 'vhdl-include-type-comments 16812 'vhdl-include-group-comments 16813 'vhdl-actual-port-name 16814 'vhdl-instance-name 16815 'vhdl-testbench-entity-name 16816 'vhdl-testbench-architecture-name 16817 'vhdl-testbench-configuration-name 16818 'vhdl-testbench-dut-name 16819 'vhdl-testbench-include-header 16820 'vhdl-testbench-declarations 16821 'vhdl-testbench-statements 16822 'vhdl-testbench-initialize-signals 16823 'vhdl-testbench-include-library 16824 'vhdl-testbench-include-configuration 16825 'vhdl-testbench-create-files 16826 'vhdl-testbench-entity-file-name 16827 'vhdl-testbench-architecture-file-name 16828 'vhdl-compose-create-files 16829 'vhdl-compose-configuration-create-file 16830 'vhdl-compose-configuration-hierarchical 16831 'vhdl-compose-configuration-use-subconfiguration 16832 'vhdl-compose-include-header 16833 'vhdl-compose-architecture-name 16834 'vhdl-components-package-name 16835 'vhdl-use-components-package 16836 'vhdl-self-insert-comments 16837 'vhdl-prompt-for-comments 16838 'vhdl-inline-comment-column 16839 'vhdl-end-comment-column 16840 'vhdl-auto-align 16841 'vhdl-align-groups 16842 'vhdl-align-group-separate 16843 'vhdl-align-same-indent 16844 'vhdl-highlight-keywords 16845 'vhdl-highlight-names 16846 'vhdl-highlight-special-words 16847 'vhdl-highlight-forbidden-words 16848 'vhdl-highlight-verilog-keywords 16849 'vhdl-highlight-translate-off 16850 'vhdl-highlight-case-sensitive 16851 'vhdl-special-syntax-alist 16852 'vhdl-forbidden-words 16853 'vhdl-forbidden-syntax 16854 'vhdl-directive-keywords 16855 'vhdl-speedbar-auto-open 16856 'vhdl-speedbar-display-mode 16857 'vhdl-speedbar-scan-limit 16858 'vhdl-speedbar-jump-to-unit 16859 'vhdl-speedbar-update-on-saving 16860 'vhdl-speedbar-save-cache 16861 'vhdl-speedbar-cache-file-name 16862 'vhdl-index-menu 16863 'vhdl-source-file-menu 16864 'vhdl-hideshow-menu 16865 'vhdl-hide-all-init 16866 'vhdl-print-two-column 16867 'vhdl-print-customize-faces 16868 'vhdl-intelligent-tab 16869 'vhdl-indent-syntax-based 16870 'vhdl-word-completion-case-sensitive 16871 'vhdl-word-completion-in-minibuffer 16872 'vhdl-underscore-is-part-of-word 16873 'vhdl-mode-hook) 16874 (function 16875 (lambda () 16876 (insert 16877 (if vhdl-special-indent-hook 16878 (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" 16879 "vhdl-special-indent-hook is set to '" 16880 (format "%s" vhdl-special-indent-hook) 16881 ".\nPerhaps this is your problem?\n" 16882 "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") 16883 "\n")))) 16884 nil 16885 "Hi Reto,")))) 16886 16887 16888;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16889;;; Documentation 16890;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16891 16892(defconst vhdl-doc-release-notes nil 16893 "\ 16894Release Notes for VHDL Mode 3.33 16895================================ 16896 16897 - New Features 16898 - User Options 16899 16900 16901New Features 16902------------ 16903 16904CONFIGURATION DECLARATION GENERATION: 16905 - Automatic generation of a configuration declaration for a design. 16906 (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) 16907 16908 16909User Options 16910------------ 16911 16912`vhdl-configuration-file-name': (new) 16913 Specify how the configuration file name is obtained. 16914`vhdl-compose-configuration-name': (new) 16915 Specify how the configuration name is optained. 16916`vhdl-compose-configuration-create-file': (new) 16917 Specify whether a new file should be created for a configuration. 16918`vhdl-compose-configuration-hierarchical': (new) 16919 Specify whether hierarchical configurations should be created. 16920`vhdl-compose-configuration-use-subconfiguration': (new) 16921 Specify whether subconfigurations should be used inside configurations. 16922") 16923 16924 16925(defconst vhdl-doc-keywords nil 16926 "\ 16927Reserved words in VHDL 16928---------------------- 16929 16930VHDL'93 (IEEE Std 1076-1993): 16931 `vhdl-93-keywords' : keywords 16932 `vhdl-93-types' : standardized types 16933 `vhdl-93-attributes' : standardized attributes 16934 `vhdl-93-enum-values' : standardized enumeration values 16935 `vhdl-93-functions' : standardized functions 16936 `vhdl-93-packages' : standardized packages and libraries 16937 16938VHDL-AMS (IEEE Std 1076.1): 16939 `vhdl-ams-keywords' : keywords 16940 `vhdl-ams-types' : standardized types 16941 `vhdl-ams-attributes' : standardized attributes 16942 `vhdl-ams-enum-values' : standardized enumeration values 16943 `vhdl-ams-functions' : standardized functions 16944 16945Math Packages (IEEE Std 1076.2): 16946 `vhdl-math-types' : standardized types 16947 `vhdl-math-constants' : standardized constants 16948 `vhdl-math-functions' : standardized functions 16949 `vhdl-math-packages' : standardized packages 16950 16951Forbidden words: 16952 `vhdl-verilog-keywords' : Verilog reserved words 16953 16954NOTE: click `mouse-2' on variable names above (not in XEmacs).") 16955 16956 16957(defconst vhdl-doc-coding-style nil 16958 "\ 16959For VHDL coding style and naming convention guidelines, see the following 16960references: 16961 16962\[1] Ben Cohen. 16963 \"VHDL Coding Styles and Methodologies\". 16964 Kluwer Academic Publishers, 1999. 16965 http://members.aol.com/vhdlcohen/vhdl/ 16966 16967\[2] Michael Keating and Pierre Bricaud. 16968 \"Reuse Methodology Manual, Second Edition\". 16969 Kluwer Academic Publishers, 1999. 16970 http://www.openmore.com/openmore/rmm2.html 16971 16972\[3] European Space Agency. 16973 \"VHDL Modelling Guidelines\". 16974 ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps} 16975 16976Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' 16977to visually support naming conventions.") 16978 16979 16980(defun vhdl-version () 16981 "Echo the current version of VHDL Mode in the minibuffer." 16982 (interactive) 16983 (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) 16984 (vhdl-keep-region-active)) 16985 16986(defun vhdl-doc-variable (variable) 16987 "Display VARIABLE's documentation in *Help* buffer." 16988 (interactive) 16989 (unless vhdl-xemacs 16990 (help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p))) 16991 (with-output-to-temp-buffer 16992 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 16993 (princ (documentation-property variable 'variable-documentation)) 16994 (with-current-buffer standard-output 16995 (help-mode)) 16996 (print-help-return-message))) 16997 16998(defun vhdl-doc-mode () 16999 "Display VHDL Mode documentation in *Help* buffer." 17000 (interactive) 17001 (unless vhdl-xemacs 17002 (help-setup-xref (list #'vhdl-doc-mode) (interactive-p))) 17003 (with-output-to-temp-buffer 17004 (if (fboundp 'help-buffer) (help-buffer) "*Help*") 17005 (princ mode-name) 17006 (princ " mode:\n") 17007 (princ (documentation 'vhdl-mode)) 17008 (with-current-buffer standard-output 17009 (help-mode)) 17010 (print-help-return-message))) 17011 17012 17013;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 17014 17015(provide 'vhdl-mode) 17016 17017;; arch-tag: 780d7073-9b5d-4c6c-b0d8-26b28783aba3 17018;;; vhdl-mode.el ends here 17019