| 1 | ;;; vhdl-mode.el --- major mode for editing VHDL code |
| 2 | |
| 3 | ;; Copyright (C) 1992-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Authors: Reto Zimmermann <reto@gnu.org> |
| 6 | ;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net> |
| 7 | ;; Maintainer: Reto Zimmermann <reto@gnu.org> |
| 8 | ;; Keywords: languages vhdl |
| 9 | ;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html |
| 10 | |
| 11 | ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this |
| 12 | ;; file on 18/3/2008, and the maintainer agreed that when a bug is |
| 13 | ;; filed in the Emacs bug reporting system against this file, a copy |
| 14 | ;; of the bug report be sent to the maintainer's email address. |
| 15 | |
| 16 | (defconst vhdl-version "3.35.2" |
| 17 | "VHDL Mode version number.") |
| 18 | |
| 19 | (defconst vhdl-time-stamp "2014-03-28" |
| 20 | "VHDL Mode time stamp for last update.") |
| 21 | |
| 22 | ;; This file is part of GNU Emacs. |
| 23 | |
| 24 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 25 | ;; it under the terms of the GNU General Public License as published by |
| 26 | ;; the Free Software Foundation, either version 3 of the License, or |
| 27 | ;; (at your option) any later version. |
| 28 | |
| 29 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 30 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 31 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 32 | ;; GNU General Public License for more details. |
| 33 | |
| 34 | ;; You should have received a copy of the GNU General Public License |
| 35 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 36 | |
| 37 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 38 | ;;; Commentary: |
| 39 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 40 | |
| 41 | ;; This package provides an Emacs major mode for editing VHDL code. |
| 42 | ;; It includes the following features: |
| 43 | |
| 44 | ;; - Syntax highlighting |
| 45 | ;; - Indentation |
| 46 | ;; - Template insertion (electrification) |
| 47 | ;; - Insertion of file headers |
| 48 | ;; - Insertion of user-specified models |
| 49 | ;; - Port translation / testbench generation |
| 50 | ;; - Structural composition |
| 51 | ;; - Configuration generation |
| 52 | ;; - Sensitivity list updating |
| 53 | ;; - File browser |
| 54 | ;; - Design hierarchy browser |
| 55 | ;; - Source file compilation (syntax analysis) |
| 56 | ;; - Makefile generation |
| 57 | ;; - Code hiding |
| 58 | ;; - Word/keyword completion |
| 59 | ;; - Block commenting |
| 60 | ;; - Code fixing/alignment/beautification |
| 61 | ;; - PostScript printing |
| 62 | ;; - VHDL'87/'93 and VHDL-AMS supported |
| 63 | ;; - Comprehensive menu |
| 64 | ;; - Fully customizable |
| 65 | ;; - Works under GNU Emacs (recommended) and XEmacs |
| 66 | |
| 67 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 68 | ;; Documentation |
| 69 | |
| 70 | ;; See comment string of function `vhdl-mode' or type `C-c C-h' in Emacs. |
| 71 | |
| 72 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 73 | ;; Emacs Versions |
| 74 | |
| 75 | ;; this updated version was only tested on: GNU Emacs 24.1 |
| 76 | |
| 77 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 78 | ;; Installation |
| 79 | |
| 80 | ;; Prerequisites: GNU Emacs 20/21/22/23/24, XEmacs 20/21. |
| 81 | |
| 82 | ;; Put `vhdl-mode.el' into the `site-lisp' directory of your Emacs installation |
| 83 | ;; or into an arbitrary directory that is added to the load path by the |
| 84 | ;; following line in your Emacs start-up file `.emacs': |
| 85 | |
| 86 | ;; (push (expand-file-name "<directory-name>") load-path) |
| 87 | |
| 88 | ;; If you already have the compiled `vhdl-mode.elc' file, put it in the same |
| 89 | ;; directory. Otherwise, byte-compile the source file: |
| 90 | ;; Emacs: M-x byte-compile-file RET vhdl-mode.el RET |
| 91 | ;; Unix: emacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el |
| 92 | |
| 93 | ;; Add the following lines to the `site-start.el' file in the `site-lisp' |
| 94 | ;; directory of your Emacs installation or to your Emacs start-up file `.emacs' |
| 95 | ;; (not required in Emacs 20 and higher): |
| 96 | |
| 97 | ;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Mode" t) |
| 98 | ;; (push '("\\.vhdl?\\'" . vhdl-mode) auto-mode-alist) |
| 99 | |
| 100 | ;; More detailed installation instructions are included in the official |
| 101 | ;; VHDL Mode distribution. |
| 102 | |
| 103 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 104 | ;; Acknowledgments |
| 105 | |
| 106 | ;; Electrification ideas by Bob Pack <rlpst@cislabs.pitt.edu> |
| 107 | ;; and Steve Grout. |
| 108 | |
| 109 | ;; Fontification approach suggested by Ken Wood <ken@eda.com.au>. |
| 110 | ;; Ideas about alignment from John Wiegley <johnw@gnu.org>. |
| 111 | |
| 112 | ;; Many thanks to all the users who sent me bug reports and enhancement |
| 113 | ;; requests. |
| 114 | ;; Thanks to Colin Marquardt for his serious beta testing, his innumerable |
| 115 | ;; enhancement suggestions and the fruitful discussions. |
| 116 | ;; Thanks to Dan Nicolaescu for reviewing the code and for his valuable hints. |
| 117 | ;; Thanks to Ulf Klaperski for the indentation speedup hint. |
| 118 | |
| 119 | ;; Special thanks go to Wolfgang Fichtner and the crew from the Integrated |
| 120 | ;; Systems Laboratory, Swiss Federal Institute of Technology Zurich, for |
| 121 | ;; giving me the opportunity to develop this code. |
| 122 | ;; This work has been funded in part by MICROSWISS, a Microelectronics Program |
| 123 | ;; of the Swiss Government. |
| 124 | |
| 125 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 126 | |
| 127 | ;;; Code: |
| 128 | |
| 129 | ;; Emacs 21+ handling |
| 130 | (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) |
| 131 | "Non-nil if GNU Emacs 21, 22, ... is used.") |
| 132 | ;; Emacs 22+ handling |
| 133 | (defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs))) |
| 134 | "Non-nil if GNU Emacs 22, ... is used.") |
| 135 | |
| 136 | (defvar compilation-file-regexp-alist) |
| 137 | (defvar conf-alist) |
| 138 | (defvar conf-entry) |
| 139 | (defvar conf-key) |
| 140 | (defvar ent-alist) |
| 141 | (defvar itimer-version) |
| 142 | (defvar lazy-lock-defer-contextually) |
| 143 | (defvar lazy-lock-defer-on-scrolling) |
| 144 | (defvar lazy-lock-defer-on-the-fly) |
| 145 | (defvar speedbar-attached-frame) |
| 146 | |
| 147 | |
| 148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 149 | ;;; Variables |
| 150 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 151 | |
| 152 | ;; help function for user options |
| 153 | (defun vhdl-custom-set (variable value &rest functions) |
| 154 | "Set variables as in `custom-set-default' and call FUNCTIONS afterwards." |
| 155 | (if (fboundp 'custom-set-default) |
| 156 | (custom-set-default variable value) |
| 157 | (set-default variable value)) |
| 158 | (while functions |
| 159 | (when (fboundp (car functions)) (funcall (car functions))) |
| 160 | (setq functions (cdr functions)))) |
| 161 | |
| 162 | (defun vhdl-widget-directory-validate (widget) |
| 163 | "Check that the value of WIDGET is a valid directory entry (i.e. ends with |
| 164 | '/' or is empty)." |
| 165 | (let ((val (widget-value widget))) |
| 166 | (unless (string-match "^\\(\\|.*/\\)$" val) |
| 167 | (widget-put widget :error "Invalid directory entry: must end with '/'") |
| 168 | widget))) |
| 169 | |
| 170 | ;; help string for user options |
| 171 | (defconst vhdl-name-doc-string " |
| 172 | |
| 173 | FROM REGEXP is a regular expression matching the original name: |
| 174 | \".*\" matches the entire string |
| 175 | \"\\(...\\)\" matches a substring |
| 176 | TO STRING specifies the string to be inserted as new name: |
| 177 | \"\\&\" means substitute entire matched text |
| 178 | \"\\N\" means substitute what matched the Nth \"\\(...\\)\" |
| 179 | Examples: |
| 180 | \".*\" \"\\&\" inserts original string |
| 181 | \".*\" \"\\&_i\" attaches \"_i\" to original string |
| 182 | \"\\(.*\\)_[io]$\" \"\\1\" strips off \"_i\" or \"_o\" from original string |
| 183 | \".*\" \"foo\" inserts constant string \"foo\" |
| 184 | \".*\" \"\" inserts empty string") |
| 185 | |
| 186 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 187 | ;; User variables (customization options) |
| 188 | |
| 189 | (defgroup vhdl nil |
| 190 | "Customizations for VHDL Mode." |
| 191 | :prefix "vhdl-" |
| 192 | :group 'languages |
| 193 | ; :version "21.2" ; comment out for XEmacs |
| 194 | ) |
| 195 | |
| 196 | (defgroup vhdl-mode nil |
| 197 | "Customizations for modes." |
| 198 | :group 'vhdl) |
| 199 | |
| 200 | (defcustom vhdl-indent-tabs-mode nil |
| 201 | "Non-nil means indentation can insert tabs. |
| 202 | Overrides local variable `indent-tabs-mode'." |
| 203 | :type 'boolean |
| 204 | :group 'vhdl-mode) |
| 205 | |
| 206 | |
| 207 | (defgroup vhdl-compile nil |
| 208 | "Customizations for compilation." |
| 209 | :group 'vhdl) |
| 210 | |
| 211 | (defcustom vhdl-compiler-alist |
| 212 | '( |
| 213 | ;; 60: docal <= false; |
| 214 | ;; ^^^^^ |
| 215 | ;; [Error] Assignment error: variable is illegal target of signal assignment |
| 216 | ("ADVance MS" "vacom" "-work \\1" "make" "-f \\1" |
| 217 | nil "valib \\1; vamap \\2 \\1" "./" "work/" "Makefile" "adms" |
| 218 | ("^\\s-+\\([0-9]+\\):\\s-+" nil 1 nil) ("Compiling file \\(.+\\)" 1) |
| 219 | ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" |
| 220 | "PACK/\\1.vif" "BODY/\\1.vif" upcase)) |
| 221 | ;; Aldec |
| 222 | ;; COMP96 ERROR COMP96_0018: "Identifier expected." "test.vhd" 66 3 |
| 223 | ("Aldec" "vcom" "-work \\1" "make" "-f \\1" |
| 224 | nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "aldec" |
| 225 | (".* ERROR [^:]+: \".*\" \"\\([^ \\t\\n]+\\)\" \\([0-9]+\\) \\([0-9]+\\)" 1 2 3) ("" 0) |
| 226 | nil) |
| 227 | ;; Cadence Leapfrog: cv -file test.vhd |
| 228 | ;; duluth: *E,430 (test.vhd,13): identifier (POSITIV) is not declared |
| 229 | ("Cadence Leapfrog" "cv" "-work \\1 -file" "make" "-f \\1" |
| 230 | nil "mkdir \\1" "./" "work/" "Makefile" "leapfrog" |
| 231 | ("duluth: \\*E,[0-9]+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)):" 1 2 nil) ("" 0) |
| 232 | ("\\1/entity" "\\2/\\1" "\\1/configuration" |
| 233 | "\\1/package" "\\1/body" downcase)) |
| 234 | ;; Cadence Affirma NC vhdl: ncvhdl test.vhd |
| 235 | ;; ncvhdl_p: *E,IDENTU (test.vhd,13|25): identifier |
| 236 | ;; (PLL_400X_TOP) is not declared [10.3]. |
| 237 | ("Cadence NC" "ncvhdl" "-work \\1" "make" "-f \\1" |
| 238 | nil "mkdir \\1" "./" "work/" "Makefile" "ncvhdl" |
| 239 | ("ncvhdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) |
| 240 | ("\\1/entity/pc.db" "\\2/\\1/pc.db" "\\1/configuration/pc.db" |
| 241 | "\\1/package/pc.db" "\\1/body/pc.db" downcase)) |
| 242 | ;; ghdl vhdl: ghdl test.vhd |
| 243 | ("GHDL" "ghdl" "-i --workdir=\\1 --ieee=synopsys -fexplicit " "make" "-f \\1" |
| 244 | nil "mkdir \\1" "./" "work/" "Makefile" "ghdl" |
| 245 | ("ghdl_p: \\*E,\\w+ (\\([^ \\t\\n]+\\),\\([0-9]+\\)|\\([0-9]+\\)):" 1 2 3) ("" 0) |
| 246 | ("\\1/entity" "\\2/\\1" "\\1/configuration" |
| 247 | "\\1/package" "\\1/body" downcase)) |
| 248 | ;; IBM Compiler |
| 249 | ;; 00 COACHDL* | [CCHDL-1]: File: adder.vhd, line.column: 120.6 |
| 250 | ("IBM Compiler" "g2tvc" "-src" "precomp" "\\1" |
| 251 | nil "mkdir \\1" "./" "work/" "Makefile" "ibm" |
| 252 | ("[0-9]+ COACHDL.*: File: \\([^ \\t\\n]+\\), line.column: \\([0-9]+\\).\\([0-9]+\\)" 1 2 3) (" " 0) |
| 253 | nil) |
| 254 | ;; Ikos Voyager: analyze test.vhd |
| 255 | ;; analyze test.vhd |
| 256 | ;; E L4/C5: this library unit is inaccessible |
| 257 | ("Ikos" "analyze" "-l \\1" "make" "-f \\1" |
| 258 | nil "mkdir \\1" "./" "work/" "Makefile" "ikos" |
| 259 | ("E L\\([0-9]+\\)/C\\([0-9]+\\):" nil 1 2) |
| 260 | ("^analyze +\\(.+ +\\)*\\(.+\\)$" 2) |
| 261 | nil) |
| 262 | ;; ModelSim, Model Technology: vcom test.vhd |
| 263 | ;; ERROR: test.vhd(14): Unknown identifier: positiv |
| 264 | ;; WARNING[2]: test.vhd(85): Possible infinite loop |
| 265 | ;; ** Warning: [4] ../src/emacsvsim.vhd(43): An abstract ... |
| 266 | ;; ** Error: adder.vhd(190): Unknown identifier: ctl_numb |
| 267 | ("ModelSim" "vcom" "-93 -work \\1" "make" "-f \\1" |
| 268 | nil "vlib \\1; vmap \\2 \\1" "./" "work/" "Makefile" "modelsim" |
| 269 | ("\\(ERROR\\|WARNING\\|\\*\\* Error\\|\\*\\* Warning\\)[^:]*:\\( *\[[0-9]+\]\\)? \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 3 4 nil) ("" 0) |
| 270 | ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" |
| 271 | "\\1/_primary.dat" "\\1/body.dat" downcase)) |
| 272 | ;; ProVHDL, Synopsys LEDA: provhdl -w work -f test.vhd |
| 273 | ;; test.vhd:34: error message |
| 274 | ("LEDA ProVHDL" "provhdl" "-w \\1 -f" "make" "-f \\1" |
| 275 | nil "mkdir \\1" "./" "work/" "Makefile" "provhdl" |
| 276 | ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) |
| 277 | ("ENTI/\\1.vif" "ARCH/\\1-\\2.vif" "CONF/\\1.vif" |
| 278 | "PACK/\\1.vif" "BODY/BODY-\\1.vif" upcase)) |
| 279 | ;; Quartus compiler |
| 280 | ;; Error: VHDL error at dvi2sdi.vhd(473): object k2_alto_out_lvl is used |
| 281 | ;; Error: Verilog HDL syntax error at otsuif_v1_top.vhd(147) near text |
| 282 | ;; Error: VHDL syntax error at otsuif_v1_top.vhd(147): clk_ is an illegal |
| 283 | ;; Error: VHDL Use Clause error at otsuif_v1_top.vhd(455): design library |
| 284 | ;; Warning: VHDL Process Statement warning at dvi2sdi_tst.vhd(172): ... |
| 285 | ("Quartus" "make" "-work \\1" "make" "-f \\1" |
| 286 | nil "mkdir \\1" "./" "work/" "Makefile" "quartus" |
| 287 | ("\\(Error\\|Warning\\): .* \\([^ \\t\\n]+\\)(\\([0-9]+\\))" 2 3 nil) ("" 0) |
| 288 | nil) |
| 289 | ;; QuickHDL, Mentor Graphics: qvhcom test.vhd |
| 290 | ;; ERROR: test.vhd(24): near "dnd": expecting: END |
| 291 | ;; WARNING[4]: test.vhd(30): A space is required between ... |
| 292 | ("QuickHDL" "qvhcom" "-work \\1" "make" "-f \\1" |
| 293 | nil "mkdir \\1" "./" "work/" "Makefile" "quickhdl" |
| 294 | ("\\(ERROR\\|WARNING\\)[^:]*: \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 2 3 nil) ("" 0) |
| 295 | ("\\1/_primary.dat" "\\2/\\1.dat" "\\1/_primary.dat" |
| 296 | "\\1/_primary.dat" "\\1/body.dat" downcase)) |
| 297 | ;; Savant: scram -publish-cc test.vhd |
| 298 | ;; test.vhd:87: _set_passed_through_out_port(IIR_Boolean) not defined for |
| 299 | ("Savant" "scram" "-publish-cc -design-library-name \\1" "make" "-f \\1" |
| 300 | nil "mkdir \\1" "./" "work._savant_lib/" "Makefile" "savant" |
| 301 | ("\\([^ \\t\\n]+\\):\\([0-9]+\\): " 1 2 nil) ("" 0) |
| 302 | ("\\1_entity.vhdl" "\\2_secondary_units._savant_lib/\\2_\\1.vhdl" |
| 303 | "\\1_config.vhdl" "\\1_package.vhdl" |
| 304 | "\\1_secondary_units._savant_lib/\\1_package_body.vhdl" downcase)) |
| 305 | ;; Simili: vhdlp -work test.vhd |
| 306 | ;; Error: CSVHDL0002: test.vhd: (line 97): Invalid prefix |
| 307 | ("Simili" "vhdlp" "-work \\1" "make" "-f \\1" |
| 308 | nil "mkdir \\1" "./" "work/" "Makefile" "simili" |
| 309 | ("\\(Error\\|Warning\\): \\w+: \\([^ \\t\\n]+\\): (line \\([0-9]+\\)): " 2 3 nil) ("" 0) |
| 310 | ("\\1/prim.var" "\\2/_\\1.var" "\\1/prim.var" |
| 311 | "\\1/prim.var" "\\1/_body.var" downcase)) |
| 312 | ;; Speedwave (Innoveda): analyze -libfile vsslib.ini -src test.vhd |
| 313 | ;; ERROR[11]::File test.vhd Line 100: Use of undeclared identifier |
| 314 | ("Speedwave" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 315 | nil "mkdir \\1" "./" "work/" "Makefile" "speedwave" |
| 316 | ("^ *ERROR\[[0-9]+\]::File \\([^ \\t\\n]+\\) Line \\([0-9]+\\):" 1 2 nil) ("" 0) |
| 317 | nil) |
| 318 | ;; Synopsys, VHDL Analyzer (sim): vhdlan -nc test.vhd |
| 319 | ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. |
| 320 | ("Synopsys" "vhdlan" "-nc -work \\1" "make" "-f \\1" |
| 321 | nil "mkdir \\1" "./" "work/" "Makefile" "synopsys" |
| 322 | ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) |
| 323 | ("\\1.sim" "\\2__\\1.sim" "\\1.sim" "\\1.sim" "\\1__.sim" upcase)) |
| 324 | ;; Synopsys, VHDL Analyzer (syn): vhdlan -nc -spc test.vhd |
| 325 | ;; **Error: vhdlan,703 test.vhd(22): OTHERS is not legal in this context. |
| 326 | ("Synopsys Design Compiler" "vhdlan" "-nc -spc -work \\1" "make" "-f \\1" |
| 327 | nil "mkdir \\1" "./" "work/" "Makefile" "synopsys_dc" |
| 328 | ("\\*\\*Error: vhdlan,[0-9]+ \\([^ \\t\\n]+\\)(\\([0-9]+\\)):" 1 2 nil) ("" 0) |
| 329 | ("\\1.syn" "\\2__\\1.syn" "\\1.syn" "\\1.syn" "\\1__.syn" upcase)) |
| 330 | ;; Synplify: |
| 331 | ;; @W:"test.vhd":57:8:57:9|Optimizing register bit count_x(5) to a constant 0 |
| 332 | ("Synplify" "n/a" "n/a" "make" "-f \\1" |
| 333 | nil "mkdir \\1" "./" "work/" "Makefile" "synplify" |
| 334 | ("@[EWN]:\"\\([^ \\t\\n]+\\)\":\\([0-9]+\\):\\([0-9]+\\):" 1 2 3) ("" 0) |
| 335 | nil) |
| 336 | ;; Vantage: analyze -libfile vsslib.ini -src test.vhd |
| 337 | ;; Compiling "test.vhd" line 1... |
| 338 | ;; **Error: LINE 49 *** No aggregate value is valid in this context. |
| 339 | ("Vantage" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 340 | nil "mkdir \\1" "./" "work/" "Makefile" "vantage" |
| 341 | ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) |
| 342 | ("^ *Compiling \"\\(.+\\)\" " 1) |
| 343 | nil) |
| 344 | ;; VeriBest: vc vhdl test.vhd |
| 345 | ;; (no file name printed out!) |
| 346 | ;; 32: Z <= A and BitA ; |
| 347 | ;; ^^^^ |
| 348 | ;; [Error] Name BITA is unknown |
| 349 | ("VeriBest" "vc" "vhdl" "make" "-f \\1" |
| 350 | nil "mkdir \\1" "./" "work/" "Makefile" "veribest" |
| 351 | ("^ +\\([0-9]+\\): +[^ ]" nil 1 nil) ("" 0) |
| 352 | nil) |
| 353 | ;; Viewlogic: analyze -libfile vsslib.ini -src test.vhd |
| 354 | ;; Compiling "test.vhd" line 1... |
| 355 | ;; **Error: LINE 49 *** No aggregate value is valid in this context. |
| 356 | ("Viewlogic" "analyze" "-libfile vsslib.ini -src" "make" "-f \\1" |
| 357 | nil "mkdir \\1" "./" "work/" "Makefile" "viewlogic" |
| 358 | ("\\*\\*Error: LINE \\([0-9]+\\) \\*\\*\\*" nil 1 nil) |
| 359 | ("^ *Compiling \"\\(.+\\)\" " 1) |
| 360 | nil) |
| 361 | ;; Xilinx XST: |
| 362 | ;; ERROR:HDLParsers:164 - "test.vhd" Line 3. parse error |
| 363 | ("Xilinx XST" "xflow" "" "make" "-f \\1" |
| 364 | nil "mkdir \\1" "./" "work/" "Makefile" "xilinx" |
| 365 | ("^ERROR:HDLParsers:[0-9]+ - \"\\([^ \\t\\n]+\\)\" Line \\([0-9]+\\)\." 1 2 nil) ("" 0) |
| 366 | nil) |
| 367 | ) |
| 368 | "List of available VHDL compilers and their properties. |
| 369 | Each list entry specifies the following items for a compiler: |
| 370 | Compiler: |
| 371 | Compiler name : name used in option `vhdl-compiler' to choose compiler |
| 372 | Compile command : command used for source file compilation |
| 373 | Compile options : compile options (\"\\1\" inserts library name) |
| 374 | Make command : command used for compilation using a Makefile |
| 375 | Make options : make options (\"\\1\" inserts Makefile name) |
| 376 | Generate Makefile: use built-in function or command to generate a Makefile |
| 377 | \(\"\\1\" inserts Makefile name, \"\\2\" inserts library name) |
| 378 | Library command : command to create library directory \(\"\\1\" inserts |
| 379 | library directory, \"\\2\" inserts library name) |
| 380 | Compile directory: where compilation is run and the Makefile is placed |
| 381 | Library directory: directory of default library |
| 382 | Makefile name : name of Makefile (default is \"Makefile\") |
| 383 | ID string : compiler identification string (see `vhdl-project-alist') |
| 384 | Error message: |
| 385 | Regexp : regular expression to match error messages (*) |
| 386 | File subexp index: index of subexpression that matches the file name |
| 387 | Line subexp index: index of subexpression that matches the line number |
| 388 | Column subexp idx: index of subexpression that matches the column number |
| 389 | File message: |
| 390 | Regexp : regular expression to match a file name message |
| 391 | File subexp index: index of subexpression that matches the file name |
| 392 | Unit-to-file name mapping: mapping of library unit names to names of files |
| 393 | generated by the compiler (used for Makefile generation) |
| 394 | To string : string a name is mapped to (\"\\1\" inserts the unit name, |
| 395 | \"\\2\" inserts the entity name for architectures, |
| 396 | \"\\3\" inserts the library name) |
| 397 | Case adjustment : adjust case of inserted unit names |
| 398 | |
| 399 | \(*) The regular expression must match the error message starting from the |
| 400 | beginning of the line (but not necessarily to the end of the line). |
| 401 | |
| 402 | Compile options allows insertion of the library name (see `vhdl-project-alist') |
| 403 | in order to set the compilers library option (e.g. \"vcom -work my_lib\"). |
| 404 | |
| 405 | For Makefile generation, the built-in function can be used (requires |
| 406 | specification of the unit-to-file name mapping). Alternatively, an |
| 407 | external command can be specified. Work directory allows specification of |
| 408 | an alternative \"work\" library path (e.g. \"WORK/\" instead of \"work/\", |
| 409 | used for Makefile generation). To use another library name than \"work\", |
| 410 | customize `vhdl-project-alist'. The library command is inserted in Makefiles |
| 411 | to automatically create the library directory if not existent. |
| 412 | |
| 413 | Compile options, compile directory, library directory, and Makefile name are |
| 414 | overwritten by the project settings if a project is defined (see |
| 415 | `vhdl-project-alist'). Directory paths are relative to the source file |
| 416 | directory. |
| 417 | |
| 418 | Some compilers do not include the file name in the error message, but print |
| 419 | out a file name message in advance. In this case, set \"File Subexp Index\" |
| 420 | under \"Error Message\" to 0 and fill out the \"File Message\" entries. |
| 421 | If no file name at all is printed out, set both \"File Message\" entries to 0 |
| 422 | \(a default file name message will be printed out instead, does not work in |
| 423 | XEmacs). |
| 424 | |
| 425 | A compiler is selected for syntax analysis (`\\[vhdl-compile]') by |
| 426 | assigning its name to option `vhdl-compiler'. |
| 427 | |
| 428 | Please send any missing or erroneous compiler properties to the maintainer for |
| 429 | updating. |
| 430 | |
| 431 | NOTE: Activate new error and file message regexps and reflect the new setting |
| 432 | in the choice list of option `vhdl-compiler' by restarting Emacs." |
| 433 | :type '(repeat |
| 434 | (list :tag "Compiler" :indent 2 |
| 435 | (string :tag "Compiler name ") |
| 436 | (string :tag "Compile command ") |
| 437 | (string :tag "Compile options " "-work \\1") |
| 438 | (string :tag "Make command " "make") |
| 439 | (string :tag "Make options " "-f \\1") |
| 440 | (choice :tag "Generate Makefile " |
| 441 | (const :tag "Built-in function" nil) |
| 442 | (string :tag "Command" "vmake \\2 > \\1")) |
| 443 | (string :tag "Library command " "mkdir \\1") |
| 444 | (directory :tag "Compile directory " |
| 445 | :validate vhdl-widget-directory-validate "./") |
| 446 | (directory :tag "Library directory " |
| 447 | :validate vhdl-widget-directory-validate "work/") |
| 448 | (file :tag "Makefile name " "Makefile") |
| 449 | (string :tag "ID string ") |
| 450 | (list :tag "Error message" :indent 4 |
| 451 | (regexp :tag "Regexp ") |
| 452 | (choice :tag "File subexp " |
| 453 | (integer :tag "Index") |
| 454 | (const :tag "No file name" nil)) |
| 455 | (integer :tag "Line subexp index") |
| 456 | (choice :tag "Column subexp " |
| 457 | (integer :tag "Index") |
| 458 | (const :tag "No column number" nil))) |
| 459 | (list :tag "File message" :indent 4 |
| 460 | (regexp :tag "Regexp ") |
| 461 | (integer :tag "File subexp index")) |
| 462 | (choice :tag "Unit-to-file name mapping" |
| 463 | :format "%t: %[Value Menu%] %v\n" |
| 464 | (const :tag "Not defined" nil) |
| 465 | (list :tag "To string" :indent 4 |
| 466 | (string :tag "Entity " "\\1.vhd") |
| 467 | (string :tag "Architecture " "\\2_\\1.vhd") |
| 468 | (string :tag "Configuration " "\\1.vhd") |
| 469 | (string :tag "Package " "\\1.vhd") |
| 470 | (string :tag "Package Body " "\\1_body.vhd") |
| 471 | (choice :tag "Case adjustment " |
| 472 | (const :tag "None" identity) |
| 473 | (const :tag "Upcase" upcase) |
| 474 | (const :tag "Downcase" downcase)))))) |
| 475 | :set (lambda (variable value) |
| 476 | (vhdl-custom-set variable value 'vhdl-update-mode-menu)) |
| 477 | :version "24.4" |
| 478 | :group 'vhdl-compile) |
| 479 | |
| 480 | (defcustom vhdl-compiler "GHDL" |
| 481 | "Specifies the VHDL compiler to be used for syntax analysis. |
| 482 | Select a compiler name from the ones defined in option `vhdl-compiler-alist'." |
| 483 | :type (let ((alist vhdl-compiler-alist) list) |
| 484 | (while alist |
| 485 | (push (list 'const (caar alist)) list) |
| 486 | (setq alist (cdr alist))) |
| 487 | (append '(choice) (nreverse list))) |
| 488 | :group 'vhdl-compile) |
| 489 | |
| 490 | (defcustom vhdl-compile-use-local-error-regexp t |
| 491 | "Non-nil means use buffer-local `compilation-error-regexp-alist'. |
| 492 | In this case, only error message regexps for VHDL compilers are active if |
| 493 | compilation is started from a VHDL buffer. Otherwise, the error message |
| 494 | regexps are appended to the predefined global regexps, and all regexps are |
| 495 | active all the time. Note that by doing that, the predefined global regexps |
| 496 | might result in erroneous parsing of error messages for some VHDL compilers. |
| 497 | |
| 498 | NOTE: Activate the new setting by restarting Emacs." |
| 499 | :type 'boolean |
| 500 | :group 'vhdl-compile) |
| 501 | |
| 502 | (defcustom vhdl-makefile-default-targets '("all" "clean" "library") |
| 503 | "List of default target names in Makefiles. |
| 504 | Automatically generated Makefiles include three default targets to compile |
| 505 | the entire design, clean the entire design and to create the design library. |
| 506 | This option allows to change the names of these targets to avoid conflicts |
| 507 | with other user Makefiles." |
| 508 | :type '(list (string :tag "Compile entire design") |
| 509 | (string :tag "Clean entire design ") |
| 510 | (string :tag "Create design library")) |
| 511 | :version "24.3" |
| 512 | :group 'vhdl-compile) |
| 513 | |
| 514 | (defcustom vhdl-makefile-generation-hook nil |
| 515 | "Functions to run at the end of Makefile generation. |
| 516 | Allows to insert user specific parts into a Makefile. |
| 517 | |
| 518 | Example: |
| 519 | \(lambda nil |
| 520 | \(re-search-backward \"^# Rule for compiling entire design\") |
| 521 | \(insert \"# My target\\n\\n.MY_TARGET :\\n\\n\\n\"))" |
| 522 | :type 'hook |
| 523 | :group 'vhdl-compile) |
| 524 | |
| 525 | (defcustom vhdl-default-library "work" |
| 526 | "Name of default library. |
| 527 | Is overwritten by project settings if a project is active." |
| 528 | :type 'string |
| 529 | :group 'vhdl-compile) |
| 530 | |
| 531 | |
| 532 | (defgroup vhdl-project nil |
| 533 | "Customizations for projects." |
| 534 | :group 'vhdl) |
| 535 | |
| 536 | (defcustom vhdl-project-alist |
| 537 | '(("Example 1" "Source files in two directories, custom library name, VHDL'87" |
| 538 | "~/example1/" ("src/system/" "src/components/") "" |
| 539 | (("ModelSim" "-87 \\2" "-f \\1 top_level" nil) |
| 540 | ("Synopsys" "-vhdl87 \\2" "-f \\1 top_level" ((".*/datapath/.*" . "-optimize \\3") (".*_tb\\.vhd" . nil)))) |
| 541 | "lib/" "example3_lib" "lib/example3/" "Makefile_\\2" "") |
| 542 | ("Example 2" "Individual source files, multiple compilers in different directories" |
| 543 | "$EXAMPLE2/" ("vhdl/system.vhd" "vhdl/component_*.vhd") "" |
| 544 | nil "\\1/" "work" "\\1/work/" "Makefile" "") |
| 545 | ("Example 3" "Source files in a directory tree, multiple compilers in same directory" |
| 546 | "/home/me/example3/" ("-r ./*/vhdl/") "/CVS/" |
| 547 | nil "./" "work" "work-\\1/" "Makefile-\\1" "\ |
| 548 | ------------------------------------------------------------------------------- |
| 549 | -- This is a multi-line project description |
| 550 | -- that can be used as a project dependent part of the file header. |
| 551 | ")) |
| 552 | "List of projects and their properties. |
| 553 | Name : name used in option `vhdl-project' to choose project |
| 554 | Title : title of project (single-line string) |
| 555 | Default directory: default project directory (absolute path) |
| 556 | Sources : a) source files : path + \"/\" + file name |
| 557 | b) directory : path + \"/\" |
| 558 | c) directory tree: \"-r \" + path + \"/\" |
| 559 | Exclude regexp : matches file/directory names to be excluded as sources |
| 560 | Compile options : project-specific options for each compiler |
| 561 | Compiler name : name of compiler for which these options are valid |
| 562 | Compile options: project-specific compiler options |
| 563 | (\"\\1\" inserts library name, \"\\2\" default options) |
| 564 | Make options: project-specific make options |
| 565 | (\"\\1\" inserts Makefile name, \"\\2\" default options) |
| 566 | Exceptions : file-specific exceptions |
| 567 | File name regexp: matches file names for which exceptions are valid |
| 568 | - Options : file-specific compiler options string |
| 569 | (\"\\1\" inserts library name, \"\\2\" default options, |
| 570 | \"\\3\" project-specific options) |
| 571 | - Do not compile: do not compile this file (in Makefile) |
| 572 | Compile directory: where compilation is run and the Makefile is placed |
| 573 | \(\"\\1\" inserts compiler ID string) |
| 574 | Library name : name of library (default is \"work\") |
| 575 | Library directory: path to library (\"\\1\" inserts compiler ID string) |
| 576 | Makefile name : name of Makefile |
| 577 | (\"\\1\" inserts compiler ID string, \"\\2\" library name) |
| 578 | Description : description of project (multi-line string) |
| 579 | |
| 580 | Project title and description are used to insert into the file header (see |
| 581 | option `vhdl-file-header'). |
| 582 | |
| 583 | The default directory must have an absolute path (use `M-TAB' for completion). |
| 584 | All other paths can be absolute or relative to the default directory. All |
| 585 | paths must end with '/'. |
| 586 | |
| 587 | The design units found in the sources (files and directories) are shown in the |
| 588 | hierarchy browser. Path and file name can contain wildcards `*' and `?' as |
| 589 | well as \"./\" and \"../\" (\"sh\" syntax). Paths can also be absolute. |
| 590 | Environment variables (e.g. \"$EXAMPLE2\") are resolved. If no sources are |
| 591 | specified, the default directory is taken as source directory. Otherwise, |
| 592 | the default directory is only taken as source directory if there is a sources |
| 593 | entry with the empty string or \"./\". Exclude regexp allows to filter out |
| 594 | specific file and directory names from the list of sources (e.g. CVS |
| 595 | directories). |
| 596 | |
| 597 | Files are compiled in the compile directory. Makefiles are also placed into |
| 598 | the compile directory. Library directory specifies which directory the |
| 599 | compiler compiles into (used to generate the Makefile). |
| 600 | |
| 601 | Since different compile/library directories and Makefiles may exist for |
| 602 | different compilers within one project, these paths and names allow the |
| 603 | insertion of a compiler-dependent ID string (defined in `vhdl-compiler-alist'). |
| 604 | Compile options, compile directory, library directory, and Makefile name |
| 605 | overwrite the settings of the current compiler. |
| 606 | |
| 607 | File-specific compiler options (highest priority) overwrite project-specific |
| 608 | options which overwrite default options (lowest priority). Lower priority |
| 609 | options can be inserted in higher priority options. This allows to reuse |
| 610 | default options (e.g. \"-file\") in project- or file-specific options (e.g. |
| 611 | \"-93 -file\"). |
| 612 | |
| 613 | NOTE: Reflect the new setting in the choice list of option `vhdl-project' |
| 614 | by restarting Emacs." |
| 615 | :type `(repeat |
| 616 | (list :tag "Project" :indent 2 |
| 617 | (string :tag "Name ") |
| 618 | (string :tag "Title ") |
| 619 | (directory :tag "Default directory" |
| 620 | :validate vhdl-widget-directory-validate |
| 621 | ,(abbreviate-file-name default-directory)) |
| 622 | (repeat :tag "Sources " :indent 4 |
| 623 | (directory :format " %v" "./")) |
| 624 | (regexp :tag "Exclude regexp ") |
| 625 | (repeat |
| 626 | :tag "Compile options " :indent 4 |
| 627 | (list :tag "Compiler" :indent 6 |
| 628 | ,(let ((alist vhdl-compiler-alist) list) |
| 629 | (while alist |
| 630 | (push (list 'const (caar alist)) list) |
| 631 | (setq alist (cdr alist))) |
| 632 | (append '(choice :tag "Compiler name") |
| 633 | (nreverse list))) |
| 634 | (string :tag "Compile options" "\\2") |
| 635 | (string :tag "Make options " "\\2") |
| 636 | (repeat |
| 637 | :tag "Exceptions " :indent 8 |
| 638 | (cons :format "%v" |
| 639 | (regexp :tag "File name regexp ") |
| 640 | (choice :format "%[Value Menu%] %v" |
| 641 | (string :tag "Options" "\\3") |
| 642 | (const :tag "Do not compile" nil)))))) |
| 643 | (directory :tag "Compile directory" |
| 644 | :validate vhdl-widget-directory-validate "./") |
| 645 | (string :tag "Library name " "work") |
| 646 | (directory :tag "Library directory" |
| 647 | :validate vhdl-widget-directory-validate "work/") |
| 648 | (file :tag "Makefile name " "Makefile") |
| 649 | (string :tag "Description: (type `C-j' for newline)" |
| 650 | :format "%t\n%v\n"))) |
| 651 | :set (lambda (variable value) |
| 652 | (vhdl-custom-set variable value |
| 653 | 'vhdl-update-mode-menu |
| 654 | 'vhdl-speedbar-refresh)) |
| 655 | :group 'vhdl-project) |
| 656 | |
| 657 | (defcustom vhdl-project nil |
| 658 | "Specifies the default for the current project. |
| 659 | Select a project name from the ones defined in option `vhdl-project-alist'. |
| 660 | Is used to determine the project title and description to be inserted in file |
| 661 | headers and the source files/directories to be scanned in the hierarchy |
| 662 | browser. The current project can also be changed temporarily in the menu." |
| 663 | :type (let ((alist vhdl-project-alist) list) |
| 664 | (while alist |
| 665 | (push (list 'const (caar alist)) list) |
| 666 | (setq alist (cdr alist))) |
| 667 | (append '(choice (const :tag "None" nil) (const :tag "--")) |
| 668 | (nreverse list))) |
| 669 | :group 'vhdl-project) |
| 670 | |
| 671 | (defcustom vhdl-project-file-name '("\\1.prj") |
| 672 | "List of file names/paths for importing/exporting project setups. |
| 673 | \"\\1\" is replaced by the project name (SPC is replaced by `_'), \"\\2\" is |
| 674 | replaced by the user name (allows to have user-specific project setups). |
| 675 | The first entry is used as file name to import/export individual project |
| 676 | setups. All entries are used to automatically import project setups at |
| 677 | startup (see option `vhdl-project-auto-load'). Projects loaded from the |
| 678 | first entry are automatically made current. Hint: specify local project |
| 679 | setups in first entry, global setups in following entries; loading a local |
| 680 | project setup will make it current, while loading the global setups |
| 681 | is done without changing the current project. |
| 682 | Names can also have an absolute path (i.e. project setups can be stored |
| 683 | in global directories)." |
| 684 | :type '(repeat (string :tag "File name" "\\1.prj")) |
| 685 | :group 'vhdl-project) |
| 686 | |
| 687 | (defcustom vhdl-project-auto-load '(startup) |
| 688 | "Automatically load project setups from files. |
| 689 | All project setup files that match the file names specified in option |
| 690 | `vhdl-project-file-name' are automatically loaded. The project of the |
| 691 | \(alphabetically) last loaded setup of the first `vhdl-project-file-name' |
| 692 | entry is activated. |
| 693 | A project setup file can be obtained by exporting a project (see menu). |
| 694 | At startup: project setup file is loaded at Emacs startup" |
| 695 | :type '(set (const :tag "At startup" startup)) |
| 696 | :group 'vhdl-project) |
| 697 | |
| 698 | (defcustom vhdl-project-sort t |
| 699 | "Non-nil means projects are displayed in alphabetical order." |
| 700 | :type 'boolean |
| 701 | :group 'vhdl-project) |
| 702 | |
| 703 | |
| 704 | (defgroup vhdl-style nil |
| 705 | "Customizations for coding styles." |
| 706 | :group 'vhdl |
| 707 | :group 'vhdl-template |
| 708 | :group 'vhdl-port |
| 709 | :group 'vhdl-compose) |
| 710 | |
| 711 | (defcustom vhdl-standard '(93 nil) |
| 712 | "VHDL standards used. |
| 713 | Basic standard: |
| 714 | VHDL'87 : IEEE Std 1076-1987 |
| 715 | VHDL'93/02 : IEEE Std 1076-1993/2002 |
| 716 | Additional standards: |
| 717 | VHDL-AMS : IEEE Std 1076.1 (analog-mixed-signal) |
| 718 | Math packages: IEEE Std 1076.2 (`math_real', `math_complex') |
| 719 | |
| 720 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 721 | \"Activate Options\"." |
| 722 | :type '(list (choice :tag "Basic standard" |
| 723 | (const :tag "VHDL'87" 87) |
| 724 | (const :tag "VHDL'93/02" 93)) |
| 725 | (set :tag "Additional standards" :indent 2 |
| 726 | (const :tag "VHDL-AMS" ams) |
| 727 | (const :tag "Math packages" math))) |
| 728 | :set (lambda (variable value) |
| 729 | (vhdl-custom-set variable value |
| 730 | 'vhdl-template-map-init |
| 731 | 'vhdl-mode-abbrev-table-init |
| 732 | 'vhdl-template-construct-alist-init |
| 733 | 'vhdl-template-package-alist-init |
| 734 | 'vhdl-update-mode-menu |
| 735 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 736 | :group 'vhdl-style) |
| 737 | |
| 738 | (defcustom vhdl-basic-offset 2 |
| 739 | "Amount of basic offset used for indentation. |
| 740 | This value is used by + and - symbols in `vhdl-offsets-alist'." |
| 741 | :type 'integer |
| 742 | :group 'vhdl-style) |
| 743 | |
| 744 | (defcustom vhdl-upper-case-keywords nil |
| 745 | "Non-nil means convert keywords to upper case. |
| 746 | This is done when typed or expanded or by the fix case functions." |
| 747 | :type 'boolean |
| 748 | :set (lambda (variable value) |
| 749 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 750 | :group 'vhdl-style) |
| 751 | |
| 752 | (defcustom vhdl-upper-case-types nil |
| 753 | "Non-nil means convert standardized types to upper case. |
| 754 | This is done when expanded or by the fix case functions." |
| 755 | :type 'boolean |
| 756 | :set (lambda (variable value) |
| 757 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 758 | :group 'vhdl-style) |
| 759 | |
| 760 | (defcustom vhdl-upper-case-attributes nil |
| 761 | "Non-nil means convert standardized attributes to upper case. |
| 762 | This is done when expanded or by the fix case functions." |
| 763 | :type 'boolean |
| 764 | :set (lambda (variable value) |
| 765 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 766 | :group 'vhdl-style) |
| 767 | |
| 768 | (defcustom vhdl-upper-case-enum-values nil |
| 769 | "Non-nil means convert standardized enumeration values to upper case. |
| 770 | This is done when expanded or by the fix case functions." |
| 771 | :type 'boolean |
| 772 | :set (lambda (variable value) |
| 773 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 774 | :group 'vhdl-style) |
| 775 | |
| 776 | (defcustom vhdl-upper-case-constants t |
| 777 | "Non-nil means convert standardized constants to upper case. |
| 778 | This is done when expanded." |
| 779 | :type 'boolean |
| 780 | :set (lambda (variable value) |
| 781 | (vhdl-custom-set variable value 'vhdl-abbrev-list-init)) |
| 782 | :group 'vhdl-style) |
| 783 | |
| 784 | (defcustom vhdl-use-direct-instantiation 'standard |
| 785 | "Non-nil means use VHDL'93 direct component instantiation. |
| 786 | Never : never |
| 787 | Standard: only in VHDL standards that allow it (VHDL'93 and higher) |
| 788 | Always : always" |
| 789 | :type '(choice (const :tag "Never" never) |
| 790 | (const :tag "Standard" standard) |
| 791 | (const :tag "Always" always)) |
| 792 | :group 'vhdl-style) |
| 793 | |
| 794 | (defcustom vhdl-array-index-record-field-in-sensitivity-list t |
| 795 | "Non-nil means include array indices / record fields in sensitivity list. |
| 796 | If a signal read in a process is a record field or pointed to by an array |
| 797 | index, the record field or array index is included with the record name in |
| 798 | the sensitivity list (e.g. \"in1(0)\", \"in2.f0\"). |
| 799 | Otherwise, only the record name is included (e.g. \"in1\", \"in2\")." |
| 800 | :type 'boolean |
| 801 | :version "24.3" |
| 802 | :group 'vhdl-style) |
| 803 | |
| 804 | (defgroup vhdl-naming nil |
| 805 | "Customizations for naming conventions." |
| 806 | :group 'vhdl) |
| 807 | |
| 808 | (defcustom vhdl-entity-file-name '(".*" . "\\&") |
| 809 | (concat |
| 810 | "Specifies how the entity file name is obtained. |
| 811 | The entity file name can be obtained by modifying the entity name (e.g. |
| 812 | attaching or stripping off a substring). The file extension is automatically |
| 813 | taken from the file name of the current buffer." |
| 814 | vhdl-name-doc-string) |
| 815 | :type '(cons (regexp :tag "From regexp") |
| 816 | (string :tag "To string ")) |
| 817 | :group 'vhdl-naming |
| 818 | :group 'vhdl-compose) |
| 819 | |
| 820 | (defcustom vhdl-architecture-file-name '("\\(.*\\) \\(.*\\)" . "\\1_\\2") |
| 821 | (concat |
| 822 | "Specifies how the architecture file name is obtained. |
| 823 | The architecture file name can be obtained by modifying the entity |
| 824 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 825 | file extension is automatically taken from the file name of the current |
| 826 | buffer. The string that is matched against the regexp is the concatenation |
| 827 | of the entity and the architecture name separated by a space. This gives |
| 828 | access to both names (see default setting as example)." |
| 829 | vhdl-name-doc-string) |
| 830 | :type '(cons (regexp :tag "From regexp") |
| 831 | (string :tag "To string ")) |
| 832 | :group 'vhdl-naming |
| 833 | :group 'vhdl-compose) |
| 834 | |
| 835 | (defcustom vhdl-configuration-file-name '(".*" . "\\&") |
| 836 | (concat |
| 837 | "Specifies how the configuration file name is obtained. |
| 838 | The configuration file name can be obtained by modifying the configuration |
| 839 | name (e.g. attaching or stripping off a substring). The file extension is |
| 840 | automatically taken from the file name of the current buffer." |
| 841 | vhdl-name-doc-string) |
| 842 | :type '(cons (regexp :tag "From regexp") |
| 843 | (string :tag "To string ")) |
| 844 | :group 'vhdl-naming |
| 845 | :group 'vhdl-compose) |
| 846 | |
| 847 | (defcustom vhdl-package-file-name '(".*" . "\\&") |
| 848 | (concat |
| 849 | "Specifies how the package file name is obtained. |
| 850 | The package file name can be obtained by modifying the package name (e.g. |
| 851 | attaching or stripping off a substring). The file extension is automatically |
| 852 | taken from the file name of the current buffer. Package files can be created |
| 853 | in a different directory by prepending a relative or absolute path to the |
| 854 | file name." |
| 855 | vhdl-name-doc-string) |
| 856 | :type '(cons (regexp :tag "From regexp") |
| 857 | (string :tag "To string ")) |
| 858 | :group 'vhdl-naming |
| 859 | :group 'vhdl-compose) |
| 860 | |
| 861 | (defcustom vhdl-file-name-case 'identity |
| 862 | "Specifies how to change case for obtaining file names. |
| 863 | When deriving a file name from a VHDL unit name, case can be changed as |
| 864 | follows: |
| 865 | As Is: case is not changed (taken as is) |
| 866 | Lower Case: whole name is changed to lower case |
| 867 | Upper Case: whole name is changed to upper case |
| 868 | Capitalize: first letter of each word in name is capitalized" |
| 869 | :type '(choice (const :tag "As Is" identity) |
| 870 | (const :tag "Lower Case" downcase) |
| 871 | (const :tag "Upper Case" upcase) |
| 872 | (const :tag "Capitalize" capitalize)) |
| 873 | :group 'vhdl-naming |
| 874 | :group 'vhdl-compose) |
| 875 | |
| 876 | |
| 877 | (defgroup vhdl-template nil |
| 878 | "Customizations for electrification." |
| 879 | :group 'vhdl) |
| 880 | |
| 881 | (defcustom vhdl-electric-keywords '(vhdl user) |
| 882 | "Type of keywords for which electrification is enabled. |
| 883 | VHDL keywords: invoke built-in templates |
| 884 | User keywords: invoke user models (see option `vhdl-model-alist')" |
| 885 | :type '(set (const :tag "VHDL keywords" vhdl) |
| 886 | (const :tag "User model keywords" user)) |
| 887 | :set (lambda (variable value) |
| 888 | (vhdl-custom-set variable value 'vhdl-mode-abbrev-table-init)) |
| 889 | :group 'vhdl-template) |
| 890 | |
| 891 | (defcustom vhdl-optional-labels 'process |
| 892 | "Constructs for which labels are to be queried. |
| 893 | Template generators prompt for optional labels for: |
| 894 | None : no constructs |
| 895 | Processes only: processes only (also procedurals in VHDL-AMS) |
| 896 | All constructs: all constructs with optional labels and keyword END" |
| 897 | :type '(choice (const :tag "None" none) |
| 898 | (const :tag "Processes only" process) |
| 899 | (const :tag "All constructs" all)) |
| 900 | :group 'vhdl-template) |
| 901 | |
| 902 | (defcustom vhdl-insert-empty-lines 'unit |
| 903 | "Specifies whether to insert empty lines in some templates. |
| 904 | This improves readability of code. Empty lines are inserted in: |
| 905 | None : no constructs |
| 906 | Design units only: entities, architectures, configurations, packages only |
| 907 | All constructs : also all constructs with BEGIN...END parts |
| 908 | |
| 909 | Replaces option `vhdl-additional-empty-lines'." |
| 910 | :type '(choice (const :tag "None" none) |
| 911 | (const :tag "Design units only" unit) |
| 912 | (const :tag "All constructs" all)) |
| 913 | :group 'vhdl-template |
| 914 | :group 'vhdl-port |
| 915 | :group 'vhdl-compose) |
| 916 | |
| 917 | (defcustom vhdl-argument-list-indent nil |
| 918 | "Non-nil means indent argument lists relative to opening parenthesis. |
| 919 | That is, argument, association, and port lists start on the same line as the |
| 920 | opening parenthesis and subsequent lines are indented accordingly. |
| 921 | Otherwise, lists start on a new line and are indented as normal code." |
| 922 | :type 'boolean |
| 923 | :group 'vhdl-template |
| 924 | :group 'vhdl-port |
| 925 | :group 'vhdl-compose) |
| 926 | |
| 927 | (defcustom vhdl-association-list-with-formals t |
| 928 | "Non-nil means write association lists with formal parameters. |
| 929 | Templates prompt for formal and actual parameters (ports/generics). |
| 930 | When pasting component instantiations, formals are included. |
| 931 | If nil, only a list of actual parameters is entered." |
| 932 | :type 'boolean |
| 933 | :group 'vhdl-template |
| 934 | :group 'vhdl-port |
| 935 | :group 'vhdl-compose) |
| 936 | |
| 937 | (defcustom vhdl-conditions-in-parenthesis nil |
| 938 | "Non-nil means place parenthesis around condition expressions." |
| 939 | :type 'boolean |
| 940 | :group 'vhdl-template) |
| 941 | |
| 942 | (defcustom vhdl-zero-string "'0'" |
| 943 | "String to use for a logic zero." |
| 944 | :type 'string |
| 945 | :group 'vhdl-template) |
| 946 | |
| 947 | (defcustom vhdl-one-string "'1'" |
| 948 | "String to use for a logic one." |
| 949 | :type 'string |
| 950 | :group 'vhdl-template) |
| 951 | |
| 952 | |
| 953 | (defgroup vhdl-header nil |
| 954 | "Customizations for file header." |
| 955 | :group 'vhdl-template |
| 956 | :group 'vhdl-compose) |
| 957 | |
| 958 | (defcustom vhdl-file-header "\ |
| 959 | ------------------------------------------------------------------------------- |
| 960 | -- Title : <title string> |
| 961 | -- Project : <project> |
| 962 | ------------------------------------------------------------------------------- |
| 963 | -- File : <filename> |
| 964 | -- Author : <author> |
| 965 | -- Company : <company> |
| 966 | -- Created : <date> |
| 967 | -- Last update: <date> |
| 968 | -- Platform : <platform> |
| 969 | -- Standard : <standard> |
| 970 | <projectdesc>------------------------------------------------------------------------------- |
| 971 | -- Description: <cursor> |
| 972 | <copyright>------------------------------------------------------------------------------- |
| 973 | -- Revisions : |
| 974 | -- Date Version Author Description |
| 975 | -- <date> 1.0 <login>\tCreated |
| 976 | ------------------------------------------------------------------------------- |
| 977 | |
| 978 | " |
| 979 | "String or file to insert as file header. |
| 980 | If the string specifies an existing file name, the contents of the file is |
| 981 | inserted, otherwise the string itself is inserted as file header. |
| 982 | Type `C-j' for newlines. |
| 983 | If the header contains RCS keywords, they may be written as <RCS>Keyword<RCS> |
| 984 | if the header needs to be version controlled. |
| 985 | |
| 986 | The following keywords for template generation are supported: |
| 987 | <filename> : replaced by the name of the buffer |
| 988 | <author> : replaced by the user name and email address |
| 989 | \(`user-full-name',`mail-host-address', `user-mail-address') |
| 990 | <authorfull> : replaced by the user full name (`user-full-name') |
| 991 | <login> : replaced by user login name (`user-login-name') |
| 992 | <company> : replaced by contents of option `vhdl-company-name' |
| 993 | <date> : replaced by the current date |
| 994 | <year> : replaced by the current year |
| 995 | <project> : replaced by title of current project (`vhdl-project') |
| 996 | <projectdesc> : replaced by description of current project (`vhdl-project') |
| 997 | <copyright> : replaced by copyright string (`vhdl-copyright-string') |
| 998 | <platform> : replaced by contents of option `vhdl-platform-spec' |
| 999 | <standard> : replaced by the VHDL language standard(s) used |
| 1000 | <... string> : replaced by a queried string (\"...\" is the prompt word) |
| 1001 | <title string>: replaced by file title in automatically generated files |
| 1002 | <cursor> : final cursor position |
| 1003 | |
| 1004 | The (multi-line) project description <projectdesc> can be used as a project |
| 1005 | dependent part of the file header and can also contain the above keywords." |
| 1006 | :type 'string |
| 1007 | :group 'vhdl-header) |
| 1008 | |
| 1009 | (defcustom vhdl-file-footer "" |
| 1010 | "String or file to insert as file footer. |
| 1011 | If the string specifies an existing file name, the contents of the file is |
| 1012 | inserted, otherwise the string itself is inserted as file footer (i.e. at |
| 1013 | the end of the file). |
| 1014 | Type `C-j' for newlines. |
| 1015 | The same keywords as in option `vhdl-file-header' can be used." |
| 1016 | :type 'string |
| 1017 | :group 'vhdl-header) |
| 1018 | |
| 1019 | (defcustom vhdl-company-name "" |
| 1020 | "Name of company to insert in file header. |
| 1021 | See option `vhdl-file-header'." |
| 1022 | :type 'string |
| 1023 | :group 'vhdl-header) |
| 1024 | |
| 1025 | (defcustom vhdl-copyright-string "\ |
| 1026 | ------------------------------------------------------------------------------- |
| 1027 | -- Copyright (c) <year> <company> |
| 1028 | " |
| 1029 | "Copyright string to insert in file header. |
| 1030 | Can be multi-line string (type `C-j' for newline) and contain other file |
| 1031 | header keywords (see option `vhdl-file-header')." |
| 1032 | :type 'string |
| 1033 | :group 'vhdl-header) |
| 1034 | |
| 1035 | (defcustom vhdl-platform-spec "" |
| 1036 | "Specification of VHDL platform to insert in file header. |
| 1037 | The platform specification should contain names and versions of the |
| 1038 | simulation and synthesis tools used. |
| 1039 | See option `vhdl-file-header'." |
| 1040 | :type 'string |
| 1041 | :group 'vhdl-header) |
| 1042 | |
| 1043 | (defcustom vhdl-date-format "%Y-%m-%d" |
| 1044 | "Specifies the date format to use in the header. |
| 1045 | This string is passed as argument to the command `format-time-string'. |
| 1046 | For more information on format strings, see the documentation for the |
| 1047 | `format-time-string' command (C-h f `format-time-string')." |
| 1048 | :type 'string |
| 1049 | :group 'vhdl-header) |
| 1050 | |
| 1051 | (defcustom vhdl-modify-date-prefix-string "-- Last update: " |
| 1052 | "Prefix string of modification date in VHDL file header. |
| 1053 | If actualization of the modification date is called (menu, |
| 1054 | `\\[vhdl-template-modify]'), this string is searched and the rest |
| 1055 | of the line replaced by the current date." |
| 1056 | :type 'string |
| 1057 | :group 'vhdl-header) |
| 1058 | |
| 1059 | (defcustom vhdl-modify-date-on-saving t |
| 1060 | "Non-nil means update the modification date when the buffer is saved. |
| 1061 | Calls function `\\[vhdl-template-modify]'). |
| 1062 | |
| 1063 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1064 | \"Activate Options\"." |
| 1065 | :type 'boolean |
| 1066 | :group 'vhdl-header) |
| 1067 | |
| 1068 | |
| 1069 | (defgroup vhdl-sequential-process nil |
| 1070 | "Customizations for sequential processes." |
| 1071 | :group 'vhdl-template) |
| 1072 | |
| 1073 | (defcustom vhdl-reset-kind 'async |
| 1074 | "Specifies which kind of reset to use in sequential processes." |
| 1075 | :type '(choice (const :tag "None" none) |
| 1076 | (const :tag "Synchronous" sync) |
| 1077 | (const :tag "Asynchronous" async) |
| 1078 | (const :tag "Query" query)) |
| 1079 | :group 'vhdl-sequential-process) |
| 1080 | |
| 1081 | (defcustom vhdl-reset-active-high nil |
| 1082 | "Non-nil means reset in sequential processes is active high. |
| 1083 | Otherwise, reset is active low." |
| 1084 | :type 'boolean |
| 1085 | :group 'vhdl-sequential-process) |
| 1086 | |
| 1087 | (defcustom vhdl-clock-rising-edge t |
| 1088 | "Non-nil means rising edge of clock triggers sequential processes. |
| 1089 | Otherwise, falling edge triggers." |
| 1090 | :type 'boolean |
| 1091 | :group 'vhdl-sequential-process) |
| 1092 | |
| 1093 | (defcustom vhdl-clock-edge-condition 'standard |
| 1094 | "Syntax of the clock edge condition. |
| 1095 | Standard: \"clk'event and clk = '1'\" |
| 1096 | Function: \"rising_edge(clk)\"" |
| 1097 | :type '(choice (const :tag "Standard" standard) |
| 1098 | (const :tag "Function" function)) |
| 1099 | :group 'vhdl-sequential-process) |
| 1100 | |
| 1101 | (defcustom vhdl-clock-name "" |
| 1102 | "Name of clock signal to use in templates." |
| 1103 | :type 'string |
| 1104 | :group 'vhdl-sequential-process) |
| 1105 | |
| 1106 | (defcustom vhdl-reset-name "" |
| 1107 | "Name of reset signal to use in templates." |
| 1108 | :type 'string |
| 1109 | :group 'vhdl-sequential-process) |
| 1110 | |
| 1111 | |
| 1112 | (defgroup vhdl-model nil |
| 1113 | "Customizations for user models." |
| 1114 | :group 'vhdl) |
| 1115 | |
| 1116 | (defcustom vhdl-model-alist |
| 1117 | '(("Example Model" |
| 1118 | "<label> : process (<clock>, <reset>) |
| 1119 | begin -- process <label> |
| 1120 | if <reset> = '0' then -- asynchronous reset (active low) |
| 1121 | <cursor> |
| 1122 | elsif <clock>'event and <clock> = '1' then -- rising clock edge |
| 1123 | if <enable> = '1' then -- synchronous load |
| 1124 | |
| 1125 | end if; |
| 1126 | end if; |
| 1127 | end process <label>;" |
| 1128 | "e" "")) |
| 1129 | "List of user models. |
| 1130 | VHDL models (templates) can be specified by the user in this list. They can be |
| 1131 | invoked from the menu, through key bindings (`C-c C-m ...'), or by keyword |
| 1132 | electrification (i.e. overriding existing or creating new keywords, see |
| 1133 | option `vhdl-electric-keywords'). |
| 1134 | Name : name of model (string of words and spaces) |
| 1135 | String : string or name of file to be inserted as model (newline: `C-j') |
| 1136 | Key Binding: key binding to invoke model, added to prefix `C-c C-m' |
| 1137 | (must be in double-quotes, examples: \"i\", \"\\C-p\", \"\\M-s\") |
| 1138 | Keyword : keyword to invoke model |
| 1139 | |
| 1140 | The models can contain prompts to be queried. A prompt is of the form \"<...>\". |
| 1141 | A prompt that appears several times is queried once and replaced throughout |
| 1142 | the model. Special prompts are: |
| 1143 | <clock> : name specified in `vhdl-clock-name' (if not empty) |
| 1144 | <reset> : name specified in `vhdl-reset-name' (if not empty) |
| 1145 | <cursor>: final cursor position |
| 1146 | File header prompts (see variable `vhdl-file-header') are automatically |
| 1147 | replaced, so that user models can also be used to insert different types of |
| 1148 | headers. |
| 1149 | |
| 1150 | If the string specifies an existing file name, the contents of the file is |
| 1151 | inserted, otherwise the string itself is inserted. |
| 1152 | The code within the models should be correctly indented. |
| 1153 | Type `C-j' for newlines. |
| 1154 | |
| 1155 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1156 | \"Activate Options\"." |
| 1157 | :type '(repeat (list :tag "Model" :indent 2 |
| 1158 | (string :tag "Name ") |
| 1159 | (string :tag "String : (type `C-j' for newline)" |
| 1160 | :format "%t\n%v") |
| 1161 | (sexp :tag "Key binding" x) |
| 1162 | (string :tag "Keyword " :format "%t: %v\n"))) |
| 1163 | :set (lambda (variable value) |
| 1164 | (vhdl-custom-set variable value |
| 1165 | 'vhdl-model-map-init |
| 1166 | 'vhdl-model-defun |
| 1167 | 'vhdl-mode-abbrev-table-init |
| 1168 | 'vhdl-update-mode-menu)) |
| 1169 | :group 'vhdl-model) |
| 1170 | |
| 1171 | |
| 1172 | (defgroup vhdl-compose nil |
| 1173 | "Customizations for structural composition." |
| 1174 | :group 'vhdl) |
| 1175 | |
| 1176 | (defcustom vhdl-compose-architecture-name '(".*" . "str") |
| 1177 | (concat |
| 1178 | "Specifies how the component architecture name is obtained. |
| 1179 | The component architecture name can be obtained by modifying the entity name |
| 1180 | \(e.g. attaching or stripping off a substring). |
| 1181 | If TO STRING is empty, the architecture name is queried." |
| 1182 | vhdl-name-doc-string) |
| 1183 | :type '(cons (regexp :tag "From regexp") |
| 1184 | (string :tag "To string ")) |
| 1185 | :group 'vhdl-compose) |
| 1186 | |
| 1187 | (defcustom vhdl-compose-configuration-name |
| 1188 | '("\\(.*\\) \\(.*\\)" . "\\1_\\2_cfg") |
| 1189 | (concat |
| 1190 | "Specifies how the configuration name is obtained. |
| 1191 | The configuration name can be obtained by modifying the entity and/or |
| 1192 | architecture name (e.g. attaching or stripping off a substring). The string |
| 1193 | that is matched against the regexp is the concatenation of the entity and the |
| 1194 | architecture name separated by a space. This gives access to both names (see |
| 1195 | default setting as example)." |
| 1196 | vhdl-name-doc-string) |
| 1197 | :type '(cons (regexp :tag "From regexp") |
| 1198 | (string :tag "To string ")) |
| 1199 | :group 'vhdl-compose) |
| 1200 | |
| 1201 | (defcustom vhdl-components-package-name |
| 1202 | '((".*" . "\\&_components") . "components") |
| 1203 | (concat |
| 1204 | "Specifies how the name for the components package is obtained. |
| 1205 | The components package is a package containing all component declarations for |
| 1206 | the current design. Its name can be obtained by modifying the project name |
| 1207 | \(e.g. attaching or stripping off a substring). If no project is defined, the |
| 1208 | DIRECTORY entry is chosen." |
| 1209 | vhdl-name-doc-string) |
| 1210 | :type '(cons (cons :tag "Project" :indent 2 |
| 1211 | (regexp :tag "From regexp") |
| 1212 | (string :tag "To string ")) |
| 1213 | (string :tag "Directory:\n String ")) |
| 1214 | :group 'vhdl-compose) |
| 1215 | |
| 1216 | (defcustom vhdl-use-components-package nil |
| 1217 | "Non-nil means use a separate components package for component declarations. |
| 1218 | Otherwise, component declarations are inserted and searched for in the |
| 1219 | architecture declarative parts." |
| 1220 | :type 'boolean |
| 1221 | :group 'vhdl-compose) |
| 1222 | |
| 1223 | (defcustom vhdl-compose-include-header t |
| 1224 | "Non-nil means include a header in automatically generated files." |
| 1225 | :type 'boolean |
| 1226 | :group 'vhdl-compose) |
| 1227 | |
| 1228 | (defcustom vhdl-compose-create-files 'single |
| 1229 | "Specifies whether new files should be created for the new component. |
| 1230 | The component's entity and architecture are inserted: |
| 1231 | None : in current buffer |
| 1232 | Single file : in new single file |
| 1233 | Separate files: in two separate files |
| 1234 | The file names are obtained from variables `vhdl-entity-file-name' and |
| 1235 | `vhdl-architecture-file-name'." |
| 1236 | :type '(choice (const :tag "None" none) |
| 1237 | (const :tag "Single file" single) |
| 1238 | (const :tag "Separate files" separate)) |
| 1239 | :group 'vhdl-compose) |
| 1240 | |
| 1241 | (defcustom vhdl-compose-configuration-create-file nil |
| 1242 | "Specifies whether a new file should be created for the configuration. |
| 1243 | If non-nil, a new file is created for the configuration. |
| 1244 | The file name is obtained from variable `vhdl-configuration-file-name'." |
| 1245 | :type 'boolean |
| 1246 | :group 'vhdl-compose) |
| 1247 | |
| 1248 | (defcustom vhdl-compose-configuration-hierarchical t |
| 1249 | "Specifies whether hierarchical configurations should be created. |
| 1250 | If non-nil, automatically created configurations are hierarchical and include |
| 1251 | the whole hierarchy of subcomponents. Otherwise the configuration only |
| 1252 | includes one level of subcomponents." |
| 1253 | :type 'boolean |
| 1254 | :group 'vhdl-compose) |
| 1255 | |
| 1256 | (defcustom vhdl-compose-configuration-use-subconfiguration t |
| 1257 | "Specifies whether subconfigurations should be used inside configurations. |
| 1258 | If non-nil, automatically created configurations use configurations in binding |
| 1259 | indications for subcomponents, if such configurations exist. Otherwise, |
| 1260 | entities are used in binding indications for subcomponents." |
| 1261 | :type 'boolean |
| 1262 | :group 'vhdl-compose) |
| 1263 | |
| 1264 | |
| 1265 | (defgroup vhdl-port nil |
| 1266 | "Customizations for port translation functions." |
| 1267 | :group 'vhdl |
| 1268 | :group 'vhdl-compose) |
| 1269 | |
| 1270 | (defcustom vhdl-include-port-comments nil |
| 1271 | "Non-nil means include port comments when a port is pasted." |
| 1272 | :type 'boolean |
| 1273 | :group 'vhdl-port) |
| 1274 | |
| 1275 | (defcustom vhdl-include-direction-comments nil |
| 1276 | "Non-nil means include port direction in instantiations as comments." |
| 1277 | :type 'boolean |
| 1278 | :group 'vhdl-port) |
| 1279 | |
| 1280 | (defcustom vhdl-include-type-comments nil |
| 1281 | "Non-nil means include generic/port type in instantiations as comments." |
| 1282 | :type 'boolean |
| 1283 | :group 'vhdl-port) |
| 1284 | |
| 1285 | (defcustom vhdl-include-group-comments 'never |
| 1286 | "Specifies whether to include group comments and spacings. |
| 1287 | The comments and empty lines between groups of ports are pasted: |
| 1288 | Never : never |
| 1289 | Declarations: in entity/component/constant/signal declarations only |
| 1290 | Always : also in generic/port maps" |
| 1291 | :type '(choice (const :tag "Never" never) |
| 1292 | (const :tag "Declarations" decl) |
| 1293 | (const :tag "Always" always)) |
| 1294 | :group 'vhdl-port) |
| 1295 | |
| 1296 | (defcustom vhdl-actual-generic-name '(".*" . "\\&") |
| 1297 | (concat |
| 1298 | "Specifies how actual generic names are obtained from formal generic names. |
| 1299 | In a component instantiation, an actual generic name can be |
| 1300 | obtained by modifying the formal generic name (e.g. attaching or stripping |
| 1301 | off a substring)." |
| 1302 | vhdl-name-doc-string) |
| 1303 | :type '(cons (regexp :tag "From regexp") |
| 1304 | (string :tag "To string ")) |
| 1305 | :group 'vhdl-port |
| 1306 | :version "24.4") |
| 1307 | |
| 1308 | (defcustom vhdl-actual-port-name '(".*" . "\\&") |
| 1309 | (concat |
| 1310 | "Specifies how actual port names are obtained from formal port names. |
| 1311 | In a component instantiation, an actual port name can be obtained by |
| 1312 | modifying the formal port name (e.g. attaching or stripping off a substring)." |
| 1313 | vhdl-name-doc-string) |
| 1314 | :type '(cons (regexp :tag "From regexp") |
| 1315 | (string :tag "To string ")) |
| 1316 | :group 'vhdl-port) |
| 1317 | |
| 1318 | (defcustom vhdl-instance-name '(".*" . "\\&_%d") |
| 1319 | (concat |
| 1320 | "Specifies how an instance name is obtained. |
| 1321 | The instance name can be obtained by modifying the name of the component to be |
| 1322 | instantiated (e.g. attaching or stripping off a substring). \"%d\" is replaced |
| 1323 | by a unique number (starting with 1). |
| 1324 | If TO STRING is empty, the instance name is queried." |
| 1325 | vhdl-name-doc-string) |
| 1326 | :type '(cons (regexp :tag "From regexp") |
| 1327 | (string :tag "To string ")) |
| 1328 | :group 'vhdl-port) |
| 1329 | |
| 1330 | |
| 1331 | (defgroup vhdl-testbench nil |
| 1332 | "Customizations for testbench generation." |
| 1333 | :group 'vhdl-port) |
| 1334 | |
| 1335 | (defcustom vhdl-testbench-entity-name '(".*" . "\\&_tb") |
| 1336 | (concat |
| 1337 | "Specifies how the testbench entity name is obtained. |
| 1338 | The entity name of a testbench can be obtained by modifying the name of |
| 1339 | the component to be tested (e.g. attaching or stripping off a substring)." |
| 1340 | vhdl-name-doc-string) |
| 1341 | :type '(cons (regexp :tag "From regexp") |
| 1342 | (string :tag "To string ")) |
| 1343 | :group 'vhdl-testbench) |
| 1344 | |
| 1345 | (defcustom vhdl-testbench-architecture-name '(".*" . "") |
| 1346 | (concat |
| 1347 | "Specifies how the testbench architecture name is obtained. |
| 1348 | The testbench architecture name can be obtained by modifying the name of |
| 1349 | the component to be tested (e.g. attaching or stripping off a substring). |
| 1350 | If TO STRING is empty, the architecture name is queried." |
| 1351 | vhdl-name-doc-string) |
| 1352 | :type '(cons (regexp :tag "From regexp") |
| 1353 | (string :tag "To string ")) |
| 1354 | :group 'vhdl-testbench) |
| 1355 | |
| 1356 | (defcustom vhdl-testbench-configuration-name vhdl-compose-configuration-name |
| 1357 | (concat |
| 1358 | "Specifies how the testbench configuration name is obtained. |
| 1359 | The configuration name of a testbench can be obtained by modifying the entity |
| 1360 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 1361 | string that is matched against the regexp is the concatenation of the entity |
| 1362 | and the architecture name separated by a space. This gives access to both |
| 1363 | names (see default setting as example)." |
| 1364 | vhdl-name-doc-string) |
| 1365 | :type '(cons (regexp :tag "From regexp") |
| 1366 | (string :tag "To string ")) |
| 1367 | :group 'vhdl-testbench) |
| 1368 | |
| 1369 | (defcustom vhdl-testbench-dut-name '(".*" . "DUT") |
| 1370 | (concat |
| 1371 | "Specifies how a DUT instance name is obtained. |
| 1372 | The design-under-test instance name (i.e. the component instantiated in the |
| 1373 | testbench) can be obtained by modifying the component name (e.g. attaching |
| 1374 | or stripping off a substring)." |
| 1375 | vhdl-name-doc-string) |
| 1376 | :type '(cons (regexp :tag "From regexp") |
| 1377 | (string :tag "To string ")) |
| 1378 | :group 'vhdl-testbench) |
| 1379 | |
| 1380 | (defcustom vhdl-testbench-include-header t |
| 1381 | "Non-nil means include a header in automatically generated files." |
| 1382 | :type 'boolean |
| 1383 | :group 'vhdl-testbench) |
| 1384 | |
| 1385 | (defcustom vhdl-testbench-declarations "\ |
| 1386 | -- clock |
| 1387 | signal Clk : std_logic := '1'; |
| 1388 | " |
| 1389 | "String or file to be inserted in the testbench declarative part. |
| 1390 | If the string specifies an existing file name, the contents of the file is |
| 1391 | inserted, otherwise the string itself is inserted in the testbench |
| 1392 | architecture before the BEGIN keyword. |
| 1393 | Type `C-j' for newlines." |
| 1394 | :type 'string |
| 1395 | :group 'vhdl-testbench) |
| 1396 | |
| 1397 | (defcustom vhdl-testbench-statements "\ |
| 1398 | -- clock generation |
| 1399 | Clk <= not Clk after 10 ns; |
| 1400 | |
| 1401 | -- waveform generation |
| 1402 | WaveGen_Proc: process |
| 1403 | begin |
| 1404 | -- insert signal assignments here |
| 1405 | |
| 1406 | wait until Clk = '1'; |
| 1407 | end process WaveGen_Proc; |
| 1408 | " |
| 1409 | "String or file to be inserted in the testbench statement part. |
| 1410 | If the string specifies an existing file name, the contents of the file is |
| 1411 | inserted, otherwise the string itself is inserted in the testbench |
| 1412 | architecture before the END keyword. |
| 1413 | Type `C-j' for newlines." |
| 1414 | :type 'string |
| 1415 | :group 'vhdl-testbench) |
| 1416 | |
| 1417 | (defcustom vhdl-testbench-initialize-signals nil |
| 1418 | "Non-nil means initialize signals with `0' when declared in testbench." |
| 1419 | :type 'boolean |
| 1420 | :group 'vhdl-testbench) |
| 1421 | |
| 1422 | (defcustom vhdl-testbench-include-library t |
| 1423 | "Non-nil means a library/use clause for std_logic_1164 is included." |
| 1424 | :type 'boolean |
| 1425 | :group 'vhdl-testbench) |
| 1426 | |
| 1427 | (defcustom vhdl-testbench-include-configuration t |
| 1428 | "Non-nil means a testbench configuration is attached at the end." |
| 1429 | :type 'boolean |
| 1430 | :group 'vhdl-testbench) |
| 1431 | |
| 1432 | (defcustom vhdl-testbench-create-files 'single |
| 1433 | "Specifies whether new files should be created for the testbench. |
| 1434 | testbench entity and architecture are inserted: |
| 1435 | None : in current buffer |
| 1436 | Single file : in new single file |
| 1437 | Separate files: in two separate files |
| 1438 | The file names are obtained from variables `vhdl-testbench-entity-file-name' |
| 1439 | and `vhdl-testbench-architecture-file-name'." |
| 1440 | :type '(choice (const :tag "None" none) |
| 1441 | (const :tag "Single file" single) |
| 1442 | (const :tag "Separate files" separate)) |
| 1443 | :group 'vhdl-testbench) |
| 1444 | |
| 1445 | (defcustom vhdl-testbench-entity-file-name vhdl-entity-file-name |
| 1446 | (concat |
| 1447 | "Specifies how the testbench entity file name is obtained. |
| 1448 | The entity file name can be obtained by modifying the testbench entity name |
| 1449 | \(e.g. attaching or stripping off a substring). The file extension is |
| 1450 | automatically taken from the file name of the current buffer. Testbench |
| 1451 | files can be created in a different directory by prepending a relative or |
| 1452 | absolute path to the file name." |
| 1453 | vhdl-name-doc-string) |
| 1454 | :type '(cons (regexp :tag "From regexp") |
| 1455 | (string :tag "To string ")) |
| 1456 | :group 'vhdl-testbench) |
| 1457 | |
| 1458 | (defcustom vhdl-testbench-architecture-file-name vhdl-architecture-file-name |
| 1459 | (concat |
| 1460 | "Specifies how the testbench architecture file name is obtained. |
| 1461 | The architecture file name can be obtained by modifying the testbench entity |
| 1462 | and/or architecture name (e.g. attaching or stripping off a substring). The |
| 1463 | string that is matched against the regexp is the concatenation of the entity |
| 1464 | and the architecture name separated by a space. This gives access to both |
| 1465 | names (see default setting as example). Testbench files can be created in |
| 1466 | a different directory by prepending a relative or absolute path to the file |
| 1467 | name." |
| 1468 | vhdl-name-doc-string) |
| 1469 | :type '(cons (regexp :tag "From regexp") |
| 1470 | (string :tag "To string ")) |
| 1471 | :group 'vhdl-testbench) |
| 1472 | |
| 1473 | |
| 1474 | (defgroup vhdl-comment nil |
| 1475 | "Customizations for comments." |
| 1476 | :group 'vhdl) |
| 1477 | |
| 1478 | (defcustom vhdl-self-insert-comments t |
| 1479 | "Non-nil means various templates automatically insert help comments." |
| 1480 | :type 'boolean |
| 1481 | :group 'vhdl-comment) |
| 1482 | |
| 1483 | (defcustom vhdl-prompt-for-comments t |
| 1484 | "Non-nil means various templates prompt for user definable comments." |
| 1485 | :type 'boolean |
| 1486 | :group 'vhdl-comment) |
| 1487 | |
| 1488 | (defcustom vhdl-inline-comment-column 40 |
| 1489 | "Column to indent and align inline comments to. |
| 1490 | Overrides local option `comment-column'. |
| 1491 | |
| 1492 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1493 | \"Activate Options\"." |
| 1494 | :type 'integer |
| 1495 | :group 'vhdl-comment) |
| 1496 | |
| 1497 | (defcustom vhdl-end-comment-column 79 |
| 1498 | "End of comment column. |
| 1499 | Comments that exceed this column number are wrapped. |
| 1500 | |
| 1501 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1502 | \"Activate Options\"." |
| 1503 | :type 'integer |
| 1504 | :group 'vhdl-comment) |
| 1505 | |
| 1506 | (defvar end-comment-column) |
| 1507 | |
| 1508 | |
| 1509 | (defgroup vhdl-beautify nil |
| 1510 | "Customizations for beautification." |
| 1511 | :group 'vhdl) |
| 1512 | |
| 1513 | (defcustom vhdl-auto-align t |
| 1514 | "Non-nil means align some templates automatically after generation." |
| 1515 | :type 'boolean |
| 1516 | :group 'vhdl-beautify) |
| 1517 | |
| 1518 | (defcustom vhdl-align-groups t |
| 1519 | "Non-nil means align groups of code lines separately. |
| 1520 | A group of code lines is a region of consecutive lines between two lines that |
| 1521 | match the regexp in option `vhdl-align-group-separate'." |
| 1522 | :type 'boolean |
| 1523 | :group 'vhdl-beautify) |
| 1524 | |
| 1525 | (defcustom vhdl-align-group-separate "^\\s-*$" |
| 1526 | "Regexp for matching a line that separates groups of lines for alignment. |
| 1527 | Examples: |
| 1528 | \"^\\s-*$\": matches an empty line |
| 1529 | \"^\\s-*\\(--.*\\)?$\": matches an empty line or a comment-only line" |
| 1530 | :type 'regexp |
| 1531 | :group 'vhdl-beautify) |
| 1532 | |
| 1533 | (defcustom vhdl-align-same-indent t |
| 1534 | "Non-nil means align blocks with same indent separately. |
| 1535 | When a region or the entire buffer is aligned, the code is divided into |
| 1536 | blocks of same indent which are aligned separately (except for argument/port |
| 1537 | lists). This gives nicer alignment in most cases. |
| 1538 | Option `vhdl-align-groups' still applies within these blocks." |
| 1539 | :type 'boolean |
| 1540 | :group 'vhdl-beautify) |
| 1541 | |
| 1542 | (defcustom vhdl-beautify-options '(t t t t t) |
| 1543 | "List of options for beautifying code. Allows to disable individual |
| 1544 | features of code beautification." |
| 1545 | :type '(list (boolean :tag "Whitespace cleanup ") |
| 1546 | (boolean :tag "Single statement per line") |
| 1547 | (boolean :tag "Indentation ") |
| 1548 | (boolean :tag "Alignment ") |
| 1549 | (boolean :tag "Case fixing ")) |
| 1550 | :group 'vhdl-beautify |
| 1551 | :version "24.4") |
| 1552 | |
| 1553 | |
| 1554 | (defgroup vhdl-highlight nil |
| 1555 | "Customizations for highlighting." |
| 1556 | :group 'vhdl) |
| 1557 | |
| 1558 | (defcustom vhdl-highlight-keywords t |
| 1559 | "Non-nil means highlight VHDL keywords and other standardized words. |
| 1560 | The following faces are used: |
| 1561 | `font-lock-keyword-face' : keywords |
| 1562 | `font-lock-type-face' : standardized types |
| 1563 | `vhdl-font-lock-attribute-face': standardized attributes |
| 1564 | `vhdl-font-lock-enumvalue-face': standardized enumeration values |
| 1565 | `vhdl-font-lock-function-face' : standardized function and package names |
| 1566 | |
| 1567 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1568 | entry \"Fontify Buffer\")." |
| 1569 | :type 'boolean |
| 1570 | :set (lambda (variable value) |
| 1571 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1572 | :group 'vhdl-highlight) |
| 1573 | |
| 1574 | (defcustom vhdl-highlight-names t |
| 1575 | "Non-nil means highlight declaration names and construct labels. |
| 1576 | The following faces are used: |
| 1577 | `font-lock-function-name-face' : names in declarations of units, |
| 1578 | subprograms, components, as well as labels of VHDL constructs |
| 1579 | `font-lock-type-face' : names in type/nature declarations |
| 1580 | `vhdl-font-lock-attribute-face': names in attribute declarations |
| 1581 | `font-lock-variable-name-face' : names in declarations of signals, |
| 1582 | variables, constants, subprogram parameters, generics, and ports |
| 1583 | |
| 1584 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1585 | entry \"Fontify Buffer\")." |
| 1586 | :type 'boolean |
| 1587 | :set (lambda (variable value) |
| 1588 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1589 | :group 'vhdl-highlight) |
| 1590 | |
| 1591 | (defcustom vhdl-highlight-special-words nil |
| 1592 | "Non-nil means highlight words with special syntax. |
| 1593 | The words with syntax and color specified in option `vhdl-special-syntax-alist' |
| 1594 | are highlighted accordingly. |
| 1595 | Can be used for visual support of naming conventions. |
| 1596 | |
| 1597 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1598 | entry \"Fontify Buffer\")." |
| 1599 | :type 'boolean |
| 1600 | :set (lambda (variable value) |
| 1601 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1602 | :group 'vhdl-highlight) |
| 1603 | |
| 1604 | (defcustom vhdl-highlight-forbidden-words nil |
| 1605 | "Non-nil means highlight forbidden words. |
| 1606 | The reserved words specified in option `vhdl-forbidden-words' or having the |
| 1607 | syntax specified in option `vhdl-forbidden-syntax' are highlighted in a |
| 1608 | warning color (face `vhdl-font-lock-reserved-words-face') to indicate not to |
| 1609 | use them. |
| 1610 | |
| 1611 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1612 | entry \"Fontify Buffer\")." |
| 1613 | :type 'boolean |
| 1614 | :set (lambda (variable value) |
| 1615 | (vhdl-custom-set variable value |
| 1616 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1617 | :group 'vhdl-highlight) |
| 1618 | |
| 1619 | (defcustom vhdl-highlight-verilog-keywords nil |
| 1620 | "Non-nil means highlight Verilog keywords as reserved words. |
| 1621 | Verilog keywords are highlighted in a warning color (face |
| 1622 | `vhdl-font-lock-reserved-words-face') to indicate not to use them. |
| 1623 | |
| 1624 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1625 | entry \"Fontify Buffer\")." |
| 1626 | :type 'boolean |
| 1627 | :set (lambda (variable value) |
| 1628 | (vhdl-custom-set variable value |
| 1629 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1630 | :group 'vhdl-highlight) |
| 1631 | |
| 1632 | (defcustom vhdl-highlight-translate-off nil |
| 1633 | "Non-nil means background-highlight code excluded from translation. |
| 1634 | That is, all code between \"-- pragma translate_off\" and |
| 1635 | \"-- pragma translate_on\" is highlighted using a different background color |
| 1636 | \(face `vhdl-font-lock-translate-off-face'). |
| 1637 | Note: this might slow down on-the-fly fontification (and thus editing). |
| 1638 | |
| 1639 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1640 | entry \"Fontify Buffer\")." |
| 1641 | :type 'boolean |
| 1642 | :set (lambda (variable value) |
| 1643 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1644 | :group 'vhdl-highlight) |
| 1645 | |
| 1646 | (defcustom vhdl-highlight-case-sensitive nil |
| 1647 | "Non-nil means consider case for highlighting. |
| 1648 | Possible trade-off: |
| 1649 | non-nil also upper-case VHDL words are highlighted, but case of words with |
| 1650 | special syntax is not considered |
| 1651 | nil only lower-case VHDL words are highlighted, but case of words with |
| 1652 | special syntax is considered |
| 1653 | Overrides local option `font-lock-keywords-case-fold-search'. |
| 1654 | |
| 1655 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1656 | entry \"Fontify Buffer\")." |
| 1657 | :type 'boolean |
| 1658 | :group 'vhdl-highlight) |
| 1659 | |
| 1660 | (defcustom vhdl-special-syntax-alist |
| 1661 | '(("generic/constant" "\\<\\w+_[cg]\\>" "Gold3" "BurlyWood1" nil) |
| 1662 | ("type" "\\<\\w+_t\\>" "ForestGreen" "PaleGreen" nil) |
| 1663 | ("variable" "\\<\\w+_v\\>" "Grey50" "Grey80" nil)) |
| 1664 | "List of special syntax to be highlighted. |
| 1665 | If option `vhdl-highlight-special-words' is non-nil, words with the specified |
| 1666 | syntax (as regular expression) are highlighted in the corresponding color. |
| 1667 | |
| 1668 | Name : string of words and spaces |
| 1669 | Regexp : regular expression describing word syntax |
| 1670 | (e.g. \"\\\\=\<\\\w+_c\\\\=\>\" matches word with suffix \"_c\") |
| 1671 | expression must start with \"\\\\=\<\" and end with \"\\\\=\>\" |
| 1672 | if only whole words should be matched (no substrings) |
| 1673 | Color (light): foreground color for light background |
| 1674 | (matching color examples: Gold3, Grey50, LimeGreen, Tomato, |
| 1675 | LightSeaGreen, DodgerBlue, Gold, PaleVioletRed) |
| 1676 | Color (dark) : foreground color for dark background |
| 1677 | (matching color examples: BurlyWood1, Grey80, Green, Coral, |
| 1678 | AquaMarine2, LightSkyBlue1, Yellow, PaleVioletRed1) |
| 1679 | In comments : If non-nil, words are also highlighted inside comments |
| 1680 | |
| 1681 | Can be used for visual support of naming conventions, such as highlighting |
| 1682 | different kinds of signals (e.g. \"Clk50\", \"Rst_n\") or objects (e.g. |
| 1683 | \"Signal_s\", \"Variable_v\", \"Constant_c\") by distinguishing them using |
| 1684 | common substrings or name suffices. |
| 1685 | For each entry, a new face is generated with the specified colors and name |
| 1686 | \"vhdl-font-lock-\" + name + \"-face\". |
| 1687 | |
| 1688 | NOTE: Activate a changed regexp in a VHDL buffer by re-fontifying it (menu |
| 1689 | entry \"Fontify Buffer\"). All other changes require restarting Emacs." |
| 1690 | :type '(repeat (list :tag "Face" :indent 2 |
| 1691 | (string :tag "Name ") |
| 1692 | (regexp :tag "Regexp " "\\w+_") |
| 1693 | (string :tag "Color (light)") |
| 1694 | (string :tag "Color (dark) ") |
| 1695 | (boolean :tag "In comments "))) |
| 1696 | :set (lambda (variable value) |
| 1697 | (vhdl-custom-set variable value 'vhdl-font-lock-init)) |
| 1698 | :group 'vhdl-highlight) |
| 1699 | |
| 1700 | (defcustom vhdl-forbidden-words '() |
| 1701 | "List of forbidden words to be highlighted. |
| 1702 | If option `vhdl-highlight-forbidden-words' is non-nil, these reserved |
| 1703 | words are highlighted in a warning color to indicate not to use them. |
| 1704 | |
| 1705 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1706 | entry \"Fontify Buffer\")." |
| 1707 | :type '(repeat (string :format "%v")) |
| 1708 | :set (lambda (variable value) |
| 1709 | (vhdl-custom-set variable value |
| 1710 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1711 | :group 'vhdl-highlight) |
| 1712 | |
| 1713 | (defcustom vhdl-forbidden-syntax "" |
| 1714 | "Syntax of forbidden words to be highlighted. |
| 1715 | If option `vhdl-highlight-forbidden-words' is non-nil, words with this |
| 1716 | syntax are highlighted in a warning color to indicate not to use them. |
| 1717 | Can be used to highlight too long identifiers (e.g. \"\\w\\w\\w\\w\\w\\w\\w\\w\\w\\w+\" |
| 1718 | highlights identifiers with 10 or more characters). |
| 1719 | |
| 1720 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1721 | entry \"Fontify Buffer\")." |
| 1722 | :type 'regexp |
| 1723 | :set (lambda (variable value) |
| 1724 | (vhdl-custom-set variable value |
| 1725 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1726 | :group 'vhdl-highlight) |
| 1727 | |
| 1728 | (defcustom vhdl-directive-keywords '("pragma" "synopsys") |
| 1729 | "List of compiler directive keywords recognized for highlighting. |
| 1730 | |
| 1731 | NOTE: Activate the new setting in a VHDL buffer by re-fontifying it (menu |
| 1732 | entry \"Fontify Buffer\")." |
| 1733 | :type '(repeat (string :format "%v")) |
| 1734 | :set (lambda (variable value) |
| 1735 | (vhdl-custom-set variable value |
| 1736 | 'vhdl-words-init 'vhdl-font-lock-init)) |
| 1737 | :group 'vhdl-highlight) |
| 1738 | |
| 1739 | |
| 1740 | (defgroup vhdl-speedbar nil |
| 1741 | "Customizations for speedbar." |
| 1742 | :group 'vhdl) |
| 1743 | |
| 1744 | (defcustom vhdl-speedbar-auto-open nil |
| 1745 | "Non-nil means automatically open speedbar at startup. |
| 1746 | Alternatively, the speedbar can be opened from the VHDL menu." |
| 1747 | :type 'boolean |
| 1748 | :group 'vhdl-speedbar) |
| 1749 | |
| 1750 | (defcustom vhdl-speedbar-display-mode 'files |
| 1751 | "Specifies the default displaying mode when opening speedbar. |
| 1752 | Alternatively, the displaying mode can be selected from the speedbar menu or |
| 1753 | by typing `f' (files), `h' (directory hierarchy) or `H' (project hierarchy)." |
| 1754 | :type '(choice (const :tag "Files" files) |
| 1755 | (const :tag "Directory hierarchy" directory) |
| 1756 | (const :tag "Project hierarchy" project)) |
| 1757 | :group 'vhdl-speedbar) |
| 1758 | |
| 1759 | (defcustom vhdl-speedbar-scan-limit '(10000000 (1000000 50)) |
| 1760 | "Limits scanning of large files and netlists. |
| 1761 | Design units: maximum file size to scan for design units |
| 1762 | Hierarchy (instances of subcomponents): |
| 1763 | File size: maximum file size to scan for instances (in bytes) |
| 1764 | Instances per arch: maximum number of instances to scan per architecture |
| 1765 | |
| 1766 | \"None\" always means that there is no limit. |
| 1767 | In case of files not or incompletely scanned, a warning message and the file |
| 1768 | names are printed out. |
| 1769 | Background: scanning for instances is considerably slower than scanning for |
| 1770 | design units, especially when there are many instances. These limits should |
| 1771 | prevent the scanning of large netlists." |
| 1772 | :type '(list (choice :tag "Design units" |
| 1773 | :format "%t : %[Value Menu%] %v" |
| 1774 | (const :tag "None" nil) |
| 1775 | (integer :tag "File size")) |
| 1776 | (list :tag "Hierarchy" :indent 2 |
| 1777 | (choice :tag "File size" |
| 1778 | :format "%t : %[Value Menu%] %v" |
| 1779 | (const :tag "None" nil) |
| 1780 | (integer :tag "Size ")) |
| 1781 | (choice :tag "Instances per arch" |
| 1782 | (const :tag "None" nil) |
| 1783 | (integer :tag "Number ")))) |
| 1784 | :group 'vhdl-speedbar) |
| 1785 | |
| 1786 | (defcustom vhdl-speedbar-jump-to-unit t |
| 1787 | "Non-nil means jump to the design unit code when opened in a buffer. |
| 1788 | The buffer cursor position is left unchanged otherwise." |
| 1789 | :type 'boolean |
| 1790 | :group 'vhdl-speedbar) |
| 1791 | |
| 1792 | (defcustom vhdl-speedbar-update-on-saving t |
| 1793 | "Automatically update design hierarchy when buffer is saved." |
| 1794 | :type 'boolean |
| 1795 | :group 'vhdl-speedbar) |
| 1796 | |
| 1797 | (defcustom vhdl-speedbar-save-cache '(hierarchy display) |
| 1798 | "Automatically save modified hierarchy caches when exiting Emacs. |
| 1799 | Hierarchy: design hierarchy information |
| 1800 | Display: displaying information (which design units to expand)" |
| 1801 | :type '(set (const :tag "Hierarchy" hierarchy) |
| 1802 | (const :tag "Display" display)) |
| 1803 | :group 'vhdl-speedbar) |
| 1804 | |
| 1805 | (defcustom vhdl-speedbar-cache-file-name ".emacs-vhdl-cache-\\1-\\2" |
| 1806 | "Name of file for saving hierarchy cache. |
| 1807 | \"\\1\" is replaced by the project name if a project is specified, |
| 1808 | \"directory\" otherwise. \"\\2\" is replaced by the user name (allows for |
| 1809 | different users to have cache files in the same directory). Can also have |
| 1810 | an absolute path (i.e. all caches can be stored in one global directory)." |
| 1811 | :type 'string |
| 1812 | :group 'vhdl-speedbar) |
| 1813 | |
| 1814 | |
| 1815 | (defgroup vhdl-menu nil |
| 1816 | "Customizations for menus." |
| 1817 | :group 'vhdl) |
| 1818 | |
| 1819 | (defcustom vhdl-index-menu nil |
| 1820 | "Non-nil means add an index menu for a source file when loading. |
| 1821 | Alternatively, the speedbar can be used. Note that the index menu scans a file |
| 1822 | when it is opened, while speedbar only scans the file upon request." |
| 1823 | :type 'boolean |
| 1824 | :group 'vhdl-menu) |
| 1825 | |
| 1826 | (defcustom vhdl-source-file-menu nil |
| 1827 | "Non-nil means add a menu of all source files in current directory. |
| 1828 | Alternatively, the speedbar can be used." |
| 1829 | :type 'boolean |
| 1830 | :group 'vhdl-menu) |
| 1831 | |
| 1832 | (defcustom vhdl-hideshow-menu nil |
| 1833 | "Non-nil means add hideshow menu and functionality at startup. |
| 1834 | Hideshow can also be enabled from the VHDL Mode menu. |
| 1835 | Hideshow allows hiding code of various VHDL constructs. |
| 1836 | |
| 1837 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1838 | \"Activate Options\"." |
| 1839 | :type 'boolean |
| 1840 | :group 'vhdl-menu) |
| 1841 | |
| 1842 | (defcustom vhdl-hide-all-init nil |
| 1843 | "Non-nil means hide all design units initially after a file is loaded." |
| 1844 | :type 'boolean |
| 1845 | :group 'vhdl-menu) |
| 1846 | |
| 1847 | |
| 1848 | (defgroup vhdl-print nil |
| 1849 | "Customizations for printing." |
| 1850 | :group 'vhdl) |
| 1851 | |
| 1852 | (defcustom vhdl-print-two-column t |
| 1853 | "Non-nil means print code in two columns and landscape format. |
| 1854 | Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print') |
| 1855 | prints VHDL files in a nice two-column landscape style. |
| 1856 | |
| 1857 | NOTE: Activate the new setting by restarting Emacs. |
| 1858 | Overrides `ps-print' settings locally." |
| 1859 | :type 'boolean |
| 1860 | :group 'vhdl-print) |
| 1861 | |
| 1862 | (defcustom vhdl-print-customize-faces t |
| 1863 | "Non-nil means use an optimized set of faces for PostScript printing. |
| 1864 | |
| 1865 | NOTE: Activate the new setting by restarting Emacs. |
| 1866 | Overrides `ps-print' settings locally." |
| 1867 | :type 'boolean |
| 1868 | :group 'vhdl-print) |
| 1869 | |
| 1870 | |
| 1871 | (defgroup vhdl-misc nil |
| 1872 | "Miscellaneous customizations." |
| 1873 | :group 'vhdl) |
| 1874 | |
| 1875 | (defcustom vhdl-intelligent-tab t |
| 1876 | "Non-nil means `TAB' does indentation, word completion and tab insertion. |
| 1877 | That is, if preceding character is part of a word then complete word, |
| 1878 | else if not at beginning of line then insert tab, |
| 1879 | else if last command was a `TAB' or `RET' then dedent one step, |
| 1880 | else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab'). |
| 1881 | If nil, TAB always indents current line (i.e. `TAB' is bound to |
| 1882 | `indent-according-to-mode'). |
| 1883 | |
| 1884 | NOTE: Activate the new setting in a VHDL buffer by using the menu entry |
| 1885 | \"Activate Options\"." |
| 1886 | :type 'boolean |
| 1887 | :group 'vhdl-misc) |
| 1888 | |
| 1889 | (defcustom vhdl-indent-syntax-based t |
| 1890 | "Non-nil means indent lines of code based on their syntactic context. |
| 1891 | Otherwise, a line is indented like the previous nonblank line. This can be |
| 1892 | useful in large files where syntax-based indentation gets very slow." |
| 1893 | :type 'boolean |
| 1894 | :group 'vhdl-misc) |
| 1895 | |
| 1896 | (defcustom vhdl-indent-comment-like-next-code-line t |
| 1897 | "Non-nil means comment lines are indented like the following code line. |
| 1898 | Otherwise, comment lines are indented like the preceding code line. |
| 1899 | Indenting comment lines like the following code line gives nicer indentation |
| 1900 | when comments precede the code that they refer to." |
| 1901 | :type 'boolean |
| 1902 | :version "24.3" |
| 1903 | :group 'vhdl-misc) |
| 1904 | |
| 1905 | (defcustom vhdl-word-completion-case-sensitive nil |
| 1906 | "Non-nil means word completion using `TAB' is case sensitive. |
| 1907 | That is, `TAB' completes words that start with the same letters and case. |
| 1908 | Otherwise, case is ignored." |
| 1909 | :type 'boolean |
| 1910 | :group 'vhdl-misc) |
| 1911 | |
| 1912 | (defcustom vhdl-word-completion-in-minibuffer t |
| 1913 | "Non-nil enables word completion in minibuffer (for template prompts). |
| 1914 | |
| 1915 | NOTE: Activate the new setting by restarting Emacs." |
| 1916 | :type 'boolean |
| 1917 | :group 'vhdl-misc) |
| 1918 | |
| 1919 | (defcustom vhdl-underscore-is-part-of-word nil |
| 1920 | "Non-nil means consider the underscore character `_' as part of word. |
| 1921 | An identifier containing underscores is then treated as a single word in |
| 1922 | select and move operations. All parts of an identifier separated by underscore |
| 1923 | are treated as single words otherwise." |
| 1924 | :type 'boolean |
| 1925 | :group 'vhdl-misc) |
| 1926 | (make-obsolete-variable 'vhdl-underscore-is-part-of-word |
| 1927 | 'superword-mode "24.4") |
| 1928 | |
| 1929 | |
| 1930 | (defgroup vhdl-related nil |
| 1931 | "Related general customizations." |
| 1932 | :group 'vhdl) |
| 1933 | |
| 1934 | ;; add related general customizations |
| 1935 | (custom-add-to-group 'vhdl-related 'hideshow 'custom-group) |
| 1936 | (if (featurep 'xemacs) |
| 1937 | (custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable) |
| 1938 | (custom-add-to-group 'vhdl-related 'paren-showing 'custom-group)) |
| 1939 | (custom-add-to-group 'vhdl-related 'ps-print 'custom-group) |
| 1940 | (custom-add-to-group 'vhdl-related 'speedbar 'custom-group) |
| 1941 | (custom-add-to-group 'vhdl-related 'comment-style 'custom-variable) |
| 1942 | (custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable) |
| 1943 | (unless (featurep 'xemacs) |
| 1944 | (custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable)) |
| 1945 | (custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable) |
| 1946 | (custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable) |
| 1947 | (custom-add-to-group 'vhdl-related 'user-mail-address 'custom-variable) |
| 1948 | |
| 1949 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1950 | ;; Hidden user variables |
| 1951 | |
| 1952 | (defvar vhdl-compile-absolute-path nil |
| 1953 | "If non-nil, use absolute instead of relative path for compiled files.") |
| 1954 | |
| 1955 | (defvar vhdl-comment-display-line-char ?- |
| 1956 | "Character to use in comment display line.") |
| 1957 | |
| 1958 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1959 | ;; Internal variables |
| 1960 | |
| 1961 | (defvar vhdl-menu-max-size 20 |
| 1962 | "Specifies the maximum size of a menu before splitting it into submenus.") |
| 1963 | |
| 1964 | (defvar vhdl-progress-interval 1 |
| 1965 | "Interval used to update progress status during long operations. |
| 1966 | If a number, percentage complete gets updated after each interval of |
| 1967 | that many seconds. To inhibit all messages, set this option to nil.") |
| 1968 | |
| 1969 | (defvar vhdl-inhibit-startup-warnings-p nil |
| 1970 | "If non-nil, inhibits start up compatibility warnings.") |
| 1971 | |
| 1972 | (defvar vhdl-strict-syntax-p nil |
| 1973 | "If non-nil, all syntactic symbols must be found in `vhdl-offsets-alist'. |
| 1974 | If the syntactic symbol for a particular line does not match a symbol |
| 1975 | in the offsets alist, an error is generated, otherwise no error is |
| 1976 | reported and the syntactic symbol is ignored.") |
| 1977 | |
| 1978 | (defvar vhdl-echo-syntactic-information-p nil |
| 1979 | "If non-nil, syntactic info is echoed when the line is indented.") |
| 1980 | |
| 1981 | (defconst vhdl-offsets-alist-default |
| 1982 | '((string . -1000) |
| 1983 | (cpp-macro . -1000) |
| 1984 | (block-open . 0) |
| 1985 | (block-close . 0) |
| 1986 | (statement . 0) |
| 1987 | (statement-cont . vhdl-lineup-statement-cont) |
| 1988 | (statement-block-intro . +) |
| 1989 | (statement-case-intro . +) |
| 1990 | (case-alternative . +) |
| 1991 | (comment . vhdl-lineup-comment) |
| 1992 | (arglist-intro . +) |
| 1993 | (arglist-cont . 0) |
| 1994 | (arglist-cont-nonempty . vhdl-lineup-arglist) |
| 1995 | (arglist-close . vhdl-lineup-arglist) |
| 1996 | (entity . 0) |
| 1997 | (configuration . 0) |
| 1998 | (package . 0) |
| 1999 | (architecture . 0) |
| 2000 | (package-body . 0) |
| 2001 | ) |
| 2002 | "Default settings for offsets of syntactic elements. |
| 2003 | Do not change this constant! See the variable `vhdl-offsets-alist' for |
| 2004 | more information.") |
| 2005 | |
| 2006 | (defvar vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default) |
| 2007 | "Association list of syntactic element symbols and indentation offsets. |
| 2008 | As described below, each cons cell in this list has the form: |
| 2009 | |
| 2010 | (SYNTACTIC-SYMBOL . OFFSET) |
| 2011 | |
| 2012 | When a line is indented, `vhdl-mode' first determines the syntactic |
| 2013 | context of the line by generating a list of symbols called syntactic |
| 2014 | elements. This list can contain more than one syntactic element and |
| 2015 | the global variable `vhdl-syntactic-context' contains the context list |
| 2016 | for the line being indented. Each element in this list is actually a |
| 2017 | cons cell of the syntactic symbol and a buffer position. This buffer |
| 2018 | position is call the relative indent point for the line. Some |
| 2019 | syntactic symbols may not have a relative indent point associated with |
| 2020 | them. |
| 2021 | |
| 2022 | After the syntactic context list for a line is generated, `vhdl-mode' |
| 2023 | calculates the absolute indentation for the line by looking at each |
| 2024 | syntactic element in the list. First, it compares the syntactic |
| 2025 | element against the SYNTACTIC-SYMBOL's in `vhdl-offsets-alist'. When it |
| 2026 | finds a match, it adds the OFFSET to the column of the relative indent |
| 2027 | point. The sum of this calculation for each element in the syntactic |
| 2028 | list is the absolute offset for line being indented. |
| 2029 | |
| 2030 | If the syntactic element does not match any in the `vhdl-offsets-alist', |
| 2031 | an error is generated if `vhdl-strict-syntax-p' is non-nil, otherwise |
| 2032 | the element is ignored. |
| 2033 | |
| 2034 | Actually, OFFSET can be an integer, a function, a variable, or one of |
| 2035 | the following symbols: `+', `-', `++', or `--'. These latter |
| 2036 | designate positive or negative multiples of `vhdl-basic-offset', |
| 2037 | respectively: *1, *-1, *2, and *-2. If OFFSET is a function, it is |
| 2038 | called with a single argument containing the cons of the syntactic |
| 2039 | element symbol and the relative indent point. The function should |
| 2040 | return an integer offset. |
| 2041 | |
| 2042 | Here is the current list of valid syntactic element symbols: |
| 2043 | |
| 2044 | string -- inside multi-line string |
| 2045 | block-open -- statement block open |
| 2046 | block-close -- statement block close |
| 2047 | statement -- a VHDL statement |
| 2048 | statement-cont -- a continuation of a VHDL statement |
| 2049 | statement-block-intro -- the first line in a new statement block |
| 2050 | statement-case-intro -- the first line in a case alternative block |
| 2051 | case-alternative -- a case statement alternative clause |
| 2052 | comment -- a line containing only a comment |
| 2053 | arglist-intro -- the first line in an argument list |
| 2054 | arglist-cont -- subsequent argument list lines when no |
| 2055 | arguments follow on the same line as |
| 2056 | the arglist opening paren |
| 2057 | arglist-cont-nonempty -- subsequent argument list lines when at |
| 2058 | least one argument follows on the same |
| 2059 | line as the arglist opening paren |
| 2060 | arglist-close -- the solo close paren of an argument list |
| 2061 | entity -- inside an entity declaration |
| 2062 | configuration -- inside a configuration declaration |
| 2063 | package -- inside a package declaration |
| 2064 | architecture -- inside an architecture body |
| 2065 | package-body -- inside a package body") |
| 2066 | |
| 2067 | (defvar vhdl-comment-only-line-offset 0 |
| 2068 | "Extra offset for line which contains only the start of a comment. |
| 2069 | Can contain an integer or a cons cell of the form: |
| 2070 | |
| 2071 | (NON-ANCHORED-OFFSET . ANCHORED-OFFSET) |
| 2072 | |
| 2073 | Where NON-ANCHORED-OFFSET is the amount of offset given to |
| 2074 | non-column-zero anchored comment-only lines, and ANCHORED-OFFSET is |
| 2075 | the amount of offset to give column-zero anchored comment-only lines. |
| 2076 | Just an integer as value is equivalent to (<val> . 0)") |
| 2077 | |
| 2078 | (defvar vhdl-special-indent-hook nil |
| 2079 | "Hook for user defined special indentation adjustments. |
| 2080 | This hook gets called after a line is indented by the mode.") |
| 2081 | |
| 2082 | (defvar vhdl-style-alist |
| 2083 | '(("IEEE" |
| 2084 | (vhdl-basic-offset . 4) |
| 2085 | (vhdl-offsets-alist . ()))) |
| 2086 | "Styles of Indentation. |
| 2087 | Elements of this alist are of the form: |
| 2088 | |
| 2089 | (STYLE-STRING (VARIABLE . VALUE) [(VARIABLE . VALUE) ...]) |
| 2090 | |
| 2091 | where STYLE-STRING is a short descriptive string used to select a |
| 2092 | style, VARIABLE is any `vhdl-mode' variable, and VALUE is the intended |
| 2093 | value for that variable when using the selected style. |
| 2094 | |
| 2095 | There is one special case when VARIABLE is `vhdl-offsets-alist'. In this |
| 2096 | case, the VALUE is a list containing elements of the form: |
| 2097 | |
| 2098 | (SYNTACTIC-SYMBOL . VALUE) |
| 2099 | |
| 2100 | as described in `vhdl-offsets-alist'. These are passed directly to |
| 2101 | `vhdl-set-offset' so there is no need to set every syntactic symbol in |
| 2102 | your style, only those that are different from the default.") |
| 2103 | |
| 2104 | ;; dynamically append the default value of most variables |
| 2105 | (or (assoc "Default" vhdl-style-alist) |
| 2106 | (let* ((varlist '(vhdl-inhibit-startup-warnings-p |
| 2107 | vhdl-strict-syntax-p |
| 2108 | vhdl-echo-syntactic-information-p |
| 2109 | vhdl-basic-offset |
| 2110 | vhdl-offsets-alist |
| 2111 | vhdl-comment-only-line-offset)) |
| 2112 | (default (cons "Default" |
| 2113 | (mapcar |
| 2114 | (function |
| 2115 | (lambda (var) |
| 2116 | (cons var (symbol-value var)))) |
| 2117 | varlist)))) |
| 2118 | (push default vhdl-style-alist))) |
| 2119 | |
| 2120 | (defvar vhdl-mode-hook nil |
| 2121 | "Hook called by `vhdl-mode'.") |
| 2122 | |
| 2123 | |
| 2124 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2125 | ;;; Required packages |
| 2126 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2127 | |
| 2128 | ;; mandatory |
| 2129 | (require 'compile) ; XEmacs |
| 2130 | (require 'easymenu) |
| 2131 | (require 'hippie-exp) |
| 2132 | |
| 2133 | ;; optional (minimize warning messages during compile) |
| 2134 | (unless (featurep 'xemacs) |
| 2135 | (eval-when-compile |
| 2136 | (require 'font-lock) |
| 2137 | (require 'ps-print) |
| 2138 | (require 'speedbar))) ; for speedbar-with-writable |
| 2139 | |
| 2140 | ;; functions from obsolete assoc.el package (obsoleted in GNU Emacs 24.3) |
| 2141 | (defun vhdl-asort (alist-symbol key) |
| 2142 | "Move a specified key-value pair to the head of an alist. |
| 2143 | The alist is referenced by ALIST-SYMBOL. Key-value pair to move to |
| 2144 | head is one matching KEY. Returns the sorted list and doesn't affect |
| 2145 | the order of any other key-value pair. Side effect sets alist to new |
| 2146 | sorted list." |
| 2147 | (set alist-symbol |
| 2148 | (sort (copy-alist (symbol-value alist-symbol)) |
| 2149 | (lambda (a _b) (equal (car a) key))))) |
| 2150 | |
| 2151 | (defun vhdl-anot-head-p (alist key) |
| 2152 | "Find out if a specified key-value pair is not at the head of an alist. |
| 2153 | The alist to check is specified by ALIST and the key-value pair is the |
| 2154 | one matching the supplied KEY. Returns nil if ALIST is nil, or if |
| 2155 | key-value pair is at the head of the alist. Returns t if key-value |
| 2156 | pair is not at the head of alist. ALIST is not altered." |
| 2157 | (not (equal (car (car alist)) key))) |
| 2158 | |
| 2159 | (defun vhdl-aput (alist-symbol key &optional value) |
| 2160 | "Insert a key-value pair into an alist. |
| 2161 | The alist is referenced by ALIST-SYMBOL. The key-value pair is made |
| 2162 | from KEY and optionally, VALUE. Returns the altered alist. |
| 2163 | |
| 2164 | If the key-value pair referenced by KEY can be found in the alist, and |
| 2165 | VALUE is supplied non-nil, then the value of KEY will be set to VALUE. |
| 2166 | If VALUE is not supplied, or is nil, the key-value pair will not be |
| 2167 | modified, but will be moved to the head of the alist. If the key-value |
| 2168 | pair cannot be found in the alist, it will be inserted into the head |
| 2169 | of the alist (with value nil if VALUE is nil or not supplied)." |
| 2170 | (let ((elem (list (cons key value))) |
| 2171 | alist) |
| 2172 | (vhdl-asort alist-symbol key) |
| 2173 | (setq alist (symbol-value alist-symbol)) |
| 2174 | (cond ((null alist) (set alist-symbol elem)) |
| 2175 | ((vhdl-anot-head-p alist key) (set alist-symbol (nconc elem alist))) |
| 2176 | (value (setcar alist (car elem)) alist) |
| 2177 | (t alist)))) |
| 2178 | |
| 2179 | (defun vhdl-adelete (alist-symbol key) |
| 2180 | "Delete a key-value pair from the alist. |
| 2181 | Alist is referenced by ALIST-SYMBOL and the key-value pair to remove |
| 2182 | is pair matching KEY. Returns the altered alist." |
| 2183 | (vhdl-asort alist-symbol key) |
| 2184 | (let ((alist (symbol-value alist-symbol))) |
| 2185 | (cond ((null alist) nil) |
| 2186 | ((vhdl-anot-head-p alist key) alist) |
| 2187 | (t (set alist-symbol (cdr alist)))))) |
| 2188 | |
| 2189 | (defun vhdl-aget (alist key &optional keynil-p) |
| 2190 | "Return the value in ALIST that is associated with KEY. |
| 2191 | Optional KEYNIL-P describes what to do if the value associated with |
| 2192 | KEY is nil. If KEYNIL-P is not supplied or is nil, and the value is |
| 2193 | nil, then KEY is returned. If KEYNIL-P is non-nil, then nil would be |
| 2194 | returned. |
| 2195 | |
| 2196 | If no key-value pair matching KEY could be found in ALIST, or ALIST is |
| 2197 | nil then nil is returned. ALIST is not altered." |
| 2198 | (let ((copy (copy-alist alist))) |
| 2199 | (cond ((null alist) nil) |
| 2200 | ((progn (vhdl-asort 'copy key) |
| 2201 | (vhdl-anot-head-p copy key)) nil) |
| 2202 | ((cdr (car copy))) |
| 2203 | (keynil-p nil) |
| 2204 | ((car (car copy))) |
| 2205 | (t nil)))) |
| 2206 | |
| 2207 | |
| 2208 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2209 | ;;; Compatibility |
| 2210 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2211 | |
| 2212 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2213 | ;; XEmacs compatibility |
| 2214 | |
| 2215 | ;; active regions |
| 2216 | (defun vhdl-keep-region-active () |
| 2217 | "Do whatever is necessary to keep the region active in XEmacs. |
| 2218 | Ignore byte-compiler warnings you might see." |
| 2219 | (and (featurep 'xemacs) |
| 2220 | (setq zmacs-region-stays t))) |
| 2221 | |
| 2222 | ;; `wildcard-to-regexp' is included only in XEmacs 21 |
| 2223 | (unless (fboundp 'wildcard-to-regexp) |
| 2224 | (defun wildcard-to-regexp (wildcard) |
| 2225 | "Simplified version of `wildcard-to-regexp' from Emacs's `files.el'." |
| 2226 | (let* ((i (string-match "[*?]" wildcard)) |
| 2227 | (result (substring wildcard 0 i)) |
| 2228 | (len (length wildcard))) |
| 2229 | (when i |
| 2230 | (while (< i len) |
| 2231 | (let ((ch (aref wildcard i))) |
| 2232 | (setq result (concat result |
| 2233 | (cond ((eq ch ?*) "[^\000]*") |
| 2234 | ((eq ch ??) "[^\000]") |
| 2235 | (t (char-to-string ch))))) |
| 2236 | (setq i (1+ i))))) |
| 2237 | (concat "\\`" result "\\'")))) |
| 2238 | |
| 2239 | ;; `regexp-opt' undefined (`xemacs-devel' not installed) |
| 2240 | ;; `regexp-opt' accelerates fontification by 10-20% |
| 2241 | (unless (fboundp 'regexp-opt) |
| 2242 | ; (vhdl-warning-when-idle "Please install `xemacs-devel' package.") |
| 2243 | (defun regexp-opt (strings &optional paren) |
| 2244 | (let ((open (if paren "\\(" "")) (close (if paren "\\)" ""))) |
| 2245 | (concat open (mapconcat 'regexp-quote strings "\\|") close)))) |
| 2246 | |
| 2247 | ;; `match-string-no-properties' undefined (XEmacs, what else?) |
| 2248 | (unless (fboundp 'match-string-no-properties) |
| 2249 | (defalias 'match-string-no-properties 'match-string)) |
| 2250 | |
| 2251 | ;; `subst-char-in-string' undefined (XEmacs) |
| 2252 | (unless (fboundp 'subst-char-in-string) |
| 2253 | (defun subst-char-in-string (fromchar tochar string &optional inplace) |
| 2254 | (let ((i (length string)) |
| 2255 | (newstr (if inplace string (copy-sequence string)))) |
| 2256 | (while (> i 0) |
| 2257 | (setq i (1- i)) |
| 2258 | (if (eq (aref newstr i) fromchar) (aset newstr i tochar))) |
| 2259 | newstr))) |
| 2260 | |
| 2261 | ;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9) |
| 2262 | (when (and (featurep 'xemacs) (string< itimer-version "1.09") |
| 2263 | (not noninteractive)) |
| 2264 | (load "itimer") |
| 2265 | (when (string< itimer-version "1.09") |
| 2266 | (message "WARNING: Install included `itimer.el' patch first (see INSTALL file)") |
| 2267 | (beep) (sit-for 5))) |
| 2268 | |
| 2269 | ;; `file-expand-wildcards' undefined (XEmacs) |
| 2270 | (unless (fboundp 'file-expand-wildcards) |
| 2271 | (defun file-expand-wildcards (pattern &optional full) |
| 2272 | "Taken from Emacs's `files.el'." |
| 2273 | (let* ((nondir (file-name-nondirectory pattern)) |
| 2274 | (dirpart (file-name-directory pattern)) |
| 2275 | (dirs (if (and dirpart (string-match "[[*?]" dirpart)) |
| 2276 | (mapcar 'file-name-as-directory |
| 2277 | (file-expand-wildcards (directory-file-name dirpart))) |
| 2278 | (list dirpart))) |
| 2279 | contents) |
| 2280 | (while dirs |
| 2281 | (when (or (null (car dirs)) ; Possible if DIRPART is not wild. |
| 2282 | (file-directory-p (directory-file-name (car dirs)))) |
| 2283 | (let ((this-dir-contents |
| 2284 | (delq nil |
| 2285 | (mapcar #'(lambda (name) |
| 2286 | (unless (string-match "\\`\\.\\.?\\'" |
| 2287 | (file-name-nondirectory name)) |
| 2288 | name)) |
| 2289 | (directory-files (or (car dirs) ".") full |
| 2290 | (wildcard-to-regexp nondir)))))) |
| 2291 | (setq contents |
| 2292 | (nconc |
| 2293 | (if (and (car dirs) (not full)) |
| 2294 | (mapcar (function (lambda (name) (concat (car dirs) name))) |
| 2295 | this-dir-contents) |
| 2296 | this-dir-contents) |
| 2297 | contents)))) |
| 2298 | (setq dirs (cdr dirs))) |
| 2299 | contents))) |
| 2300 | |
| 2301 | ;; `member-ignore-case' undefined (XEmacs) |
| 2302 | (unless (fboundp 'member-ignore-case) |
| 2303 | (defalias 'member-ignore-case 'member)) |
| 2304 | |
| 2305 | ;; `last-input-char' obsolete in Emacs 24, `last-input-event' different |
| 2306 | ;; behavior in XEmacs |
| 2307 | (defvar vhdl-last-input-event) |
| 2308 | (if (featurep 'xemacs) |
| 2309 | (defvaralias 'vhdl-last-input-event 'last-input-char) |
| 2310 | (defvaralias 'vhdl-last-input-event 'last-input-event)) |
| 2311 | |
| 2312 | ;; `help-print-return-message' changed to `print-help-return-message' in Emacs |
| 2313 | ;;;(unless (fboundp 'help-print-return-message) |
| 2314 | ;;; (defalias 'help-print-return-message 'print-help-return-message)) |
| 2315 | |
| 2316 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2317 | ;; Compatibility with older VHDL Mode versions |
| 2318 | |
| 2319 | (defvar vhdl-warnings nil |
| 2320 | "Warnings to tell the user during start up.") |
| 2321 | |
| 2322 | (defun vhdl-run-when-idle (secs repeat function) |
| 2323 | "Wait until idle, then run FUNCTION." |
| 2324 | (if (fboundp 'start-itimer) |
| 2325 | (start-itimer "vhdl-mode" function secs repeat t) |
| 2326 | ;; explicitly activate timer (necessary when Emacs is already idle) |
| 2327 | (aset (run-with-idle-timer secs repeat function) 0 nil))) |
| 2328 | |
| 2329 | (defun vhdl-warning-when-idle (&rest args) |
| 2330 | "Wait until idle, then print out warning STRING and beep." |
| 2331 | (if noninteractive |
| 2332 | (vhdl-warning (apply 'format args) t) |
| 2333 | (unless vhdl-warnings |
| 2334 | (vhdl-run-when-idle .1 nil 'vhdl-print-warnings)) |
| 2335 | (push (apply 'format args) vhdl-warnings))) |
| 2336 | |
| 2337 | (defun vhdl-warning (string &optional nobeep) |
| 2338 | "Print out warning STRING and beep." |
| 2339 | (message "WARNING: %s" string) |
| 2340 | (unless (or nobeep noninteractive) (beep))) |
| 2341 | |
| 2342 | (defun vhdl-print-warnings () |
| 2343 | "Print out messages in variable `vhdl-warnings'." |
| 2344 | (let ((no-warnings (length vhdl-warnings))) |
| 2345 | (setq vhdl-warnings (nreverse vhdl-warnings)) |
| 2346 | (while vhdl-warnings |
| 2347 | (message "WARNING: %s" (car vhdl-warnings)) |
| 2348 | (setq vhdl-warnings (cdr vhdl-warnings))) |
| 2349 | (beep) |
| 2350 | (when (> no-warnings 1) |
| 2351 | (message "WARNING: See warnings in message buffer (type `C-c M-m').")))) |
| 2352 | |
| 2353 | ;; Backward compatibility checks and fixes |
| 2354 | ;; option `vhdl-compiler' changed format |
| 2355 | (unless (stringp vhdl-compiler) |
| 2356 | (setq vhdl-compiler "ModelSim") |
| 2357 | (vhdl-warning-when-idle "Option `vhdl-compiler' has changed format; customize again")) |
| 2358 | |
| 2359 | ;; option `vhdl-standard' changed format |
| 2360 | (unless (listp vhdl-standard) |
| 2361 | (setq vhdl-standard '(87 nil)) |
| 2362 | (vhdl-warning-when-idle "Option `vhdl-standard' has changed format; customize again")) |
| 2363 | |
| 2364 | ;; option `vhdl-model-alist' changed format |
| 2365 | (when (= (length (car vhdl-model-alist)) 3) |
| 2366 | (let ((old-alist vhdl-model-alist) |
| 2367 | new-alist) |
| 2368 | (while old-alist |
| 2369 | (push (append (car old-alist) '("")) new-alist) |
| 2370 | (setq old-alist (cdr old-alist))) |
| 2371 | (setq vhdl-model-alist (nreverse new-alist))) |
| 2372 | (customize-save-variable 'vhdl-model-alist vhdl-model-alist)) |
| 2373 | |
| 2374 | ;; option `vhdl-project-alist' changed format |
| 2375 | (when (= (length (car vhdl-project-alist)) 3) |
| 2376 | (let ((old-alist vhdl-project-alist) |
| 2377 | new-alist) |
| 2378 | (while old-alist |
| 2379 | (push (append (car old-alist) '("")) new-alist) |
| 2380 | (setq old-alist (cdr old-alist))) |
| 2381 | (setq vhdl-project-alist (nreverse new-alist))) |
| 2382 | (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) |
| 2383 | |
| 2384 | ;; option `vhdl-project-alist' changed format (3.31.1) |
| 2385 | (when (= (length (car vhdl-project-alist)) 4) |
| 2386 | (let ((old-alist vhdl-project-alist) |
| 2387 | new-alist elem) |
| 2388 | (while old-alist |
| 2389 | (setq elem (car old-alist)) |
| 2390 | (setq new-alist |
| 2391 | (cons (list (nth 0 elem) (nth 1 elem) "" (nth 2 elem) |
| 2392 | nil "./" "work" "work/" "Makefile" (nth 3 elem)) |
| 2393 | new-alist)) |
| 2394 | (setq old-alist (cdr old-alist))) |
| 2395 | (setq vhdl-project-alist (nreverse new-alist))) |
| 2396 | (vhdl-warning-when-idle "Option `vhdl-project-alist' changed format; please re-customize")) |
| 2397 | |
| 2398 | ;; option `vhdl-project-alist' changed format (3.31.12) |
| 2399 | (when (= (length (car vhdl-project-alist)) 10) |
| 2400 | (let ((tmp-alist vhdl-project-alist)) |
| 2401 | (while tmp-alist |
| 2402 | (setcdr (nthcdr 3 (car tmp-alist)) |
| 2403 | (cons "" (nthcdr 4 (car tmp-alist)))) |
| 2404 | (setq tmp-alist (cdr tmp-alist)))) |
| 2405 | (customize-save-variable 'vhdl-project-alist vhdl-project-alist)) |
| 2406 | |
| 2407 | ;; option `vhdl-compiler-alist' changed format (3.31.1) |
| 2408 | (when (= (length (car vhdl-compiler-alist)) 7) |
| 2409 | (let ((old-alist vhdl-compiler-alist) |
| 2410 | new-alist elem) |
| 2411 | (while old-alist |
| 2412 | (setq elem (car old-alist)) |
| 2413 | (setq new-alist |
| 2414 | (cons (list (nth 0 elem) (nth 1 elem) "" "make -f \\1" |
| 2415 | (if (equal (nth 3 elem) "") nil (nth 3 elem)) |
| 2416 | (nth 4 elem) "work/" "Makefile" (downcase (nth 0 elem)) |
| 2417 | (nth 5 elem) (nth 6 elem) nil) |
| 2418 | new-alist)) |
| 2419 | (setq old-alist (cdr old-alist))) |
| 2420 | (setq vhdl-compiler-alist (nreverse new-alist))) |
| 2421 | (vhdl-warning-when-idle "Option `vhdl-compiler-alist' changed; please reset and re-customize")) |
| 2422 | |
| 2423 | ;; option `vhdl-compiler-alist' changed format (3.31.10) |
| 2424 | (when (= (length (car vhdl-compiler-alist)) 12) |
| 2425 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2426 | (while tmp-alist |
| 2427 | (setcdr (nthcdr 4 (car tmp-alist)) |
| 2428 | (cons "mkdir \\1" (nthcdr 5 (car tmp-alist)))) |
| 2429 | (setq tmp-alist (cdr tmp-alist)))) |
| 2430 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2431 | |
| 2432 | ;; option `vhdl-compiler-alist' changed format (3.31.11) |
| 2433 | (when (= (length (car vhdl-compiler-alist)) 13) |
| 2434 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2435 | (while tmp-alist |
| 2436 | (setcdr (nthcdr 3 (car tmp-alist)) |
| 2437 | (cons "" (nthcdr 4 (car tmp-alist)))) |
| 2438 | (setq tmp-alist (cdr tmp-alist)))) |
| 2439 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2440 | |
| 2441 | ;; option `vhdl-compiler-alist' changed format (3.32.7) |
| 2442 | (when (= (length (nth 11 (car vhdl-compiler-alist))) 3) |
| 2443 | (let ((tmp-alist vhdl-compiler-alist)) |
| 2444 | (while tmp-alist |
| 2445 | (setcdr (nthcdr 2 (nth 11 (car tmp-alist))) |
| 2446 | '(0 . nil)) |
| 2447 | (setq tmp-alist (cdr tmp-alist)))) |
| 2448 | (customize-save-variable 'vhdl-compiler-alist vhdl-compiler-alist)) |
| 2449 | |
| 2450 | ;; option `vhdl-project': empty value changed from "" to nil (3.31.1) |
| 2451 | (when (equal vhdl-project "") |
| 2452 | (setq vhdl-project nil) |
| 2453 | (customize-save-variable 'vhdl-project vhdl-project)) |
| 2454 | |
| 2455 | ;; option `vhdl-project-file-name': changed format (3.31.17 beta) |
| 2456 | (when (stringp vhdl-project-file-name) |
| 2457 | (setq vhdl-project-file-name (list vhdl-project-file-name)) |
| 2458 | (customize-save-variable 'vhdl-project-file-name vhdl-project-file-name)) |
| 2459 | |
| 2460 | ;; option `speedbar-indentation-width': introduced in speedbar 0.10 |
| 2461 | (if (not (boundp 'speedbar-indentation-width)) |
| 2462 | (defvar speedbar-indentation-width 2) |
| 2463 | ;; set default to 2 if not already customized |
| 2464 | (unless (get 'speedbar-indentation-width 'saved-value) |
| 2465 | (setq speedbar-indentation-width 2))) |
| 2466 | |
| 2467 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2468 | ;;; Help functions / inline substitutions / macros |
| 2469 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2470 | |
| 2471 | (defun vhdl-standard-p (standard) |
| 2472 | "Check if STANDARD is specified as used standard." |
| 2473 | (or (eq standard (car vhdl-standard)) |
| 2474 | (memq standard (cadr vhdl-standard)))) |
| 2475 | |
| 2476 | (defun vhdl-project-p (&optional warning) |
| 2477 | "Return non-nil if a project is displayed, i.e. directories or files are |
| 2478 | specified." |
| 2479 | (if (assoc vhdl-project vhdl-project-alist) |
| 2480 | vhdl-project |
| 2481 | (when (and vhdl-project warning) |
| 2482 | (vhdl-warning-when-idle "Project does not exist: \"%s\"" vhdl-project)) |
| 2483 | nil)) |
| 2484 | |
| 2485 | (defun vhdl-resolve-env-variable (string) |
| 2486 | "Resolve environment variables in STRING." |
| 2487 | (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) |
| 2488 | (setq string (concat (match-string 1 string) |
| 2489 | (getenv (match-string 2 string)) |
| 2490 | (match-string 4 string)))) |
| 2491 | string) |
| 2492 | |
| 2493 | (defun vhdl-default-directory () |
| 2494 | "Return the default directory of the current project or the directory of the |
| 2495 | current buffer if no project is defined." |
| 2496 | (if (vhdl-project-p) |
| 2497 | (expand-file-name (vhdl-resolve-env-variable |
| 2498 | (nth 1 (vhdl-aget vhdl-project-alist vhdl-project)))) |
| 2499 | default-directory)) |
| 2500 | |
| 2501 | (defmacro vhdl-prepare-search-1 (&rest body) |
| 2502 | "Enable case insensitive search and switch to syntax table that includes '_', |
| 2503 | then execute BODY, and finally restore the old environment. Used for |
| 2504 | consistent searching." |
| 2505 | `(let ((case-fold-search t)) ; case insensitive search |
| 2506 | ;; use extended syntax table |
| 2507 | (with-syntax-table vhdl-mode-ext-syntax-table |
| 2508 | ,@body))) |
| 2509 | |
| 2510 | (defmacro vhdl-prepare-search-2 (&rest body) |
| 2511 | "Enable case insensitive search, switch to syntax table that includes '_', |
| 2512 | and remove `intangible' overlays, then execute BODY, and finally restore the |
| 2513 | old environment. Used for consistent searching." |
| 2514 | ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef |
| 2515 | `(let ((case-fold-search t) ; case insensitive search |
| 2516 | (current-syntax-table (syntax-table)) |
| 2517 | overlay-all-list overlay-intangible-list overlay) |
| 2518 | ;; use extended syntax table |
| 2519 | (set-syntax-table vhdl-mode-ext-syntax-table) |
| 2520 | ;; remove `intangible' overlays |
| 2521 | (when (fboundp 'overlay-lists) |
| 2522 | (setq overlay-all-list (overlay-lists)) |
| 2523 | (setq overlay-all-list |
| 2524 | (append (car overlay-all-list) (cdr overlay-all-list))) |
| 2525 | (while overlay-all-list |
| 2526 | (setq overlay (car overlay-all-list)) |
| 2527 | (when (memq 'intangible (overlay-properties overlay)) |
| 2528 | (setq overlay-intangible-list |
| 2529 | (cons overlay overlay-intangible-list)) |
| 2530 | (overlay-put overlay 'intangible nil)) |
| 2531 | (setq overlay-all-list (cdr overlay-all-list)))) |
| 2532 | ;; execute BODY safely |
| 2533 | (unwind-protect |
| 2534 | (progn ,@body) |
| 2535 | ;; restore syntax table |
| 2536 | (set-syntax-table current-syntax-table) |
| 2537 | ;; restore `intangible' overlays |
| 2538 | (when (fboundp 'overlay-lists) |
| 2539 | (while overlay-intangible-list |
| 2540 | (overlay-put (car overlay-intangible-list) 'intangible t) |
| 2541 | (setq overlay-intangible-list |
| 2542 | (cdr overlay-intangible-list))))))) |
| 2543 | |
| 2544 | (defmacro vhdl-visit-file (file-name issue-error &rest body) |
| 2545 | "Visit file FILE-NAME and execute BODY." |
| 2546 | `(if (null ,file-name) |
| 2547 | (progn ,@body) |
| 2548 | (unless (file-directory-p ,file-name) |
| 2549 | (let ((source-buffer (current-buffer)) |
| 2550 | (visiting-buffer (find-buffer-visiting ,file-name)) |
| 2551 | file-opened) |
| 2552 | (when (or (and visiting-buffer (set-buffer visiting-buffer)) |
| 2553 | (condition-case () |
| 2554 | (progn (set-buffer (create-file-buffer ,file-name)) |
| 2555 | (setq file-opened t) |
| 2556 | (vhdl-insert-file-contents ,file-name) |
| 2557 | ;; FIXME: This modifies a global syntax-table! |
| 2558 | (modify-syntax-entry ?\- ". 12" (syntax-table)) |
| 2559 | (modify-syntax-entry ?\n ">" (syntax-table)) |
| 2560 | (modify-syntax-entry ?\^M ">" (syntax-table)) |
| 2561 | (modify-syntax-entry ?_ "w" (syntax-table)) |
| 2562 | t) |
| 2563 | (error |
| 2564 | (if ,issue-error |
| 2565 | (progn |
| 2566 | (when file-opened (kill-buffer (current-buffer))) |
| 2567 | (set-buffer source-buffer) |
| 2568 | (error "ERROR: File cannot be opened: \"%s\"" ,file-name)) |
| 2569 | (vhdl-warning (format "File cannot be opened: \"%s\"" ,file-name) t) |
| 2570 | nil)))) |
| 2571 | (condition-case info |
| 2572 | (progn ,@body) |
| 2573 | (error |
| 2574 | (if ,issue-error |
| 2575 | (progn |
| 2576 | (when file-opened (kill-buffer (current-buffer))) |
| 2577 | (set-buffer source-buffer) |
| 2578 | (error (cadr info))) |
| 2579 | (vhdl-warning (cadr info)))))) |
| 2580 | (when file-opened (kill-buffer (current-buffer))) |
| 2581 | (set-buffer source-buffer))))) |
| 2582 | |
| 2583 | (defun vhdl-insert-file-contents (filename) |
| 2584 | "Nicked from `insert-file-contents-literally', but allow coding system |
| 2585 | conversion." |
| 2586 | (let ((format-alist nil) |
| 2587 | (after-insert-file-functions nil) |
| 2588 | (jka-compr-compression-info-list nil)) |
| 2589 | (insert-file-contents filename t))) |
| 2590 | |
| 2591 | (defun vhdl-sort-alist (alist) |
| 2592 | "Sort ALIST." |
| 2593 | (sort alist (function (lambda (a b) (string< (car a) (car b)))))) |
| 2594 | |
| 2595 | (defun vhdl-get-subdirs (directory) |
| 2596 | "Recursively get subdirectories of DIRECTORY." |
| 2597 | (let ((dir-list (list (file-name-as-directory directory))) |
| 2598 | file-list) |
| 2599 | (setq file-list (vhdl-directory-files directory t "\\w.*")) |
| 2600 | (while file-list |
| 2601 | (when (file-directory-p (car file-list)) |
| 2602 | (setq dir-list (append dir-list (vhdl-get-subdirs (car file-list))))) |
| 2603 | (setq file-list (cdr file-list))) |
| 2604 | dir-list)) |
| 2605 | |
| 2606 | (defun vhdl-aput-delete-if-nil (alist-symbol key &optional value) |
| 2607 | "As `aput', but delete key-value pair if VALUE is nil." |
| 2608 | (if value |
| 2609 | (vhdl-aput alist-symbol key value) |
| 2610 | (vhdl-adelete alist-symbol key))) |
| 2611 | |
| 2612 | (defun vhdl-delete (elt list) |
| 2613 | "Delete by side effect the first occurrence of ELT as a member of LIST." |
| 2614 | (push nil list) |
| 2615 | (let ((list1 list)) |
| 2616 | (while (and (cdr list1) (not (equal elt (cadr list1)))) |
| 2617 | (setq list1 (cdr list1))) |
| 2618 | (when list |
| 2619 | (setcdr list1 (cddr list1)))) |
| 2620 | (cdr list)) |
| 2621 | |
| 2622 | (declare-function speedbar-refresh "speedbar" (&optional arg)) |
| 2623 | (declare-function speedbar-do-function-pointer "speedbar" ()) |
| 2624 | |
| 2625 | (defun vhdl-speedbar-refresh (&optional key) |
| 2626 | "Refresh directory or project with name KEY." |
| 2627 | (when (and (boundp 'speedbar-frame) |
| 2628 | (frame-live-p speedbar-frame)) |
| 2629 | (let ((pos (point)) |
| 2630 | (last-frame (selected-frame))) |
| 2631 | (if (null key) |
| 2632 | (speedbar-refresh) |
| 2633 | (select-frame speedbar-frame) |
| 2634 | (when (save-excursion |
| 2635 | (goto-char (point-min)) |
| 2636 | (re-search-forward (concat "^\\([0-9]+:\\s-*<\\)->\\s-+" key "$") nil t)) |
| 2637 | (goto-char (match-end 1)) |
| 2638 | (speedbar-do-function-pointer) |
| 2639 | (backward-char 2) |
| 2640 | (speedbar-do-function-pointer) |
| 2641 | (message "Refreshing speedbar...done")) |
| 2642 | (select-frame last-frame))))) |
| 2643 | |
| 2644 | (defun vhdl-show-messages () |
| 2645 | "Get *Messages* buffer to show recent messages." |
| 2646 | (interactive) |
| 2647 | (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*"))) |
| 2648 | |
| 2649 | (defun vhdl-use-direct-instantiation () |
| 2650 | "Return whether direct instantiation is used." |
| 2651 | (or (eq vhdl-use-direct-instantiation 'always) |
| 2652 | (and (eq vhdl-use-direct-instantiation 'standard) |
| 2653 | (not (vhdl-standard-p '87))))) |
| 2654 | |
| 2655 | (defun vhdl-max-marker (marker1 marker2) |
| 2656 | "Return larger marker." |
| 2657 | (if (> marker1 marker2) marker1 marker2)) |
| 2658 | |
| 2659 | (defun vhdl-goto-marker (marker) |
| 2660 | "Goto marker in appropriate buffer." |
| 2661 | (when (markerp marker) |
| 2662 | (set-buffer (marker-buffer marker))) |
| 2663 | (goto-char marker)) |
| 2664 | |
| 2665 | (defun vhdl-menu-split (list title) |
| 2666 | "Split menu LIST into several submenus, if number of |
| 2667 | elements > `vhdl-menu-max-size'." |
| 2668 | (if (> (length list) vhdl-menu-max-size) |
| 2669 | (let ((remain list) |
| 2670 | (result '()) |
| 2671 | (sublist '()) |
| 2672 | (menuno 1) |
| 2673 | (i 0)) |
| 2674 | (while remain |
| 2675 | (push (car remain) sublist) |
| 2676 | (setq remain (cdr remain)) |
| 2677 | (setq i (+ i 1)) |
| 2678 | (if (= i vhdl-menu-max-size) |
| 2679 | (progn |
| 2680 | (push (cons (format "%s %s" title menuno) |
| 2681 | (nreverse sublist)) result) |
| 2682 | (setq i 0) |
| 2683 | (setq menuno (+ menuno 1)) |
| 2684 | (setq sublist '())))) |
| 2685 | (and sublist |
| 2686 | (push (cons (format "%s %s" title menuno) |
| 2687 | (nreverse sublist)) result)) |
| 2688 | (nreverse result)) |
| 2689 | list)) |
| 2690 | |
| 2691 | |
| 2692 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2693 | ;;; Bindings |
| 2694 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2695 | |
| 2696 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2697 | ;; Key bindings |
| 2698 | |
| 2699 | (defvar vhdl-template-map nil |
| 2700 | "Keymap for VHDL templates.") |
| 2701 | |
| 2702 | (defun vhdl-template-map-init () |
| 2703 | "Initialize `vhdl-template-map'." |
| 2704 | (setq vhdl-template-map (make-sparse-keymap)) |
| 2705 | ;; key bindings for VHDL templates |
| 2706 | (define-key vhdl-template-map "al" 'vhdl-template-alias) |
| 2707 | (define-key vhdl-template-map "ar" 'vhdl-template-architecture) |
| 2708 | (define-key vhdl-template-map "at" 'vhdl-template-assert) |
| 2709 | (define-key vhdl-template-map "ad" 'vhdl-template-attribute-decl) |
| 2710 | (define-key vhdl-template-map "as" 'vhdl-template-attribute-spec) |
| 2711 | (define-key vhdl-template-map "bl" 'vhdl-template-block) |
| 2712 | (define-key vhdl-template-map "ca" 'vhdl-template-case-is) |
| 2713 | (define-key vhdl-template-map "cd" 'vhdl-template-component-decl) |
| 2714 | (define-key vhdl-template-map "ci" 'vhdl-template-component-inst) |
| 2715 | (define-key vhdl-template-map "cs" 'vhdl-template-conditional-signal-asst) |
| 2716 | (define-key vhdl-template-map "Cb" 'vhdl-template-block-configuration) |
| 2717 | (define-key vhdl-template-map "Cc" 'vhdl-template-component-conf) |
| 2718 | (define-key vhdl-template-map "Cd" 'vhdl-template-configuration-decl) |
| 2719 | (define-key vhdl-template-map "Cs" 'vhdl-template-configuration-spec) |
| 2720 | (define-key vhdl-template-map "co" 'vhdl-template-constant) |
| 2721 | (define-key vhdl-template-map "di" 'vhdl-template-disconnect) |
| 2722 | (define-key vhdl-template-map "el" 'vhdl-template-else) |
| 2723 | (define-key vhdl-template-map "ei" 'vhdl-template-elsif) |
| 2724 | (define-key vhdl-template-map "en" 'vhdl-template-entity) |
| 2725 | (define-key vhdl-template-map "ex" 'vhdl-template-exit) |
| 2726 | (define-key vhdl-template-map "fi" 'vhdl-template-file) |
| 2727 | (define-key vhdl-template-map "fg" 'vhdl-template-for-generate) |
| 2728 | (define-key vhdl-template-map "fl" 'vhdl-template-for-loop) |
| 2729 | (define-key vhdl-template-map "\C-f" 'vhdl-template-footer) |
| 2730 | (define-key vhdl-template-map "fb" 'vhdl-template-function-body) |
| 2731 | (define-key vhdl-template-map "fd" 'vhdl-template-function-decl) |
| 2732 | (define-key vhdl-template-map "ge" 'vhdl-template-generic) |
| 2733 | (define-key vhdl-template-map "gd" 'vhdl-template-group-decl) |
| 2734 | (define-key vhdl-template-map "gt" 'vhdl-template-group-template) |
| 2735 | (define-key vhdl-template-map "\C-h" 'vhdl-template-header) |
| 2736 | (define-key vhdl-template-map "ig" 'vhdl-template-if-generate) |
| 2737 | (define-key vhdl-template-map "it" 'vhdl-template-if-then) |
| 2738 | (define-key vhdl-template-map "li" 'vhdl-template-library) |
| 2739 | (define-key vhdl-template-map "lo" 'vhdl-template-bare-loop) |
| 2740 | (define-key vhdl-template-map "\C-m" 'vhdl-template-modify) |
| 2741 | (define-key vhdl-template-map "\C-t" 'vhdl-template-insert-date) |
| 2742 | (define-key vhdl-template-map "ma" 'vhdl-template-map) |
| 2743 | (define-key vhdl-template-map "ne" 'vhdl-template-next) |
| 2744 | (define-key vhdl-template-map "ot" 'vhdl-template-others) |
| 2745 | (define-key vhdl-template-map "Pd" 'vhdl-template-package-decl) |
| 2746 | (define-key vhdl-template-map "Pb" 'vhdl-template-package-body) |
| 2747 | (define-key vhdl-template-map "(" 'vhdl-template-paired-parens) |
| 2748 | (define-key vhdl-template-map "po" 'vhdl-template-port) |
| 2749 | (define-key vhdl-template-map "pb" 'vhdl-template-procedure-body) |
| 2750 | (define-key vhdl-template-map "pd" 'vhdl-template-procedure-decl) |
| 2751 | (define-key vhdl-template-map "pc" 'vhdl-template-process-comb) |
| 2752 | (define-key vhdl-template-map "ps" 'vhdl-template-process-seq) |
| 2753 | (define-key vhdl-template-map "rp" 'vhdl-template-report) |
| 2754 | (define-key vhdl-template-map "rt" 'vhdl-template-return) |
| 2755 | (define-key vhdl-template-map "ss" 'vhdl-template-selected-signal-asst) |
| 2756 | (define-key vhdl-template-map "si" 'vhdl-template-signal) |
| 2757 | (define-key vhdl-template-map "su" 'vhdl-template-subtype) |
| 2758 | (define-key vhdl-template-map "ty" 'vhdl-template-type) |
| 2759 | (define-key vhdl-template-map "us" 'vhdl-template-use) |
| 2760 | (define-key vhdl-template-map "va" 'vhdl-template-variable) |
| 2761 | (define-key vhdl-template-map "wa" 'vhdl-template-wait) |
| 2762 | (define-key vhdl-template-map "wl" 'vhdl-template-while-loop) |
| 2763 | (define-key vhdl-template-map "wi" 'vhdl-template-with) |
| 2764 | (define-key vhdl-template-map "wc" 'vhdl-template-clocked-wait) |
| 2765 | (define-key vhdl-template-map "\C-pb" 'vhdl-template-package-numeric-bit) |
| 2766 | (define-key vhdl-template-map "\C-pn" 'vhdl-template-package-numeric-std) |
| 2767 | (define-key vhdl-template-map "\C-ps" 'vhdl-template-package-std-logic-1164) |
| 2768 | (define-key vhdl-template-map "\C-pA" 'vhdl-template-package-std-logic-arith) |
| 2769 | (define-key vhdl-template-map "\C-pM" 'vhdl-template-package-std-logic-misc) |
| 2770 | (define-key vhdl-template-map "\C-pS" 'vhdl-template-package-std-logic-signed) |
| 2771 | (define-key vhdl-template-map "\C-pT" 'vhdl-template-package-std-logic-textio) |
| 2772 | (define-key vhdl-template-map "\C-pU" 'vhdl-template-package-std-logic-unsigned) |
| 2773 | (define-key vhdl-template-map "\C-pt" 'vhdl-template-package-textio) |
| 2774 | (define-key vhdl-template-map "\C-dn" 'vhdl-template-directive-translate-on) |
| 2775 | (define-key vhdl-template-map "\C-df" 'vhdl-template-directive-translate-off) |
| 2776 | (define-key vhdl-template-map "\C-dN" 'vhdl-template-directive-synthesis-on) |
| 2777 | (define-key vhdl-template-map "\C-dF" 'vhdl-template-directive-synthesis-off) |
| 2778 | (define-key vhdl-template-map "\C-q" 'vhdl-template-search-prompt) |
| 2779 | (when (vhdl-standard-p 'ams) |
| 2780 | (define-key vhdl-template-map "br" 'vhdl-template-break) |
| 2781 | (define-key vhdl-template-map "cu" 'vhdl-template-case-use) |
| 2782 | (define-key vhdl-template-map "iu" 'vhdl-template-if-use) |
| 2783 | (define-key vhdl-template-map "lm" 'vhdl-template-limit) |
| 2784 | (define-key vhdl-template-map "na" 'vhdl-template-nature) |
| 2785 | (define-key vhdl-template-map "pa" 'vhdl-template-procedural) |
| 2786 | (define-key vhdl-template-map "qf" 'vhdl-template-quantity-free) |
| 2787 | (define-key vhdl-template-map "qb" 'vhdl-template-quantity-branch) |
| 2788 | (define-key vhdl-template-map "qs" 'vhdl-template-quantity-source) |
| 2789 | (define-key vhdl-template-map "sn" 'vhdl-template-subnature) |
| 2790 | (define-key vhdl-template-map "te" 'vhdl-template-terminal) |
| 2791 | ) |
| 2792 | (when (vhdl-standard-p 'math) |
| 2793 | (define-key vhdl-template-map "\C-pc" 'vhdl-template-package-math-complex) |
| 2794 | (define-key vhdl-template-map "\C-pr" 'vhdl-template-package-math-real) |
| 2795 | )) |
| 2796 | |
| 2797 | ;; initialize template map for VHDL Mode |
| 2798 | (vhdl-template-map-init) |
| 2799 | |
| 2800 | (defun vhdl-function-name (prefix string &optional postfix) |
| 2801 | "Generate a Lisp function name. |
| 2802 | PREFIX, STRING and optional POSTFIX are concatenated by '-' and spaces in |
| 2803 | STRING are replaced by `-' and substrings are converted to lower case." |
| 2804 | (let ((name prefix)) |
| 2805 | (while (string-match "\\(\\w+\\)\\s-*\\(.*\\)" string) |
| 2806 | (setq name |
| 2807 | (concat name "-" (downcase (substring string 0 (match-end 1))))) |
| 2808 | (setq string (substring string (match-beginning 2)))) |
| 2809 | (when postfix (setq name (concat name "-" postfix))) |
| 2810 | (intern name))) |
| 2811 | |
| 2812 | (defvar vhdl-model-map nil |
| 2813 | "Keymap for VHDL models.") |
| 2814 | |
| 2815 | (defun vhdl-model-map-init () |
| 2816 | "Initialize `vhdl-model-map'." |
| 2817 | (setq vhdl-model-map (make-sparse-keymap)) |
| 2818 | ;; key bindings for VHDL models |
| 2819 | (let ((model-alist vhdl-model-alist) model) |
| 2820 | (while model-alist |
| 2821 | (setq model (car model-alist)) |
| 2822 | (define-key vhdl-model-map (nth 2 model) |
| 2823 | (vhdl-function-name "vhdl-model" (nth 0 model))) |
| 2824 | (setq model-alist (cdr model-alist))))) |
| 2825 | |
| 2826 | ;; initialize user model map for VHDL Mode |
| 2827 | (vhdl-model-map-init) |
| 2828 | |
| 2829 | (defvar vhdl-mode-map nil |
| 2830 | "Keymap for VHDL Mode.") |
| 2831 | |
| 2832 | (defun vhdl-mode-map-init () |
| 2833 | "Initialize `vhdl-mode-map'." |
| 2834 | (setq vhdl-mode-map (make-sparse-keymap)) |
| 2835 | ;; template key bindings |
| 2836 | (define-key vhdl-mode-map "\C-c\C-t" vhdl-template-map) |
| 2837 | ;; model key bindings |
| 2838 | (define-key vhdl-mode-map "\C-c\C-m" vhdl-model-map) |
| 2839 | ;; standard key bindings |
| 2840 | (define-key vhdl-mode-map "\M-a" 'vhdl-beginning-of-statement) |
| 2841 | (define-key vhdl-mode-map "\M-e" 'vhdl-end-of-statement) |
| 2842 | (define-key vhdl-mode-map "\M-\C-f" 'vhdl-forward-sexp) |
| 2843 | (define-key vhdl-mode-map "\M-\C-b" 'vhdl-backward-sexp) |
| 2844 | (define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list) |
| 2845 | (define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent) |
| 2846 | (define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent) |
| 2847 | (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs |
| 2848 | (define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun)) |
| 2849 | (define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp) |
| 2850 | (define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation) |
| 2851 | ;; mode specific key bindings |
| 2852 | (define-key vhdl-mode-map "\C-c\C-m\C-e" 'vhdl-electric-mode) |
| 2853 | (define-key vhdl-mode-map "\C-c\C-m\C-s" 'vhdl-stutter-mode) |
| 2854 | (define-key vhdl-mode-map "\C-c\C-s\C-p" 'vhdl-set-project) |
| 2855 | (define-key vhdl-mode-map "\C-c\C-p\C-d" 'vhdl-duplicate-project) |
| 2856 | (define-key vhdl-mode-map "\C-c\C-p\C-m" 'vhdl-import-project) |
| 2857 | (define-key vhdl-mode-map "\C-c\C-p\C-x" 'vhdl-export-project) |
| 2858 | (define-key vhdl-mode-map "\C-c\C-s\C-k" 'vhdl-set-compiler) |
| 2859 | (define-key vhdl-mode-map "\C-c\C-k" 'vhdl-compile) |
| 2860 | (define-key vhdl-mode-map "\C-c\M-\C-k" 'vhdl-make) |
| 2861 | (define-key vhdl-mode-map "\C-c\M-k" 'vhdl-generate-makefile) |
| 2862 | (define-key vhdl-mode-map "\C-c\C-p\C-w" 'vhdl-port-copy) |
| 2863 | (define-key vhdl-mode-map "\C-c\C-p\M-w" 'vhdl-port-copy) |
| 2864 | (define-key vhdl-mode-map "\C-c\C-p\C-e" 'vhdl-port-paste-entity) |
| 2865 | (define-key vhdl-mode-map "\C-c\C-p\C-c" 'vhdl-port-paste-component) |
| 2866 | (define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance) |
| 2867 | (define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals) |
| 2868 | (define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants) |
| 2869 | (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs |
| 2870 | (define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map) |
| 2871 | (define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map)) |
| 2872 | (define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations) |
| 2873 | (define-key vhdl-mode-map "\C-c\C-p\C-t" 'vhdl-port-paste-testbench) |
| 2874 | (define-key vhdl-mode-map "\C-c\C-p\C-f" 'vhdl-port-flatten) |
| 2875 | (define-key vhdl-mode-map "\C-c\C-p\C-r" 'vhdl-port-reverse-direction) |
| 2876 | (define-key vhdl-mode-map "\C-c\C-s\C-w" 'vhdl-subprog-copy) |
| 2877 | (define-key vhdl-mode-map "\C-c\C-s\M-w" 'vhdl-subprog-copy) |
| 2878 | (define-key vhdl-mode-map "\C-c\C-s\C-d" 'vhdl-subprog-paste-declaration) |
| 2879 | (define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body) |
| 2880 | (define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call) |
| 2881 | (define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten) |
| 2882 | (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component) |
| 2883 | (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component) |
| 2884 | (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components) |
| 2885 | (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration) |
| 2886 | (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package) |
| 2887 | (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region) |
| 2888 | (define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline) |
| 2889 | (define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line) |
| 2890 | (define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode) |
| 2891 | (define-key vhdl-mode-map "\C-c\C-i\C-g" 'vhdl-indent-group) |
| 2892 | (define-key vhdl-mode-map "\M-\C-\\" 'vhdl-indent-region) |
| 2893 | (define-key vhdl-mode-map "\C-c\C-i\C-b" 'vhdl-indent-buffer) |
| 2894 | (define-key vhdl-mode-map "\C-c\C-a\C-g" 'vhdl-align-group) |
| 2895 | (define-key vhdl-mode-map "\C-c\C-a\C-a" 'vhdl-align-group) |
| 2896 | (define-key vhdl-mode-map "\C-c\C-a\C-i" 'vhdl-align-same-indent) |
| 2897 | (define-key vhdl-mode-map "\C-c\C-a\C-l" 'vhdl-align-list) |
| 2898 | (define-key vhdl-mode-map "\C-c\C-a\C-d" 'vhdl-align-declarations) |
| 2899 | (define-key vhdl-mode-map "\C-c\C-a\M-a" 'vhdl-align-region) |
| 2900 | (define-key vhdl-mode-map "\C-c\C-a\C-b" 'vhdl-align-buffer) |
| 2901 | (define-key vhdl-mode-map "\C-c\C-a\C-c" 'vhdl-align-inline-comment-group) |
| 2902 | (define-key vhdl-mode-map "\C-c\C-a\M-c" 'vhdl-align-inline-comment-region) |
| 2903 | (define-key vhdl-mode-map "\C-c\C-f\C-l" 'vhdl-fill-list) |
| 2904 | (define-key vhdl-mode-map "\C-c\C-f\C-f" 'vhdl-fill-list) |
| 2905 | (define-key vhdl-mode-map "\C-c\C-f\C-g" 'vhdl-fill-group) |
| 2906 | (define-key vhdl-mode-map "\C-c\C-f\C-i" 'vhdl-fill-same-indent) |
| 2907 | (define-key vhdl-mode-map "\C-c\C-f\M-f" 'vhdl-fill-region) |
| 2908 | (define-key vhdl-mode-map "\C-c\C-l\C-w" 'vhdl-line-kill) |
| 2909 | (define-key vhdl-mode-map "\C-c\C-l\M-w" 'vhdl-line-copy) |
| 2910 | (define-key vhdl-mode-map "\C-c\C-l\C-y" 'vhdl-line-yank) |
| 2911 | (define-key vhdl-mode-map "\C-c\C-l\t" 'vhdl-line-expand) |
| 2912 | (define-key vhdl-mode-map "\C-c\C-l\C-n" 'vhdl-line-transpose-next) |
| 2913 | (define-key vhdl-mode-map "\C-c\C-l\C-p" 'vhdl-line-transpose-previous) |
| 2914 | (define-key vhdl-mode-map "\C-c\C-l\C-o" 'vhdl-line-open) |
| 2915 | (define-key vhdl-mode-map "\C-c\C-l\C-g" 'goto-line) |
| 2916 | (define-key vhdl-mode-map "\C-c\C-l\C-c" 'vhdl-comment-uncomment-line) |
| 2917 | (define-key vhdl-mode-map "\C-c\C-x\C-s" 'vhdl-fix-statement-region) |
| 2918 | (define-key vhdl-mode-map "\C-c\C-x\M-s" 'vhdl-fix-statement-buffer) |
| 2919 | (define-key vhdl-mode-map "\C-c\C-x\C-p" 'vhdl-fix-clause) |
| 2920 | (define-key vhdl-mode-map "\C-c\C-x\M-c" 'vhdl-fix-case-region) |
| 2921 | (define-key vhdl-mode-map "\C-c\C-x\C-c" 'vhdl-fix-case-buffer) |
| 2922 | (define-key vhdl-mode-map "\C-c\C-x\M-w" 'vhdl-fixup-whitespace-region) |
| 2923 | (define-key vhdl-mode-map "\C-c\C-x\C-w" 'vhdl-fixup-whitespace-buffer) |
| 2924 | (define-key vhdl-mode-map "\C-c\M-b" 'vhdl-beautify-region) |
| 2925 | (define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer) |
| 2926 | (define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process) |
| 2927 | (define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer) |
| 2928 | (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer) |
| 2929 | (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer) |
| 2930 | (define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages) |
| 2931 | (define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode) |
| 2932 | (define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version) |
| 2933 | (define-key vhdl-mode-map "\M-\t" 'insert-tab) |
| 2934 | ;; insert commands bindings |
| 2935 | (define-key vhdl-mode-map "\C-c\C-i\C-t" 'vhdl-template-insert-construct) |
| 2936 | (define-key vhdl-mode-map "\C-c\C-i\C-p" 'vhdl-template-insert-package) |
| 2937 | (define-key vhdl-mode-map "\C-c\C-i\C-d" 'vhdl-template-insert-directive) |
| 2938 | (define-key vhdl-mode-map "\C-c\C-i\C-m" 'vhdl-model-insert) |
| 2939 | ;; electric key bindings |
| 2940 | (define-key vhdl-mode-map " " 'vhdl-electric-space) |
| 2941 | (when vhdl-intelligent-tab |
| 2942 | (define-key vhdl-mode-map "\t" 'vhdl-electric-tab)) |
| 2943 | (define-key vhdl-mode-map "\r" 'vhdl-electric-return) |
| 2944 | (define-key vhdl-mode-map "-" 'vhdl-electric-dash) |
| 2945 | (define-key vhdl-mode-map "[" 'vhdl-electric-open-bracket) |
| 2946 | (define-key vhdl-mode-map "]" 'vhdl-electric-close-bracket) |
| 2947 | (define-key vhdl-mode-map "'" 'vhdl-electric-quote) |
| 2948 | (define-key vhdl-mode-map ";" 'vhdl-electric-semicolon) |
| 2949 | (define-key vhdl-mode-map "," 'vhdl-electric-comma) |
| 2950 | (define-key vhdl-mode-map "." 'vhdl-electric-period) |
| 2951 | (when (vhdl-standard-p 'ams) |
| 2952 | (define-key vhdl-mode-map "=" 'vhdl-electric-equal))) |
| 2953 | |
| 2954 | ;; initialize mode map for VHDL Mode |
| 2955 | (vhdl-mode-map-init) |
| 2956 | |
| 2957 | ;; define special minibuffer keymap for enabling word completion in minibuffer |
| 2958 | ;; (useful in template generator prompts) |
| 2959 | (defvar vhdl-minibuffer-local-map |
| 2960 | (let ((map (make-sparse-keymap))) |
| 2961 | (set-keymap-parent map minibuffer-local-map) |
| 2962 | (when vhdl-word-completion-in-minibuffer |
| 2963 | (define-key map "\t" 'vhdl-minibuffer-tab)) |
| 2964 | map) |
| 2965 | "Keymap for minibuffer used in VHDL Mode.") |
| 2966 | |
| 2967 | ;; set up electric character functions to work with |
| 2968 | ;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs) |
| 2969 | (mapc |
| 2970 | (function |
| 2971 | (lambda (sym) |
| 2972 | (put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs) |
| 2973 | (put sym 'pending-delete t))) ; for `pending-delete-mode' (XEmacs) |
| 2974 | '(vhdl-electric-space |
| 2975 | vhdl-electric-tab |
| 2976 | vhdl-electric-return |
| 2977 | vhdl-electric-dash |
| 2978 | vhdl-electric-open-bracket |
| 2979 | vhdl-electric-close-bracket |
| 2980 | vhdl-electric-quote |
| 2981 | vhdl-electric-semicolon |
| 2982 | vhdl-electric-comma |
| 2983 | vhdl-electric-period |
| 2984 | vhdl-electric-equal)) |
| 2985 | |
| 2986 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2987 | ;; Syntax table |
| 2988 | |
| 2989 | (defvar vhdl-mode-syntax-table |
| 2990 | (let ((st (make-syntax-table))) |
| 2991 | ;; define punctuation |
| 2992 | (modify-syntax-entry ?\# "." st) |
| 2993 | (modify-syntax-entry ?\$ "." st) |
| 2994 | (modify-syntax-entry ?\% "." st) |
| 2995 | (modify-syntax-entry ?\& "." st) |
| 2996 | (modify-syntax-entry ?\' "." st) |
| 2997 | (modify-syntax-entry ?\* "." st) |
| 2998 | (modify-syntax-entry ?\+ "." st) |
| 2999 | (modify-syntax-entry ?\. "." st) |
| 3000 | (modify-syntax-entry ?\/ "." st) |
| 3001 | (modify-syntax-entry ?\: "." st) |
| 3002 | (modify-syntax-entry ?\; "." st) |
| 3003 | (modify-syntax-entry ?\< "." st) |
| 3004 | (modify-syntax-entry ?\= "." st) |
| 3005 | (modify-syntax-entry ?\> "." st) |
| 3006 | (modify-syntax-entry ?\\ "." st) |
| 3007 | (modify-syntax-entry ?\| "." st) |
| 3008 | ;; define string |
| 3009 | (modify-syntax-entry ?\" "\"" st) |
| 3010 | ;; define underscore |
| 3011 | (modify-syntax-entry ?\_ (if vhdl-underscore-is-part-of-word "w" "_") st) |
| 3012 | ;; a single hyphen is punctuation, but a double hyphen starts a comment |
| 3013 | (modify-syntax-entry ?\- ". 12" st) |
| 3014 | ;; and \n and \^M end a comment |
| 3015 | (modify-syntax-entry ?\n ">" st) |
| 3016 | (modify-syntax-entry ?\^M ">" st) |
| 3017 | ;; define parentheses to match |
| 3018 | (modify-syntax-entry ?\( "()" st) |
| 3019 | (modify-syntax-entry ?\) ")(" st) |
| 3020 | (modify-syntax-entry ?\[ "(]" st) |
| 3021 | (modify-syntax-entry ?\] ")[" st) |
| 3022 | (modify-syntax-entry ?\{ "(}" st) |
| 3023 | (modify-syntax-entry ?\} "){" st) |
| 3024 | st) |
| 3025 | "Syntax table used in `vhdl-mode' buffers.") |
| 3026 | |
| 3027 | (defvar vhdl-mode-ext-syntax-table |
| 3028 | ;; Extended syntax table including '_' (for simpler search regexps). |
| 3029 | (let ((st (copy-syntax-table vhdl-mode-syntax-table))) |
| 3030 | (modify-syntax-entry ?_ "w" st) |
| 3031 | st) |
| 3032 | "Syntax table extended by `_' used in `vhdl-mode' buffers.") |
| 3033 | |
| 3034 | (defvar vhdl-syntactic-context nil |
| 3035 | "Buffer local variable containing syntactic analysis list.") |
| 3036 | (make-variable-buffer-local 'vhdl-syntactic-context) |
| 3037 | |
| 3038 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3039 | ;; Abbrev hook bindings |
| 3040 | |
| 3041 | (defvar vhdl-mode-abbrev-table nil |
| 3042 | "Abbrev table to use in `vhdl-mode' buffers.") |
| 3043 | |
| 3044 | (defun vhdl-mode-abbrev-table-init () |
| 3045 | "Initialize `vhdl-mode-abbrev-table'." |
| 3046 | (define-abbrev-table 'vhdl-mode-abbrev-table |
| 3047 | (append |
| 3048 | (when (memq 'vhdl vhdl-electric-keywords) |
| 3049 | ;; VHDL'02 keywords |
| 3050 | (mapcar (if (featurep 'xemacs) |
| 3051 | (lambda (x) (list (car x) "" (cdr x) 0)) |
| 3052 | (lambda (x) (list (car x) "" (cdr x) 0 'system))) |
| 3053 | '( |
| 3054 | ("--" . vhdl-template-display-comment-hook) |
| 3055 | ("abs" . vhdl-template-default-hook) |
| 3056 | ("access" . vhdl-template-default-hook) |
| 3057 | ("after" . vhdl-template-default-hook) |
| 3058 | ("alias" . vhdl-template-alias-hook) |
| 3059 | ("all" . vhdl-template-default-hook) |
| 3060 | ("and" . vhdl-template-default-hook) |
| 3061 | ("arch" . vhdl-template-architecture-hook) |
| 3062 | ("architecture" . vhdl-template-architecture-hook) |
| 3063 | ("array" . vhdl-template-default-hook) |
| 3064 | ("assert" . vhdl-template-assert-hook) |
| 3065 | ("attr" . vhdl-template-attribute-hook) |
| 3066 | ("attribute" . vhdl-template-attribute-hook) |
| 3067 | ("begin" . vhdl-template-default-indent-hook) |
| 3068 | ("block" . vhdl-template-block-hook) |
| 3069 | ("body" . vhdl-template-default-hook) |
| 3070 | ("buffer" . vhdl-template-default-hook) |
| 3071 | ("bus" . vhdl-template-default-hook) |
| 3072 | ("case" . vhdl-template-case-hook) |
| 3073 | ("comp" . vhdl-template-component-hook) |
| 3074 | ("component" . vhdl-template-component-hook) |
| 3075 | ("cond" . vhdl-template-conditional-signal-asst-hook) |
| 3076 | ("conditional" . vhdl-template-conditional-signal-asst-hook) |
| 3077 | ("conf" . vhdl-template-configuration-hook) |
| 3078 | ("configuration" . vhdl-template-configuration-hook) |
| 3079 | ("cons" . vhdl-template-constant-hook) |
| 3080 | ("constant" . vhdl-template-constant-hook) |
| 3081 | ("disconnect" . vhdl-template-disconnect-hook) |
| 3082 | ("downto" . vhdl-template-default-hook) |
| 3083 | ("else" . vhdl-template-else-hook) |
| 3084 | ("elseif" . vhdl-template-elsif-hook) |
| 3085 | ("elsif" . vhdl-template-elsif-hook) |
| 3086 | ("end" . vhdl-template-default-indent-hook) |
| 3087 | ("entity" . vhdl-template-entity-hook) |
| 3088 | ("exit" . vhdl-template-exit-hook) |
| 3089 | ("file" . vhdl-template-file-hook) |
| 3090 | ("for" . vhdl-template-for-hook) |
| 3091 | ("func" . vhdl-template-function-hook) |
| 3092 | ("function" . vhdl-template-function-hook) |
| 3093 | ("generic" . vhdl-template-generic-hook) |
| 3094 | ("group" . vhdl-template-group-hook) |
| 3095 | ("guarded" . vhdl-template-default-hook) |
| 3096 | ("if" . vhdl-template-if-hook) |
| 3097 | ("impure" . vhdl-template-default-hook) |
| 3098 | ("in" . vhdl-template-default-hook) |
| 3099 | ("inertial" . vhdl-template-default-hook) |
| 3100 | ("inout" . vhdl-template-default-hook) |
| 3101 | ("inst" . vhdl-template-instance-hook) |
| 3102 | ("instance" . vhdl-template-instance-hook) |
| 3103 | ("is" . vhdl-template-default-hook) |
| 3104 | ("label" . vhdl-template-default-hook) |
| 3105 | ("library" . vhdl-template-library-hook) |
| 3106 | ("linkage" . vhdl-template-default-hook) |
| 3107 | ("literal" . vhdl-template-default-hook) |
| 3108 | ("loop" . vhdl-template-bare-loop-hook) |
| 3109 | ("map" . vhdl-template-map-hook) |
| 3110 | ("mod" . vhdl-template-default-hook) |
| 3111 | ("nand" . vhdl-template-default-hook) |
| 3112 | ("new" . vhdl-template-default-hook) |
| 3113 | ("next" . vhdl-template-next-hook) |
| 3114 | ("nor" . vhdl-template-default-hook) |
| 3115 | ("not" . vhdl-template-default-hook) |
| 3116 | ("null" . vhdl-template-default-hook) |
| 3117 | ("of" . vhdl-template-default-hook) |
| 3118 | ("on" . vhdl-template-default-hook) |
| 3119 | ("open" . vhdl-template-default-hook) |
| 3120 | ("or" . vhdl-template-default-hook) |
| 3121 | ("others" . vhdl-template-others-hook) |
| 3122 | ("out" . vhdl-template-default-hook) |
| 3123 | ("pack" . vhdl-template-package-hook) |
| 3124 | ("package" . vhdl-template-package-hook) |
| 3125 | ("port" . vhdl-template-port-hook) |
| 3126 | ("postponed" . vhdl-template-default-hook) |
| 3127 | ("procedure" . vhdl-template-procedure-hook) |
| 3128 | ("process" . vhdl-template-process-hook) |
| 3129 | ("pure" . vhdl-template-default-hook) |
| 3130 | ("range" . vhdl-template-default-hook) |
| 3131 | ("record" . vhdl-template-default-hook) |
| 3132 | ("register" . vhdl-template-default-hook) |
| 3133 | ("reject" . vhdl-template-default-hook) |
| 3134 | ("rem" . vhdl-template-default-hook) |
| 3135 | ("report" . vhdl-template-report-hook) |
| 3136 | ("return" . vhdl-template-return-hook) |
| 3137 | ("rol" . vhdl-template-default-hook) |
| 3138 | ("ror" . vhdl-template-default-hook) |
| 3139 | ("select" . vhdl-template-selected-signal-asst-hook) |
| 3140 | ("severity" . vhdl-template-default-hook) |
| 3141 | ("shared" . vhdl-template-default-hook) |
| 3142 | ("sig" . vhdl-template-signal-hook) |
| 3143 | ("signal" . vhdl-template-signal-hook) |
| 3144 | ("sla" . vhdl-template-default-hook) |
| 3145 | ("sll" . vhdl-template-default-hook) |
| 3146 | ("sra" . vhdl-template-default-hook) |
| 3147 | ("srl" . vhdl-template-default-hook) |
| 3148 | ("subtype" . vhdl-template-subtype-hook) |
| 3149 | ("then" . vhdl-template-default-hook) |
| 3150 | ("to" . vhdl-template-default-hook) |
| 3151 | ("transport" . vhdl-template-default-hook) |
| 3152 | ("type" . vhdl-template-type-hook) |
| 3153 | ("unaffected" . vhdl-template-default-hook) |
| 3154 | ("units" . vhdl-template-default-hook) |
| 3155 | ("until" . vhdl-template-default-hook) |
| 3156 | ("use" . vhdl-template-use-hook) |
| 3157 | ("var" . vhdl-template-variable-hook) |
| 3158 | ("variable" . vhdl-template-variable-hook) |
| 3159 | ("wait" . vhdl-template-wait-hook) |
| 3160 | ("when" . vhdl-template-when-hook) |
| 3161 | ("while" . vhdl-template-while-loop-hook) |
| 3162 | ("with" . vhdl-template-with-hook) |
| 3163 | ("xnor" . vhdl-template-default-hook) |
| 3164 | ("xor" . vhdl-template-default-hook) |
| 3165 | ))) |
| 3166 | ;; VHDL-AMS keywords |
| 3167 | (when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams)) |
| 3168 | (mapcar (if (featurep 'xemacs) |
| 3169 | (lambda (x) (list (car x) "" (cdr x) 0)) |
| 3170 | (lambda (x) (list (car x) "" (cdr x) 0 'system))) |
| 3171 | '( |
| 3172 | ("across" . vhdl-template-default-hook) |
| 3173 | ("break" . vhdl-template-break-hook) |
| 3174 | ("limit" . vhdl-template-limit-hook) |
| 3175 | ("nature" . vhdl-template-nature-hook) |
| 3176 | ("noise" . vhdl-template-default-hook) |
| 3177 | ("procedural" . vhdl-template-procedural-hook) |
| 3178 | ("quantity" . vhdl-template-quantity-hook) |
| 3179 | ("reference" . vhdl-template-default-hook) |
| 3180 | ("spectrum" . vhdl-template-default-hook) |
| 3181 | ("subnature" . vhdl-template-subnature-hook) |
| 3182 | ("terminal" . vhdl-template-terminal-hook) |
| 3183 | ("through" . vhdl-template-default-hook) |
| 3184 | ("tolerance" . vhdl-template-default-hook) |
| 3185 | ))) |
| 3186 | ;; user model keywords |
| 3187 | (when (memq 'user vhdl-electric-keywords) |
| 3188 | (let (abbrev-list keyword) |
| 3189 | (dolist (elem vhdl-model-alist) |
| 3190 | (setq keyword (nth 3 elem)) |
| 3191 | (unless (equal keyword "") |
| 3192 | (push (list keyword "" |
| 3193 | (vhdl-function-name |
| 3194 | "vhdl-model" (nth 0 elem) "hook") 0 'system) |
| 3195 | abbrev-list))) |
| 3196 | abbrev-list))))) |
| 3197 | |
| 3198 | ;; initialize abbrev table for VHDL Mode |
| 3199 | (vhdl-mode-abbrev-table-init) |
| 3200 | |
| 3201 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3202 | ;; Template completion lists |
| 3203 | |
| 3204 | (defvar vhdl-template-construct-alist nil |
| 3205 | "List of built-in construct templates.") |
| 3206 | |
| 3207 | (defun vhdl-template-construct-alist-init () |
| 3208 | "Initialize `vhdl-template-construct-alist'." |
| 3209 | (setq |
| 3210 | vhdl-template-construct-alist |
| 3211 | (append |
| 3212 | '( |
| 3213 | ("alias declaration" vhdl-template-alias) |
| 3214 | ("architecture body" vhdl-template-architecture) |
| 3215 | ("assertion" vhdl-template-assert) |
| 3216 | ("attribute declaration" vhdl-template-attribute-decl) |
| 3217 | ("attribute specification" vhdl-template-attribute-spec) |
| 3218 | ("block configuration" vhdl-template-block-configuration) |
| 3219 | ("block statement" vhdl-template-block) |
| 3220 | ("case statement" vhdl-template-case-is) |
| 3221 | ("component configuration" vhdl-template-component-conf) |
| 3222 | ("component declaration" vhdl-template-component-decl) |
| 3223 | ("component instantiation statement" vhdl-template-component-inst) |
| 3224 | ("conditional signal assignment" vhdl-template-conditional-signal-asst) |
| 3225 | ("configuration declaration" vhdl-template-configuration-decl) |
| 3226 | ("configuration specification" vhdl-template-configuration-spec) |
| 3227 | ("constant declaration" vhdl-template-constant) |
| 3228 | ("disconnection specification" vhdl-template-disconnect) |
| 3229 | ("entity declaration" vhdl-template-entity) |
| 3230 | ("exit statement" vhdl-template-exit) |
| 3231 | ("file declaration" vhdl-template-file) |
| 3232 | ("generate statement" vhdl-template-generate) |
| 3233 | ("generic clause" vhdl-template-generic) |
| 3234 | ("group declaration" vhdl-template-group-decl) |
| 3235 | ("group template declaration" vhdl-template-group-template) |
| 3236 | ("if statement" vhdl-template-if-then) |
| 3237 | ("library clause" vhdl-template-library) |
| 3238 | ("loop statement" vhdl-template-loop) |
| 3239 | ("next statement" vhdl-template-next) |
| 3240 | ("package declaration" vhdl-template-package-decl) |
| 3241 | ("package body" vhdl-template-package-body) |
| 3242 | ("port clause" vhdl-template-port) |
| 3243 | ("process statement" vhdl-template-process) |
| 3244 | ("report statement" vhdl-template-report) |
| 3245 | ("return statement" vhdl-template-return) |
| 3246 | ("selected signal assignment" vhdl-template-selected-signal-asst) |
| 3247 | ("signal declaration" vhdl-template-signal) |
| 3248 | ("subprogram declaration" vhdl-template-subprogram-decl) |
| 3249 | ("subprogram body" vhdl-template-subprogram-body) |
| 3250 | ("subtype declaration" vhdl-template-subtype) |
| 3251 | ("type declaration" vhdl-template-type) |
| 3252 | ("use clause" vhdl-template-use) |
| 3253 | ("variable declaration" vhdl-template-variable) |
| 3254 | ("wait statement" vhdl-template-wait) |
| 3255 | ) |
| 3256 | (when (vhdl-standard-p 'ams) |
| 3257 | '( |
| 3258 | ("break statement" vhdl-template-break) |
| 3259 | ("nature declaration" vhdl-template-nature) |
| 3260 | ("quantity declaration" vhdl-template-quantity) |
| 3261 | ("simultaneous case statement" vhdl-template-case-use) |
| 3262 | ("simultaneous if statement" vhdl-template-if-use) |
| 3263 | ("simultaneous procedural statement" vhdl-template-procedural) |
| 3264 | ("step limit specification" vhdl-template-limit) |
| 3265 | ("subnature declaration" vhdl-template-subnature) |
| 3266 | ("terminal declaration" vhdl-template-terminal) |
| 3267 | ))))) |
| 3268 | |
| 3269 | ;; initialize for VHDL Mode |
| 3270 | (vhdl-template-construct-alist-init) |
| 3271 | |
| 3272 | (defvar vhdl-template-package-alist nil |
| 3273 | "List of built-in package templates.") |
| 3274 | |
| 3275 | (defun vhdl-template-package-alist-init () |
| 3276 | "Initialize `vhdl-template-package-alist'." |
| 3277 | (setq |
| 3278 | vhdl-template-package-alist |
| 3279 | (append |
| 3280 | '( |
| 3281 | ("numeric_bit" vhdl-template-package-numeric-bit) |
| 3282 | ("numeric_std" vhdl-template-package-numeric-std) |
| 3283 | ("std_logic_1164" vhdl-template-package-std-logic-1164) |
| 3284 | ("std_logic_arith" vhdl-template-package-std-logic-arith) |
| 3285 | ("std_logic_misc" vhdl-template-package-std-logic-misc) |
| 3286 | ("std_logic_signed" vhdl-template-package-std-logic-signed) |
| 3287 | ("std_logic_textio" vhdl-template-package-std-logic-textio) |
| 3288 | ("std_logic_unsigned" vhdl-template-package-std-logic-unsigned) |
| 3289 | ("textio" vhdl-template-package-textio) |
| 3290 | ) |
| 3291 | (when (vhdl-standard-p 'math) |
| 3292 | '( |
| 3293 | ("math_complex" vhdl-template-package-math-complex) |
| 3294 | ("math_real" vhdl-template-package-math-real) |
| 3295 | ))))) |
| 3296 | |
| 3297 | ;; initialize for VHDL Mode |
| 3298 | (vhdl-template-package-alist-init) |
| 3299 | |
| 3300 | (defvar vhdl-template-directive-alist |
| 3301 | '( |
| 3302 | ("translate_on" vhdl-template-directive-translate-on) |
| 3303 | ("translate_off" vhdl-template-directive-translate-off) |
| 3304 | ("synthesis_on" vhdl-template-directive-synthesis-on) |
| 3305 | ("synthesis_off" vhdl-template-directive-synthesis-off) |
| 3306 | ) |
| 3307 | "List of built-in directive templates.") |
| 3308 | |
| 3309 | |
| 3310 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3311 | ;;; Menus |
| 3312 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3313 | |
| 3314 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 3315 | ;; VHDL menu (using `easy-menu.el') |
| 3316 | |
| 3317 | (defun vhdl-customize () |
| 3318 | "Call the customize function with `vhdl' as argument." |
| 3319 | (interactive) |
| 3320 | (customize-browse 'vhdl)) |
| 3321 | |
| 3322 | (defun vhdl-create-mode-menu () |
| 3323 | "Create VHDL Mode menu." |
| 3324 | `("VHDL" |
| 3325 | ,(append |
| 3326 | '("Project" |
| 3327 | ["None" (vhdl-set-project "") |
| 3328 | :style radio :selected (null vhdl-project)] |
| 3329 | "--") |
| 3330 | ;; add menu entries for defined projects |
| 3331 | (let ((project-alist vhdl-project-alist) menu-list name) |
| 3332 | (while project-alist |
| 3333 | (setq name (caar project-alist)) |
| 3334 | (setq menu-list |
| 3335 | (cons `[,name (vhdl-set-project ,name) |
| 3336 | :style radio :selected (equal ,name vhdl-project)] |
| 3337 | menu-list)) |
| 3338 | (setq project-alist (cdr project-alist))) |
| 3339 | (setq menu-list |
| 3340 | (if vhdl-project-sort |
| 3341 | (sort menu-list |
| 3342 | (function (lambda (a b) (string< (elt a 0) (elt b 0))))) |
| 3343 | (nreverse menu-list))) |
| 3344 | (vhdl-menu-split menu-list "Project")) |
| 3345 | '("--" "--" |
| 3346 | ["Select Project..." vhdl-set-project t] |
| 3347 | ["Set As Default Project" vhdl-set-default-project t] |
| 3348 | "--" |
| 3349 | ["Duplicate Project" vhdl-duplicate-project vhdl-project] |
| 3350 | ["Import Project..." vhdl-import-project |
| 3351 | :keys "C-c C-p C-m" :active t] |
| 3352 | ["Export Project" vhdl-export-project vhdl-project] |
| 3353 | "--" |
| 3354 | ["Customize Project..." (customize-option 'vhdl-project-alist) t])) |
| 3355 | "--" |
| 3356 | ("Compile" |
| 3357 | ["Compile Buffer" vhdl-compile t] |
| 3358 | ["Stop Compilation" kill-compilation t] |
| 3359 | "--" |
| 3360 | ["Make" vhdl-make t] |
| 3361 | ["Generate Makefile" vhdl-generate-makefile t] |
| 3362 | "--" |
| 3363 | ["Next Error" next-error t] |
| 3364 | ["Previous Error" previous-error t] |
| 3365 | ["First Error" first-error t] |
| 3366 | "--" |
| 3367 | ,(append |
| 3368 | '("Compiler") |
| 3369 | ;; add menu entries for defined compilers |
| 3370 | (let ((comp-alist vhdl-compiler-alist) menu-list name) |
| 3371 | (while comp-alist |
| 3372 | (setq name (caar comp-alist)) |
| 3373 | (setq menu-list |
| 3374 | (cons `[,name (setq vhdl-compiler ,name) |
| 3375 | :style radio :selected (equal ,name vhdl-compiler)] |
| 3376 | menu-list)) |
| 3377 | (setq comp-alist (cdr comp-alist))) |
| 3378 | (setq menu-list (nreverse menu-list)) |
| 3379 | (vhdl-menu-split menu-list "Compiler")) |
| 3380 | '("--" "--" |
| 3381 | ["Select Compiler..." vhdl-set-compiler t] |
| 3382 | "--" |
| 3383 | ["Customize Compiler..." |
| 3384 | (customize-option 'vhdl-compiler-alist) t]))) |
| 3385 | "--" |
| 3386 | ,(append |
| 3387 | '("Template" |
| 3388 | ("VHDL Construct 1" |
| 3389 | ["Alias" vhdl-template-alias t] |
| 3390 | ["Architecture" vhdl-template-architecture t] |
| 3391 | ["Assert" vhdl-template-assert t] |
| 3392 | ["Attribute (Decl)" vhdl-template-attribute-decl t] |
| 3393 | ["Attribute (Spec)" vhdl-template-attribute-spec t] |
| 3394 | ["Block" vhdl-template-block t] |
| 3395 | ["Case" vhdl-template-case-is t] |
| 3396 | ["Component (Decl)" vhdl-template-component-decl t] |
| 3397 | ["(Component) Instance" vhdl-template-component-inst t] |
| 3398 | ["Conditional (Signal Asst)" vhdl-template-conditional-signal-asst t] |
| 3399 | ["Configuration (Block)" vhdl-template-block-configuration t] |
| 3400 | ["Configuration (Comp)" vhdl-template-component-conf t] |
| 3401 | ["Configuration (Decl)" vhdl-template-configuration-decl t] |
| 3402 | ["Configuration (Spec)" vhdl-template-configuration-spec t] |
| 3403 | ["Constant" vhdl-template-constant t] |
| 3404 | ["Disconnect" vhdl-template-disconnect t] |
| 3405 | ["Else" vhdl-template-else t] |
| 3406 | ["Elsif" vhdl-template-elsif t] |
| 3407 | ["Entity" vhdl-template-entity t] |
| 3408 | ["Exit" vhdl-template-exit t] |
| 3409 | ["File" vhdl-template-file t] |
| 3410 | ["For (Generate)" vhdl-template-for-generate t] |
| 3411 | ["For (Loop)" vhdl-template-for-loop t] |
| 3412 | ["Function (Body)" vhdl-template-function-body t] |
| 3413 | ["Function (Decl)" vhdl-template-function-decl t] |
| 3414 | ["Generic" vhdl-template-generic t] |
| 3415 | ["Group (Decl)" vhdl-template-group-decl t] |
| 3416 | ["Group (Template)" vhdl-template-group-template t]) |
| 3417 | ("VHDL Construct 2" |
| 3418 | ["If (Generate)" vhdl-template-if-generate t] |
| 3419 | ["If (Then)" vhdl-template-if-then t] |
| 3420 | ["Library" vhdl-template-library t] |
| 3421 | ["Loop" vhdl-template-bare-loop t] |
| 3422 | ["Map" vhdl-template-map t] |
| 3423 | ["Next" vhdl-template-next t] |
| 3424 | ["Others (Aggregate)" vhdl-template-others t] |
| 3425 | ["Package (Decl)" vhdl-template-package-decl t] |
| 3426 | ["Package (Body)" vhdl-template-package-body t] |
| 3427 | ["Port" vhdl-template-port t] |
| 3428 | ["Procedure (Body)" vhdl-template-procedure-body t] |
| 3429 | ["Procedure (Decl)" vhdl-template-procedure-decl t] |
| 3430 | ["Process (Comb)" vhdl-template-process-comb t] |
| 3431 | ["Process (Seq)" vhdl-template-process-seq t] |
| 3432 | ["Report" vhdl-template-report t] |
| 3433 | ["Return" vhdl-template-return t] |
| 3434 | ["Select" vhdl-template-selected-signal-asst t] |
| 3435 | ["Signal" vhdl-template-signal t] |
| 3436 | ["Subtype" vhdl-template-subtype t] |
| 3437 | ["Type" vhdl-template-type t] |
| 3438 | ["Use" vhdl-template-use t] |
| 3439 | ["Variable" vhdl-template-variable t] |
| 3440 | ["Wait" vhdl-template-wait t] |
| 3441 | ["(Clocked Wait)" vhdl-template-clocked-wait t] |
| 3442 | ["When" vhdl-template-when t] |
| 3443 | ["While (Loop)" vhdl-template-while-loop t] |
| 3444 | ["With" vhdl-template-with t])) |
| 3445 | (when (vhdl-standard-p 'ams) |
| 3446 | '(("VHDL-AMS Construct" |
| 3447 | ["Break" vhdl-template-break t] |
| 3448 | ["Case (Use)" vhdl-template-case-use t] |
| 3449 | ["If (Use)" vhdl-template-if-use t] |
| 3450 | ["Limit" vhdl-template-limit t] |
| 3451 | ["Nature" vhdl-template-nature t] |
| 3452 | ["Procedural" vhdl-template-procedural t] |
| 3453 | ["Quantity (Free)" vhdl-template-quantity-free t] |
| 3454 | ["Quantity (Branch)" vhdl-template-quantity-branch t] |
| 3455 | ["Quantity (Source)" vhdl-template-quantity-source t] |
| 3456 | ["Subnature" vhdl-template-subnature t] |
| 3457 | ["Terminal" vhdl-template-terminal t]))) |
| 3458 | '(["Insert Construct..." vhdl-template-insert-construct |
| 3459 | :keys "C-c C-i C-t"] |
| 3460 | "--") |
| 3461 | (list |
| 3462 | (append |
| 3463 | '("Package") |
| 3464 | '(["numeric_bit" vhdl-template-package-numeric-bit t] |
| 3465 | ["numeric_std" vhdl-template-package-numeric-std t] |
| 3466 | ["std_logic_1164" vhdl-template-package-std-logic-1164 t] |
| 3467 | ["textio" vhdl-template-package-textio t] |
| 3468 | "--" |
| 3469 | ["std_logic_arith" vhdl-template-package-std-logic-arith t] |
| 3470 | ["std_logic_signed" vhdl-template-package-std-logic-signed t] |
| 3471 | ["std_logic_unsigned" vhdl-template-package-std-logic-unsigned t] |
| 3472 | ["std_logic_misc" vhdl-template-package-std-logic-misc t] |
| 3473 | ["std_logic_textio" vhdl-template-package-std-logic-textio t] |
| 3474 | "--") |
| 3475 | (when (vhdl-standard-p 'ams) |
| 3476 | '(["fundamental_constants" vhdl-template-package-fundamental-constants t] |
| 3477 | ["material_constants" vhdl-template-package-material-constants t] |
| 3478 | ["energy_systems" vhdl-template-package-energy-systems t] |
| 3479 | ["electrical_systems" vhdl-template-package-electrical-systems t] |
| 3480 | ["mechanical_systems" vhdl-template-package-mechanical-systems t] |
| 3481 | ["radiant_systems" vhdl-template-package-radiant-systems t] |
| 3482 | ["thermal_systems" vhdl-template-package-thermal-systems t] |
| 3483 | ["fluidic_systems" vhdl-template-package-fluidic-systems t] |
| 3484 | "--")) |
| 3485 | (when (vhdl-standard-p 'math) |
| 3486 | '(["math_complex" vhdl-template-package-math-complex t] |
| 3487 | ["math_real" vhdl-template-package-math-real t] |
| 3488 | "--")) |
| 3489 | '(["Insert Package..." vhdl-template-insert-package |
| 3490 | :keys "C-c C-i C-p"]))) |
| 3491 | '(("Directive" |
| 3492 | ["translate_on" vhdl-template-directive-translate-on t] |
| 3493 | ["translate_off" vhdl-template-directive-translate-off t] |
| 3494 | ["synthesis_on" vhdl-template-directive-synthesis-on t] |
| 3495 | ["synthesis_off" vhdl-template-directive-synthesis-off t] |
| 3496 | "--" |
| 3497 | ["Insert Directive..." vhdl-template-insert-directive |
| 3498 | :keys "C-c C-i C-d"]) |
| 3499 | "--" |
| 3500 | ["Insert Header" vhdl-template-header :keys "C-c C-t C-h"] |
| 3501 | ["Insert Footer" vhdl-template-footer t] |
| 3502 | ["Insert Date" vhdl-template-insert-date t] |
| 3503 | ["Modify Date" vhdl-template-modify :keys "C-c C-t C-m"] |
| 3504 | "--" |
| 3505 | ["Query Next Prompt" vhdl-template-search-prompt t])) |
| 3506 | ,(append |
| 3507 | '("Model") |
| 3508 | ;; add menu entries for defined models |
| 3509 | (let ((model-alist vhdl-model-alist) menu-list model) |
| 3510 | (while model-alist |
| 3511 | (setq model (car model-alist)) |
| 3512 | (setq menu-list |
| 3513 | (cons |
| 3514 | (vector |
| 3515 | (nth 0 model) |
| 3516 | (vhdl-function-name "vhdl-model" (nth 0 model)) |
| 3517 | :keys (concat "C-c C-m " (key-description (nth 2 model)))) |
| 3518 | menu-list)) |
| 3519 | (setq model-alist (cdr model-alist))) |
| 3520 | (setq menu-list (nreverse menu-list)) |
| 3521 | (vhdl-menu-split menu-list "Model")) |
| 3522 | '("--" "--" |
| 3523 | ["Insert Model..." vhdl-model-insert :keys "C-c C-i C-m"] |
| 3524 | ["Customize Model..." (customize-option 'vhdl-model-alist) t])) |
| 3525 | ("Port" |
| 3526 | ["Copy" vhdl-port-copy t] |
| 3527 | "--" |
| 3528 | ["Paste As Entity" vhdl-port-paste-entity vhdl-port-list] |
| 3529 | ["Paste As Component" vhdl-port-paste-component vhdl-port-list] |
| 3530 | ["Paste As Instance" vhdl-port-paste-instance |
| 3531 | :keys "C-c C-p C-i" :active vhdl-port-list] |
| 3532 | ["Paste As Signals" vhdl-port-paste-signals vhdl-port-list] |
| 3533 | ["Paste As Constants" vhdl-port-paste-constants vhdl-port-list] |
| 3534 | ["Paste As Generic Map" vhdl-port-paste-generic-map vhdl-port-list] |
| 3535 | ["Paste As Initializations" vhdl-port-paste-initializations vhdl-port-list] |
| 3536 | "--" |
| 3537 | ["Paste As Testbench" vhdl-port-paste-testbench vhdl-port-list] |
| 3538 | "--" |
| 3539 | ["Flatten" vhdl-port-flatten |
| 3540 | :style toggle :selected vhdl-port-flattened :active vhdl-port-list] |
| 3541 | ["Reverse Direction" vhdl-port-reverse-direction |
| 3542 | :style toggle :selected vhdl-port-reversed-direction :active vhdl-port-list]) |
| 3543 | ("Compose" |
| 3544 | ["New Component" vhdl-compose-new-component t] |
| 3545 | ["Copy Component" vhdl-port-copy t] |
| 3546 | ["Place Component" vhdl-compose-place-component vhdl-port-list] |
| 3547 | ["Wire Components" vhdl-compose-wire-components t] |
| 3548 | "--" |
| 3549 | ["Generate Configuration" vhdl-compose-configuration t] |
| 3550 | ["Generate Components Package" vhdl-compose-components-package t]) |
| 3551 | ("Subprogram" |
| 3552 | ["Copy" vhdl-subprog-copy t] |
| 3553 | "--" |
| 3554 | ["Paste As Declaration" vhdl-subprog-paste-declaration vhdl-subprog-list] |
| 3555 | ["Paste As Body" vhdl-subprog-paste-body vhdl-subprog-list] |
| 3556 | ["Paste As Call" vhdl-subprog-paste-call vhdl-subprog-list] |
| 3557 | "--" |
| 3558 | ["Flatten" vhdl-subprog-flatten |
| 3559 | :style toggle :selected vhdl-subprog-flattened :active vhdl-subprog-list]) |
| 3560 | "--" |
| 3561 | ("Comment" |
| 3562 | ["(Un)Comment Out Region" vhdl-comment-uncomment-region (mark)] |
| 3563 | "--" |
| 3564 | ["Insert Inline Comment" vhdl-comment-append-inline t] |
| 3565 | ["Insert Horizontal Line" vhdl-comment-display-line t] |
| 3566 | ["Insert Display Comment" vhdl-comment-display t] |
| 3567 | "--" |
| 3568 | ["Fill Comment" fill-paragraph t] |
| 3569 | ["Fill Comment Region" fill-region (mark)] |
| 3570 | ["Kill Comment Region" vhdl-comment-kill-region (mark)] |
| 3571 | ["Kill Inline Comment Region" vhdl-comment-kill-inline-region (mark)]) |
| 3572 | ("Line" |
| 3573 | ["Kill" vhdl-line-kill t] |
| 3574 | ["Copy" vhdl-line-copy t] |
| 3575 | ["Yank" vhdl-line-yank t] |
| 3576 | ["Expand" vhdl-line-expand t] |
| 3577 | "--" |
| 3578 | ["Transpose Next" vhdl-line-transpose-next t] |
| 3579 | ["Transpose Prev" vhdl-line-transpose-previous t] |
| 3580 | ["Open" vhdl-line-open t] |
| 3581 | ["Join" vhdl-delete-indentation t] |
| 3582 | "--" |
| 3583 | ["Goto" goto-line t] |
| 3584 | ["(Un)Comment Out" vhdl-comment-uncomment-line t]) |
| 3585 | ("Move" |
| 3586 | ["Forward Statement" vhdl-end-of-statement t] |
| 3587 | ["Backward Statement" vhdl-beginning-of-statement t] |
| 3588 | ["Forward Expression" vhdl-forward-sexp t] |
| 3589 | ["Backward Expression" vhdl-backward-sexp t] |
| 3590 | ["Forward Same Indent" vhdl-forward-same-indent t] |
| 3591 | ["Backward Same Indent" vhdl-backward-same-indent t] |
| 3592 | ["Forward Function" vhdl-end-of-defun t] |
| 3593 | ["Backward Function" vhdl-beginning-of-defun t] |
| 3594 | ["Mark Function" vhdl-mark-defun t]) |
| 3595 | "--" |
| 3596 | ("Indent" |
| 3597 | ["Line" indent-according-to-mode :keys "C-c C-i C-l"] |
| 3598 | ["Group" vhdl-indent-group :keys "C-c C-i C-g"] |
| 3599 | ["Region" vhdl-indent-region (mark)] |
| 3600 | ["Buffer" vhdl-indent-buffer :keys "C-c C-i C-b"]) |
| 3601 | ("Align" |
| 3602 | ["Group" vhdl-align-group t] |
| 3603 | ["Same Indent" vhdl-align-same-indent :keys "C-c C-a C-i"] |
| 3604 | ["List" vhdl-align-list t] |
| 3605 | ["Declarations" vhdl-align-declarations t] |
| 3606 | ["Region" vhdl-align-region (mark)] |
| 3607 | ["Buffer" vhdl-align-buffer t] |
| 3608 | "--" |
| 3609 | ["Inline Comment Group" vhdl-align-inline-comment-group t] |
| 3610 | ["Inline Comment Region" vhdl-align-inline-comment-region (mark)] |
| 3611 | ["Inline Comment Buffer" vhdl-align-inline-comment-buffer t]) |
| 3612 | ("Fill" |
| 3613 | ["List" vhdl-fill-list t] |
| 3614 | ["Group" vhdl-fill-group t] |
| 3615 | ["Same Indent" vhdl-fill-same-indent :keys "C-c C-f C-i"] |
| 3616 | ["Region" vhdl-fill-region (mark)]) |
| 3617 | ("Beautify" |
| 3618 | ["Region" vhdl-beautify-region (mark)] |
| 3619 | ["Buffer" vhdl-beautify-buffer t]) |
| 3620 | ("Fix" |
| 3621 | ["Generic/Port Clause" vhdl-fix-clause t] |
| 3622 | ["Generic/Port Clause Buffer" vhdl-fix-clause t] |
| 3623 | "--" |
| 3624 | ["Case Region" vhdl-fix-case-region (mark)] |
| 3625 | ["Case Buffer" vhdl-fix-case-buffer t] |
| 3626 | "--" |
| 3627 | ["Whitespace Region" vhdl-fixup-whitespace-region (mark)] |
| 3628 | ["Whitespace Buffer" vhdl-fixup-whitespace-buffer t] |
| 3629 | "--" |
| 3630 | ["Statement Region" vhdl-fix-statement-region (mark)] |
| 3631 | ["Statement Buffer" vhdl-fix-statement-buffer t] |
| 3632 | "--" |
| 3633 | ["Trailing Spaces Buffer" vhdl-remove-trailing-spaces t]) |
| 3634 | ("Update" |
| 3635 | ["Sensitivity List" vhdl-update-sensitivity-list-process t] |
| 3636 | ["Sensitivity List Buffer" vhdl-update-sensitivity-list-buffer t]) |
| 3637 | "--" |
| 3638 | ["Fontify Buffer" vhdl-fontify-buffer t] |
| 3639 | ["Statistics Buffer" vhdl-statistics-buffer t] |
| 3640 | ["Show Messages" vhdl-show-messages t] |
| 3641 | ["Syntactic Info" vhdl-show-syntactic-information t] |
| 3642 | "--" |
| 3643 | ["Speedbar" vhdl-speedbar t] |
| 3644 | ["Hide/Show" vhdl-hs-minor-mode t] |
| 3645 | "--" |
| 3646 | ("Documentation" |
| 3647 | ["VHDL Mode" vhdl-doc-mode :keys "C-c C-h"] |
| 3648 | ["Release Notes" (vhdl-doc-variable 'vhdl-doc-release-notes) t] |
| 3649 | ["Reserved Words" (vhdl-doc-variable 'vhdl-doc-keywords) t] |
| 3650 | ["Coding Style" (vhdl-doc-variable 'vhdl-doc-coding-style) t]) |
| 3651 | ["Version" vhdl-version t] |
| 3652 | ["Bug Report..." vhdl-submit-bug-report t] |
| 3653 | "--" |
| 3654 | ("Options" |
| 3655 | ("Mode" |
| 3656 | ["Electric Mode" |
| 3657 | (progn (customize-set-variable 'vhdl-electric-mode |
| 3658 | (not vhdl-electric-mode)) |
| 3659 | (vhdl-mode-line-update)) |
| 3660 | :style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"] |
| 3661 | ["Stutter Mode" |
| 3662 | (progn (customize-set-variable 'vhdl-stutter-mode |
| 3663 | (not vhdl-stutter-mode)) |
| 3664 | (vhdl-mode-line-update)) |
| 3665 | :style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"] |
| 3666 | ["Indent Tabs Mode" |
| 3667 | (progn (customize-set-variable 'vhdl-indent-tabs-mode |
| 3668 | (not vhdl-indent-tabs-mode)) |
| 3669 | (setq indent-tabs-mode vhdl-indent-tabs-mode)) |
| 3670 | :style toggle :selected vhdl-indent-tabs-mode] |
| 3671 | "--" |
| 3672 | ["Customize Group..." (customize-group 'vhdl-mode) t]) |
| 3673 | ("Project" |
| 3674 | ["Project Setup..." (customize-option 'vhdl-project-alist) t] |
| 3675 | ,(append |
| 3676 | '("Selected Project at Startup" |
| 3677 | ["None" (progn (customize-set-variable 'vhdl-project nil) |
| 3678 | (vhdl-set-project "")) |
| 3679 | :style radio :selected (null vhdl-project)] |
| 3680 | "--") |
| 3681 | ;; add menu entries for defined projects |
| 3682 | (let ((project-alist vhdl-project-alist) menu-list name) |
| 3683 | (while project-alist |
| 3684 | (setq name (caar project-alist)) |
| 3685 | (setq menu-list |
| 3686 | (cons `[,name (progn (customize-set-variable |
| 3687 | 'vhdl-project ,name) |
| 3688 | (vhdl-set-project ,name)) |
| 3689 | :style radio :selected (equal ,name vhdl-project)] |
| 3690 | menu-list)) |
| 3691 | (setq project-alist (cdr project-alist))) |
| 3692 | (setq menu-list (nreverse menu-list)) |
| 3693 | (vhdl-menu-split menu-list "Project"))) |
| 3694 | ["Setup File Name..." (customize-option 'vhdl-project-file-name) t] |
| 3695 | ("Auto Load Setup File" |
| 3696 | ["At Startup" |
| 3697 | (customize-set-variable 'vhdl-project-auto-load |
| 3698 | (if (memq 'startup vhdl-project-auto-load) |
| 3699 | (delq 'startup vhdl-project-auto-load) |
| 3700 | (cons 'startup vhdl-project-auto-load))) |
| 3701 | :style toggle :selected (memq 'startup vhdl-project-auto-load)]) |
| 3702 | ["Sort Projects" |
| 3703 | (customize-set-variable 'vhdl-project-sort (not vhdl-project-sort)) |
| 3704 | :style toggle :selected vhdl-project-sort] |
| 3705 | "--" |
| 3706 | ["Customize Group..." (customize-group 'vhdl-project) t]) |
| 3707 | ("Compiler" |
| 3708 | ["Compiler Setup..." (customize-option 'vhdl-compiler-alist) t] |
| 3709 | ,(append |
| 3710 | '("Selected Compiler at Startup") |
| 3711 | ;; add menu entries for defined compilers |
| 3712 | (let ((comp-alist vhdl-compiler-alist) menu-list name) |
| 3713 | (while comp-alist |
| 3714 | (setq name (caar comp-alist)) |
| 3715 | (setq menu-list |
| 3716 | (cons `[,name (customize-set-variable 'vhdl-compiler ,name) |
| 3717 | :style radio :selected (equal ,name vhdl-compiler)] |
| 3718 | menu-list)) |
| 3719 | (setq comp-alist (cdr comp-alist))) |
| 3720 | (setq menu-list (nreverse menu-list)) |
| 3721 | (vhdl-menu-split menu-list "Compiler"))) |
| 3722 | ["Use Local Error Regexp" |
| 3723 | (customize-set-variable 'vhdl-compile-use-local-error-regexp |
| 3724 | (not vhdl-compile-use-local-error-regexp)) |
| 3725 | :style toggle :selected vhdl-compile-use-local-error-regexp] |
| 3726 | ["Makefile Default Targets..." |
| 3727 | (customize-option 'vhdl-makefile-default-targets) t] |
| 3728 | ["Makefile Generation Hook..." |
| 3729 | (customize-option 'vhdl-makefile-generation-hook) t] |
| 3730 | ["Default Library Name" (customize-option 'vhdl-default-library) t] |
| 3731 | "--" |
| 3732 | ["Customize Group..." (customize-group 'vhdl-compiler) t]) |
| 3733 | ("Style" |
| 3734 | ("VHDL Standard" |
| 3735 | ["VHDL'87" |
| 3736 | (progn (customize-set-variable 'vhdl-standard |
| 3737 | (list '87 (cadr vhdl-standard))) |
| 3738 | (vhdl-activate-customizations)) |
| 3739 | :style radio :selected (eq '87 (car vhdl-standard))] |
| 3740 | ["VHDL'93/02" |
| 3741 | (progn (customize-set-variable 'vhdl-standard |
| 3742 | (list '93 (cadr vhdl-standard))) |
| 3743 | (vhdl-activate-customizations)) |
| 3744 | :style radio :selected (eq '93 (car vhdl-standard))] |
| 3745 | "--" |
| 3746 | ["VHDL-AMS" |
| 3747 | (progn (customize-set-variable |
| 3748 | 'vhdl-standard (list (car vhdl-standard) |
| 3749 | (if (memq 'ams (cadr vhdl-standard)) |
| 3750 | (delq 'ams (cadr vhdl-standard)) |
| 3751 | (cons 'ams (cadr vhdl-standard))))) |
| 3752 | (vhdl-activate-customizations)) |
| 3753 | :style toggle :selected (memq 'ams (cadr vhdl-standard))] |
| 3754 | ["Math Packages" |
| 3755 | (progn (customize-set-variable |
| 3756 | 'vhdl-standard (list (car vhdl-standard) |
| 3757 | (if (memq 'math (cadr vhdl-standard)) |
| 3758 | (delq 'math (cadr vhdl-standard)) |
| 3759 | (cons 'math (cadr vhdl-standard))))) |
| 3760 | (vhdl-activate-customizations)) |
| 3761 | :style toggle :selected (memq 'math (cadr vhdl-standard))]) |
| 3762 | ["Indentation Offset..." (customize-option 'vhdl-basic-offset) t] |
| 3763 | ["Upper Case Keywords" |
| 3764 | (customize-set-variable 'vhdl-upper-case-keywords |
| 3765 | (not vhdl-upper-case-keywords)) |
| 3766 | :style toggle :selected vhdl-upper-case-keywords] |
| 3767 | ["Upper Case Types" |
| 3768 | (customize-set-variable 'vhdl-upper-case-types |
| 3769 | (not vhdl-upper-case-types)) |
| 3770 | :style toggle :selected vhdl-upper-case-types] |
| 3771 | ["Upper Case Attributes" |
| 3772 | (customize-set-variable 'vhdl-upper-case-attributes |
| 3773 | (not vhdl-upper-case-attributes)) |
| 3774 | :style toggle :selected vhdl-upper-case-attributes] |
| 3775 | ["Upper Case Enumeration Values" |
| 3776 | (customize-set-variable 'vhdl-upper-case-enum-values |
| 3777 | (not vhdl-upper-case-enum-values)) |
| 3778 | :style toggle :selected vhdl-upper-case-enum-values] |
| 3779 | ["Upper Case Constants" |
| 3780 | (customize-set-variable 'vhdl-upper-case-constants |
| 3781 | (not vhdl-upper-case-constants)) |
| 3782 | :style toggle :selected vhdl-upper-case-constants] |
| 3783 | ("Use Direct Instantiation" |
| 3784 | ["Never" |
| 3785 | (customize-set-variable 'vhdl-use-direct-instantiation 'never) |
| 3786 | :style radio :selected (eq 'never vhdl-use-direct-instantiation)] |
| 3787 | ["Standard" |
| 3788 | (customize-set-variable 'vhdl-use-direct-instantiation 'standard) |
| 3789 | :style radio :selected (eq 'standard vhdl-use-direct-instantiation)] |
| 3790 | ["Always" |
| 3791 | (customize-set-variable 'vhdl-use-direct-instantiation 'always) |
| 3792 | :style radio :selected (eq 'always vhdl-use-direct-instantiation)]) |
| 3793 | ["Include Array Index and Record Field in Sensitivity List" |
| 3794 | (customize-set-variable 'vhdl-array-index-record-field-in-sensitivity-list |
| 3795 | (not vhdl-array-index-record-field-in-sensitivity-list)) |
| 3796 | :style toggle :selected vhdl-array-index-record-field-in-sensitivity-list] |
| 3797 | "--" |
| 3798 | ["Customize Group..." (customize-group 'vhdl-style) t]) |
| 3799 | ("Naming" |
| 3800 | ["Entity File Name..." (customize-option 'vhdl-entity-file-name) t] |
| 3801 | ["Architecture File Name..." |
| 3802 | (customize-option 'vhdl-architecture-file-name) t] |
| 3803 | ["Configuration File Name..." |
| 3804 | (customize-option 'vhdl-configuration-file-name) t] |
| 3805 | ["Package File Name..." (customize-option 'vhdl-package-file-name) t] |
| 3806 | ("File Name Case" |
| 3807 | ["As Is" |
| 3808 | (customize-set-variable 'vhdl-file-name-case 'identity) |
| 3809 | :style radio :selected (eq 'identity vhdl-file-name-case)] |
| 3810 | ["Lower Case" |
| 3811 | (customize-set-variable 'vhdl-file-name-case 'downcase) |
| 3812 | :style radio :selected (eq 'downcase vhdl-file-name-case)] |
| 3813 | ["Upper Case" |
| 3814 | (customize-set-variable 'vhdl-file-name-case 'upcase) |
| 3815 | :style radio :selected (eq 'upcase vhdl-file-name-case)] |
| 3816 | ["Capitalize" |
| 3817 | (customize-set-variable 'vhdl-file-name-case 'capitalize) |
| 3818 | :style radio :selected (eq 'capitalize vhdl-file-name-case)]) |
| 3819 | "--" |
| 3820 | ["Customize Group..." (customize-group 'vhdl-naming) t]) |
| 3821 | ("Template" |
| 3822 | ("Electric Keywords" |
| 3823 | ["VHDL Keywords" |
| 3824 | (customize-set-variable 'vhdl-electric-keywords |
| 3825 | (if (memq 'vhdl vhdl-electric-keywords) |
| 3826 | (delq 'vhdl vhdl-electric-keywords) |
| 3827 | (cons 'vhdl vhdl-electric-keywords))) |
| 3828 | :style toggle :selected (memq 'vhdl vhdl-electric-keywords)] |
| 3829 | ["User Model Keywords" |
| 3830 | (customize-set-variable 'vhdl-electric-keywords |
| 3831 | (if (memq 'user vhdl-electric-keywords) |
| 3832 | (delq 'user vhdl-electric-keywords) |
| 3833 | (cons 'user vhdl-electric-keywords))) |
| 3834 | :style toggle :selected (memq 'user vhdl-electric-keywords)]) |
| 3835 | ("Insert Optional Labels" |
| 3836 | ["None" |
| 3837 | (customize-set-variable 'vhdl-optional-labels 'none) |
| 3838 | :style radio :selected (eq 'none vhdl-optional-labels)] |
| 3839 | ["Processes Only" |
| 3840 | (customize-set-variable 'vhdl-optional-labels 'process) |
| 3841 | :style radio :selected (eq 'process vhdl-optional-labels)] |
| 3842 | ["All Constructs" |
| 3843 | (customize-set-variable 'vhdl-optional-labels 'all) |
| 3844 | :style radio :selected (eq 'all vhdl-optional-labels)]) |
| 3845 | ("Insert Empty Lines" |
| 3846 | ["None" |
| 3847 | (customize-set-variable 'vhdl-insert-empty-lines 'none) |
| 3848 | :style radio :selected (eq 'none vhdl-insert-empty-lines)] |
| 3849 | ["Design Units Only" |
| 3850 | (customize-set-variable 'vhdl-insert-empty-lines 'unit) |
| 3851 | :style radio :selected (eq 'unit vhdl-insert-empty-lines)] |
| 3852 | ["All Constructs" |
| 3853 | (customize-set-variable 'vhdl-insert-empty-lines 'all) |
| 3854 | :style radio :selected (eq 'all vhdl-insert-empty-lines)]) |
| 3855 | ["Argument List Indent" |
| 3856 | (customize-set-variable 'vhdl-argument-list-indent |
| 3857 | (not vhdl-argument-list-indent)) |
| 3858 | :style toggle :selected vhdl-argument-list-indent] |
| 3859 | ["Association List with Formals" |
| 3860 | (customize-set-variable 'vhdl-association-list-with-formals |
| 3861 | (not vhdl-association-list-with-formals)) |
| 3862 | :style toggle :selected vhdl-association-list-with-formals] |
| 3863 | ["Conditions in Parenthesis" |
| 3864 | (customize-set-variable 'vhdl-conditions-in-parenthesis |
| 3865 | (not vhdl-conditions-in-parenthesis)) |
| 3866 | :style toggle :selected vhdl-conditions-in-parenthesis] |
| 3867 | ["Zero String..." (customize-option 'vhdl-zero-string) t] |
| 3868 | ["One String..." (customize-option 'vhdl-one-string) t] |
| 3869 | ("File Header" |
| 3870 | ["Header String..." (customize-option 'vhdl-file-header) t] |
| 3871 | ["Footer String..." (customize-option 'vhdl-file-footer) t] |
| 3872 | ["Company Name..." (customize-option 'vhdl-company-name) t] |
| 3873 | ["Copyright String..." (customize-option 'vhdl-copyright-string) t] |
| 3874 | ["Platform Specification..." (customize-option 'vhdl-platform-spec) t] |
| 3875 | ["Date Format..." (customize-option 'vhdl-date-format) t] |
| 3876 | ["Modify Date Prefix String..." |
| 3877 | (customize-option 'vhdl-modify-date-prefix-string) t] |
| 3878 | ["Modify Date on Saving" |
| 3879 | (progn (customize-set-variable 'vhdl-modify-date-on-saving |
| 3880 | (not vhdl-modify-date-on-saving)) |
| 3881 | (vhdl-activate-customizations)) |
| 3882 | :style toggle :selected vhdl-modify-date-on-saving]) |
| 3883 | ("Sequential Process" |
| 3884 | ("Kind of Reset" |
| 3885 | ["None" |
| 3886 | (customize-set-variable 'vhdl-reset-kind 'none) |
| 3887 | :style radio :selected (eq 'none vhdl-reset-kind)] |
| 3888 | ["Synchronous" |
| 3889 | (customize-set-variable 'vhdl-reset-kind 'sync) |
| 3890 | :style radio :selected (eq 'sync vhdl-reset-kind)] |
| 3891 | ["Asynchronous" |
| 3892 | (customize-set-variable 'vhdl-reset-kind 'async) |
| 3893 | :style radio :selected (eq 'async vhdl-reset-kind)] |
| 3894 | ["Query" |
| 3895 | (customize-set-variable 'vhdl-reset-kind 'query) |
| 3896 | :style radio :selected (eq 'query vhdl-reset-kind)]) |
| 3897 | ["Reset is Active High" |
| 3898 | (customize-set-variable 'vhdl-reset-active-high |
| 3899 | (not vhdl-reset-active-high)) |
| 3900 | :style toggle :selected vhdl-reset-active-high] |
| 3901 | ["Use Rising Clock Edge" |
| 3902 | (customize-set-variable 'vhdl-clock-rising-edge |
| 3903 | (not vhdl-clock-rising-edge)) |
| 3904 | :style toggle :selected vhdl-clock-rising-edge] |
| 3905 | ("Clock Edge Condition" |
| 3906 | ["Standard" |
| 3907 | (customize-set-variable 'vhdl-clock-edge-condition 'standard) |
| 3908 | :style radio :selected (eq 'standard vhdl-clock-edge-condition)] |
| 3909 | ["Function \"rising_edge\"" |
| 3910 | (customize-set-variable 'vhdl-clock-edge-condition 'function) |
| 3911 | :style radio :selected (eq 'function vhdl-clock-edge-condition)]) |
| 3912 | ["Clock Name..." (customize-option 'vhdl-clock-name) t] |
| 3913 | ["Reset Name..." (customize-option 'vhdl-reset-name) t]) |
| 3914 | "--" |
| 3915 | ["Customize Group..." (customize-group 'vhdl-template) t]) |
| 3916 | ("Model" |
| 3917 | ["Model Definition..." (customize-option 'vhdl-model-alist) t]) |
| 3918 | ("Port" |
| 3919 | ["Include Port Comments" |
| 3920 | (customize-set-variable 'vhdl-include-port-comments |
| 3921 | (not vhdl-include-port-comments)) |
| 3922 | :style toggle :selected vhdl-include-port-comments] |
| 3923 | ["Include Direction Comments" |
| 3924 | (customize-set-variable 'vhdl-include-direction-comments |
| 3925 | (not vhdl-include-direction-comments)) |
| 3926 | :style toggle :selected vhdl-include-direction-comments] |
| 3927 | ["Include Type Comments" |
| 3928 | (customize-set-variable 'vhdl-include-type-comments |
| 3929 | (not vhdl-include-type-comments)) |
| 3930 | :style toggle :selected vhdl-include-type-comments] |
| 3931 | ("Include Group Comments" |
| 3932 | ["Never" |
| 3933 | (customize-set-variable 'vhdl-include-group-comments 'never) |
| 3934 | :style radio :selected (eq 'never vhdl-include-group-comments)] |
| 3935 | ["Declarations" |
| 3936 | (customize-set-variable 'vhdl-include-group-comments 'decl) |
| 3937 | :style radio :selected (eq 'decl vhdl-include-group-comments)] |
| 3938 | ["Always" |
| 3939 | (customize-set-variable 'vhdl-include-group-comments 'always) |
| 3940 | :style radio :selected (eq 'always vhdl-include-group-comments)]) |
| 3941 | ["Actual Generic Name..." (customize-option 'vhdl-actual-generic-name) t] |
| 3942 | ["Actual Port Name..." (customize-option 'vhdl-actual-port-name) t] |
| 3943 | ["Instance Name..." (customize-option 'vhdl-instance-name) t] |
| 3944 | ("Testbench" |
| 3945 | ["Entity Name..." (customize-option 'vhdl-testbench-entity-name) t] |
| 3946 | ["Architecture Name..." |
| 3947 | (customize-option 'vhdl-testbench-architecture-name) t] |
| 3948 | ["Configuration Name..." |
| 3949 | (customize-option 'vhdl-testbench-configuration-name) t] |
| 3950 | ["DUT Name..." (customize-option 'vhdl-testbench-dut-name) t] |
| 3951 | ["Include Header" |
| 3952 | (customize-set-variable 'vhdl-testbench-include-header |
| 3953 | (not vhdl-testbench-include-header)) |
| 3954 | :style toggle :selected vhdl-testbench-include-header] |
| 3955 | ["Declarations..." (customize-option 'vhdl-testbench-declarations) t] |
| 3956 | ["Statements..." (customize-option 'vhdl-testbench-statements) t] |
| 3957 | ["Initialize Signals" |
| 3958 | (customize-set-variable 'vhdl-testbench-initialize-signals |
| 3959 | (not vhdl-testbench-initialize-signals)) |
| 3960 | :style toggle :selected vhdl-testbench-initialize-signals] |
| 3961 | ["Include Library Clause" |
| 3962 | (customize-set-variable 'vhdl-testbench-include-library |
| 3963 | (not vhdl-testbench-include-library)) |
| 3964 | :style toggle :selected vhdl-testbench-include-library] |
| 3965 | ["Include Configuration" |
| 3966 | (customize-set-variable 'vhdl-testbench-include-configuration |
| 3967 | (not vhdl-testbench-include-configuration)) |
| 3968 | :style toggle :selected vhdl-testbench-include-configuration] |
| 3969 | ("Create Files" |
| 3970 | ["None" |
| 3971 | (customize-set-variable 'vhdl-testbench-create-files 'none) |
| 3972 | :style radio :selected (eq 'none vhdl-testbench-create-files)] |
| 3973 | ["Single" |
| 3974 | (customize-set-variable 'vhdl-testbench-create-files 'single) |
| 3975 | :style radio :selected (eq 'single vhdl-testbench-create-files)] |
| 3976 | ["Separate" |
| 3977 | (customize-set-variable 'vhdl-testbench-create-files 'separate) |
| 3978 | :style radio :selected (eq 'separate vhdl-testbench-create-files)]) |
| 3979 | ["Testbench Entity File Name..." |
| 3980 | (customize-option 'vhdl-testbench-entity-file-name) t] |
| 3981 | ["Testbench Architecture File Name..." |
| 3982 | (customize-option 'vhdl-testbench-architecture-file-name) t]) |
| 3983 | "--" |
| 3984 | ["Customize Group..." (customize-group 'vhdl-port) t]) |
| 3985 | ("Compose" |
| 3986 | ["Architecture Name..." |
| 3987 | (customize-option 'vhdl-compose-architecture-name) t] |
| 3988 | ["Configuration Name..." |
| 3989 | (customize-option 'vhdl-compose-configuration-name) t] |
| 3990 | ["Components Package Name..." |
| 3991 | (customize-option 'vhdl-components-package-name) t] |
| 3992 | ["Use Components Package" |
| 3993 | (customize-set-variable 'vhdl-use-components-package |
| 3994 | (not vhdl-use-components-package)) |
| 3995 | :style toggle :selected vhdl-use-components-package] |
| 3996 | ["Include Header" |
| 3997 | (customize-set-variable 'vhdl-compose-include-header |
| 3998 | (not vhdl-compose-include-header)) |
| 3999 | :style toggle :selected vhdl-compose-include-header] |
| 4000 | ("Create Entity/Architecture Files" |
| 4001 | ["None" |
| 4002 | (customize-set-variable 'vhdl-compose-create-files 'none) |
| 4003 | :style radio :selected (eq 'none vhdl-compose-create-files)] |
| 4004 | ["Single" |
| 4005 | (customize-set-variable 'vhdl-compose-create-files 'single) |
| 4006 | :style radio :selected (eq 'single vhdl-compose-create-files)] |
| 4007 | ["Separate" |
| 4008 | (customize-set-variable 'vhdl-compose-create-files 'separate) |
| 4009 | :style radio :selected (eq 'separate vhdl-compose-create-files)]) |
| 4010 | ["Create Configuration File" |
| 4011 | (customize-set-variable 'vhdl-compose-configuration-create-file |
| 4012 | (not vhdl-compose-configuration-create-file)) |
| 4013 | :style toggle :selected vhdl-compose-configuration-create-file] |
| 4014 | ["Hierarchical Configuration" |
| 4015 | (customize-set-variable 'vhdl-compose-configuration-hierarchical |
| 4016 | (not vhdl-compose-configuration-hierarchical)) |
| 4017 | :style toggle :selected vhdl-compose-configuration-hierarchical] |
| 4018 | ["Use Subconfiguration" |
| 4019 | (customize-set-variable 'vhdl-compose-configuration-use-subconfiguration |
| 4020 | (not vhdl-compose-configuration-use-subconfiguration)) |
| 4021 | :style toggle :selected vhdl-compose-configuration-use-subconfiguration] |
| 4022 | "--" |
| 4023 | ["Customize Group..." (customize-group 'vhdl-compose) t]) |
| 4024 | ("Comment" |
| 4025 | ["Self Insert Comments" |
| 4026 | (customize-set-variable 'vhdl-self-insert-comments |
| 4027 | (not vhdl-self-insert-comments)) |
| 4028 | :style toggle :selected vhdl-self-insert-comments] |
| 4029 | ["Prompt for Comments" |
| 4030 | (customize-set-variable 'vhdl-prompt-for-comments |
| 4031 | (not vhdl-prompt-for-comments)) |
| 4032 | :style toggle :selected vhdl-prompt-for-comments] |
| 4033 | ["Inline Comment Column..." |
| 4034 | (customize-option 'vhdl-inline-comment-column) t] |
| 4035 | ["End Comment Column..." (customize-option 'vhdl-end-comment-column) t] |
| 4036 | "--" |
| 4037 | ["Customize Group..." (customize-group 'vhdl-comment) t]) |
| 4038 | ("Beautify" |
| 4039 | ["Auto Align Templates" |
| 4040 | (customize-set-variable 'vhdl-auto-align (not vhdl-auto-align)) |
| 4041 | :style toggle :selected vhdl-auto-align] |
| 4042 | ["Align Line Groups" |
| 4043 | (customize-set-variable 'vhdl-align-groups (not vhdl-align-groups)) |
| 4044 | :style toggle :selected vhdl-align-groups] |
| 4045 | ["Group Separation String..." |
| 4046 | (customize-option 'vhdl-align-group-separate) t] |
| 4047 | ["Align Lines with Same Indent" |
| 4048 | (customize-set-variable 'vhdl-align-same-indent |
| 4049 | (not vhdl-align-same-indent)) |
| 4050 | :style toggle :selected vhdl-align-same-indent] |
| 4051 | ["Beautify Options..." (customize-option 'vhdl-beautify-options) t] |
| 4052 | "--" |
| 4053 | ["Customize Group..." (customize-group 'vhdl-beautify) t]) |
| 4054 | ("Highlight" |
| 4055 | ["Highlighting On/Off..." |
| 4056 | (customize-option |
| 4057 | (if (fboundp 'global-font-lock-mode) |
| 4058 | 'global-font-lock-mode 'font-lock-auto-fontify)) t] |
| 4059 | ["Highlight Keywords" |
| 4060 | (progn (customize-set-variable 'vhdl-highlight-keywords |
| 4061 | (not vhdl-highlight-keywords)) |
| 4062 | (vhdl-fontify-buffer)) |
| 4063 | :style toggle :selected vhdl-highlight-keywords] |
| 4064 | ["Highlight Names" |
| 4065 | (progn (customize-set-variable 'vhdl-highlight-names |
| 4066 | (not vhdl-highlight-names)) |
| 4067 | (vhdl-fontify-buffer)) |
| 4068 | :style toggle :selected vhdl-highlight-names] |
| 4069 | ["Highlight Special Words" |
| 4070 | (progn (customize-set-variable 'vhdl-highlight-special-words |
| 4071 | (not vhdl-highlight-special-words)) |
| 4072 | (vhdl-fontify-buffer)) |
| 4073 | :style toggle :selected vhdl-highlight-special-words] |
| 4074 | ["Highlight Forbidden Words" |
| 4075 | (progn (customize-set-variable 'vhdl-highlight-forbidden-words |
| 4076 | (not vhdl-highlight-forbidden-words)) |
| 4077 | (vhdl-fontify-buffer)) |
| 4078 | :style toggle :selected vhdl-highlight-forbidden-words] |
| 4079 | ["Highlight Verilog Keywords" |
| 4080 | (progn (customize-set-variable 'vhdl-highlight-verilog-keywords |
| 4081 | (not vhdl-highlight-verilog-keywords)) |
| 4082 | (vhdl-fontify-buffer)) |
| 4083 | :style toggle :selected vhdl-highlight-verilog-keywords] |
| 4084 | ["Highlight \"translate_off\"" |
| 4085 | (progn (customize-set-variable 'vhdl-highlight-translate-off |
| 4086 | (not vhdl-highlight-translate-off)) |
| 4087 | (vhdl-fontify-buffer)) |
| 4088 | :style toggle :selected vhdl-highlight-translate-off] |
| 4089 | ["Case Sensitive Highlighting" |
| 4090 | (progn (customize-set-variable 'vhdl-highlight-case-sensitive |
| 4091 | (not vhdl-highlight-case-sensitive)) |
| 4092 | (vhdl-fontify-buffer)) |
| 4093 | :style toggle :selected vhdl-highlight-case-sensitive] |
| 4094 | ["Special Syntax Definition..." |
| 4095 | (customize-option 'vhdl-special-syntax-alist) t] |
| 4096 | ["Forbidden Words..." (customize-option 'vhdl-forbidden-words) t] |
| 4097 | ["Forbidden Syntax..." (customize-option 'vhdl-forbidden-syntax) t] |
| 4098 | ["Directive Keywords..." (customize-option 'vhdl-directive-keywords) t] |
| 4099 | ["Colors..." (customize-group 'vhdl-highlight-faces) t] |
| 4100 | "--" |
| 4101 | ["Customize Group..." (customize-group 'vhdl-highlight) t]) |
| 4102 | ("Speedbar" |
| 4103 | ["Auto Open at Startup" |
| 4104 | (customize-set-variable 'vhdl-speedbar-auto-open |
| 4105 | (not vhdl-speedbar-auto-open)) |
| 4106 | :style toggle :selected vhdl-speedbar-auto-open] |
| 4107 | ("Default Displaying Mode" |
| 4108 | ["Files" |
| 4109 | (customize-set-variable 'vhdl-speedbar-display-mode 'files) |
| 4110 | :style radio :selected (eq 'files vhdl-speedbar-display-mode)] |
| 4111 | ["Directory Hierarchy" |
| 4112 | (customize-set-variable 'vhdl-speedbar-display-mode 'directory) |
| 4113 | :style radio :selected (eq 'directory vhdl-speedbar-display-mode)] |
| 4114 | ["Project Hierarchy" |
| 4115 | (customize-set-variable 'vhdl-speedbar-display-mode 'project) |
| 4116 | :style radio :selected (eq 'project vhdl-speedbar-display-mode)]) |
| 4117 | ["Indentation Offset..." |
| 4118 | (customize-option 'speedbar-indentation-width) t] |
| 4119 | ["Scan Size Limits..." (customize-option 'vhdl-speedbar-scan-limit) t] |
| 4120 | ["Jump to Unit when Opening" |
| 4121 | (customize-set-variable 'vhdl-speedbar-jump-to-unit |
| 4122 | (not vhdl-speedbar-jump-to-unit)) |
| 4123 | :style toggle :selected vhdl-speedbar-jump-to-unit] |
| 4124 | ["Update Hierarchy on File Saving" |
| 4125 | (customize-set-variable 'vhdl-speedbar-update-on-saving |
| 4126 | (not vhdl-speedbar-update-on-saving)) |
| 4127 | :style toggle :selected vhdl-speedbar-update-on-saving] |
| 4128 | ("Save in Cache File" |
| 4129 | ["Hierarchy Information" |
| 4130 | (customize-set-variable 'vhdl-speedbar-save-cache |
| 4131 | (if (memq 'hierarchy vhdl-speedbar-save-cache) |
| 4132 | (delq 'hierarchy vhdl-speedbar-save-cache) |
| 4133 | (cons 'hierarchy vhdl-speedbar-save-cache))) |
| 4134 | :style toggle :selected (memq 'hierarchy vhdl-speedbar-save-cache)] |
| 4135 | ["Displaying Status" |
| 4136 | (customize-set-variable 'vhdl-speedbar-save-cache |
| 4137 | (if (memq 'display vhdl-speedbar-save-cache) |
| 4138 | (delq 'display vhdl-speedbar-save-cache) |
| 4139 | (cons 'display vhdl-speedbar-save-cache))) |
| 4140 | :style toggle :selected (memq 'display vhdl-speedbar-save-cache)]) |
| 4141 | ["Cache File Name..." |
| 4142 | (customize-option 'vhdl-speedbar-cache-file-name) t] |
| 4143 | "--" |
| 4144 | ["Customize Group..." (customize-group 'vhdl-speedbar) t]) |
| 4145 | ("Menu" |
| 4146 | ["Add Index Menu when Loading File" |
| 4147 | (progn (customize-set-variable 'vhdl-index-menu (not vhdl-index-menu)) |
| 4148 | (vhdl-index-menu-init)) |
| 4149 | :style toggle :selected vhdl-index-menu] |
| 4150 | ["Add Source File Menu when Loading File" |
| 4151 | (progn (customize-set-variable 'vhdl-source-file-menu |
| 4152 | (not vhdl-source-file-menu)) |
| 4153 | (vhdl-add-source-files-menu)) |
| 4154 | :style toggle :selected vhdl-source-file-menu] |
| 4155 | ["Add Hideshow Menu at Startup" |
| 4156 | (progn (customize-set-variable 'vhdl-hideshow-menu |
| 4157 | (not vhdl-hideshow-menu)) |
| 4158 | (vhdl-activate-customizations)) |
| 4159 | :style toggle :selected vhdl-hideshow-menu] |
| 4160 | ["Hide Everything Initially" |
| 4161 | (customize-set-variable 'vhdl-hide-all-init (not vhdl-hide-all-init)) |
| 4162 | :style toggle :selected vhdl-hide-all-init] |
| 4163 | "--" |
| 4164 | ["Customize Group..." (customize-group 'vhdl-menu) t]) |
| 4165 | ("Print" |
| 4166 | ["In Two Column Format" |
| 4167 | (progn (customize-set-variable 'vhdl-print-two-column |
| 4168 | (not vhdl-print-two-column)) |
| 4169 | (message "Activate new setting by saving options and restarting Emacs")) |
| 4170 | :style toggle :selected vhdl-print-two-column] |
| 4171 | ["Use Customized Faces" |
| 4172 | (progn (customize-set-variable 'vhdl-print-customize-faces |
| 4173 | (not vhdl-print-customize-faces)) |
| 4174 | (message "Activate new setting by saving options and restarting Emacs")) |
| 4175 | :style toggle :selected vhdl-print-customize-faces] |
| 4176 | "--" |
| 4177 | ["Customize Group..." (customize-group 'vhdl-print) t]) |
| 4178 | ("Miscellaneous" |
| 4179 | ["Use Intelligent Tab" |
| 4180 | (progn (customize-set-variable 'vhdl-intelligent-tab |
| 4181 | (not vhdl-intelligent-tab)) |
| 4182 | (vhdl-activate-customizations)) |
| 4183 | :style toggle :selected vhdl-intelligent-tab] |
| 4184 | ["Indent Syntax-Based" |
| 4185 | (customize-set-variable 'vhdl-indent-syntax-based |
| 4186 | (not vhdl-indent-syntax-based)) |
| 4187 | :style toggle :selected vhdl-indent-syntax-based] |
| 4188 | ["Indent Comments Like Next Code Line" |
| 4189 | (customize-set-variable 'vhdl-indent-comment-like-next-code-line |
| 4190 | (not vhdl-indent-comment-like-next-code-line)) |
| 4191 | :style toggle :selected vhdl-indent-comment-like-next-code-line] |
| 4192 | ["Word Completion is Case Sensitive" |
| 4193 | (customize-set-variable 'vhdl-word-completion-case-sensitive |
| 4194 | (not vhdl-word-completion-case-sensitive)) |
| 4195 | :style toggle :selected vhdl-word-completion-case-sensitive] |
| 4196 | ["Word Completion in Minibuffer" |
| 4197 | (progn (customize-set-variable 'vhdl-word-completion-in-minibuffer |
| 4198 | (not vhdl-word-completion-in-minibuffer)) |
| 4199 | (message "Activate new setting by saving options and restarting Emacs")) |
| 4200 | :style toggle :selected vhdl-word-completion-in-minibuffer] |
| 4201 | ["Underscore is Part of Word" |
| 4202 | (progn (customize-set-variable 'vhdl-underscore-is-part-of-word |
| 4203 | (not vhdl-underscore-is-part-of-word)) |
| 4204 | (vhdl-activate-customizations)) |
| 4205 | :style toggle :selected vhdl-underscore-is-part-of-word] |
| 4206 | "--" |
| 4207 | ["Customize Group..." (customize-group 'vhdl-misc) t]) |
| 4208 | ["Related..." (customize-browse 'vhdl-related) t] |
| 4209 | "--" |
| 4210 | ["Save Options" customize-save-customized t] |
| 4211 | ["Activate Options" vhdl-activate-customizations t] |
| 4212 | ["Browse Options..." vhdl-customize t]))) |
| 4213 | |
| 4214 | (defvar vhdl-mode-menu-list (vhdl-create-mode-menu) |
| 4215 | "VHDL Mode menu.") |
| 4216 | |
| 4217 | (defun vhdl-update-mode-menu () |
| 4218 | "Update VHDL Mode menu." |
| 4219 | (interactive) |
| 4220 | (easy-menu-remove vhdl-mode-menu-list) ; for XEmacs |
| 4221 | (setq vhdl-mode-menu-list (vhdl-create-mode-menu)) |
| 4222 | (easy-menu-add vhdl-mode-menu-list) ; for XEmacs |
| 4223 | (easy-menu-define vhdl-mode-menu vhdl-mode-map |
| 4224 | "Menu keymap for VHDL Mode." vhdl-mode-menu-list)) |
| 4225 | |
| 4226 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4227 | ;; Index menu (using `imenu.el'), also used for speedbar (using `speedbar.el') |
| 4228 | |
| 4229 | (defconst vhdl-imenu-generic-expression |
| 4230 | '( |
| 4231 | ("Subprogram" |
| 4232 | "^\\s-*\\(\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\s-+\\(\"?\\(\\w\\|\\s_\\)+\"?\\)" |
| 4233 | 4) |
| 4234 | ("Instance" |
| 4235 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\s-*:\\(\\s-\\|\n\\)*\\(entity\\s-+\\(\\w\\|\\s_\\)+\\.\\)?\\(\\w\\|\\s_\\)+\\)\\(\\s-\\|\n\\)+\\(generic\\|port\\)\\s-+map\\>" |
| 4236 | 1) |
| 4237 | ("Component" |
| 4238 | "^\\s-*\\(component\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4239 | 2) |
| 4240 | ("Procedural" |
| 4241 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(procedural\\)" |
| 4242 | 1) |
| 4243 | ("Process" |
| 4244 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(\\(postponed\\s-+\\|\\)process\\)" |
| 4245 | 1) |
| 4246 | ("Block" |
| 4247 | "^\\s-*\\(\\(\\w\\|\\s_\\)+\\)\\s-*:\\(\\s-\\|\n\\)*\\(block\\)" |
| 4248 | 1) |
| 4249 | ("Package" |
| 4250 | "^\\s-*\\(package\\( body\\|\\)\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4251 | 3) |
| 4252 | ("Configuration" |
| 4253 | "^\\s-*\\(configuration\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" |
| 4254 | 2) |
| 4255 | ("Architecture" |
| 4256 | "^\\s-*\\(architecture\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\s-+of\\s-+\\(\\w\\|\\s_\\)+\\)" |
| 4257 | 2) |
| 4258 | ("Entity" |
| 4259 | "^\\s-*\\(entity\\)\\s-+\\(\\(\\w\\|\\s_\\)+\\)" |
| 4260 | 2) |
| 4261 | ) |
| 4262 | "Imenu generic expression for VHDL Mode. See `imenu-generic-expression'.") |
| 4263 | |
| 4264 | (defun vhdl-index-menu-init () |
| 4265 | "Initialize index menu." |
| 4266 | (set (make-local-variable 'imenu-case-fold-search) t) |
| 4267 | (set (make-local-variable 'imenu-generic-expression) |
| 4268 | vhdl-imenu-generic-expression) |
| 4269 | (when (and vhdl-index-menu (fboundp 'imenu)) |
| 4270 | (imenu-add-to-menubar "Index"))) |
| 4271 | |
| 4272 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4273 | ;; Source file menu (using `easy-menu.el') |
| 4274 | |
| 4275 | (defvar vhdl-sources-menu nil) |
| 4276 | |
| 4277 | (defun vhdl-directory-files (directory &optional full match) |
| 4278 | "Call `directory-files' if DIRECTORY exists, otherwise generate error |
| 4279 | message." |
| 4280 | (if (not (file-directory-p directory)) |
| 4281 | (vhdl-warning-when-idle "No such directory: \"%s\"" directory) |
| 4282 | (let ((dir (directory-files directory full match))) |
| 4283 | (setq dir (delete "." dir)) |
| 4284 | (setq dir (delete ".." dir)) |
| 4285 | dir))) |
| 4286 | |
| 4287 | (defun vhdl-get-source-files (&optional full directory) |
| 4288 | "Get list of VHDL source files in DIRECTORY or current directory." |
| 4289 | (let ((mode-alist auto-mode-alist) |
| 4290 | filename-regexp) |
| 4291 | ;; create regular expressions for matching file names |
| 4292 | (setq filename-regexp "\\`[^.].*\\(") |
| 4293 | (while mode-alist |
| 4294 | (when (eq (cdar mode-alist) 'vhdl-mode) |
| 4295 | (setq filename-regexp |
| 4296 | (concat filename-regexp (caar mode-alist) "\\|"))) |
| 4297 | (setq mode-alist (cdr mode-alist))) |
| 4298 | (setq filename-regexp |
| 4299 | (concat (substring filename-regexp 0 |
| 4300 | (string-match "\\\\|$" filename-regexp)) "\\)")) |
| 4301 | ;; find files |
| 4302 | (vhdl-directory-files |
| 4303 | (or directory default-directory) full filename-regexp))) |
| 4304 | |
| 4305 | (defun vhdl-add-source-files-menu () |
| 4306 | "Scan directory for all VHDL source files and generate menu. |
| 4307 | The directory of the current source file is scanned." |
| 4308 | (interactive) |
| 4309 | (message "Scanning directory for source files ...") |
| 4310 | (let ((newmap (current-local-map)) |
| 4311 | (file-list (vhdl-get-source-files)) |
| 4312 | menu-list found) |
| 4313 | ;; Create list for menu |
| 4314 | (setq found nil) |
| 4315 | (while file-list |
| 4316 | (setq found t) |
| 4317 | (push (vector (car file-list) (list 'find-file (car file-list)) t) |
| 4318 | menu-list) |
| 4319 | (setq file-list (cdr file-list))) |
| 4320 | (setq menu-list (vhdl-menu-split menu-list "Sources")) |
| 4321 | (when found (push "--" menu-list)) |
| 4322 | (push ["*Rescan*" vhdl-add-source-files-menu t] menu-list) |
| 4323 | (push "Sources" menu-list) |
| 4324 | ;; Create menu |
| 4325 | (easy-menu-add menu-list) |
| 4326 | (easy-menu-define vhdl-sources-menu newmap |
| 4327 | "VHDL source files menu" menu-list)) |
| 4328 | (message "")) |
| 4329 | |
| 4330 | |
| 4331 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4332 | ;;; Mode definition |
| 4333 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4334 | ;; performs all buffer local initializations |
| 4335 | |
| 4336 | ;;;###autoload |
| 4337 | (define-derived-mode vhdl-mode prog-mode |
| 4338 | '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/")) |
| 4339 | (vhdl-electric-mode "e") |
| 4340 | (vhdl-stutter-mode "s")) |
| 4341 | "Major mode for editing VHDL code. |
| 4342 | |
| 4343 | Usage: |
| 4344 | ------ |
| 4345 | |
| 4346 | TEMPLATE INSERTION (electrification): |
| 4347 | After typing a VHDL keyword and entering `SPC', you are prompted for |
| 4348 | arguments while a template is generated for that VHDL construct. Typing |
| 4349 | `RET' or `C-g' at the first \(mandatory) prompt aborts the current |
| 4350 | template generation. Optional arguments are indicated by square |
| 4351 | brackets and removed if the queried string is left empty. Prompts for |
| 4352 | mandatory arguments remain in the code if the queried string is left |
| 4353 | empty. They can be queried again by `C-c C-t C-q'. Enabled |
| 4354 | electrification is indicated by `/e' in the mode line. |
| 4355 | |
| 4356 | Typing `M-SPC' after a keyword inserts a space without calling the |
| 4357 | template generator. Automatic template generation (i.e. |
| 4358 | electrification) can be disabled (enabled) by typing `C-c C-m C-e' or by |
| 4359 | setting option `vhdl-electric-mode' (see OPTIONS). |
| 4360 | |
| 4361 | Template generators can be invoked from the VHDL menu, by key |
| 4362 | bindings, by typing `C-c C-i C-c' and choosing a construct, or by typing |
| 4363 | the keyword (i.e. first word of menu entry not in parenthesis) and |
| 4364 | `SPC'. The following abbreviations can also be used: arch, attr, cond, |
| 4365 | conf, comp, cons, func, inst, pack, sig, var. |
| 4366 | |
| 4367 | Template styles can be customized in customization group |
| 4368 | `vhdl-template' \(see OPTIONS). |
| 4369 | |
| 4370 | |
| 4371 | HEADER INSERTION: |
| 4372 | A file header can be inserted by `C-c C-t C-h'. A file footer |
| 4373 | (template at the end of the file) can be inserted by `C-c C-t C-f'. |
| 4374 | See customization group `vhdl-header'. |
| 4375 | |
| 4376 | |
| 4377 | STUTTERING: |
| 4378 | Double striking of some keys inserts cumbersome VHDL syntax elements. |
| 4379 | Stuttering can be disabled (enabled) by typing `C-c C-m C-s' or by |
| 4380 | option `vhdl-stutter-mode'. Enabled stuttering is indicated by `/s' in |
| 4381 | the mode line. The stuttering keys and their effects are: |
| 4382 | |
| 4383 | ;; --> \" : \" [ --> ( -- --> comment |
| 4384 | ;;; --> \" := \" [[ --> [ --CR --> comment-out code |
| 4385 | .. --> \" => \" ] --> ) --- --> horizontal line |
| 4386 | ,, --> \" <= \" ]] --> ] ---- --> display comment |
| 4387 | == --> \" == \" '' --> \\\" |
| 4388 | |
| 4389 | |
| 4390 | WORD COMPLETION: |
| 4391 | Typing `TAB' after a (not completed) word looks for a VHDL keyword or a |
| 4392 | word in the buffer that starts alike, inserts it and adjusts case. |
| 4393 | Re-typing `TAB' toggles through alternative word completions. This also |
| 4394 | works in the minibuffer (i.e. in template generator prompts). |
| 4395 | |
| 4396 | Typing `TAB' after `(' looks for and inserts complete parenthesized |
| 4397 | expressions (e.g. for array index ranges). All keywords as well as |
| 4398 | standard types and subprograms of VHDL have predefined abbreviations |
| 4399 | \(e.g. type \"std\" and `TAB' will toggle through all standard types |
| 4400 | beginning with \"std\"). |
| 4401 | |
| 4402 | Typing `TAB' after a non-word character indents the line if at the |
| 4403 | beginning of a line (i.e. no preceding non-blank characters), and |
| 4404 | inserts a tabulator stop otherwise. `M-TAB' always inserts a tabulator |
| 4405 | stop. |
| 4406 | |
| 4407 | |
| 4408 | COMMENTS: |
| 4409 | `--' puts a single comment. |
| 4410 | `---' draws a horizontal line for separating code segments. |
| 4411 | `----' inserts a display comment, i.e. two horizontal lines |
| 4412 | with a comment in between. |
| 4413 | `--CR' comments out code on that line. Re-hitting CR comments |
| 4414 | out following lines. |
| 4415 | `C-c C-c' comments out a region if not commented out, |
| 4416 | uncomments a region if already commented out. Option |
| 4417 | `comment-style' defines where the comment characters |
| 4418 | should be placed (beginning of line, indent, etc.). |
| 4419 | |
| 4420 | You are prompted for comments after object definitions (i.e. signals, |
| 4421 | variables, constants, ports) and after subprogram and process |
| 4422 | specifications if option `vhdl-prompt-for-comments' is non-nil. |
| 4423 | Comments are automatically inserted as additional labels (e.g. after |
| 4424 | begin statements) and as help comments if `vhdl-self-insert-comments' is |
| 4425 | non-nil. |
| 4426 | |
| 4427 | Inline comments (i.e. comments after a piece of code on the same line) |
| 4428 | are indented at least to `vhdl-inline-comment-column'. Comments go at |
| 4429 | maximum to `vhdl-end-comment-column'. `RET' after a space in a comment |
| 4430 | will open a new comment line. Typing beyond `vhdl-end-comment-column' |
| 4431 | in a comment automatically opens a new comment line. `M-q' re-fills |
| 4432 | multi-line comments. |
| 4433 | |
| 4434 | |
| 4435 | INDENTATION: |
| 4436 | `TAB' indents a line if at the beginning of the line. The amount of |
| 4437 | indentation is specified by option `vhdl-basic-offset'. `C-c C-i C-l' |
| 4438 | always indents the current line (is bound to `TAB' if option |
| 4439 | `vhdl-intelligent-tab' is nil). If a region is active, `TAB' indents |
| 4440 | the entire region. |
| 4441 | |
| 4442 | Indentation can be done for a group of lines (`C-c C-i C-g'), a region |
| 4443 | \(`M-C-\\') or the entire buffer (menu). Argument and port lists are |
| 4444 | indented normally (nil) or relative to the opening parenthesis (non-nil) |
| 4445 | according to option `vhdl-argument-list-indent'. |
| 4446 | |
| 4447 | If option `vhdl-indent-tabs-mode' is nil, spaces are used instead of |
| 4448 | tabs. `M-x tabify' and `M-x untabify' allow to convert spaces to tabs |
| 4449 | and vice versa. |
| 4450 | |
| 4451 | Syntax-based indentation can be very slow in large files. Option |
| 4452 | `vhdl-indent-syntax-based' allows to use faster but simpler indentation. |
| 4453 | |
| 4454 | Option `vhdl-indent-comment-like-next-code-line' controls whether |
| 4455 | comment lines are indented like the preceding or like the following code |
| 4456 | line. |
| 4457 | |
| 4458 | |
| 4459 | ALIGNMENT: |
| 4460 | The alignment functions align operators, keywords, and inline comments |
| 4461 | to beautify the code. `C-c C-a C-a' aligns a group of consecutive lines |
| 4462 | separated by blank lines, `C-c C-a C-i' a block of lines with same |
| 4463 | indent. `C-c C-a C-l' aligns all lines belonging to a list enclosed by |
| 4464 | a pair of parentheses (e.g. port clause/map, argument list), and `C-c |
| 4465 | C-a C-d' all lines within the declarative part of a design unit. `C-c |
| 4466 | C-a M-a' aligns an entire region. `C-c C-a C-c' aligns inline comments |
| 4467 | for a group of lines, and `C-c C-a M-c' for a region. |
| 4468 | |
| 4469 | If option `vhdl-align-groups' is non-nil, groups of code lines |
| 4470 | separated by special lines (see option `vhdl-align-group-separate') are |
| 4471 | aligned individually. If option `vhdl-align-same-indent' is non-nil, |
| 4472 | blocks of lines with same indent are aligned separately. Some templates |
| 4473 | are automatically aligned after generation if option `vhdl-auto-align' |
| 4474 | is non-nil. |
| 4475 | |
| 4476 | Alignment tries to align inline comments at |
| 4477 | `vhdl-inline-comment-column' and tries inline comment not to exceed |
| 4478 | `vhdl-end-comment-column'. |
| 4479 | |
| 4480 | `C-c C-x M-w' fixes up whitespace in a region. That is, operator |
| 4481 | symbols are surrounded by one space, and multiple spaces are eliminated. |
| 4482 | |
| 4483 | |
| 4484 | CODE FILLING: |
| 4485 | Code filling allows to condense code (e.g. sensitivity lists or port |
| 4486 | maps) by removing comments and newlines and re-wrapping so that all |
| 4487 | lines are maximally filled (block filling). `C-c C-f C-f' fills a list |
| 4488 | enclosed by parenthesis, `C-c C-f C-g' a group of lines separated by |
| 4489 | blank lines, `C-c C-f C-i' a block of lines with same indent, and |
| 4490 | `C-c C-f M-f' an entire region. |
| 4491 | |
| 4492 | |
| 4493 | CODE BEAUTIFICATION: |
| 4494 | `C-c M-b' and `C-c C-b' beautify the code of a region or of the entire |
| 4495 | buffer respectively. This includes indentation, alignment, and case |
| 4496 | fixing. Code beautification can also be run non-interactively using the |
| 4497 | command: |
| 4498 | |
| 4499 | emacs -batch -l ~/.emacs filename.vhd -f vhdl-beautify-buffer |
| 4500 | |
| 4501 | |
| 4502 | PORT TRANSLATION: |
| 4503 | Generic and port clauses from entity or component declarations can be |
| 4504 | copied (`C-c C-p C-w') and pasted as entity and component declarations, |
| 4505 | as component instantiations and corresponding internal constants and |
| 4506 | signals, as a generic map with constants as actual generics, and as |
| 4507 | internal signal initializations (menu). |
| 4508 | |
| 4509 | To include formals in component instantiations, see option |
| 4510 | `vhdl-association-list-with-formals'. To include comments in pasting, |
| 4511 | see options `vhdl-include-...-comments'. |
| 4512 | |
| 4513 | A clause with several generic/port names on the same line can be |
| 4514 | flattened (`C-c C-p C-f') so that only one name per line exists. The |
| 4515 | direction of ports can be reversed (`C-c C-p C-r'), i.e., inputs become |
| 4516 | outputs and vice versa, which can be useful in testbenches. (This |
| 4517 | reversion is done on the internal data structure and is only reflected |
| 4518 | in subsequent paste operations.) |
| 4519 | |
| 4520 | Names for actual ports, instances, testbenches, and |
| 4521 | design-under-test instances can be derived from existing names according |
| 4522 | to options `vhdl-...-name'. See customization group `vhdl-port'. |
| 4523 | |
| 4524 | |
| 4525 | SUBPROGRAM TRANSLATION: |
| 4526 | Similar functionality exists for copying/pasting the interface of |
| 4527 | subprograms (function/procedure). A subprogram interface can be copied |
| 4528 | and then pasted as a subprogram declaration, body or call (uses |
| 4529 | association list with formals). |
| 4530 | |
| 4531 | |
| 4532 | TESTBENCH GENERATION: |
| 4533 | A copied port can also be pasted as a testbench. The generated |
| 4534 | testbench includes an entity, an architecture, and an optional |
| 4535 | configuration. The architecture contains the component declaration and |
| 4536 | instantiation of the DUT as well as internal constant and signal |
| 4537 | declarations. Additional user-defined templates can be inserted. The |
| 4538 | names used for entity/architecture/configuration/DUT as well as the file |
| 4539 | structure to be generated can be customized. See customization group |
| 4540 | `vhdl-testbench'. |
| 4541 | |
| 4542 | |
| 4543 | KEY BINDINGS: |
| 4544 | Key bindings (`C-c ...') exist for most commands (see in menu). |
| 4545 | |
| 4546 | |
| 4547 | VHDL MENU: |
| 4548 | All commands can be found in the VHDL menu including their key bindings. |
| 4549 | |
| 4550 | |
| 4551 | FILE BROWSER: |
| 4552 | The speedbar allows browsing of directories and file contents. It can |
| 4553 | be accessed from the VHDL menu and is automatically opened if option |
| 4554 | `vhdl-speedbar-auto-open' is non-nil. |
| 4555 | |
| 4556 | In speedbar, open files and directories with `mouse-2' on the name and |
| 4557 | browse/rescan their contents with `mouse-2'/`S-mouse-2' on the `+'. |
| 4558 | |
| 4559 | |
| 4560 | DESIGN HIERARCHY BROWSER: |
| 4561 | The speedbar can also be used for browsing the hierarchy of design units |
| 4562 | contained in the source files of the current directory or the specified |
| 4563 | projects (see option `vhdl-project-alist'). |
| 4564 | |
| 4565 | The speedbar can be switched between file, directory hierarchy and |
| 4566 | project hierarchy browsing mode in the speedbar menu or by typing `f', |
| 4567 | `h' or `H' in speedbar. |
| 4568 | |
| 4569 | In speedbar, open design units with `mouse-2' on the name and browse |
| 4570 | their hierarchy with `mouse-2' on the `+'. Ports can directly be copied |
| 4571 | from entities and components (in packages). Individual design units and |
| 4572 | complete designs can directly be compiled (\"Make\" menu entry). |
| 4573 | |
| 4574 | The hierarchy is automatically updated upon saving a modified source |
| 4575 | file when option `vhdl-speedbar-update-on-saving' is non-nil. The |
| 4576 | hierarchy is only updated for projects that have been opened once in the |
| 4577 | speedbar. The hierarchy is cached between Emacs sessions in a file (see |
| 4578 | options in group `vhdl-speedbar'). |
| 4579 | |
| 4580 | Simple design consistency checks are done during scanning, such as |
| 4581 | multiple declarations of the same unit or missing primary units that are |
| 4582 | required by secondary units. |
| 4583 | |
| 4584 | |
| 4585 | STRUCTURAL COMPOSITION: |
| 4586 | Enables simple structural composition. `C-c C-m C-n' creates a skeleton |
| 4587 | for a new component. Subcomponents (i.e. component declaration and |
| 4588 | instantiation) can be automatically placed from a previously read port |
| 4589 | \(`C-c C-m C-p') or directly from the hierarchy browser (`P'). Finally, |
| 4590 | all subcomponents can be automatically connected using internal signals |
| 4591 | and ports (`C-c C-m C-w') following these rules: |
| 4592 | - subcomponent actual ports with same name are considered to be |
| 4593 | connected by a signal (internal signal or port) |
| 4594 | - signals that are only inputs to subcomponents are considered as |
| 4595 | inputs to this component -> input port created |
| 4596 | - signals that are only outputs from subcomponents are considered as |
| 4597 | outputs from this component -> output port created |
| 4598 | - signals that are inputs to AND outputs from subcomponents are |
| 4599 | considered as internal connections -> internal signal created |
| 4600 | |
| 4601 | Purpose: With appropriate naming conventions it is possible to |
| 4602 | create higher design levels with only a few mouse clicks or key |
| 4603 | strokes. A new design level can be created by simply generating a new |
| 4604 | component, placing the required subcomponents from the hierarchy |
| 4605 | browser, and wiring everything automatically. |
| 4606 | |
| 4607 | Note: Automatic wiring only works reliably on templates of new |
| 4608 | components and component instantiations that were created by VHDL mode. |
| 4609 | |
| 4610 | Component declarations can be placed in a components package (option |
| 4611 | `vhdl-use-components-package') which can be automatically generated for |
| 4612 | an entire directory or project (`C-c C-m M-p'). The VHDL'93 direct |
| 4613 | component instantiation is also supported (option |
| 4614 | `vhdl-use-direct-instantiation'). |
| 4615 | |
| 4616 | Configuration declarations can automatically be generated either from |
| 4617 | the menu (`C-c C-m C-f') (for the architecture the cursor is in) or from |
| 4618 | the speedbar menu (for the architecture under the cursor). The |
| 4619 | configurations can optionally be hierarchical (i.e. include all |
| 4620 | component levels of a hierarchical design, option |
| 4621 | `vhdl-compose-configuration-hierarchical') or include subconfigurations |
| 4622 | (option `vhdl-compose-configuration-use-subconfiguration'). For |
| 4623 | subcomponents in hierarchical configurations, the most-recently-analyzed |
| 4624 | (mra) architecture is selected. If another architecture is desired, it |
| 4625 | can be marked as most-recently-analyzed (speedbar menu) before |
| 4626 | generating the configuration. |
| 4627 | |
| 4628 | Note: Configurations of subcomponents (i.e. hierarchical configuration |
| 4629 | declarations) are currently not considered when displaying |
| 4630 | configurations in speedbar. |
| 4631 | |
| 4632 | See the options group `vhdl-compose' for all relevant user options. |
| 4633 | |
| 4634 | |
| 4635 | SOURCE FILE COMPILATION: |
| 4636 | The syntax of the current buffer can be analyzed by calling a VHDL |
| 4637 | compiler (menu, `C-c C-k'). The compiler to be used is specified by |
| 4638 | option `vhdl-compiler'. The available compilers are listed in option |
| 4639 | `vhdl-compiler-alist' including all required compilation command, |
| 4640 | command options, compilation directory, and error message syntax |
| 4641 | information. New compilers can be added. |
| 4642 | |
| 4643 | All the source files of an entire design can be compiled by the `make' |
| 4644 | command (menu, `C-c M-C-k') if an appropriate Makefile exists. |
| 4645 | |
| 4646 | |
| 4647 | MAKEFILE GENERATION: |
| 4648 | Makefiles can be generated automatically by an internal generation |
| 4649 | routine (`C-c M-k'). The library unit dependency information is |
| 4650 | obtained from the hierarchy browser. Makefile generation can be |
| 4651 | customized for each compiler in option `vhdl-compiler-alist'. |
| 4652 | |
| 4653 | Makefile generation can also be run non-interactively using the |
| 4654 | command: |
| 4655 | |
| 4656 | emacs -batch -l ~/.emacs -l vhdl-mode |
| 4657 | [-compiler compilername] [-project projectname] |
| 4658 | -f vhdl-generate-makefile |
| 4659 | |
| 4660 | The Makefile's default target \"all\" compiles the entire design, the |
| 4661 | target \"clean\" removes it and the target \"library\" creates the |
| 4662 | library directory if not existent. These target names can be customized |
| 4663 | by option `vhdl-makefile-default-targets'. The Makefile also includes a |
| 4664 | target for each primary library unit which allows selective compilation |
| 4665 | of this unit, its secondary units and its subhierarchy (example: |
| 4666 | compilation of a design specified by a configuration). User specific |
| 4667 | parts can be inserted into a Makefile with option |
| 4668 | `vhdl-makefile-generation-hook'. |
| 4669 | |
| 4670 | Limitations: |
| 4671 | - Only library units and dependencies within the current library are |
| 4672 | considered. Makefiles for designs that span multiple libraries are |
| 4673 | not (yet) supported. |
| 4674 | - Only one-level configurations are supported (also hierarchical), |
| 4675 | but configurations that go down several levels are not. |
| 4676 | - The \"others\" keyword in configurations is not supported. |
| 4677 | |
| 4678 | |
| 4679 | PROJECTS: |
| 4680 | Projects can be defined in option `vhdl-project-alist' and a current |
| 4681 | project be selected using option `vhdl-project' (permanently) or from |
| 4682 | the menu or speedbar (temporarily). For each project, title and |
| 4683 | description strings (for the file headers), source files/directories |
| 4684 | (for the hierarchy browser and Makefile generation), library name, and |
| 4685 | compiler-dependent options, exceptions and compilation directory can be |
| 4686 | specified. Compilation settings overwrite the settings of option |
| 4687 | `vhdl-compiler-alist'. |
| 4688 | |
| 4689 | Project setups can be exported (i.e. written to a file) and imported. |
| 4690 | Imported setups are not automatically saved in `vhdl-project-alist' but |
| 4691 | can be saved afterwards in its customization buffer. When starting |
| 4692 | Emacs with VHDL Mode (i.e. load a VHDL file or use \"emacs -l |
| 4693 | vhdl-mode\") in a directory with an existing project setup file, it is |
| 4694 | automatically loaded and its project activated if option |
| 4695 | `vhdl-project-auto-load' is non-nil. Names/paths of the project setup |
| 4696 | files can be specified in option `vhdl-project-file-name'. Multiple |
| 4697 | project setups can be automatically loaded from global directories. |
| 4698 | This is an alternative to specifying project setups with option |
| 4699 | `vhdl-project-alist'. |
| 4700 | |
| 4701 | |
| 4702 | SPECIAL MENUES: |
| 4703 | As an alternative to the speedbar, an index menu can be added (set |
| 4704 | option `vhdl-index-menu' to non-nil) or made accessible as a mouse menu |
| 4705 | (e.g. add \"(global-set-key '[S-down-mouse-3] 'imenu)\" to your start-up |
| 4706 | file) for browsing the file contents (is not populated if buffer is |
| 4707 | larger than 256000). Also, a source file menu can be |
| 4708 | added (set option `vhdl-source-file-menu' to non-nil) for browsing the |
| 4709 | current directory for VHDL source files. |
| 4710 | |
| 4711 | |
| 4712 | VHDL STANDARDS: |
| 4713 | The VHDL standards to be used are specified in option `vhdl-standard'. |
| 4714 | Available standards are: VHDL'87/'93(02), VHDL-AMS, and Math Packages. |
| 4715 | |
| 4716 | |
| 4717 | KEYWORD CASE: |
| 4718 | Lower and upper case for keywords and standardized types, attributes, |
| 4719 | and enumeration values is supported. If the option |
| 4720 | `vhdl-upper-case-keywords' is set to non-nil, keywords can be typed in |
| 4721 | lower case and are converted into upper case automatically (not for |
| 4722 | types, attributes, and enumeration values). The case of keywords, |
| 4723 | types, attributes,and enumeration values can be fixed for an entire |
| 4724 | region (menu) or buffer (`C-c C-x C-c') according to the options |
| 4725 | `vhdl-upper-case-{keywords,types,attributes,enum-values}'. |
| 4726 | |
| 4727 | |
| 4728 | HIGHLIGHTING (fontification): |
| 4729 | Keywords and standardized types, attributes, enumeration values, and |
| 4730 | function names (controlled by option `vhdl-highlight-keywords'), as well |
| 4731 | as comments, strings, and template prompts are highlighted using |
| 4732 | different colors. Unit, subprogram, signal, variable, constant, |
| 4733 | parameter and generic/port names in declarations as well as labels are |
| 4734 | highlighted if option `vhdl-highlight-names' is non-nil. |
| 4735 | |
| 4736 | Additional reserved words or words with a forbidden syntax (e.g. words |
| 4737 | that should be avoided) can be specified in option |
| 4738 | `vhdl-forbidden-words' or `vhdl-forbidden-syntax' and be highlighted in |
| 4739 | a warning color (option `vhdl-highlight-forbidden-words'). Verilog |
| 4740 | keywords are highlighted as forbidden words if option |
| 4741 | `vhdl-highlight-verilog-keywords' is non-nil. |
| 4742 | |
| 4743 | Words with special syntax can be highlighted by specifying their |
| 4744 | syntax and color in option `vhdl-special-syntax-alist' and by setting |
| 4745 | option `vhdl-highlight-special-words' to non-nil. This allows to |
| 4746 | establish some naming conventions (e.g. to distinguish different kinds |
| 4747 | of signals or other objects by using name suffices) and to support them |
| 4748 | visually. |
| 4749 | |
| 4750 | Option `vhdl-highlight-case-sensitive' can be set to non-nil in order |
| 4751 | to support case-sensitive highlighting. However, keywords are then only |
| 4752 | highlighted if written in lower case. |
| 4753 | |
| 4754 | Code between \"translate_off\" and \"translate_on\" pragmas is |
| 4755 | highlighted using a different background color if option |
| 4756 | `vhdl-highlight-translate-off' is non-nil. |
| 4757 | |
| 4758 | For documentation and customization of the used colors see |
| 4759 | customization group `vhdl-highlight-faces' (`M-x customize-group'). For |
| 4760 | highlighting of matching parenthesis, see customization group |
| 4761 | `paren-showing'. Automatic buffer highlighting is turned on/off by |
| 4762 | option `global-font-lock-mode' (`font-lock-auto-fontify' in XEmacs). |
| 4763 | |
| 4764 | |
| 4765 | USER MODELS: |
| 4766 | VHDL models (templates) can be specified by the user and made accessible |
| 4767 | in the menu, through key bindings (`C-c C-m ...'), or by keyword |
| 4768 | electrification. See option `vhdl-model-alist'. |
| 4769 | |
| 4770 | |
| 4771 | HIDE/SHOW: |
| 4772 | The code of blocks, processes, subprograms, component declarations and |
| 4773 | instantiations, generic/port clauses, and configuration declarations can |
| 4774 | be hidden using the `Hide/Show' menu or by pressing `S-mouse-2' within |
| 4775 | the code (see customization group `vhdl-menu'). XEmacs: limited |
| 4776 | functionality due to old `hideshow.el' package. |
| 4777 | |
| 4778 | |
| 4779 | CODE UPDATING: |
| 4780 | - Sensitivity List: `C-c C-u C-s' updates the sensitivity list of the |
| 4781 | current process, `C-c C-u M-s' of all processes in the current buffer. |
| 4782 | Limitations: |
| 4783 | - Only declared local signals (ports, signals declared in |
| 4784 | architecture and blocks) are automatically inserted. |
| 4785 | - Global signals declared in packages are not automatically inserted. |
| 4786 | Insert them once manually (will be kept afterwards). |
| 4787 | - Out parameters of procedures are considered to be read. |
| 4788 | Use option `vhdl-entity-file-name' to specify the entity file name |
| 4789 | \(used to obtain the port names). |
| 4790 | Use option `vhdl-array-index-record-field-in-sensitivity-list' to |
| 4791 | specify whether to include array indices and record fields in |
| 4792 | sensitivity lists. |
| 4793 | |
| 4794 | |
| 4795 | CODE FIXING: |
| 4796 | `C-c C-x C-p' fixes the closing parenthesis of a generic/port clause |
| 4797 | \(e.g. if the closing parenthesis is on the wrong line or is missing). |
| 4798 | |
| 4799 | |
| 4800 | PRINTING: |
| 4801 | PostScript printing with different faces (an optimized set of faces is |
| 4802 | used if `vhdl-print-customize-faces' is non-nil) or colors \(if |
| 4803 | `ps-print-color-p' is non-nil) is possible using the standard Emacs |
| 4804 | PostScript printing commands. Option `vhdl-print-two-column' defines |
| 4805 | appropriate default settings for nice landscape two-column printing. |
| 4806 | The paper format can be set by option `ps-paper-type'. Do not forget to |
| 4807 | switch `ps-print-color-p' to nil for printing on black-and-white |
| 4808 | printers. |
| 4809 | |
| 4810 | |
| 4811 | OPTIONS: |
| 4812 | User options allow customization of VHDL Mode. All options are |
| 4813 | accessible from the \"Options\" menu entry. Simple options (switches |
| 4814 | and choices) can directly be changed, while for complex options a |
| 4815 | customization buffer is opened. Changed options can be saved for future |
| 4816 | sessions using the \"Save Options\" menu entry. |
| 4817 | |
| 4818 | Options and their detailed descriptions can also be accessed by using |
| 4819 | the \"Customize\" menu entry or the command `M-x customize-option' (`M-x |
| 4820 | customize-group' for groups). Some customizations only take effect |
| 4821 | after some action (read the NOTE in the option documentation). |
| 4822 | Customization can also be done globally (i.e. site-wide, read the |
| 4823 | INSTALL file). |
| 4824 | |
| 4825 | Not all options are described in this documentation, so go and see |
| 4826 | what other useful user options there are (`M-x vhdl-customize' or menu)! |
| 4827 | |
| 4828 | |
| 4829 | FILE EXTENSIONS: |
| 4830 | As default, files with extensions \".vhd\" and \".vhdl\" are |
| 4831 | automatically recognized as VHDL source files. To add an extension |
| 4832 | \".xxx\", add the following line to your Emacs start-up file (`.emacs'): |
| 4833 | |
| 4834 | \(push '(\"\\\\.xxx\\\\'\" . vhdl-mode) auto-mode-alist) |
| 4835 | |
| 4836 | |
| 4837 | HINTS: |
| 4838 | - To start Emacs with open VHDL hierarchy browser without having to load |
| 4839 | a VHDL file first, use the command: |
| 4840 | |
| 4841 | emacs -l vhdl-mode -f speedbar-frame-mode |
| 4842 | |
| 4843 | - Type `C-g C-g' to interrupt long operations or if Emacs hangs. |
| 4844 | |
| 4845 | - Some features only work on properly indented code. |
| 4846 | |
| 4847 | |
| 4848 | RELEASE NOTES: |
| 4849 | See also the release notes (menu) for added features in new releases. |
| 4850 | |
| 4851 | |
| 4852 | Maintenance: |
| 4853 | ------------ |
| 4854 | |
| 4855 | To submit a bug report, enter `M-x vhdl-submit-bug-report' within VHDL Mode. |
| 4856 | Add a description of the problem and include a reproducible test case. |
| 4857 | |
| 4858 | Questions and enhancement requests can be sent to <reto@gnu.org>. |
| 4859 | |
| 4860 | The `vhdl-mode-announce' mailing list informs about new VHDL Mode releases. |
| 4861 | The `vhdl-mode-victims' mailing list informs about new VHDL Mode beta |
| 4862 | releases. You are kindly invited to participate in beta testing. Subscribe |
| 4863 | to above mailing lists by sending an email to <reto@gnu.org>. |
| 4864 | |
| 4865 | VHDL Mode is officially distributed at |
| 4866 | http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html |
| 4867 | where the latest version can be found. |
| 4868 | |
| 4869 | |
| 4870 | Known problems: |
| 4871 | --------------- |
| 4872 | |
| 4873 | - XEmacs: Incorrect start-up when automatically opening speedbar. |
| 4874 | - XEmacs: Indentation in XEmacs 21.4 (and higher). |
| 4875 | - Indentation incorrect for new 'postponed' VHDL keyword. |
| 4876 | - Indentation incorrect for 'protected body' construct. |
| 4877 | |
| 4878 | |
| 4879 | The VHDL Mode Authors |
| 4880 | Reto Zimmermann and Rod Whitby |
| 4881 | |
| 4882 | Key bindings: |
| 4883 | ------------- |
| 4884 | |
| 4885 | \\{vhdl-mode-map}" |
| 4886 | :abbrev-table vhdl-mode-abbrev-table |
| 4887 | |
| 4888 | ;; set local variables |
| 4889 | (set (make-local-variable 'paragraph-start) |
| 4890 | "\\s-*\\(--+\\s-*$\\|$\\)") |
| 4891 | (set (make-local-variable 'paragraph-separate) paragraph-start) |
| 4892 | (set (make-local-variable 'paragraph-ignore-fill-prefix) t) |
| 4893 | (set (make-local-variable 'parse-sexp-ignore-comments) t) |
| 4894 | (set (make-local-variable 'indent-line-function) 'vhdl-indent-line) |
| 4895 | (set (make-local-variable 'comment-start) "--") |
| 4896 | (set (make-local-variable 'comment-end) "") |
| 4897 | (when vhdl-emacs-21 |
| 4898 | (set (make-local-variable 'comment-padding) "")) |
| 4899 | (set (make-local-variable 'comment-column) vhdl-inline-comment-column) |
| 4900 | (set (make-local-variable 'end-comment-column) vhdl-end-comment-column) |
| 4901 | (set (make-local-variable 'comment-start-skip) "--+\\s-*") |
| 4902 | (set (make-local-variable 'comment-multi-line) nil) |
| 4903 | (set (make-local-variable 'indent-tabs-mode) vhdl-indent-tabs-mode) |
| 4904 | (set (make-local-variable 'hippie-expand-verbose) nil) |
| 4905 | |
| 4906 | ;; setup the comment indent variable in a Emacs version portable way |
| 4907 | ;; ignore any byte compiler warnings you might get here |
| 4908 | (when (boundp 'comment-indent-function) |
| 4909 | (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent)) |
| 4910 | |
| 4911 | ;; initialize font locking |
| 4912 | (set (make-local-variable 'font-lock-defaults) |
| 4913 | (list |
| 4914 | '(nil vhdl-font-lock-keywords) nil |
| 4915 | (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) |
| 4916 | (if (eval-when-compile (fboundp 'syntax-propertize-rules)) |
| 4917 | (set (make-local-variable 'syntax-propertize-function) |
| 4918 | (syntax-propertize-rules |
| 4919 | ;; Mark single quotes as having string quote syntax in |
| 4920 | ;; 'c' instances. |
| 4921 | ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'")))) |
| 4922 | (set (make-local-variable 'font-lock-syntactic-keywords) |
| 4923 | vhdl-font-lock-syntactic-keywords)) |
| 4924 | (unless vhdl-emacs-21 |
| 4925 | (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) |
| 4926 | (set (make-local-variable 'lazy-lock-defer-contextually) nil) |
| 4927 | (set (make-local-variable 'lazy-lock-defer-on-the-fly) t) |
| 4928 | (set (make-local-variable 'lazy-lock-defer-on-scrolling) t)) |
| 4929 | |
| 4930 | ;; variables for source file compilation |
| 4931 | (when vhdl-compile-use-local-error-regexp |
| 4932 | (set (make-local-variable 'compilation-error-regexp-alist) nil) |
| 4933 | (set (make-local-variable 'compilation-file-regexp-alist) nil)) |
| 4934 | |
| 4935 | ;; add index menu |
| 4936 | (vhdl-index-menu-init) |
| 4937 | ;; add source file menu |
| 4938 | (if vhdl-source-file-menu (vhdl-add-source-files-menu)) |
| 4939 | ;; add VHDL menu |
| 4940 | (easy-menu-add vhdl-mode-menu-list) ; for XEmacs |
| 4941 | (easy-menu-define vhdl-mode-menu vhdl-mode-map |
| 4942 | "Menu keymap for VHDL Mode." vhdl-mode-menu-list) |
| 4943 | ;; initialize hideshow and add menu |
| 4944 | (vhdl-hideshow-init) |
| 4945 | (run-hooks 'menu-bar-update-hook) |
| 4946 | |
| 4947 | ;; miscellaneous |
| 4948 | (vhdl-ps-print-init) |
| 4949 | (vhdl-write-file-hooks-init) |
| 4950 | (message "VHDL Mode %s.%s" vhdl-version |
| 4951 | (if noninteractive "" " See menu for documentation and release notes."))) |
| 4952 | |
| 4953 | (defun vhdl-activate-customizations () |
| 4954 | "Activate all customizations on local variables." |
| 4955 | (interactive) |
| 4956 | (vhdl-mode-map-init) |
| 4957 | (use-local-map vhdl-mode-map) |
| 4958 | (set-syntax-table vhdl-mode-syntax-table) |
| 4959 | (setq comment-column vhdl-inline-comment-column) |
| 4960 | (setq end-comment-column vhdl-end-comment-column) |
| 4961 | (vhdl-write-file-hooks-init) |
| 4962 | (vhdl-update-mode-menu) |
| 4963 | (vhdl-hideshow-init) |
| 4964 | (run-hooks 'menu-bar-update-hook)) |
| 4965 | |
| 4966 | (defun vhdl-write-file-hooks-init () |
| 4967 | "Add/remove hooks when buffer is saved." |
| 4968 | (if vhdl-modify-date-on-saving |
| 4969 | (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t) |
| 4970 | (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t)) |
| 4971 | (if (featurep 'xemacs) (make-local-hook 'after-save-hook)) |
| 4972 | (add-hook 'after-save-hook 'vhdl-add-modified-file nil t)) |
| 4973 | |
| 4974 | (defun vhdl-process-command-line-option (option) |
| 4975 | "Process command line options for VHDL Mode." |
| 4976 | (cond |
| 4977 | ;; set compiler |
| 4978 | ((equal option "-compiler") |
| 4979 | (vhdl-set-compiler (car command-line-args-left)) |
| 4980 | (setq command-line-args-left (cdr command-line-args-left))) |
| 4981 | ;; set project |
| 4982 | ((equal option "-project") |
| 4983 | (vhdl-set-project (car command-line-args-left)) |
| 4984 | (setq command-line-args-left (cdr command-line-args-left))))) |
| 4985 | |
| 4986 | ;; make Emacs process VHDL Mode options |
| 4987 | (setq command-switch-alist |
| 4988 | (append command-switch-alist |
| 4989 | '(("-compiler" . vhdl-process-command-line-option) |
| 4990 | ("-project" . vhdl-process-command-line-option)))) |
| 4991 | |
| 4992 | |
| 4993 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4994 | ;;; Keywords and standardized words |
| 4995 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 4996 | |
| 4997 | (defconst vhdl-02-keywords |
| 4998 | '( |
| 4999 | "abs" "access" "after" "alias" "all" "and" "architecture" "array" |
| 5000 | "assert" "attribute" |
| 5001 | "begin" "block" "body" "buffer" "bus" |
| 5002 | "case" "component" "configuration" "constant" |
| 5003 | "disconnect" "downto" |
| 5004 | "else" "elsif" "end" "entity" "exit" |
| 5005 | "file" "for" "function" |
| 5006 | "generate" "generic" "group" "guarded" |
| 5007 | "if" "impure" "in" "inertial" "inout" "is" |
| 5008 | "label" "library" "linkage" "literal" "loop" |
| 5009 | "map" "mod" |
| 5010 | "nand" "new" "next" "nor" "not" "null" |
| 5011 | "of" "on" "open" "or" "others" "out" |
| 5012 | "package" "port" "postponed" "procedure" "process" "protected" "pure" |
| 5013 | "range" "record" "register" "reject" "rem" "report" "return" |
| 5014 | "rol" "ror" |
| 5015 | "select" "severity" "shared" "signal" "sla" "sll" "sra" "srl" "subtype" |
| 5016 | "then" "to" "transport" "type" |
| 5017 | "unaffected" "units" "until" "use" |
| 5018 | "variable" |
| 5019 | "wait" "when" "while" "with" |
| 5020 | "xnor" "xor" |
| 5021 | ) |
| 5022 | "List of VHDL'02 keywords.") |
| 5023 | |
| 5024 | (defconst vhdl-ams-keywords |
| 5025 | '( |
| 5026 | "across" "break" "limit" "nature" "noise" "procedural" "quantity" |
| 5027 | "reference" "spectrum" "subnature" "terminal" "through" |
| 5028 | "tolerance" |
| 5029 | ) |
| 5030 | "List of VHDL-AMS keywords.") |
| 5031 | |
| 5032 | (defconst vhdl-verilog-keywords |
| 5033 | '( |
| 5034 | "`define" "`else" "`endif" "`ifdef" "`include" "`timescale" "`undef" |
| 5035 | "always" "and" "assign" "begin" "buf" "bufif0" "bufif1" |
| 5036 | "case" "casex" "casez" "cmos" "deassign" "default" "defparam" "disable" |
| 5037 | "edge" "else" "end" "endattribute" "endcase" "endfunction" "endmodule" |
| 5038 | "endprimitive" "endspecify" "endtable" "endtask" "event" |
| 5039 | "for" "force" "forever" "fork" "function" |
| 5040 | "highz0" "highz1" "if" "initial" "inout" "input" "integer" "join" "large" |
| 5041 | "macromodule" "makefile" "medium" "module" |
| 5042 | "nand" "negedge" "nmos" "nor" "not" "notif0" "notif1" "or" "output" |
| 5043 | "parameter" "pmos" "posedge" "primitive" "pull0" "pull1" "pulldown" |
| 5044 | "pullup" |
| 5045 | "rcmos" "real" "realtime" "reg" "release" "repeat" "rnmos" "rpmos" "rtran" |
| 5046 | "rtranif0" "rtranif1" |
| 5047 | "scalared" "signed" "small" "specify" "specparam" "strength" "strong0" |
| 5048 | "strong1" "supply" "supply0" "supply1" |
| 5049 | "table" "task" "time" "tran" "tranif0" "tranif1" "tri" "tri0" "tri1" |
| 5050 | "triand" "trior" "trireg" |
| 5051 | "vectored" "wait" "wand" "weak0" "weak1" "while" "wire" "wor" "xnor" "xor" |
| 5052 | ) |
| 5053 | "List of Verilog keywords as candidate for additional reserved words.") |
| 5054 | |
| 5055 | (defconst vhdl-02-types |
| 5056 | '( |
| 5057 | "boolean" "bit" "bit_vector" "character" "severity_level" "integer" |
| 5058 | "real" "time" "natural" "positive" "string" "line" "text" "side" |
| 5059 | "unsigned" "signed" "delay_length" "file_open_kind" "file_open_status" |
| 5060 | "std_logic" "std_logic_vector" |
| 5061 | "std_ulogic" "std_ulogic_vector" |
| 5062 | ) |
| 5063 | "List of VHDL'02 standardized types.") |
| 5064 | |
| 5065 | (defconst vhdl-ams-types |
| 5066 | ;; standards: IEEE Std 1076.1-2007, IEEE Std 1076.1.1-2004 |
| 5067 | '( |
| 5068 | ;; package `standard' |
| 5069 | "domain_type" "real_vector" |
| 5070 | ;; package `energy_systems' |
| 5071 | "energy" "power" "periodicity" "real_across" "real_through" "unspecified" |
| 5072 | "unspecified_vector" "energy_vector" "power_vector" "periodicity_vector" |
| 5073 | "real_across_vector" "real_through_vector" |
| 5074 | ;; package `electrical_systems' |
| 5075 | "voltage" "current" "charge" "resistance" "conductance" "capacitance" |
| 5076 | "mmf" "electric_flux" "electric_flux_density" "electric_field_strength" |
| 5077 | "magnetic_flux" "magnetic_flux_density" "magnetic_field_strength" |
| 5078 | "inductance" "reluctance" "electrical" "electrical_vector" "magnetic" |
| 5079 | "magnetic_vector" "voltage_vector" "current_vector" "mmf_vector" |
| 5080 | "magnetic_flux_vector" "charge_vector" "resistance_vector" |
| 5081 | "conductance_vector" "capacitance_vector" "electric_flux_vector" |
| 5082 | "electric_flux_density_vector" "electric_field_strength_vector" |
| 5083 | "magnetic_flux_density_vector" "magnetic_field_strength_vector" |
| 5084 | "inductance_vector" "reluctance_vector" "ground" |
| 5085 | ;; package `mechanical_systems' |
| 5086 | "displacement" "force" "velocity" "acceleration" "mass" "stiffness" |
| 5087 | "damping" "momentum" "angle" "torque" "angular_velocity" |
| 5088 | "angular_acceleration" "moment_inertia" "angular_momentum" |
| 5089 | "angular_stiffness" "angular_damping" "translational" |
| 5090 | "translational_vector" "translational_velocity" |
| 5091 | "translational_velocity_vector" "rotational" "rotational_vector" |
| 5092 | "rotational_velocity" "rotational_velocity_vector" "displacement_vector" |
| 5093 | "force_vector" "velocity_vector" "force_velocity_vector" "angle_vector" |
| 5094 | "torque_vector" "angular_velocity_vector" "torque_velocity_vector" |
| 5095 | "acceleration_vector" "mass_vector" "stiffness_vector" "damping_vector" |
| 5096 | "momentum_vector" "angular_acceleration_vector" "moment_inertia_vector" |
| 5097 | "angular_momentum_vector" "angular_stiffness_vector" |
| 5098 | "angular_damping_vector" "anchor" "translational_v_ref" |
| 5099 | "rotational_v_ref" "translational_v" "rotational_v" |
| 5100 | ;; package `radiant_systems' |
| 5101 | "illuminance" "luminous_flux" "luminous_intensity" "irradiance" "radiant" |
| 5102 | "radiant_vector" "luminous_intensity_vector" "luminous_flux_vector" |
| 5103 | "illuminance_vector" "irradiance_vector" |
| 5104 | ;; package `thermal_systems' |
| 5105 | "temperature" "heat_flow" "thermal_capacitance" "thermal_resistance" |
| 5106 | "thermal_conductance" "thermal" "thermal_vector" "temperature_vector" |
| 5107 | "heat_flow_vector" "thermal_capacitance_vector" |
| 5108 | "thermal_resistance_vector" "thermal_conductance_vector" |
| 5109 | ;; package `fluidic_systems' |
| 5110 | "pressure" "vflow_rate" "mass_flow_rate" "volume" "density" "viscosity" |
| 5111 | "fresistance" "fconductance" "fcapacitance" "inertance" "cfresistance" |
| 5112 | "cfcapacitance" "cfinertance" "cfconductance" "fluidic" "fluidic_vector" |
| 5113 | "compressible_fluidic" "compressible_fluidic_vector" "pressure_vector" |
| 5114 | "vflow_rate_vector" "mass_flow_rate_vector" "volume_vector" |
| 5115 | "density_vector" "viscosity_vector" "fresistance_vector" |
| 5116 | "fconductance_vector" "fcapacitance_vector" "inertance_vector" |
| 5117 | "cfresistance_vector" "cfconductance_vector" "cfcapacitance_vector" |
| 5118 | "cfinertance_vector" |
| 5119 | ) |
| 5120 | "List of VHDL-AMS standardized types.") |
| 5121 | |
| 5122 | (defconst vhdl-math-types |
| 5123 | '( |
| 5124 | "complex" "complex_polar" "positive_real" "principal_value" |
| 5125 | ) |
| 5126 | "List of Math Packages standardized types.") |
| 5127 | |
| 5128 | (defconst vhdl-02-attributes |
| 5129 | '( |
| 5130 | "base" "left" "right" "high" "low" "pos" "val" "succ" |
| 5131 | "pred" "leftof" "rightof" "range" "reverse_range" |
| 5132 | "length" "delayed" "stable" "quiet" "transaction" |
| 5133 | "event" "active" "last_event" "last_active" "last_value" |
| 5134 | "driving" "driving_value" "ascending" "value" "image" |
| 5135 | "simple_name" "instance_name" "path_name" |
| 5136 | "foreign" |
| 5137 | ) |
| 5138 | "List of VHDL'02 standardized attributes.") |
| 5139 | |
| 5140 | (defconst vhdl-ams-attributes |
| 5141 | '( |
| 5142 | "across" "through" |
| 5143 | "reference" "contribution" "tolerance" |
| 5144 | "dot" "integ" "delayed" "above" "zoh" "ltf" "ztf" |
| 5145 | "ramp" "slew" |
| 5146 | ) |
| 5147 | "List of VHDL-AMS standardized attributes.") |
| 5148 | |
| 5149 | (defconst vhdl-02-enum-values |
| 5150 | '( |
| 5151 | "true" "false" |
| 5152 | "note" "warning" "error" "failure" |
| 5153 | "read_mode" "write_mode" "append_mode" |
| 5154 | "open_ok" "status_error" "name_error" "mode_error" |
| 5155 | "fs" "ps" "ns" "us" "ms" "sec" "min" "hr" |
| 5156 | "right" "left" |
| 5157 | ) |
| 5158 | "List of VHDL'02 standardized enumeration values.") |
| 5159 | |
| 5160 | (defconst vhdl-ams-enum-values |
| 5161 | '( |
| 5162 | "quiescent_domain" "time_domain" "frequency_domain" |
| 5163 | ;; from `nature_pkg' package |
| 5164 | "eps0" "mu0" "ground" "mecvf_gnd" "mecpf_gnd" "rot_gnd" "fld_gnd" |
| 5165 | ) |
| 5166 | "List of VHDL-AMS standardized enumeration values.") |
| 5167 | |
| 5168 | (defconst vhdl-ams-constants |
| 5169 | ;; standard: IEEE Std 1076.1.1-2004 |
| 5170 | '( |
| 5171 | ;; package `fundamental_constants' |
| 5172 | "phys_q" "phys_eps0" "phys_mu0" "phys_k" "phys_gravity" "phys_ctok" |
| 5173 | "phys_c" "phys_h" "phys_h_over_2_pi" "yocto" "zepto" "atto" "femto" |
| 5174 | "pico" "nano" "micro" "milli" "centi" "deci" "deka" "hecto" "kilo" "mega" |
| 5175 | "giga" "tera" "peta" "exa" "zetta" "yotta" "deca" |
| 5176 | ;; package `material_constants' |
| 5177 | "phys_eps_si" "phys_eps_sio2" "phys_e_si" "phys_e_sio2" "phys_e_poly" |
| 5178 | "phys_nu_si" "phys_nu_poly" "phys_rho_poly" "phys_rho_sio2" |
| 5179 | "ambient_temperature" "ambient_pressure" "ambient_illuminance" |
| 5180 | ) |
| 5181 | "List of VHDL-AMS standardized constants.") |
| 5182 | |
| 5183 | (defconst vhdl-math-constants |
| 5184 | ;; standard: IEEE Std 1076.2-1996 |
| 5185 | '( |
| 5186 | "math_1_over_e" "math_1_over_pi" "math_1_over_sqrt_2" "math_2_pi" |
| 5187 | "math_3_pi_over_2" "math_cbase_1" "math_cbase_j" "math_czero" |
| 5188 | "math_deg_to_rad" "math_e" "math_log10_of_e" "math_log2_of_e" |
| 5189 | "math_log_of_10" "math_log_of_2" "math_pi" "math_pi_over_2" |
| 5190 | "math_pi_over_3" "math_pi_over_4" "math_rad_to_deg" "math_sqrt_2" |
| 5191 | "math_sqrt_pi" |
| 5192 | ) |
| 5193 | "List of Math Packages standardized constants.") |
| 5194 | |
| 5195 | (defconst vhdl-02-functions |
| 5196 | '( |
| 5197 | "now" "resolved" "rising_edge" "falling_edge" |
| 5198 | "read" "readline" "hread" "oread" "write" "writeline" "hwrite" "owrite" |
| 5199 | "endfile" |
| 5200 | "resize" "is_X" "std_match" |
| 5201 | "shift_left" "shift_right" "rotate_left" "rotate_right" |
| 5202 | "to_unsigned" "to_signed" "to_integer" |
| 5203 | "to_stdLogicVector" "to_stdULogic" "to_stdULogicVector" |
| 5204 | "to_bit" "to_bitVector" "to_X01" "to_X01Z" "to_UX01" "to_01" |
| 5205 | "conv_unsigned" "conv_signed" "conv_integer" "conv_std_logic_vector" |
| 5206 | "shl" "shr" "ext" "sxt" |
| 5207 | "deallocate" |
| 5208 | ) |
| 5209 | "List of VHDL'02 standardized functions.") |
| 5210 | |
| 5211 | (defconst vhdl-ams-functions |
| 5212 | '( |
| 5213 | ;; package `standard' |
| 5214 | "frequency" |
| 5215 | ) |
| 5216 | "List of VHDL-AMS standardized functions.") |
| 5217 | |
| 5218 | (defconst vhdl-math-functions |
| 5219 | ;; standard: IEEE Std 1076.2-1996 |
| 5220 | '( |
| 5221 | "arccos" "arccosh" "arcsin" "arcsinh" "arctan" "arctanh" "arg" |
| 5222 | "cbrt" "ceil" "cmplx" "complex_to_polar" "conj" "cos" "cosh" "exp" |
| 5223 | "floor" "get_principal_value" "log" "log10" "log2" "polar_to_complex" |
| 5224 | "realmax" "realmin" "round" "sign" "sin" "sinh" "sqrt" |
| 5225 | "tan" "tanh" "trunc" "uniform" |
| 5226 | ) |
| 5227 | "List of Math Packages standardized functions.") |
| 5228 | |
| 5229 | (defconst vhdl-02-packages |
| 5230 | '( |
| 5231 | "std_logic_1164" "numeric_std" "numeric_bit" |
| 5232 | "standard" "textio" |
| 5233 | "std_logic_arith" "std_logic_signed" "std_logic_unsigned" |
| 5234 | "std_logic_misc" "std_logic_textio" |
| 5235 | "ieee" "std" "work" |
| 5236 | ) |
| 5237 | "List of VHDL'02 standardized packages and libraries.") |
| 5238 | |
| 5239 | (defconst vhdl-ams-packages |
| 5240 | '( |
| 5241 | "fundamental_constants" "material_constants" "energy_systems" |
| 5242 | "electrical_systems" "mechanical_systems" "radiant_systems" |
| 5243 | "thermal_systems" "fluidic_systems" |
| 5244 | ) |
| 5245 | "List of VHDL-AMS standardized packages and libraries.") |
| 5246 | |
| 5247 | (defconst vhdl-math-packages |
| 5248 | '( |
| 5249 | "math_real" "math_complex" |
| 5250 | ) |
| 5251 | "List of Math Packages standardized packages and libraries.") |
| 5252 | |
| 5253 | (defvar vhdl-keywords nil |
| 5254 | "List of VHDL keywords.") |
| 5255 | |
| 5256 | (defvar vhdl-types nil |
| 5257 | "List of VHDL standardized types.") |
| 5258 | |
| 5259 | (defvar vhdl-attributes nil |
| 5260 | "List of VHDL standardized attributes.") |
| 5261 | |
| 5262 | (defvar vhdl-enum-values nil |
| 5263 | "List of VHDL standardized enumeration values.") |
| 5264 | |
| 5265 | (defvar vhdl-constants nil |
| 5266 | "List of VHDL standardized constants.") |
| 5267 | |
| 5268 | (defvar vhdl-functions nil |
| 5269 | "List of VHDL standardized functions.") |
| 5270 | |
| 5271 | (defvar vhdl-packages nil |
| 5272 | "List of VHDL standardized packages and libraries.") |
| 5273 | |
| 5274 | (defvar vhdl-reserved-words nil |
| 5275 | "List of additional reserved words.") |
| 5276 | |
| 5277 | (defvar vhdl-keywords-regexp nil |
| 5278 | "Regexp for VHDL keywords.") |
| 5279 | |
| 5280 | (defvar vhdl-types-regexp nil |
| 5281 | "Regexp for VHDL standardized types.") |
| 5282 | |
| 5283 | (defvar vhdl-attributes-regexp nil |
| 5284 | "Regexp for VHDL standardized attributes.") |
| 5285 | |
| 5286 | (defvar vhdl-enum-values-regexp nil |
| 5287 | "Regexp for VHDL standardized enumeration values.") |
| 5288 | |
| 5289 | (defvar vhdl-constants-regexp nil |
| 5290 | "Regexp for VHDL standardized constants.") |
| 5291 | |
| 5292 | (defvar vhdl-functions-regexp nil |
| 5293 | "Regexp for VHDL standardized functions.") |
| 5294 | |
| 5295 | (defvar vhdl-packages-regexp nil |
| 5296 | "Regexp for VHDL standardized packages and libraries.") |
| 5297 | |
| 5298 | (defvar vhdl-reserved-words-regexp nil |
| 5299 | "Regexp for additional reserved words.") |
| 5300 | |
| 5301 | (defvar vhdl-directive-keywords-regexp nil |
| 5302 | "Regexp for compiler directive keywords.") |
| 5303 | |
| 5304 | (defun vhdl-upcase-list (condition list) |
| 5305 | "Upcase all elements in LIST based on CONDITION." |
| 5306 | (when condition |
| 5307 | (let ((tmp-list list)) |
| 5308 | (while tmp-list |
| 5309 | (setcar tmp-list (upcase (car tmp-list))) |
| 5310 | (setq tmp-list (cdr tmp-list))))) |
| 5311 | list) |
| 5312 | |
| 5313 | (defun vhdl-words-init () |
| 5314 | "Initialize reserved words." |
| 5315 | (setq vhdl-keywords |
| 5316 | (vhdl-upcase-list |
| 5317 | (and vhdl-highlight-case-sensitive vhdl-upper-case-keywords) |
| 5318 | (append vhdl-02-keywords |
| 5319 | (when (vhdl-standard-p 'ams) vhdl-ams-keywords)))) |
| 5320 | (setq vhdl-types |
| 5321 | (vhdl-upcase-list |
| 5322 | (and vhdl-highlight-case-sensitive vhdl-upper-case-types) |
| 5323 | (append vhdl-02-types |
| 5324 | (when (vhdl-standard-p 'ams) vhdl-ams-types) |
| 5325 | (when (vhdl-standard-p 'math) vhdl-math-types)))) |
| 5326 | (setq vhdl-attributes |
| 5327 | (vhdl-upcase-list |
| 5328 | (and vhdl-highlight-case-sensitive vhdl-upper-case-attributes) |
| 5329 | (append vhdl-02-attributes |
| 5330 | (when (vhdl-standard-p 'ams) vhdl-ams-attributes)))) |
| 5331 | (setq vhdl-enum-values |
| 5332 | (vhdl-upcase-list |
| 5333 | (and vhdl-highlight-case-sensitive vhdl-upper-case-enum-values) |
| 5334 | (append vhdl-02-enum-values |
| 5335 | (when (vhdl-standard-p 'ams) vhdl-ams-enum-values)))) |
| 5336 | (setq vhdl-constants |
| 5337 | (vhdl-upcase-list |
| 5338 | (and vhdl-highlight-case-sensitive vhdl-upper-case-constants) |
| 5339 | (append (when (vhdl-standard-p 'ams) vhdl-ams-constants) |
| 5340 | (when (vhdl-standard-p 'math) vhdl-math-constants) |
| 5341 | '("")))) |
| 5342 | (setq vhdl-functions |
| 5343 | (append vhdl-02-functions |
| 5344 | (when (vhdl-standard-p 'ams) vhdl-ams-functions) |
| 5345 | (when (vhdl-standard-p 'math) vhdl-math-functions))) |
| 5346 | (setq vhdl-packages |
| 5347 | (append vhdl-02-packages |
| 5348 | (when (vhdl-standard-p 'ams) vhdl-ams-packages) |
| 5349 | (when (vhdl-standard-p 'math) vhdl-math-packages))) |
| 5350 | (setq vhdl-reserved-words |
| 5351 | (append (when vhdl-highlight-forbidden-words vhdl-forbidden-words) |
| 5352 | (when vhdl-highlight-verilog-keywords vhdl-verilog-keywords) |
| 5353 | '(""))) |
| 5354 | (setq vhdl-keywords-regexp |
| 5355 | (concat "\\<\\(" (regexp-opt vhdl-keywords) "\\)\\>")) |
| 5356 | (setq vhdl-types-regexp |
| 5357 | (concat "\\<\\(" (regexp-opt vhdl-types) "\\)\\>")) |
| 5358 | (setq vhdl-attributes-regexp |
| 5359 | (concat "\\<\\(" (regexp-opt vhdl-attributes) "\\)\\>")) |
| 5360 | (setq vhdl-enum-values-regexp |
| 5361 | (concat "\\<\\(" (regexp-opt vhdl-enum-values) "\\)\\>")) |
| 5362 | (setq vhdl-constants-regexp |
| 5363 | (concat "\\<\\(" (regexp-opt vhdl-constants) "\\)\\>")) |
| 5364 | (setq vhdl-functions-regexp |
| 5365 | (concat "\\<\\(" (regexp-opt vhdl-functions) "\\)\\>")) |
| 5366 | (setq vhdl-packages-regexp |
| 5367 | (concat "\\<\\(" (regexp-opt vhdl-packages) "\\)\\>")) |
| 5368 | (setq vhdl-reserved-words-regexp |
| 5369 | (concat "\\<\\(" |
| 5370 | (unless (equal vhdl-forbidden-syntax "") |
| 5371 | (concat vhdl-forbidden-syntax "\\|")) |
| 5372 | (regexp-opt vhdl-reserved-words) |
| 5373 | "\\)\\>")) |
| 5374 | (setq vhdl-directive-keywords-regexp |
| 5375 | (concat "\\<\\(" (mapconcat 'regexp-quote |
| 5376 | vhdl-directive-keywords "\\|") "\\)\\>")) |
| 5377 | (vhdl-abbrev-list-init)) |
| 5378 | |
| 5379 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5380 | ;; Words to expand |
| 5381 | |
| 5382 | (defvar vhdl-abbrev-list nil |
| 5383 | "Predefined abbreviations for VHDL.") |
| 5384 | |
| 5385 | (defun vhdl-abbrev-list-init () |
| 5386 | (setq vhdl-abbrev-list |
| 5387 | (append |
| 5388 | (list vhdl-upper-case-keywords) vhdl-keywords |
| 5389 | (list vhdl-upper-case-types) vhdl-types |
| 5390 | (list vhdl-upper-case-attributes) vhdl-attributes |
| 5391 | (list vhdl-upper-case-enum-values) vhdl-enum-values |
| 5392 | (list vhdl-upper-case-constants) vhdl-constants |
| 5393 | (list nil) vhdl-functions |
| 5394 | (list nil) vhdl-packages))) |
| 5395 | |
| 5396 | ;; initialize reserved words for VHDL Mode |
| 5397 | (vhdl-words-init) |
| 5398 | |
| 5399 | |
| 5400 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5401 | ;;; Indentation |
| 5402 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5403 | |
| 5404 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5405 | ;; Syntax analysis |
| 5406 | |
| 5407 | ;; constant regular expressions for looking at various constructs |
| 5408 | |
| 5409 | (defconst vhdl-symbol-key "\\(\\w\\|\\s_\\)+" |
| 5410 | "Regexp describing a VHDL symbol. |
| 5411 | We cannot use just `word' syntax class since `_' cannot be in word |
| 5412 | class. Putting underscore in word class breaks forward word movement |
| 5413 | behavior that users are familiar with.") |
| 5414 | |
| 5415 | (defconst vhdl-case-header-key "case[( \t\n\r\f][^;=>]+[) \t\n\r\f]is" |
| 5416 | "Regexp describing a case statement header key.") |
| 5417 | |
| 5418 | (defconst vhdl-label-key |
| 5419 | (concat "\\(" vhdl-symbol-key "\\s-*:\\)[^=]") |
| 5420 | "Regexp describing a VHDL label.") |
| 5421 | |
| 5422 | ;; Macro definitions: |
| 5423 | |
| 5424 | (defmacro vhdl-point (position) |
| 5425 | "Return the value of point at certain commonly referenced POSITIONs. |
| 5426 | POSITION can be one of the following symbols: |
| 5427 | |
| 5428 | bol -- beginning of line |
| 5429 | eol -- end of line |
| 5430 | bod -- beginning of defun |
| 5431 | boi -- back to indentation |
| 5432 | eoi -- last whitespace on line |
| 5433 | ionl -- indentation of next line |
| 5434 | iopl -- indentation of previous line |
| 5435 | bonl -- beginning of next line |
| 5436 | bopl -- beginning of previous line |
| 5437 | |
| 5438 | This function does not modify point or mark." |
| 5439 | (or (and (eq 'quote (car-safe position)) |
| 5440 | (null (cddr position))) |
| 5441 | (error "ERROR: Bad buffer position requested: %s" position)) |
| 5442 | (setq position (nth 1 position)) |
| 5443 | `(let ((here (point))) |
| 5444 | ,@(cond |
| 5445 | ((eq position 'bol) '((beginning-of-line))) |
| 5446 | ((eq position 'eol) '((end-of-line))) |
| 5447 | ((eq position 'bod) '((save-match-data |
| 5448 | (vhdl-beginning-of-defun)))) |
| 5449 | ((eq position 'boi) '((back-to-indentation))) |
| 5450 | ((eq position 'eoi) '((end-of-line) (skip-chars-backward " \t"))) |
| 5451 | ((eq position 'bonl) '((forward-line 1))) |
| 5452 | ((eq position 'bopl) '((forward-line -1))) |
| 5453 | ((eq position 'iopl) |
| 5454 | '((forward-line -1) |
| 5455 | (back-to-indentation))) |
| 5456 | ((eq position 'ionl) |
| 5457 | '((forward-line 1) |
| 5458 | (back-to-indentation))) |
| 5459 | (t (error "ERROR: Unknown buffer position requested: %s" position)) |
| 5460 | ) |
| 5461 | (prog1 |
| 5462 | (point) |
| 5463 | (goto-char here)) |
| 5464 | ;; workaround for an Emacs18 bug -- blech! Well, at least it |
| 5465 | ;; doesn't hurt for v19 |
| 5466 | ,@nil |
| 5467 | )) |
| 5468 | |
| 5469 | (defmacro vhdl-safe (&rest body) |
| 5470 | "Safely execute BODY, return nil if an error occurred." |
| 5471 | `(condition-case nil |
| 5472 | (progn ,@body) |
| 5473 | (error nil))) |
| 5474 | |
| 5475 | (defmacro vhdl-add-syntax (symbol &optional relpos) |
| 5476 | "A simple macro to append the syntax in SYMBOL to the syntax list. |
| 5477 | Try to increase performance by using this macro." |
| 5478 | `(setq vhdl-syntactic-context |
| 5479 | (cons (cons ,symbol ,relpos) vhdl-syntactic-context))) |
| 5480 | |
| 5481 | (defmacro vhdl-has-syntax (symbol) |
| 5482 | "A simple macro to return check the syntax list. |
| 5483 | Try to increase performance by using this macro." |
| 5484 | `(assoc ,symbol vhdl-syntactic-context)) |
| 5485 | |
| 5486 | ;; Syntactic element offset manipulation: |
| 5487 | |
| 5488 | (defun vhdl-read-offset (langelem) |
| 5489 | "Read new offset value for LANGELEM from minibuffer. |
| 5490 | Return a valid value only." |
| 5491 | (let ((oldoff (format "%s" (cdr-safe (assq langelem vhdl-offsets-alist)))) |
| 5492 | (errmsg "Offset must be int, func, var, or one of +, -, ++, --: ") |
| 5493 | (prompt "Offset: ") |
| 5494 | offset input interned) |
| 5495 | (while (not offset) |
| 5496 | (setq input (read-string prompt oldoff) |
| 5497 | offset (cond ((string-equal "+" input) '+) |
| 5498 | ((string-equal "-" input) '-) |
| 5499 | ((string-equal "++" input) '++) |
| 5500 | ((string-equal "--" input) '--) |
| 5501 | ((string-match "^-?[0-9]+$" input) |
| 5502 | (string-to-number input)) |
| 5503 | ((fboundp (setq interned (intern input))) |
| 5504 | interned) |
| 5505 | ((boundp interned) interned) |
| 5506 | ;; error, but don't signal one, keep trying |
| 5507 | ;; to read an input value |
| 5508 | (t (ding) |
| 5509 | (setq prompt errmsg) |
| 5510 | nil)))) |
| 5511 | offset)) |
| 5512 | |
| 5513 | (defun vhdl-set-offset (symbol offset &optional add-p) |
| 5514 | "Change the value of a syntactic element symbol in `vhdl-offsets-alist'. |
| 5515 | SYMBOL is the syntactic element symbol to change and OFFSET is the new |
| 5516 | offset for that syntactic element. Optional ADD-P says to add SYMBOL to |
| 5517 | `vhdl-offsets-alist' if it doesn't already appear there." |
| 5518 | (interactive |
| 5519 | (let* ((langelem |
| 5520 | (intern (completing-read |
| 5521 | (concat "Syntactic symbol to change" |
| 5522 | (if current-prefix-arg " or add" "") |
| 5523 | ": ") |
| 5524 | (mapcar |
| 5525 | (function |
| 5526 | (lambda (langelem) |
| 5527 | (cons (format "%s" (car langelem)) nil))) |
| 5528 | vhdl-offsets-alist) |
| 5529 | nil (not current-prefix-arg) |
| 5530 | ;; initial contents tries to be the last element |
| 5531 | ;; on the syntactic analysis list for the current |
| 5532 | ;; line |
| 5533 | (let* ((syntax (vhdl-get-syntactic-context)) |
| 5534 | (len (length syntax)) |
| 5535 | (ic (format "%s" (car (nth (1- len) syntax))))) |
| 5536 | ic) |
| 5537 | ))) |
| 5538 | (offset (vhdl-read-offset langelem))) |
| 5539 | (list langelem offset current-prefix-arg))) |
| 5540 | ;; sanity check offset |
| 5541 | (or (eq offset '+) |
| 5542 | (eq offset '-) |
| 5543 | (eq offset '++) |
| 5544 | (eq offset '--) |
| 5545 | (integerp offset) |
| 5546 | (fboundp offset) |
| 5547 | (boundp offset) |
| 5548 | (error "ERROR: Offset must be int, func, var, or one of +, -, ++, --: %s" |
| 5549 | offset)) |
| 5550 | (let ((entry (assq symbol vhdl-offsets-alist))) |
| 5551 | (if entry |
| 5552 | (setcdr entry offset) |
| 5553 | (if add-p |
| 5554 | (setq vhdl-offsets-alist |
| 5555 | (cons (cons symbol offset) vhdl-offsets-alist)) |
| 5556 | (error "ERROR: %s is not a valid syntactic symbol" symbol)))) |
| 5557 | (vhdl-keep-region-active)) |
| 5558 | |
| 5559 | (defun vhdl-set-style (style &optional local) |
| 5560 | "Set `vhdl-mode' variables to use one of several different indentation styles. |
| 5561 | STYLE is a string representing the desired style and optional LOCAL is |
| 5562 | a flag which, if non-nil, means to make the style variables being |
| 5563 | changed buffer local, instead of the default, which is to set the |
| 5564 | global variables. Interactively, the flag comes from the prefix |
| 5565 | argument. The styles are chosen from the `vhdl-style-alist' variable." |
| 5566 | (interactive (list (completing-read "Use which VHDL indentation style? " |
| 5567 | vhdl-style-alist nil t) |
| 5568 | current-prefix-arg)) |
| 5569 | (let ((vars (cdr (assoc style vhdl-style-alist)))) |
| 5570 | (or vars |
| 5571 | (error "ERROR: Invalid VHDL indentation style `%s'" style)) |
| 5572 | ;; set all the variables |
| 5573 | (mapc |
| 5574 | (function |
| 5575 | (lambda (varentry) |
| 5576 | (let ((var (car varentry)) |
| 5577 | (val (cdr varentry))) |
| 5578 | ;; special case for vhdl-offsets-alist |
| 5579 | (if (not (eq var 'vhdl-offsets-alist)) |
| 5580 | (set (if local (make-local-variable var) var) val) |
| 5581 | ;; reset vhdl-offsets-alist to the default value first |
| 5582 | (set (if local (make-local-variable var) var) |
| 5583 | (copy-alist vhdl-offsets-alist-default)) |
| 5584 | ;; now set the langelems that are different |
| 5585 | (mapcar |
| 5586 | (function |
| 5587 | (lambda (langentry) |
| 5588 | (let ((langelem (car langentry)) |
| 5589 | (offset (cdr langentry))) |
| 5590 | (vhdl-set-offset langelem offset) |
| 5591 | ))) |
| 5592 | val)) |
| 5593 | ))) |
| 5594 | vars)) |
| 5595 | (vhdl-keep-region-active)) |
| 5596 | |
| 5597 | (defun vhdl-get-offset (langelem) |
| 5598 | "Get offset from LANGELEM which is a cons cell of the form: |
| 5599 | \(SYMBOL . RELPOS). The symbol is matched against |
| 5600 | vhdl-offsets-alist and the offset found there is either returned, |
| 5601 | or added to the indentation at RELPOS. If RELPOS is nil, then |
| 5602 | the offset is simply returned." |
| 5603 | (let* ((symbol (car langelem)) |
| 5604 | (relpos (cdr langelem)) |
| 5605 | (match (assq symbol vhdl-offsets-alist)) |
| 5606 | (offset (cdr-safe match))) |
| 5607 | ;; offset can be a number, a function, a variable, or one of the |
| 5608 | ;; symbols + or - |
| 5609 | (cond |
| 5610 | ((not match) |
| 5611 | (if vhdl-strict-syntax-p |
| 5612 | (error "ERROR: Don't know how to indent a %s" symbol) |
| 5613 | (setq offset 0 |
| 5614 | relpos 0))) |
| 5615 | ((eq offset '+) (setq offset vhdl-basic-offset)) |
| 5616 | ((eq offset '-) (setq offset (- vhdl-basic-offset))) |
| 5617 | ((eq offset '++) (setq offset (* 2 vhdl-basic-offset))) |
| 5618 | ((eq offset '--) (setq offset (* 2 (- vhdl-basic-offset)))) |
| 5619 | ((and (not (numberp offset)) |
| 5620 | (fboundp offset)) |
| 5621 | (setq offset (funcall offset langelem))) |
| 5622 | ((not (numberp offset)) |
| 5623 | (setq offset (eval offset))) |
| 5624 | ) |
| 5625 | (+ (if (and relpos |
| 5626 | (< relpos (vhdl-point 'bol))) |
| 5627 | (save-excursion |
| 5628 | (goto-char relpos) |
| 5629 | (current-column)) |
| 5630 | 0) |
| 5631 | offset))) |
| 5632 | |
| 5633 | ;; Syntactic support functions: |
| 5634 | |
| 5635 | (defun vhdl-in-comment-p () |
| 5636 | "Check if point is in a comment." |
| 5637 | (eq (vhdl-in-literal) 'comment)) |
| 5638 | |
| 5639 | (defun vhdl-in-string-p () |
| 5640 | "Check if point is in a string." |
| 5641 | (eq (vhdl-in-literal) 'string)) |
| 5642 | |
| 5643 | (defun vhdl-in-quote-p () |
| 5644 | "Check if point is in a quote ('x')." |
| 5645 | (or (and (> (point) (point-min)) |
| 5646 | (< (1+ (point)) (point-max)) |
| 5647 | (= (char-before (point)) ?\') |
| 5648 | (= (char-after (1+ (point))) ?\')) |
| 5649 | (and (> (1- (point)) (point-min)) |
| 5650 | (< (point) (point-max)) |
| 5651 | (= (char-before (1- (point))) ?\') |
| 5652 | (= (char-after (point)) ?\')))) |
| 5653 | |
| 5654 | (defun vhdl-in-literal () |
| 5655 | "Determine if point is in a VHDL literal." |
| 5656 | (save-excursion |
| 5657 | (let ((state (parse-partial-sexp (vhdl-point 'bol) (point)))) |
| 5658 | (cond |
| 5659 | ((nth 3 state) 'string) |
| 5660 | ((nth 4 state) 'comment) |
| 5661 | ((vhdl-beginning-of-macro) 'pound) |
| 5662 | (t nil))))) |
| 5663 | |
| 5664 | (defun vhdl-in-extended-identifier-p () |
| 5665 | "Determine if point is inside extended identifier (delimited by '\')." |
| 5666 | (save-match-data |
| 5667 | (and (save-excursion (re-search-backward "\\\\" (vhdl-point 'bol) t)) |
| 5668 | (save-excursion (re-search-forward "\\\\" (vhdl-point 'eol) t))))) |
| 5669 | |
| 5670 | (defun vhdl-forward-comment (&optional direction) |
| 5671 | "Skip all comments (including whitespace). Skip backwards if DIRECTION is |
| 5672 | negative, skip forward otherwise." |
| 5673 | (interactive "p") |
| 5674 | (if (and direction (< direction 0)) |
| 5675 | ;; skip backwards |
| 5676 | (progn |
| 5677 | (skip-chars-backward " \t\n\r\f") |
| 5678 | (while (re-search-backward "^[^\"-]*\\(\\(-?\"[^\"]*\"\\|-[^\"-]\\)[^\"-]*\\)*\\(--\\)" (vhdl-point 'bol) t) |
| 5679 | (goto-char (match-beginning 3)) |
| 5680 | (skip-chars-backward " \t\n\r\f"))) |
| 5681 | ;; skip forwards |
| 5682 | (skip-chars-forward " \t\n\r\f") |
| 5683 | (while (looking-at "--.*") |
| 5684 | (goto-char (match-end 0)) |
| 5685 | (skip-chars-forward " \t\n\r\f")))) |
| 5686 | |
| 5687 | ;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+ |
| 5688 | (unless (and (featurep 'xemacs) (string< "21.2" emacs-version)) |
| 5689 | (defalias 'vhdl-forward-comment 'forward-comment)) |
| 5690 | |
| 5691 | (defun vhdl-back-to-indentation () |
| 5692 | "Move point to the first non-whitespace character on this line." |
| 5693 | (interactive) |
| 5694 | (beginning-of-line 1) |
| 5695 | (skip-syntax-forward " " (vhdl-point 'eol))) |
| 5696 | |
| 5697 | ;; XEmacs hack: work around old `back-to-indentation' in XEmacs |
| 5698 | (when (featurep 'xemacs) |
| 5699 | (defalias 'back-to-indentation 'vhdl-back-to-indentation)) |
| 5700 | |
| 5701 | ;; This is the best we can do in Win-Emacs. |
| 5702 | (defun vhdl-win-il (&optional lim) |
| 5703 | "Determine if point is in a VHDL literal." |
| 5704 | (save-excursion |
| 5705 | (let* ((here (point)) |
| 5706 | (state nil) |
| 5707 | (match nil) |
| 5708 | (lim (or lim (vhdl-point 'bod)))) |
| 5709 | (goto-char lim ) |
| 5710 | (while (< (point) here) |
| 5711 | (setq match |
| 5712 | (and (re-search-forward "--\\|[\"']" |
| 5713 | here 'move) |
| 5714 | (buffer-substring (match-beginning 0) (match-end 0)))) |
| 5715 | (setq state |
| 5716 | (cond |
| 5717 | ;; no match |
| 5718 | ((null match) nil) |
| 5719 | ;; looking at the opening of a VHDL style comment |
| 5720 | ((string= "--" match) |
| 5721 | (if (<= here (progn (end-of-line) (point))) 'comment)) |
| 5722 | ;; looking at the opening of a double quote string |
| 5723 | ((string= "\"" match) |
| 5724 | (if (not (save-restriction |
| 5725 | ;; this seems to be necessary since the |
| 5726 | ;; re-search-forward will not work without it |
| 5727 | (narrow-to-region (point) here) |
| 5728 | (re-search-forward |
| 5729 | ;; this regexp matches a double quote |
| 5730 | ;; which is preceded by an even number |
| 5731 | ;; of backslashes, including zero |
| 5732 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)*\"" here 'move))) |
| 5733 | 'string)) |
| 5734 | ;; looking at the opening of a single quote string |
| 5735 | ((string= "'" match) |
| 5736 | (if (not (save-restriction |
| 5737 | ;; see comments from above |
| 5738 | (narrow-to-region (point) here) |
| 5739 | (re-search-forward |
| 5740 | ;; this matches a single quote which is |
| 5741 | ;; preceded by zero or two backslashes. |
| 5742 | "\\([^\\]\\|^\\)\\(\\\\\\\\\\)?'" |
| 5743 | here 'move))) |
| 5744 | 'string)) |
| 5745 | (t nil))) |
| 5746 | ) ; end-while |
| 5747 | state))) |
| 5748 | |
| 5749 | (and (string-match "Win-Emacs" emacs-version) |
| 5750 | (fset 'vhdl-in-literal 'vhdl-win-il)) |
| 5751 | |
| 5752 | ;; Skipping of "syntactic whitespace". Syntactic whitespace is |
| 5753 | ;; defined as lexical whitespace or comments. Search no farther back |
| 5754 | ;; or forward than optional LIM. If LIM is omitted, (point-min) is |
| 5755 | ;; used for backward skipping, (point-max) is used for forward |
| 5756 | ;; skipping. |
| 5757 | |
| 5758 | (defun vhdl-forward-syntactic-ws (&optional lim) |
| 5759 | "Forward skip of syntactic whitespace." |
| 5760 | (let* ((here (point-max)) |
| 5761 | (hugenum (point-max))) |
| 5762 | (while (/= here (point)) |
| 5763 | (setq here (point)) |
| 5764 | (vhdl-forward-comment hugenum) |
| 5765 | ;; skip preprocessor directives |
| 5766 | (when (and (eq (char-after) ?#) |
| 5767 | (= (vhdl-point 'boi) (point))) |
| 5768 | (while (and (eq (char-before (vhdl-point 'eol)) ?\\) |
| 5769 | (= (forward-line 1) 0))) |
| 5770 | (end-of-line))) |
| 5771 | (if lim (goto-char (min (point) lim))))) |
| 5772 | |
| 5773 | |
| 5774 | ;; This is the best we can do in Win-Emacs. |
| 5775 | (defun vhdl-win-fsws (&optional lim) |
| 5776 | "Forward skip syntactic whitespace for Win-Emacs." |
| 5777 | (let ((lim (or lim (point-max))) |
| 5778 | stop) |
| 5779 | (while (not stop) |
| 5780 | (skip-chars-forward " \t\n\r\f" lim) |
| 5781 | (cond |
| 5782 | ;; vhdl comment |
| 5783 | ((looking-at "--") (end-of-line)) |
| 5784 | ;; none of the above |
| 5785 | (t (setq stop t)))))) |
| 5786 | |
| 5787 | (and (string-match "Win-Emacs" emacs-version) |
| 5788 | (fset 'vhdl-forward-syntactic-ws 'vhdl-win-fsws)) |
| 5789 | |
| 5790 | (defun vhdl-beginning-of-macro (&optional lim) |
| 5791 | "Go to the beginning of a cpp macro definition (nicked from `cc-engine')." |
| 5792 | (let ((here (point))) |
| 5793 | (beginning-of-line) |
| 5794 | (while (eq (char-before (1- (point))) ?\\) |
| 5795 | (forward-line -1)) |
| 5796 | (back-to-indentation) |
| 5797 | (if (and (<= (point) here) |
| 5798 | (eq (char-after) ?#)) |
| 5799 | t |
| 5800 | (goto-char here) |
| 5801 | nil))) |
| 5802 | |
| 5803 | (defun vhdl-backward-syntactic-ws (&optional lim) |
| 5804 | "Backward skip over syntactic whitespace." |
| 5805 | (let* ((here (point-min)) |
| 5806 | (hugenum (- (point-max)))) |
| 5807 | (while (/= here (point)) |
| 5808 | (setq here (point)) |
| 5809 | (vhdl-forward-comment hugenum) |
| 5810 | (vhdl-beginning-of-macro)) |
| 5811 | (if lim (goto-char (max (point) lim))))) |
| 5812 | |
| 5813 | ;; This is the best we can do in Win-Emacs. |
| 5814 | (defun vhdl-win-bsws (&optional lim) |
| 5815 | "Backward skip syntactic whitespace for Win-Emacs." |
| 5816 | (let ((lim (or lim (vhdl-point 'bod))) |
| 5817 | stop) |
| 5818 | (while (not stop) |
| 5819 | (skip-chars-backward " \t\n\r\f" lim) |
| 5820 | (cond |
| 5821 | ;; vhdl comment |
| 5822 | ((eq (vhdl-in-literal) 'comment) |
| 5823 | (skip-chars-backward "^-" lim) |
| 5824 | (skip-chars-backward "-" lim) |
| 5825 | (while (not (or (and (= (following-char) ?-) |
| 5826 | (= (char-after (1+ (point))) ?-)) |
| 5827 | (<= (point) lim))) |
| 5828 | (skip-chars-backward "^-" lim) |
| 5829 | (skip-chars-backward "-" lim))) |
| 5830 | ;; none of the above |
| 5831 | (t (setq stop t)))))) |
| 5832 | |
| 5833 | (and (string-match "Win-Emacs" emacs-version) |
| 5834 | (fset 'vhdl-backward-syntactic-ws 'vhdl-win-bsws)) |
| 5835 | |
| 5836 | ;; Functions to help finding the correct indentation column: |
| 5837 | |
| 5838 | (defun vhdl-first-word (point) |
| 5839 | "If the keyword at POINT is at boi, then return (current-column) at |
| 5840 | that point, else nil." |
| 5841 | (save-excursion |
| 5842 | (and (goto-char point) |
| 5843 | (eq (point) (vhdl-point 'boi)) |
| 5844 | (current-column)))) |
| 5845 | |
| 5846 | (defun vhdl-last-word (point) |
| 5847 | "If the keyword at POINT is at eoi, then return (current-column) at |
| 5848 | that point, else nil." |
| 5849 | (save-excursion |
| 5850 | (and (goto-char point) |
| 5851 | (save-excursion (or (eq (progn (forward-sexp) (point)) |
| 5852 | (vhdl-point 'eoi)) |
| 5853 | (looking-at "\\s-*\\(--\\)?"))) |
| 5854 | (current-column)))) |
| 5855 | |
| 5856 | ;; Core syntactic evaluation functions: |
| 5857 | |
| 5858 | (defconst vhdl-libunit-re |
| 5859 | "\\b\\(architecture\\|configuration\\|entity\\|package\\)\\b[^_]") |
| 5860 | |
| 5861 | (defun vhdl-libunit-p () |
| 5862 | (and |
| 5863 | (save-excursion |
| 5864 | (forward-sexp) |
| 5865 | (skip-chars-forward " \t\n\r\f") |
| 5866 | (not (looking-at "is\\b[^_]"))) |
| 5867 | (save-excursion |
| 5868 | (backward-sexp) |
| 5869 | (and (not (looking-at "use\\b[^_]")) |
| 5870 | (progn |
| 5871 | (forward-sexp) |
| 5872 | (vhdl-forward-syntactic-ws) |
| 5873 | (/= (following-char) ?:)))) |
| 5874 | )) |
| 5875 | |
| 5876 | (defconst vhdl-defun-re |
| 5877 | "\\b\\(architecture\\|block\\|configuration\\|entity\\|package\\|process\\|procedural\\|procedure\\|function\\)\\b[^_]") |
| 5878 | |
| 5879 | (defun vhdl-defun-p () |
| 5880 | (save-excursion |
| 5881 | (if (looking-at "block\\|process\\|procedural") |
| 5882 | ;; "block", "process", "procedural": |
| 5883 | (save-excursion |
| 5884 | (backward-sexp) |
| 5885 | (not (looking-at "end\\s-+\\w"))) |
| 5886 | ;; "architecture", "configuration", "entity", |
| 5887 | ;; "package", "procedure", "function": |
| 5888 | t))) |
| 5889 | |
| 5890 | (defun vhdl-corresponding-defun () |
| 5891 | "If the word at the current position corresponds to a \"defun\" |
| 5892 | keyword, then return a string that can be used to find the |
| 5893 | corresponding \"begin\" keyword, else return nil." |
| 5894 | (save-excursion |
| 5895 | (and (looking-at vhdl-defun-re) |
| 5896 | (vhdl-defun-p) |
| 5897 | (if (looking-at "block\\|process\\|procedural") |
| 5898 | ;; "block", "process". "procedural: |
| 5899 | (buffer-substring (match-beginning 0) (match-end 0)) |
| 5900 | ;; "architecture", "configuration", "entity", "package", |
| 5901 | ;; "procedure", "function": |
| 5902 | "is")))) |
| 5903 | |
| 5904 | (defconst vhdl-begin-fwd-re |
| 5905 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b\\([^_]\\|\\'\\)" |
| 5906 | "A regular expression for searching forward that matches all known |
| 5907 | \"begin\" keywords.") |
| 5908 | |
| 5909 | (defconst vhdl-begin-bwd-re |
| 5910 | "\\b\\(is\\|begin\\|block\\|component\\|generate\\|then\\|else\\|loop\\|process\\|procedural\\(\\s-+body\\)?\\|units\\|use\\|record\\|protected\\(\\s-+body\\)?\\|for\\)\\b[^_]" |
| 5911 | "A regular expression for searching backward that matches all known |
| 5912 | \"begin\" keywords.") |
| 5913 | |
| 5914 | (defun vhdl-begin-p (&optional lim) |
| 5915 | "Return t if we are looking at a real \"begin\" keyword. |
| 5916 | Assumes that the caller will make sure that we are looking at |
| 5917 | vhdl-begin-fwd-re, and are not inside a literal, and that we are not in |
| 5918 | the middle of an identifier that just happens to contain a \"begin\" |
| 5919 | keyword." |
| 5920 | (cond |
| 5921 | ;; "[architecture|case|configuration|entity|package| |
| 5922 | ;; procedure|function] ... is": |
| 5923 | ((and (looking-at "i") |
| 5924 | (save-excursion |
| 5925 | ;; Skip backward over first sexp (needed to skip over a |
| 5926 | ;; procedure interface list, and is harmless in other |
| 5927 | ;; situations). Note that we need "return" in the |
| 5928 | ;; following search list so that we don't run into |
| 5929 | ;; semicolons in the function interface list. |
| 5930 | (backward-sexp) |
| 5931 | (let (foundp) |
| 5932 | (while (and (not foundp) |
| 5933 | (re-search-backward |
| 5934 | ";\\|\\b\\(architecture\\|case\\|configuration\\|entity\\|package\\|procedure\\|return\\|is\\|begin\\|process\\|procedural\\|block\\)\\b[^_]" |
| 5935 | lim 'move)) |
| 5936 | (if (or (= (preceding-char) ?_) |
| 5937 | (vhdl-in-literal)) |
| 5938 | (backward-char) |
| 5939 | (setq foundp t)))) |
| 5940 | (and (/= (following-char) ?\;) |
| 5941 | (not (looking-at "is\\|begin\\|process\\|procedural\\|block"))))) |
| 5942 | t) |
| 5943 | ;; "begin", "then", "use": |
| 5944 | ((looking-at "be\\|t\\|use") |
| 5945 | t) |
| 5946 | ;; "else": |
| 5947 | ((and (looking-at "e") |
| 5948 | ;; make sure that the "else" isn't inside a |
| 5949 | ;; conditional signal assignment. |
| 5950 | (save-excursion |
| 5951 | (vhdl-re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) |
| 5952 | (or (eq (following-char) ?\;) |
| 5953 | (eq (point) lim)))) |
| 5954 | t) |
| 5955 | ;; "block", "generate", "loop", "process", "procedural", |
| 5956 | ;; "units", "record", "protected body": |
| 5957 | ((and (looking-at "block\\|generate\\|loop\\|process\\|procedural\\|protected\\(\\s-+body\\)?\\|units\\|record") |
| 5958 | (save-excursion |
| 5959 | (backward-sexp) |
| 5960 | (not (looking-at "end\\s-+\\w")))) |
| 5961 | t) |
| 5962 | ;; "component": |
| 5963 | ((and (looking-at "c") |
| 5964 | (save-excursion |
| 5965 | (backward-sexp) |
| 5966 | (not (looking-at "end\\s-+\\w"))) |
| 5967 | ;; look out for the dreaded entity class in an attribute |
| 5968 | (save-excursion |
| 5969 | (vhdl-backward-syntactic-ws lim) |
| 5970 | (/= (preceding-char) ?:))) |
| 5971 | t) |
| 5972 | ;; "for" (inside configuration declaration): |
| 5973 | ((and (looking-at "f") |
| 5974 | (save-excursion |
| 5975 | (backward-sexp) |
| 5976 | (not (looking-at "end\\s-+\\w"))) |
| 5977 | (vhdl-has-syntax 'configuration)) |
| 5978 | t) |
| 5979 | )) |
| 5980 | |
| 5981 | (defun vhdl-corresponding-mid (&optional lim) |
| 5982 | (cond |
| 5983 | ((looking-at "is\\|block\\|generate\\|process\\|procedural") |
| 5984 | "begin") |
| 5985 | ((looking-at "then\\|use") |
| 5986 | "<else>") |
| 5987 | (t |
| 5988 | "end"))) |
| 5989 | |
| 5990 | (defun vhdl-corresponding-end (&optional lim) |
| 5991 | "If the word at the current position corresponds to a \"begin\" |
| 5992 | keyword, then return a vector containing enough information to find |
| 5993 | the corresponding \"end\" keyword, else return nil. The keyword to |
| 5994 | search forward for is aref 0. The column in which the keyword must |
| 5995 | appear is aref 1 or nil if any column is suitable. |
| 5996 | Assumes that the caller will make sure that we are not in the middle |
| 5997 | of an identifier that just happens to contain a \"begin\" keyword." |
| 5998 | (save-excursion |
| 5999 | (and (looking-at vhdl-begin-fwd-re) |
| 6000 | (or (not (looking-at "\\<use\\>")) |
| 6001 | (save-excursion (back-to-indentation) |
| 6002 | (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) |
| 6003 | (/= (preceding-char) ?_) |
| 6004 | (not (vhdl-in-literal)) |
| 6005 | (vhdl-begin-p lim) |
| 6006 | (cond |
| 6007 | ;; "is", "generate", "loop": |
| 6008 | ((looking-at "[igl]") |
| 6009 | (vector "end" |
| 6010 | (and (vhdl-last-word (point)) |
| 6011 | (or (vhdl-first-word (point)) |
| 6012 | (save-excursion |
| 6013 | (vhdl-beginning-of-statement-1 lim) |
| 6014 | (vhdl-backward-skip-label lim) |
| 6015 | (vhdl-first-word (point))))))) |
| 6016 | ;; "begin", "else", "for": |
| 6017 | ((looking-at "be\\|[ef]") |
| 6018 | (vector "end" |
| 6019 | (and (vhdl-last-word (point)) |
| 6020 | (or (vhdl-first-word (point)) |
| 6021 | (save-excursion |
| 6022 | (vhdl-beginning-of-statement-1 lim) |
| 6023 | (vhdl-backward-skip-label lim) |
| 6024 | (vhdl-first-word (point))))))) |
| 6025 | ;; "component", "units", "record", "protected body": |
| 6026 | ((looking-at "component\\|units\\|protected\\(\\s-+body\\)?\\|record") |
| 6027 | ;; The first end found will close the block |
| 6028 | (vector "end" nil)) |
| 6029 | ;; "block", "process", "procedural": |
| 6030 | ((looking-at "bl\\|p") |
| 6031 | (vector "end" |
| 6032 | (or (vhdl-first-word (point)) |
| 6033 | (save-excursion |
| 6034 | (vhdl-beginning-of-statement-1 lim) |
| 6035 | (vhdl-backward-skip-label lim) |
| 6036 | (vhdl-first-word (point)))))) |
| 6037 | ;; "then": |
| 6038 | ((looking-at "t\\|use") |
| 6039 | (vector "elsif\\|else\\|end\\s-+\\(if\\|use\\)" |
| 6040 | (and (vhdl-last-word (point)) |
| 6041 | (or (vhdl-first-word (point)) |
| 6042 | (save-excursion |
| 6043 | (vhdl-beginning-of-statement-1 lim) |
| 6044 | (vhdl-backward-skip-label lim) |
| 6045 | (vhdl-first-word (point))))))) |
| 6046 | )))) |
| 6047 | |
| 6048 | (defconst vhdl-end-fwd-re "\\b\\(end\\|else\\|elsif\\)\\b\\([^_]\\|\\'\\)") |
| 6049 | |
| 6050 | (defconst vhdl-end-bwd-re "\\b\\(end\\|else\\|elsif\\)\\b[^_]") |
| 6051 | |
| 6052 | (defun vhdl-end-p (&optional lim) |
| 6053 | "Return t if we are looking at a real \"end\" keyword. |
| 6054 | Assumes that the caller will make sure that we are looking at |
| 6055 | vhdl-end-fwd-re, and are not inside a literal, and that we are not in |
| 6056 | the middle of an identifier that just happens to contain an \"end\" |
| 6057 | keyword." |
| 6058 | (or (not (looking-at "else")) |
| 6059 | ;; make sure that the "else" isn't inside a conditional signal |
| 6060 | ;; assignment. |
| 6061 | (save-excursion |
| 6062 | (re-search-backward ";\\|\\bwhen\\b[^_]" lim 'move) |
| 6063 | (or (eq (following-char) ?\;) |
| 6064 | (eq (point) lim) |
| 6065 | (vhdl-in-literal))))) |
| 6066 | |
| 6067 | (defun vhdl-corresponding-begin (&optional lim) |
| 6068 | "If the word at the current position corresponds to an \"end\" |
| 6069 | keyword, then return a vector containing enough information to find |
| 6070 | the corresponding \"begin\" keyword, else return nil. The keyword to |
| 6071 | search backward for is aref 0. The column in which the keyword must |
| 6072 | appear is aref 1 or nil if any column is suitable. The supplementary |
| 6073 | keyword to search forward for is aref 2 or nil if this is not |
| 6074 | required. If aref 3 is t, then the \"begin\" keyword may be found in |
| 6075 | the middle of a statement. |
| 6076 | Assumes that the caller will make sure that we are not in the middle |
| 6077 | of an identifier that just happens to contain an \"end\" keyword." |
| 6078 | (save-excursion |
| 6079 | (let (pos) |
| 6080 | (if (and (looking-at vhdl-end-fwd-re) |
| 6081 | (not (vhdl-in-literal)) |
| 6082 | (vhdl-end-p lim)) |
| 6083 | (if (looking-at "el") |
| 6084 | ;; "else", "elsif": |
| 6085 | (vector "if\\|elsif" (vhdl-first-word (point)) "then\\|use" nil) |
| 6086 | ;; "end ...": |
| 6087 | (setq pos (point)) |
| 6088 | (forward-sexp) |
| 6089 | (skip-chars-forward " \t\n\r\f") |
| 6090 | (cond |
| 6091 | ;; "end if": |
| 6092 | ((looking-at "if\\b[^_]") |
| 6093 | (vector "else\\|elsif\\|if" |
| 6094 | (vhdl-first-word pos) |
| 6095 | "else\\|then\\|use" nil)) |
| 6096 | ;; "end component": |
| 6097 | ((looking-at "component\\b[^_]") |
| 6098 | (vector (buffer-substring (match-beginning 1) |
| 6099 | (match-end 1)) |
| 6100 | (vhdl-first-word pos) |
| 6101 | nil nil)) |
| 6102 | ;; "end units", "end record", "end protected": |
| 6103 | ((looking-at "\\(units\\|record\\|protected\\(\\s-+body\\)?\\)\\b[^_]") |
| 6104 | (vector (buffer-substring (match-beginning 1) |
| 6105 | (match-end 1)) |
| 6106 | (vhdl-first-word pos) |
| 6107 | nil t)) |
| 6108 | ;; "end block", "end process", "end procedural": |
| 6109 | ((looking-at "\\(block\\|process\\|procedural\\)\\b[^_]") |
| 6110 | (vector "begin" (vhdl-first-word pos) nil nil)) |
| 6111 | ;; "end case": |
| 6112 | ((looking-at "case\\b[^_]") |
| 6113 | (vector "case" (vhdl-first-word pos) "is" nil)) |
| 6114 | ;; "end generate": |
| 6115 | ((looking-at "generate\\b[^_]") |
| 6116 | (vector "generate\\|for\\|if" |
| 6117 | (vhdl-first-word pos) |
| 6118 | "generate" nil)) |
| 6119 | ;; "end loop": |
| 6120 | ((looking-at "loop\\b[^_]") |
| 6121 | (vector "loop\\|while\\|for" |
| 6122 | (vhdl-first-word pos) |
| 6123 | "loop" nil)) |
| 6124 | ;; "end for" (inside configuration declaration): |
| 6125 | ((looking-at "for\\b[^_]") |
| 6126 | (vector "for" (vhdl-first-word pos) nil nil)) |
| 6127 | ;; "end [id]": |
| 6128 | (t |
| 6129 | (vector "begin\\|architecture\\|configuration\\|entity\\|package\\|procedure\\|function" |
| 6130 | (vhdl-first-word pos) |
| 6131 | ;; return an alist of (statement . keyword) mappings |
| 6132 | '( |
| 6133 | ;; "begin ... end [id]": |
| 6134 | ("begin" . nil) |
| 6135 | ;; "architecture ... is ... begin ... end [id]": |
| 6136 | ("architecture" . "is") |
| 6137 | ;; "configuration ... is ... end [id]": |
| 6138 | ("configuration" . "is") |
| 6139 | ;; "entity ... is ... end [id]": |
| 6140 | ("entity" . "is") |
| 6141 | ;; "package ... is ... end [id]": |
| 6142 | ("package" . "is") |
| 6143 | ;; "procedure ... is ... begin ... end [id]": |
| 6144 | ("procedure" . "is") |
| 6145 | ;; "function ... is ... begin ... end [id]": |
| 6146 | ("function" . "is") |
| 6147 | ) |
| 6148 | nil)) |
| 6149 | ))) ; "end ..." |
| 6150 | ))) |
| 6151 | |
| 6152 | (defconst vhdl-leader-re |
| 6153 | "\\b\\(block\\|component\\|process\\|procedural\\|for\\)\\b[^_]") |
| 6154 | |
| 6155 | (defun vhdl-end-of-leader () |
| 6156 | (save-excursion |
| 6157 | (cond ((looking-at "block\\|process\\|procedural") |
| 6158 | (if (save-excursion |
| 6159 | (forward-sexp) |
| 6160 | (skip-chars-forward " \t\n\r\f") |
| 6161 | (= (following-char) ?\()) |
| 6162 | (forward-sexp 2) |
| 6163 | (forward-sexp)) |
| 6164 | (when (looking-at "[ \t\n\r\f]*is") |
| 6165 | (goto-char (match-end 0))) |
| 6166 | (point)) |
| 6167 | ((looking-at "component") |
| 6168 | (forward-sexp 2) |
| 6169 | (when (looking-at "[ \t\n\r\f]*is") |
| 6170 | (goto-char (match-end 0))) |
| 6171 | (point)) |
| 6172 | ((looking-at "for") |
| 6173 | (forward-sexp 2) |
| 6174 | (skip-chars-forward " \t\n\r\f") |
| 6175 | (while (looking-at "[,:(]") |
| 6176 | (forward-sexp) |
| 6177 | (skip-chars-forward " \t\n\r\f")) |
| 6178 | (point)) |
| 6179 | (t nil) |
| 6180 | ))) |
| 6181 | |
| 6182 | (defconst vhdl-trailer-re |
| 6183 | "\\b\\(is\\|then\\|generate\\|loop\\|record\\|protected\\(\\s-+body\\)?\\|use\\)\\b[^_]") |
| 6184 | |
| 6185 | (defconst vhdl-statement-fwd-re |
| 6186 | "\\b\\(if\\|for\\|while\\|loop\\)\\b\\([^_]\\|\\'\\)" |
| 6187 | "A regular expression for searching forward that matches all known |
| 6188 | \"statement\" keywords.") |
| 6189 | |
| 6190 | (defconst vhdl-statement-bwd-re |
| 6191 | "\\b\\(if\\|for\\|while\\|loop\\)\\b[^_]" |
| 6192 | "A regular expression for searching backward that matches all known |
| 6193 | \"statement\" keywords.") |
| 6194 | |
| 6195 | (defun vhdl-statement-p (&optional lim) |
| 6196 | "Return t if we are looking at a real \"statement\" keyword. |
| 6197 | Assumes that the caller will make sure that we are looking at |
| 6198 | vhdl-statement-fwd-re, and are not inside a literal, and that we are not |
| 6199 | in the middle of an identifier that just happens to contain a |
| 6200 | \"statement\" keyword." |
| 6201 | (cond |
| 6202 | ;; "for" ... "generate": |
| 6203 | ((and (looking-at "f") |
| 6204 | ;; Make sure it's the start of a parameter specification. |
| 6205 | (save-excursion |
| 6206 | (forward-sexp 2) |
| 6207 | (skip-chars-forward " \t\n\r\f") |
| 6208 | (looking-at "in\\b[^_]")) |
| 6209 | ;; Make sure it's not an "end for". |
| 6210 | (save-excursion |
| 6211 | (backward-sexp) |
| 6212 | (not (looking-at "end\\s-+\\w")))) |
| 6213 | t) |
| 6214 | ;; "if" ... "then", "if" ... "generate", "if" ... "loop": |
| 6215 | ((and (looking-at "i") |
| 6216 | ;; Make sure it's not an "end if". |
| 6217 | (save-excursion |
| 6218 | (backward-sexp) |
| 6219 | (not (looking-at "end\\s-+\\w")))) |
| 6220 | t) |
| 6221 | ;; "while" ... "loop": |
| 6222 | ((looking-at "w") |
| 6223 | t) |
| 6224 | )) |
| 6225 | |
| 6226 | (defconst vhdl-case-alternative-re "when[( \t\n\r\f][^;=>]+=>" |
| 6227 | "Regexp describing a case statement alternative key.") |
| 6228 | |
| 6229 | (defun vhdl-case-alternative-p (&optional lim) |
| 6230 | "Return t if we are looking at a real case alternative. |
| 6231 | Assumes that the caller will make sure that we are looking at |
| 6232 | vhdl-case-alternative-re, and are not inside a literal, and that |
| 6233 | we are not in the middle of an identifier that just happens to |
| 6234 | contain a \"when\" keyword." |
| 6235 | (save-excursion |
| 6236 | (let (foundp) |
| 6237 | (while (and (not foundp) |
| 6238 | (re-search-backward ";\\|<=" lim 'move)) |
| 6239 | (if (or (= (preceding-char) ?_) |
| 6240 | (vhdl-in-literal)) |
| 6241 | (backward-char) |
| 6242 | (setq foundp t))) |
| 6243 | (or (eq (following-char) ?\;) |
| 6244 | (eq (point) lim))) |
| 6245 | )) |
| 6246 | |
| 6247 | ;; Core syntactic movement functions: |
| 6248 | |
| 6249 | (defconst vhdl-b-t-b-re |
| 6250 | (concat vhdl-begin-bwd-re "\\|" vhdl-end-bwd-re)) |
| 6251 | |
| 6252 | (defun vhdl-backward-to-block (&optional lim) |
| 6253 | "Move backward to the previous \"begin\" or \"end\" keyword." |
| 6254 | (let (foundp) |
| 6255 | (while (and (not foundp) |
| 6256 | (re-search-backward vhdl-b-t-b-re lim 'move)) |
| 6257 | (if (or (= (preceding-char) ?_) |
| 6258 | (vhdl-in-literal)) |
| 6259 | (backward-char) |
| 6260 | (cond |
| 6261 | ;; "begin" keyword: |
| 6262 | ((and (looking-at vhdl-begin-fwd-re) |
| 6263 | (or (not (looking-at "\\<use\\>")) |
| 6264 | (save-excursion (back-to-indentation) |
| 6265 | (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) |
| 6266 | (/= (preceding-char) ?_) |
| 6267 | (vhdl-begin-p lim)) |
| 6268 | (setq foundp 'begin)) |
| 6269 | ;; "end" keyword: |
| 6270 | ((and (looking-at vhdl-end-fwd-re) |
| 6271 | (/= (preceding-char) ?_) |
| 6272 | (vhdl-end-p lim)) |
| 6273 | (setq foundp 'end)) |
| 6274 | )) |
| 6275 | ) |
| 6276 | foundp |
| 6277 | )) |
| 6278 | |
| 6279 | (defun vhdl-forward-sexp (&optional count lim) |
| 6280 | "Move forward across one balanced expression (sexp). |
| 6281 | With COUNT, do it that many times." |
| 6282 | (interactive "p") |
| 6283 | (let ((count (or count 1)) |
| 6284 | (case-fold-search t) |
| 6285 | end-vec target) |
| 6286 | (save-excursion |
| 6287 | (while (> count 0) |
| 6288 | ;; skip whitespace |
| 6289 | (skip-chars-forward " \t\n\r\f") |
| 6290 | ;; Check for an unbalanced "end" keyword |
| 6291 | (if (and (looking-at vhdl-end-fwd-re) |
| 6292 | (/= (preceding-char) ?_) |
| 6293 | (not (vhdl-in-literal)) |
| 6294 | (vhdl-end-p lim) |
| 6295 | (not (looking-at "else"))) |
| 6296 | (error |
| 6297 | "ERROR: Containing expression ends prematurely in vhdl-forward-sexp")) |
| 6298 | ;; If the current keyword is a "begin" keyword, then find the |
| 6299 | ;; corresponding "end" keyword. |
| 6300 | (if (setq end-vec (vhdl-corresponding-end lim)) |
| 6301 | (let ( |
| 6302 | ;; end-re is the statement keyword to search for |
| 6303 | (end-re |
| 6304 | (concat "\\b\\(" (aref end-vec 0) "\\)\\b\\([^_]\\|\\'\\)")) |
| 6305 | ;; column is either the statement keyword target column |
| 6306 | ;; or nil |
| 6307 | (column (aref end-vec 1)) |
| 6308 | (eol (vhdl-point 'eol)) |
| 6309 | foundp literal placeholder) |
| 6310 | ;; Look for the statement keyword. |
| 6311 | (while (and (not foundp) |
| 6312 | (re-search-forward end-re nil t) |
| 6313 | (setq placeholder (match-end 1)) |
| 6314 | (goto-char (match-beginning 0))) |
| 6315 | ;; If we are in a literal, or not in the right target |
| 6316 | ;; column and not on the same line as the begin, then |
| 6317 | ;; try again. |
| 6318 | (if (or (and column |
| 6319 | (/= (current-indentation) column) |
| 6320 | (> (point) eol)) |
| 6321 | (= (preceding-char) ?_) |
| 6322 | (setq literal (vhdl-in-literal))) |
| 6323 | (if (eq literal 'comment) |
| 6324 | (end-of-line) |
| 6325 | (forward-char)) |
| 6326 | ;; An "else" keyword corresponds to both the opening brace |
| 6327 | ;; of the following sexp and the closing brace of the |
| 6328 | ;; previous sexp. |
| 6329 | (if (not (looking-at "else")) |
| 6330 | (goto-char placeholder)) |
| 6331 | (setq foundp t)) |
| 6332 | ) |
| 6333 | (if (not foundp) |
| 6334 | (error "ERROR: Unbalanced keywords in vhdl-forward-sexp")) |
| 6335 | ) |
| 6336 | ;; If the current keyword is not a "begin" keyword, then just |
| 6337 | ;; perform the normal forward-sexp. |
| 6338 | (forward-sexp) |
| 6339 | ) |
| 6340 | (setq count (1- count)) |
| 6341 | ) |
| 6342 | (setq target (point))) |
| 6343 | (goto-char target) |
| 6344 | nil)) |
| 6345 | |
| 6346 | (defun vhdl-backward-sexp (&optional count lim) |
| 6347 | "Move backward across one balanced expression (sexp). |
| 6348 | With COUNT, do it that many times. LIM bounds any required backward |
| 6349 | searches." |
| 6350 | (interactive "p") |
| 6351 | (let ((count (or count 1)) |
| 6352 | (case-fold-search t) |
| 6353 | begin-vec target) |
| 6354 | (save-excursion |
| 6355 | (while (> count 0) |
| 6356 | ;; Perform the normal backward-sexp, unless we are looking at |
| 6357 | ;; "else" - an "else" keyword corresponds to both the opening brace |
| 6358 | ;; of the following sexp and the closing brace of the previous sexp. |
| 6359 | (if (and (looking-at "else\\b\\([^_]\\|\\'\\)") |
| 6360 | (/= (preceding-char) ?_) |
| 6361 | (not (vhdl-in-literal))) |
| 6362 | nil |
| 6363 | (backward-sexp) |
| 6364 | (if (and (looking-at vhdl-begin-fwd-re) |
| 6365 | (or (not (looking-at "\\<use\\>")) |
| 6366 | (save-excursion |
| 6367 | (back-to-indentation) |
| 6368 | (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) |
| 6369 | (/= (preceding-char) ?_) |
| 6370 | (not (vhdl-in-literal)) |
| 6371 | (vhdl-begin-p lim)) |
| 6372 | (error "ERROR: Containing expression ends prematurely in vhdl-backward-sexp"))) |
| 6373 | ;; If the current keyword is an "end" keyword, then find the |
| 6374 | ;; corresponding "begin" keyword. |
| 6375 | (if (and (setq begin-vec (vhdl-corresponding-begin lim)) |
| 6376 | (/= (preceding-char) ?_)) |
| 6377 | (let ( |
| 6378 | ;; begin-re is the statement keyword to search for |
| 6379 | (begin-re |
| 6380 | (concat "\\b\\(" (aref begin-vec 0) "\\)\\b[^_]")) |
| 6381 | ;; column is either the statement keyword target column |
| 6382 | ;; or nil |
| 6383 | (column (aref begin-vec 1)) |
| 6384 | ;; internal-p controls where the statement keyword can |
| 6385 | ;; be found. |
| 6386 | (internal-p (aref begin-vec 3)) |
| 6387 | (last-backward (point)) last-forward |
| 6388 | foundp literal keyword) |
| 6389 | ;; Look for the statement keyword. |
| 6390 | (while (and (not foundp) |
| 6391 | (re-search-backward begin-re lim t) |
| 6392 | (setq keyword |
| 6393 | (buffer-substring (match-beginning 1) |
| 6394 | (match-end 1)))) |
| 6395 | ;; If we are in a literal or in the wrong column, |
| 6396 | ;; then try again. |
| 6397 | (if (or (and column |
| 6398 | (and (/= (current-indentation) column) |
| 6399 | ;; possibly accept current-column as |
| 6400 | ;; well as current-indentation. |
| 6401 | (or (not internal-p) |
| 6402 | (/= (current-column) column)))) |
| 6403 | (= (preceding-char) ?_) |
| 6404 | (vhdl-in-literal)) |
| 6405 | (backward-char) |
| 6406 | ;; If there is a supplementary keyword, then |
| 6407 | ;; search forward for it. |
| 6408 | (if (and (setq begin-re (aref begin-vec 2)) |
| 6409 | (or (not (listp begin-re)) |
| 6410 | ;; If begin-re is an alist, then find the |
| 6411 | ;; element corresponding to the actual |
| 6412 | ;; keyword that we found. |
| 6413 | (progn |
| 6414 | (setq begin-re |
| 6415 | (assoc keyword begin-re)) |
| 6416 | (and begin-re |
| 6417 | (setq begin-re (cdr begin-re)))))) |
| 6418 | (and |
| 6419 | (setq begin-re |
| 6420 | (concat "\\b\\(" begin-re "\\)\\b[^_]")) |
| 6421 | (save-excursion |
| 6422 | (setq last-forward (point)) |
| 6423 | ;; Look for the supplementary keyword |
| 6424 | ;; (bounded by the backward search start |
| 6425 | ;; point). |
| 6426 | (while (and (not foundp) |
| 6427 | (re-search-forward begin-re |
| 6428 | last-backward t) |
| 6429 | (goto-char (match-beginning 1))) |
| 6430 | ;; If we are in a literal, then try again. |
| 6431 | (if (or (= (preceding-char) ?_) |
| 6432 | (setq literal |
| 6433 | (vhdl-in-literal))) |
| 6434 | (if (eq literal 'comment) |
| 6435 | (goto-char |
| 6436 | (min (vhdl-point 'eol) last-backward)) |
| 6437 | (forward-char)) |
| 6438 | ;; We have found the supplementary keyword. |
| 6439 | ;; Save the position of the keyword in foundp. |
| 6440 | (setq foundp (point))) |
| 6441 | ) |
| 6442 | foundp) |
| 6443 | ;; If the supplementary keyword was found, then |
| 6444 | ;; move point to the supplementary keyword. |
| 6445 | (goto-char foundp)) |
| 6446 | ;; If there was no supplementary keyword, then |
| 6447 | ;; point is already at the statement keyword. |
| 6448 | (setq foundp t))) |
| 6449 | ) ; end of the search for the statement keyword |
| 6450 | (if (not foundp) |
| 6451 | (error "ERROR: Unbalanced keywords in vhdl-backward-sexp")) |
| 6452 | )) |
| 6453 | (setq count (1- count)) |
| 6454 | ) |
| 6455 | (setq target (point))) |
| 6456 | (goto-char target) |
| 6457 | nil)) |
| 6458 | |
| 6459 | (defun vhdl-backward-up-list (&optional count limit) |
| 6460 | "Move backward out of one level of blocks. |
| 6461 | With argument, do this that many times." |
| 6462 | (interactive "p") |
| 6463 | (let ((count (or count 1)) |
| 6464 | target) |
| 6465 | (save-excursion |
| 6466 | (while (> count 0) |
| 6467 | (if (looking-at vhdl-defun-re) |
| 6468 | (error "ERROR: Unbalanced blocks")) |
| 6469 | (vhdl-backward-to-block limit) |
| 6470 | (setq count (1- count))) |
| 6471 | (setq target (point))) |
| 6472 | (goto-char target))) |
| 6473 | |
| 6474 | (defun vhdl-end-of-defun (&optional count) |
| 6475 | "Move forward to the end of a VHDL defun." |
| 6476 | (interactive) |
| 6477 | (let ((case-fold-search t)) |
| 6478 | (vhdl-beginning-of-defun) |
| 6479 | (if (not (looking-at "block\\|process\\|procedural")) |
| 6480 | (re-search-forward "\\bis\\b")) |
| 6481 | (vhdl-forward-sexp))) |
| 6482 | |
| 6483 | (defun vhdl-mark-defun () |
| 6484 | "Put mark at end of this \"defun\", point at beginning." |
| 6485 | (interactive) |
| 6486 | (let ((case-fold-search t)) |
| 6487 | (push-mark) |
| 6488 | (vhdl-beginning-of-defun) |
| 6489 | (push-mark) |
| 6490 | (if (not (looking-at "block\\|process\\|procedural")) |
| 6491 | (re-search-forward "\\bis\\b")) |
| 6492 | (vhdl-forward-sexp) |
| 6493 | (exchange-point-and-mark))) |
| 6494 | |
| 6495 | (defun vhdl-beginning-of-libunit () |
| 6496 | "Move backward to the beginning of a VHDL library unit. |
| 6497 | Returns the location of the corresponding begin keyword, unless search |
| 6498 | stops due to beginning or end of buffer. |
| 6499 | Note that if point is between the \"libunit\" keyword and the |
| 6500 | corresponding \"begin\" keyword, then that libunit will not be |
| 6501 | recognized, and the search will continue backwards. If point is |
| 6502 | at the \"begin\" keyword, then the defun will be recognized. The |
| 6503 | returned point is at the first character of the \"libunit\" keyword." |
| 6504 | (let ((last-forward (point)) |
| 6505 | (last-backward |
| 6506 | ;; Just in case we are actually sitting on the "begin" |
| 6507 | ;; keyword, allow for the keyword and an extra character, |
| 6508 | ;; as this will be used when looking forward for the |
| 6509 | ;; "begin" keyword. |
| 6510 | (save-excursion (forward-word 1) (1+ (point)))) |
| 6511 | foundp literal placeholder) |
| 6512 | ;; Find the "libunit" keyword. |
| 6513 | (while (and (not foundp) |
| 6514 | (re-search-backward vhdl-libunit-re nil 'move)) |
| 6515 | ;; If we are in a literal, or not at a real libunit, then try again. |
| 6516 | (if (or (= (preceding-char) ?_) |
| 6517 | (vhdl-in-literal) |
| 6518 | (not (vhdl-libunit-p))) |
| 6519 | (backward-char) |
| 6520 | ;; Find the corresponding "begin" keyword. |
| 6521 | (setq last-forward (point)) |
| 6522 | (while (and (not foundp) |
| 6523 | (re-search-forward "\\bis\\b[^_]" last-backward t) |
| 6524 | (setq placeholder (match-beginning 0))) |
| 6525 | (if (or (= (preceding-char) ?_) |
| 6526 | (setq literal (vhdl-in-literal))) |
| 6527 | ;; It wasn't a real keyword, so keep searching. |
| 6528 | (if (eq literal 'comment) |
| 6529 | (goto-char |
| 6530 | (min (vhdl-point 'eol) last-backward)) |
| 6531 | (forward-char)) |
| 6532 | ;; We have found the begin keyword, loop will exit. |
| 6533 | (setq foundp placeholder))) |
| 6534 | ;; Go back to the libunit keyword |
| 6535 | (goto-char last-forward))) |
| 6536 | foundp)) |
| 6537 | |
| 6538 | (defun vhdl-beginning-of-defun (&optional count) |
| 6539 | "Move backward to the beginning of a VHDL defun. |
| 6540 | With argument, do it that many times. |
| 6541 | Returns the location of the corresponding begin keyword, unless search |
| 6542 | stops due to beginning or end of buffer." |
| 6543 | ;; Note that if point is between the "defun" keyword and the |
| 6544 | ;; corresponding "begin" keyword, then that defun will not be |
| 6545 | ;; recognized, and the search will continue backwards. If point is |
| 6546 | ;; at the "begin" keyword, then the defun will be recognized. The |
| 6547 | ;; returned point is at the first character of the "defun" keyword. |
| 6548 | (interactive "p") |
| 6549 | (let ((count (or count 1)) |
| 6550 | (case-fold-search t) |
| 6551 | (last-forward (point)) |
| 6552 | foundp) |
| 6553 | (while (> count 0) |
| 6554 | (setq foundp nil) |
| 6555 | (goto-char last-forward) |
| 6556 | (let ((last-backward |
| 6557 | ;; Just in case we are actually sitting on the "begin" |
| 6558 | ;; keyword, allow for the keyword and an extra character, |
| 6559 | ;; as this will be used when looking forward for the |
| 6560 | ;; "begin" keyword. |
| 6561 | (save-excursion (forward-word 1) (1+ (point)))) |
| 6562 | begin-string literal) |
| 6563 | (while (and (not foundp) |
| 6564 | (re-search-backward vhdl-defun-re nil 'move)) |
| 6565 | ;; If we are in a literal, then try again. |
| 6566 | (if (or (= (preceding-char) ?_) |
| 6567 | (vhdl-in-literal)) |
| 6568 | (backward-char) |
| 6569 | (if (setq begin-string (vhdl-corresponding-defun)) |
| 6570 | ;; This is a real defun keyword. |
| 6571 | ;; Find the corresponding "begin" keyword. |
| 6572 | ;; Look for the begin keyword. |
| 6573 | (progn |
| 6574 | ;; Save the search start point. |
| 6575 | (setq last-forward (point)) |
| 6576 | (while (and (not foundp) |
| 6577 | (search-forward begin-string last-backward t)) |
| 6578 | (if (or (= (preceding-char) ?_) |
| 6579 | (save-match-data |
| 6580 | (setq literal (vhdl-in-literal)))) |
| 6581 | ;; It wasn't a real keyword, so keep searching. |
| 6582 | (if (eq literal 'comment) |
| 6583 | (goto-char |
| 6584 | (min (vhdl-point 'eol) last-backward)) |
| 6585 | (forward-char)) |
| 6586 | ;; We have found the begin keyword, loop will exit. |
| 6587 | (setq foundp (match-beginning 0))) |
| 6588 | ) |
| 6589 | ;; Go back to the defun keyword |
| 6590 | (goto-char last-forward)) ; end search for begin keyword |
| 6591 | )) |
| 6592 | ) ; end of the search for the defun keyword |
| 6593 | ) |
| 6594 | (setq count (1- count)) |
| 6595 | ) |
| 6596 | (vhdl-keep-region-active) |
| 6597 | foundp)) |
| 6598 | |
| 6599 | (defun vhdl-beginning-of-statement (&optional count lim interactive) |
| 6600 | "Go to the beginning of the innermost VHDL statement. |
| 6601 | With prefix arg, go back N - 1 statements. If already at the |
| 6602 | beginning of a statement then go to the beginning of the preceding |
| 6603 | one. If within a string or comment, or next to a comment (only |
| 6604 | whitespace between), move by sentences instead of statements. |
| 6605 | |
| 6606 | When called from a program, this function takes 3 optional args: the |
| 6607 | prefix arg, a buffer position limit which is the farthest back to |
| 6608 | search, and an argument indicating an interactive call." |
| 6609 | (interactive "p\np") |
| 6610 | (let ((count (or count 1)) |
| 6611 | (case-fold-search t) |
| 6612 | (lim (or lim (point-min))) |
| 6613 | (here (point)) |
| 6614 | state) |
| 6615 | (save-excursion |
| 6616 | (goto-char lim) |
| 6617 | (setq state (parse-partial-sexp (point) here nil nil))) |
| 6618 | (if (and interactive |
| 6619 | (or (nth 3 state) |
| 6620 | (nth 4 state) |
| 6621 | (looking-at (concat "[ \t]*" comment-start-skip)))) |
| 6622 | (forward-sentence (- count)) |
| 6623 | (while (> count 0) |
| 6624 | (vhdl-beginning-of-statement-1 lim) |
| 6625 | (setq count (1- count)))) |
| 6626 | ;; its possible we've been left up-buf of lim |
| 6627 | (goto-char (max (point) lim)) |
| 6628 | ) |
| 6629 | (vhdl-keep-region-active)) |
| 6630 | |
| 6631 | (defconst vhdl-e-o-s-re |
| 6632 | (concat ";\\|" vhdl-begin-fwd-re "\\|" vhdl-statement-fwd-re)) |
| 6633 | |
| 6634 | (defun vhdl-end-of-statement () |
| 6635 | "Very simple implementation." |
| 6636 | (interactive) |
| 6637 | (re-search-forward vhdl-e-o-s-re)) |
| 6638 | |
| 6639 | (defconst vhdl-b-o-s-re |
| 6640 | (concat ";[^_]\\|\([^_]\\|\)[^_]\\|\\bwhen\\b[^_]\\|" |
| 6641 | vhdl-begin-bwd-re "\\|" vhdl-statement-bwd-re)) |
| 6642 | |
| 6643 | (defun vhdl-beginning-of-statement-1 (&optional lim) |
| 6644 | "Move to the start of the current statement, or the previous |
| 6645 | statement if already at the beginning of one." |
| 6646 | (let ((lim (or lim (point-min))) |
| 6647 | (here (point)) |
| 6648 | (pos (point)) |
| 6649 | donep) |
| 6650 | ;; go backwards one balanced expression, but be careful of |
| 6651 | ;; unbalanced paren being reached |
| 6652 | (if (not (vhdl-safe (progn (backward-sexp) t))) |
| 6653 | (progn |
| 6654 | (backward-up-list 1) |
| 6655 | (forward-char) |
| 6656 | (vhdl-forward-syntactic-ws here) |
| 6657 | (setq donep t))) |
| 6658 | (while (and (not donep) |
| 6659 | (not (bobp)) |
| 6660 | ;; look backwards for a statement boundary |
| 6661 | (progn (forward-char) (re-search-backward vhdl-b-o-s-re lim 'move))) |
| 6662 | (if (or (= (preceding-char) ?_) |
| 6663 | (vhdl-in-literal)) |
| 6664 | (backward-char) |
| 6665 | (cond |
| 6666 | ;; If we are looking at an open paren, then stop after it |
| 6667 | ((eq (following-char) ?\() |
| 6668 | (forward-char) |
| 6669 | (vhdl-forward-syntactic-ws here) |
| 6670 | (setq donep t)) |
| 6671 | ;; If we are looking at a close paren, then skip it |
| 6672 | ((eq (following-char) ?\)) |
| 6673 | (forward-char) |
| 6674 | (setq pos (point)) |
| 6675 | (backward-sexp) |
| 6676 | (if (< (point) lim) |
| 6677 | (progn (goto-char pos) |
| 6678 | (vhdl-forward-syntactic-ws here) |
| 6679 | (setq donep t)))) |
| 6680 | ;; If we are looking at a semicolon, then stop |
| 6681 | ((and (eq (following-char) ?\;) (not (vhdl-in-quote-p))) |
| 6682 | (progn |
| 6683 | (forward-char) |
| 6684 | (vhdl-forward-syntactic-ws here) |
| 6685 | (setq donep t))) |
| 6686 | ;; If we are looking at a "begin", then stop |
| 6687 | ((and (looking-at vhdl-begin-fwd-re) |
| 6688 | (or (not (looking-at "\\<use\\>")) |
| 6689 | (save-excursion |
| 6690 | (back-to-indentation) |
| 6691 | (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) |
| 6692 | (/= (preceding-char) ?_) |
| 6693 | (vhdl-begin-p nil)) |
| 6694 | ;; If it's a leader "begin", then find the |
| 6695 | ;; right place |
| 6696 | (if (looking-at vhdl-leader-re) |
| 6697 | (save-excursion |
| 6698 | ;; set a default stop point at the begin |
| 6699 | (setq pos (point)) |
| 6700 | ;; is the start point inside the leader area ? |
| 6701 | (goto-char (vhdl-end-of-leader)) |
| 6702 | (vhdl-forward-syntactic-ws here) |
| 6703 | (if (< (point) here) |
| 6704 | ;; start point was not inside leader area |
| 6705 | ;; set stop point at word after leader |
| 6706 | (setq pos (point)))) |
| 6707 | (forward-word 1) |
| 6708 | (vhdl-forward-syntactic-ws here) |
| 6709 | (setq pos (point))) |
| 6710 | (goto-char pos) |
| 6711 | (setq donep t)) |
| 6712 | ;; If we are looking at a "statement", then stop |
| 6713 | ((and (looking-at vhdl-statement-fwd-re) |
| 6714 | (/= (preceding-char) ?_) |
| 6715 | (vhdl-statement-p nil)) |
| 6716 | (setq donep t)) |
| 6717 | ;; If we are looking at a case alternative key, then stop |
| 6718 | ((and (looking-at vhdl-case-alternative-re) |
| 6719 | (vhdl-case-alternative-p lim)) |
| 6720 | (save-excursion |
| 6721 | ;; set a default stop point at the when |
| 6722 | (setq pos (point)) |
| 6723 | ;; is the start point inside the case alternative key ? |
| 6724 | (looking-at vhdl-case-alternative-re) |
| 6725 | (goto-char (match-end 0)) |
| 6726 | (vhdl-forward-syntactic-ws here) |
| 6727 | (if (< (point) here) |
| 6728 | ;; start point was not inside the case alternative key |
| 6729 | ;; set stop point at word after case alternative keyleader |
| 6730 | (setq pos (point)))) |
| 6731 | (goto-char pos) |
| 6732 | (setq donep t)) |
| 6733 | ;; Bogus find, continue |
| 6734 | (t |
| 6735 | (backward-char))))) |
| 6736 | )) |
| 6737 | |
| 6738 | ;; Defuns for calculating the current syntactic state: |
| 6739 | |
| 6740 | (defun vhdl-get-library-unit (bod placeholder) |
| 6741 | "If there is an enclosing library unit at BOD, with its \"begin\" |
| 6742 | keyword at PLACEHOLDER, then return the library unit type." |
| 6743 | (let ((here (vhdl-point 'bol))) |
| 6744 | (if (save-excursion |
| 6745 | (goto-char placeholder) |
| 6746 | (vhdl-safe (vhdl-forward-sexp 1 bod)) |
| 6747 | (<= here (point))) |
| 6748 | (save-excursion |
| 6749 | (goto-char bod) |
| 6750 | (cond |
| 6751 | ((looking-at "e") 'entity) |
| 6752 | ((looking-at "a") 'architecture) |
| 6753 | ((looking-at "c") 'configuration) |
| 6754 | ((looking-at "p") |
| 6755 | (save-excursion |
| 6756 | (goto-char bod) |
| 6757 | (forward-sexp) |
| 6758 | (vhdl-forward-syntactic-ws here) |
| 6759 | (if (looking-at "body\\b[^_]") |
| 6760 | 'package-body 'package)))))) |
| 6761 | )) |
| 6762 | |
| 6763 | (defun vhdl-get-block-state (&optional lim) |
| 6764 | "Finds and records all the closest opens. |
| 6765 | LIM is the furthest back we need to search (it should be the |
| 6766 | previous libunit keyword)." |
| 6767 | (let ((here (point)) |
| 6768 | (lim (or lim (point-min))) |
| 6769 | keyword sexp-start sexp-mid sexp-end |
| 6770 | preceding-sexp containing-sexp |
| 6771 | containing-begin containing-mid containing-paren) |
| 6772 | (save-excursion |
| 6773 | ;; Find the containing-paren, and use that as the limit |
| 6774 | (if (setq containing-paren |
| 6775 | (save-restriction |
| 6776 | (narrow-to-region lim (point)) |
| 6777 | (vhdl-safe (scan-lists (point) -1 1)))) |
| 6778 | (setq lim containing-paren)) |
| 6779 | ;; Look backwards for "begin" and "end" keywords. |
| 6780 | (while (and (> (point) lim) |
| 6781 | (not containing-sexp)) |
| 6782 | (setq keyword (vhdl-backward-to-block lim)) |
| 6783 | (cond |
| 6784 | ((eq keyword 'begin) |
| 6785 | ;; Found a "begin" keyword |
| 6786 | (setq sexp-start (point)) |
| 6787 | (setq sexp-mid (vhdl-corresponding-mid lim)) |
| 6788 | (setq sexp-end (vhdl-safe |
| 6789 | (save-excursion |
| 6790 | (vhdl-forward-sexp 1 lim) (point)))) |
| 6791 | (if (and sexp-end (<= sexp-end here)) |
| 6792 | ;; we want to record this sexp, but we only want to |
| 6793 | ;; record the last-most of any of them before here |
| 6794 | (or preceding-sexp |
| 6795 | (setq preceding-sexp sexp-start)) |
| 6796 | ;; we're contained in this sexp so put sexp-start on |
| 6797 | ;; front of list |
| 6798 | (setq containing-sexp sexp-start) |
| 6799 | (setq containing-mid sexp-mid) |
| 6800 | (setq containing-begin t))) |
| 6801 | ((eq keyword 'end) |
| 6802 | ;; Found an "end" keyword |
| 6803 | (forward-sexp) |
| 6804 | (setq sexp-end (point)) |
| 6805 | (setq sexp-mid nil) |
| 6806 | (setq sexp-start |
| 6807 | (or (vhdl-safe (vhdl-backward-sexp 1 lim) (point)) |
| 6808 | (progn (backward-sexp) (point)))) |
| 6809 | ;; we want to record this sexp, but we only want to |
| 6810 | ;; record the last-most of any of them before here |
| 6811 | (or preceding-sexp |
| 6812 | (setq preceding-sexp sexp-start))) |
| 6813 | ))) |
| 6814 | ;; Check if the containing-paren should be the containing-sexp |
| 6815 | (if (and containing-paren |
| 6816 | (or (null containing-sexp) |
| 6817 | (< containing-sexp containing-paren))) |
| 6818 | (setq containing-sexp containing-paren |
| 6819 | preceding-sexp nil |
| 6820 | containing-begin nil |
| 6821 | containing-mid nil)) |
| 6822 | (vector containing-sexp preceding-sexp containing-begin containing-mid) |
| 6823 | )) |
| 6824 | |
| 6825 | |
| 6826 | (defconst vhdl-s-c-a-re |
| 6827 | (concat vhdl-case-alternative-re "\\|" vhdl-case-header-key)) |
| 6828 | |
| 6829 | (defun vhdl-skip-case-alternative (&optional lim) |
| 6830 | "Skip forward over case/when bodies, with optional maximal |
| 6831 | limit. If no next case alternative is found, nil is returned and |
| 6832 | point is not moved." |
| 6833 | (let ((lim (or lim (point-max))) |
| 6834 | (here (point)) |
| 6835 | donep foundp) |
| 6836 | (while (and (< (point) lim) |
| 6837 | (not donep)) |
| 6838 | (if (and (re-search-forward vhdl-s-c-a-re lim 'move) |
| 6839 | (save-match-data |
| 6840 | (not (vhdl-in-literal))) |
| 6841 | (/= (match-beginning 0) here)) |
| 6842 | (progn |
| 6843 | (goto-char (match-beginning 0)) |
| 6844 | (cond |
| 6845 | ((and (looking-at "case") |
| 6846 | (re-search-forward "\\bis[^_]" lim t)) |
| 6847 | (backward-sexp) |
| 6848 | (vhdl-forward-sexp)) |
| 6849 | (t |
| 6850 | (setq donep t |
| 6851 | foundp t)))))) |
| 6852 | (if (not foundp) |
| 6853 | (goto-char here)) |
| 6854 | foundp)) |
| 6855 | |
| 6856 | (defun vhdl-backward-skip-label (&optional lim) |
| 6857 | "Skip backward over a label, with optional maximal |
| 6858 | limit. If label is not found, nil is returned and point |
| 6859 | is not moved." |
| 6860 | (let ((lim (or lim (point-min))) |
| 6861 | placeholder) |
| 6862 | (if (save-excursion |
| 6863 | (vhdl-backward-syntactic-ws lim) |
| 6864 | (and (eq (preceding-char) ?:) |
| 6865 | (progn |
| 6866 | (backward-sexp) |
| 6867 | (setq placeholder (point)) |
| 6868 | (looking-at vhdl-label-key)))) |
| 6869 | (goto-char placeholder)) |
| 6870 | )) |
| 6871 | |
| 6872 | (defun vhdl-forward-skip-label (&optional lim) |
| 6873 | "Skip forward over a label, with optional maximal |
| 6874 | limit. If label is not found, nil is returned and point |
| 6875 | is not moved." |
| 6876 | (let ((lim (or lim (point-max)))) |
| 6877 | (if (looking-at vhdl-label-key) |
| 6878 | (progn |
| 6879 | (goto-char (match-end 0)) |
| 6880 | (vhdl-forward-syntactic-ws lim))) |
| 6881 | )) |
| 6882 | |
| 6883 | (defun vhdl-get-syntactic-context () |
| 6884 | "Guess the syntactic description of the current line of VHDL code." |
| 6885 | (save-excursion |
| 6886 | (save-restriction |
| 6887 | (beginning-of-line) |
| 6888 | (let* ((indent-point (point)) |
| 6889 | (case-fold-search t) |
| 6890 | vec literal containing-sexp preceding-sexp |
| 6891 | containing-begin containing-mid containing-leader |
| 6892 | char-before-ip char-after-ip begin-after-ip end-after-ip |
| 6893 | placeholder lim library-unit |
| 6894 | ) |
| 6895 | |
| 6896 | ;; Reset the syntactic context |
| 6897 | (setq vhdl-syntactic-context nil) |
| 6898 | |
| 6899 | (save-excursion |
| 6900 | ;; Move to the start of the previous library unit, and |
| 6901 | ;; record the position of the "begin" keyword. |
| 6902 | (setq placeholder (vhdl-beginning-of-libunit)) |
| 6903 | ;; The position of the "libunit" keyword gives us a gross |
| 6904 | ;; limit point. |
| 6905 | (setq lim (point)) |
| 6906 | ) |
| 6907 | |
| 6908 | ;; If there is a previous library unit, and we are enclosed by |
| 6909 | ;; it, then set the syntax accordingly. |
| 6910 | (and placeholder |
| 6911 | (setq library-unit (vhdl-get-library-unit lim placeholder)) |
| 6912 | (vhdl-add-syntax library-unit lim)) |
| 6913 | |
| 6914 | ;; Find the surrounding state. |
| 6915 | (if (setq vec (vhdl-get-block-state lim)) |
| 6916 | (progn |
| 6917 | (setq containing-sexp (aref vec 0)) |
| 6918 | (setq preceding-sexp (aref vec 1)) |
| 6919 | (setq containing-begin (aref vec 2)) |
| 6920 | (setq containing-mid (aref vec 3)) |
| 6921 | )) |
| 6922 | |
| 6923 | ;; set the limit on the farthest back we need to search |
| 6924 | (setq lim (if containing-sexp |
| 6925 | (save-excursion |
| 6926 | (goto-char containing-sexp) |
| 6927 | ;; set containing-leader if required |
| 6928 | (if (looking-at vhdl-leader-re) |
| 6929 | (setq containing-leader (vhdl-end-of-leader))) |
| 6930 | (vhdl-point 'bol)) |
| 6931 | (point-min))) |
| 6932 | |
| 6933 | ;; cache char before and after indent point, and move point to |
| 6934 | ;; the most likely position to perform the majority of tests |
| 6935 | (goto-char indent-point) |
| 6936 | (skip-chars-forward " \t") |
| 6937 | (setq literal (vhdl-in-literal)) |
| 6938 | (setq char-after-ip (following-char)) |
| 6939 | (setq begin-after-ip (and |
| 6940 | (not literal) |
| 6941 | (looking-at vhdl-begin-fwd-re) |
| 6942 | (or (not (looking-at "\\<use\\>")) |
| 6943 | (save-excursion |
| 6944 | (back-to-indentation) |
| 6945 | (looking-at "\\(\\w+\\s-*:\\s-*\\)?\\<\\(case\\|elsif\\|if\\)\\>"))) |
| 6946 | (vhdl-begin-p))) |
| 6947 | (setq end-after-ip (and |
| 6948 | (not literal) |
| 6949 | (looking-at vhdl-end-fwd-re) |
| 6950 | (vhdl-end-p))) |
| 6951 | (vhdl-backward-syntactic-ws lim) |
| 6952 | (setq char-before-ip (preceding-char)) |
| 6953 | (goto-char indent-point) |
| 6954 | (skip-chars-forward " \t") |
| 6955 | |
| 6956 | ;; now figure out syntactic qualities of the current line |
| 6957 | (cond |
| 6958 | ;; CASE 1: in a string or comment. |
| 6959 | ((memq literal '(string comment)) |
| 6960 | (vhdl-add-syntax literal (vhdl-point 'bopl))) |
| 6961 | ;; CASE 2: Line is at top level. |
| 6962 | ((null containing-sexp) |
| 6963 | ;; Find the point to which indentation will be relative |
| 6964 | (save-excursion |
| 6965 | (if (null preceding-sexp) |
| 6966 | ;; CASE 2X.1 |
| 6967 | ;; no preceding-sexp -> use the preceding statement |
| 6968 | (vhdl-beginning-of-statement-1 lim) |
| 6969 | ;; CASE 2X.2 |
| 6970 | ;; if there is a preceding-sexp then indent relative to it |
| 6971 | (goto-char preceding-sexp) |
| 6972 | ;; if not at boi, then the block-opening keyword is |
| 6973 | ;; probably following a label, so we need a different |
| 6974 | ;; relpos |
| 6975 | (if (/= (point) (vhdl-point 'boi)) |
| 6976 | ;; CASE 2X.3 |
| 6977 | (vhdl-beginning-of-statement-1 lim))) |
| 6978 | ;; v-b-o-s could have left us at point-min |
| 6979 | (and (bobp) |
| 6980 | ;; CASE 2X.4 |
| 6981 | (vhdl-forward-syntactic-ws indent-point)) |
| 6982 | (setq placeholder (point))) |
| 6983 | (cond |
| 6984 | ;; CASE 2A : we are looking at a block-open |
| 6985 | (begin-after-ip |
| 6986 | (vhdl-add-syntax 'block-open placeholder)) |
| 6987 | ;; CASE 2B: we are looking at a block-close |
| 6988 | (end-after-ip |
| 6989 | (vhdl-add-syntax 'block-close placeholder)) |
| 6990 | ;; CASE 2C: we are looking at a top-level statement |
| 6991 | ((progn |
| 6992 | (vhdl-backward-syntactic-ws lim) |
| 6993 | (or (bobp) |
| 6994 | (and (= (preceding-char) ?\;) |
| 6995 | (not (vhdl-in-quote-p))))) |
| 6996 | (vhdl-add-syntax 'statement placeholder)) |
| 6997 | ;; CASE 2D: we are looking at a top-level statement-cont |
| 6998 | (t |
| 6999 | (vhdl-beginning-of-statement-1 lim) |
| 7000 | ;; v-b-o-s could have left us at point-min |
| 7001 | (and (bobp) |
| 7002 | ;; CASE 2D.1 |
| 7003 | (vhdl-forward-syntactic-ws indent-point)) |
| 7004 | (vhdl-add-syntax 'statement-cont (point))) |
| 7005 | )) ; end CASE 2 |
| 7006 | ;; CASE 3: line is inside parentheses. Most likely we are |
| 7007 | ;; either in a subprogram argument (interface) list, or a |
| 7008 | ;; continued expression containing parentheses. |
| 7009 | ((null containing-begin) |
| 7010 | (vhdl-backward-syntactic-ws containing-sexp) |
| 7011 | (cond |
| 7012 | ;; CASE 3A: we are looking at the arglist closing paren |
| 7013 | ((eq char-after-ip ?\)) |
| 7014 | (goto-char containing-sexp) |
| 7015 | (vhdl-add-syntax 'arglist-close (vhdl-point 'boi))) |
| 7016 | ;; CASE 3B: we are looking at the first argument in an empty |
| 7017 | ;; argument list. |
| 7018 | ((eq char-before-ip ?\() |
| 7019 | (goto-char containing-sexp) |
| 7020 | (vhdl-add-syntax 'arglist-intro (vhdl-point 'boi))) |
| 7021 | ;; CASE 3C: we are looking at an arglist continuation line, |
| 7022 | ;; but the preceding argument is on the same line as the |
| 7023 | ;; opening paren. This case includes multi-line |
| 7024 | ;; expression paren groupings. |
| 7025 | ((and (save-excursion |
| 7026 | (goto-char (1+ containing-sexp)) |
| 7027 | (skip-chars-forward " \t") |
| 7028 | (not (eolp)) |
| 7029 | (not (looking-at "--"))) |
| 7030 | (save-excursion |
| 7031 | (vhdl-beginning-of-statement-1 containing-sexp) |
| 7032 | (skip-chars-backward " \t(") |
| 7033 | (while (and (= (preceding-char) ?\;) |
| 7034 | (not (vhdl-in-quote-p))) |
| 7035 | (vhdl-beginning-of-statement-1 containing-sexp) |
| 7036 | (skip-chars-backward " \t(")) |
| 7037 | (<= (point) containing-sexp))) |
| 7038 | (goto-char containing-sexp) |
| 7039 | (vhdl-add-syntax 'arglist-cont-nonempty (vhdl-point 'boi))) |
| 7040 | ;; CASE 3D: we are looking at just a normal arglist |
| 7041 | ;; continuation line |
| 7042 | (t (vhdl-beginning-of-statement-1 containing-sexp) |
| 7043 | (vhdl-forward-syntactic-ws indent-point) |
| 7044 | (vhdl-add-syntax 'arglist-cont (vhdl-point 'boi))) |
| 7045 | )) |
| 7046 | ;; CASE 4: A block mid open |
| 7047 | ((and begin-after-ip |
| 7048 | (looking-at containing-mid)) |
| 7049 | (goto-char containing-sexp) |
| 7050 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 7051 | (if (looking-at vhdl-trailer-re) |
| 7052 | ;; CASE 4.1 |
| 7053 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 7054 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 7055 | (vhdl-add-syntax 'block-open (point))) |
| 7056 | ;; CASE 5: block close brace |
| 7057 | (end-after-ip |
| 7058 | (goto-char containing-sexp) |
| 7059 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 7060 | (if (looking-at vhdl-trailer-re) |
| 7061 | ;; CASE 5.1 |
| 7062 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 7063 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 7064 | (vhdl-add-syntax 'block-close (point))) |
| 7065 | ;; CASE 6: A continued statement |
| 7066 | ((and (/= char-before-ip ?\;) |
| 7067 | ;; check it's not a trailer begin keyword, or a begin |
| 7068 | ;; keyword immediately following a label. |
| 7069 | (not (and begin-after-ip |
| 7070 | (or (looking-at vhdl-trailer-re) |
| 7071 | (save-excursion |
| 7072 | (vhdl-backward-skip-label containing-sexp))))) |
| 7073 | ;; check it's not a statement keyword |
| 7074 | (not (and (looking-at vhdl-statement-fwd-re) |
| 7075 | (vhdl-statement-p))) |
| 7076 | ;; see if the b-o-s is before the indent point |
| 7077 | (> indent-point |
| 7078 | (save-excursion |
| 7079 | (vhdl-beginning-of-statement-1 containing-sexp) |
| 7080 | ;; If we ended up after a leader, then this will |
| 7081 | ;; move us forward to the start of the first |
| 7082 | ;; statement. Note that a containing sexp here is |
| 7083 | ;; always a keyword, not a paren, so this will |
| 7084 | ;; have no effect if we hit the containing-sexp. |
| 7085 | (vhdl-forward-syntactic-ws indent-point) |
| 7086 | (setq placeholder (point)))) |
| 7087 | ;; check it's not a block-intro |
| 7088 | (/= placeholder containing-sexp) |
| 7089 | ;; check it's not a case block-intro |
| 7090 | (save-excursion |
| 7091 | (goto-char placeholder) |
| 7092 | (or (not (looking-at vhdl-case-alternative-re)) |
| 7093 | (> (match-end 0) indent-point)))) |
| 7094 | ;; Make placeholder skip a label, but only if it puts us |
| 7095 | ;; before the indent point at the start of a line. |
| 7096 | (let ((new placeholder)) |
| 7097 | (if (and (> indent-point |
| 7098 | (save-excursion |
| 7099 | (goto-char placeholder) |
| 7100 | (vhdl-forward-skip-label indent-point) |
| 7101 | (setq new (point)))) |
| 7102 | (save-excursion |
| 7103 | (goto-char new) |
| 7104 | (eq new (progn (back-to-indentation) (point))))) |
| 7105 | (setq placeholder new))) |
| 7106 | (vhdl-add-syntax 'statement-cont placeholder) |
| 7107 | (if begin-after-ip |
| 7108 | (vhdl-add-syntax 'block-open))) |
| 7109 | ;; Statement. But what kind? |
| 7110 | ;; CASE 7: A case alternative key |
| 7111 | ((and (looking-at vhdl-case-alternative-re) |
| 7112 | (vhdl-case-alternative-p containing-sexp)) |
| 7113 | ;; for a case alternative key, we set relpos to the first |
| 7114 | ;; non-whitespace char on the line containing the "case" |
| 7115 | ;; keyword. |
| 7116 | (goto-char containing-sexp) |
| 7117 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 7118 | (if (looking-at vhdl-trailer-re) |
| 7119 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 7120 | (vhdl-add-syntax 'case-alternative (vhdl-point 'boi))) |
| 7121 | ;; CASE 8: statement catchall |
| 7122 | (t |
| 7123 | ;; we know its a statement, but we need to find out if it is |
| 7124 | ;; the first statement in a block |
| 7125 | (if containing-leader |
| 7126 | (goto-char containing-leader) |
| 7127 | (goto-char containing-sexp) |
| 7128 | ;; Note that a containing sexp here is always a keyword, |
| 7129 | ;; not a paren, so skip over the keyword. |
| 7130 | (forward-sexp)) |
| 7131 | ;; move to the start of the first statement |
| 7132 | (vhdl-forward-syntactic-ws indent-point) |
| 7133 | (setq placeholder (point)) |
| 7134 | ;; we want to ignore case alternatives keys when skipping forward |
| 7135 | (let (incase-p) |
| 7136 | (while (looking-at vhdl-case-alternative-re) |
| 7137 | (setq incase-p (point)) |
| 7138 | ;; we also want to skip over the body of the |
| 7139 | ;; case/when statement if that doesn't put us at |
| 7140 | ;; after the indent-point |
| 7141 | (while (vhdl-skip-case-alternative indent-point)) |
| 7142 | ;; set up the match end |
| 7143 | (looking-at vhdl-case-alternative-re) |
| 7144 | (goto-char (match-end 0)) |
| 7145 | ;; move to the start of the first case alternative statement |
| 7146 | (vhdl-forward-syntactic-ws indent-point) |
| 7147 | (setq placeholder (point))) |
| 7148 | (cond |
| 7149 | ;; CASE 8A: we saw a case/when statement so we must be |
| 7150 | ;; in a switch statement. find out if we are at the |
| 7151 | ;; statement just after a case alternative key |
| 7152 | ((and incase-p |
| 7153 | (= (point) indent-point)) |
| 7154 | ;; relpos is the "when" keyword |
| 7155 | (vhdl-add-syntax 'statement-case-intro incase-p)) |
| 7156 | ;; CASE 8B: any old statement |
| 7157 | ((< (point) indent-point) |
| 7158 | ;; relpos is the first statement of the block |
| 7159 | (vhdl-add-syntax 'statement placeholder) |
| 7160 | (if begin-after-ip |
| 7161 | (vhdl-add-syntax 'block-open))) |
| 7162 | ;; CASE 8C: first statement in a block |
| 7163 | (t |
| 7164 | (goto-char containing-sexp) |
| 7165 | ;; If the \"begin\" keyword is a trailer, then find v-b-o-s |
| 7166 | (if (looking-at vhdl-trailer-re) |
| 7167 | (progn (forward-sexp) (vhdl-beginning-of-statement-1 nil))) |
| 7168 | (vhdl-backward-skip-label (vhdl-point 'boi)) |
| 7169 | (vhdl-add-syntax 'statement-block-intro (point)) |
| 7170 | (if begin-after-ip |
| 7171 | (vhdl-add-syntax 'block-open))) |
| 7172 | ))) |
| 7173 | ) |
| 7174 | |
| 7175 | ;; now we need to look at any modifiers |
| 7176 | (goto-char indent-point) |
| 7177 | (skip-chars-forward " \t") |
| 7178 | (if (looking-at "--") |
| 7179 | (vhdl-add-syntax 'comment)) |
| 7180 | (if (eq literal 'pound) |
| 7181 | (vhdl-add-syntax 'cpp-macro)) |
| 7182 | ;; return the syntax |
| 7183 | vhdl-syntactic-context)))) |
| 7184 | |
| 7185 | ;; Standard indentation line-ups: |
| 7186 | |
| 7187 | (defun vhdl-lineup-arglist (langelem) |
| 7188 | "Lineup the current arglist line with the arglist appearing just |
| 7189 | after the containing paren which starts the arglist." |
| 7190 | (save-excursion |
| 7191 | (let* ((containing-sexp |
| 7192 | (save-excursion |
| 7193 | ;; arglist-cont-nonempty gives relpos == |
| 7194 | ;; to boi of containing-sexp paren. This |
| 7195 | ;; is good when offset is +, but bad |
| 7196 | ;; when it is vhdl-lineup-arglist, so we |
| 7197 | ;; have to special case a kludge here. |
| 7198 | (if (memq (car langelem) '(arglist-intro arglist-cont-nonempty)) |
| 7199 | (progn |
| 7200 | (beginning-of-line) |
| 7201 | (backward-up-list 1) |
| 7202 | (skip-chars-forward " \t" (vhdl-point 'eol))) |
| 7203 | (goto-char (cdr langelem))) |
| 7204 | (point))) |
| 7205 | (cs-curcol (save-excursion |
| 7206 | (goto-char (cdr langelem)) |
| 7207 | (current-column)))) |
| 7208 | (if (save-excursion |
| 7209 | (beginning-of-line) |
| 7210 | (looking-at "[ \t]*)")) |
| 7211 | (progn (goto-char (match-end 0)) |
| 7212 | (backward-sexp) |
| 7213 | (forward-char) |
| 7214 | (vhdl-forward-syntactic-ws) |
| 7215 | (- (current-column) cs-curcol)) |
| 7216 | (goto-char containing-sexp) |
| 7217 | (or (eolp) |
| 7218 | (let ((eol (vhdl-point 'eol)) |
| 7219 | (here (progn |
| 7220 | (forward-char) |
| 7221 | (skip-chars-forward " \t") |
| 7222 | (point)))) |
| 7223 | (vhdl-forward-syntactic-ws) |
| 7224 | (if (< (point) eol) |
| 7225 | (goto-char here)))) |
| 7226 | (- (current-column) cs-curcol) |
| 7227 | )))) |
| 7228 | |
| 7229 | (defun vhdl-lineup-arglist-intro (langelem) |
| 7230 | "Lineup an arglist-intro line to just after the open paren." |
| 7231 | (save-excursion |
| 7232 | (let ((cs-curcol (save-excursion |
| 7233 | (goto-char (cdr langelem)) |
| 7234 | (current-column))) |
| 7235 | (ce-curcol (save-excursion |
| 7236 | (beginning-of-line) |
| 7237 | (backward-up-list 1) |
| 7238 | (skip-chars-forward " \t" (vhdl-point 'eol)) |
| 7239 | (current-column)))) |
| 7240 | (- ce-curcol cs-curcol -1)))) |
| 7241 | |
| 7242 | (defun vhdl-lineup-comment (langelem) |
| 7243 | "Support old behavior for comment indentation. We look at |
| 7244 | vhdl-comment-only-line-offset to decide how to indent comment |
| 7245 | only-lines." |
| 7246 | (save-excursion |
| 7247 | (back-to-indentation) |
| 7248 | ;; at or to the right of comment-column |
| 7249 | (if (>= (current-column) comment-column) |
| 7250 | (vhdl-comment-indent) |
| 7251 | ;; otherwise, indent as specified by vhdl-comment-only-line-offset |
| 7252 | (if (not (bolp)) |
| 7253 | (or (car-safe vhdl-comment-only-line-offset) |
| 7254 | vhdl-comment-only-line-offset) |
| 7255 | (or (cdr-safe vhdl-comment-only-line-offset) |
| 7256 | (car-safe vhdl-comment-only-line-offset) |
| 7257 | -1000 ;jam it against the left side |
| 7258 | ))))) |
| 7259 | |
| 7260 | (defun vhdl-lineup-statement-cont (langelem) |
| 7261 | "Line up statement-cont after the assignment operator." |
| 7262 | (save-excursion |
| 7263 | (let* ((relpos (cdr langelem)) |
| 7264 | (assignp (save-excursion |
| 7265 | (goto-char (vhdl-point 'boi)) |
| 7266 | (and (re-search-forward "\\(<\\|:\\|=\\)=" |
| 7267 | (vhdl-point 'eol) t) |
| 7268 | (- (point) (vhdl-point 'boi))))) |
| 7269 | (curcol (progn |
| 7270 | (goto-char relpos) |
| 7271 | (current-column))) |
| 7272 | foundp) |
| 7273 | (while (and (not foundp) |
| 7274 | (< (point) (vhdl-point 'eol))) |
| 7275 | (re-search-forward "\\(<\\|:\\|=\\)=\\|(" (vhdl-point 'eol) 'move) |
| 7276 | (if (vhdl-in-literal) |
| 7277 | (forward-char) |
| 7278 | (if (= (preceding-char) ?\() |
| 7279 | ;; skip over any parenthesized expressions |
| 7280 | (goto-char (min (vhdl-point 'eol) |
| 7281 | (scan-lists (point) 1 1))) |
| 7282 | ;; found an assignment operator (not at eol) |
| 7283 | (setq foundp (not (looking-at "\\s-*$")))))) |
| 7284 | (if (not foundp) |
| 7285 | ;; there's no assignment operator on the line |
| 7286 | vhdl-basic-offset |
| 7287 | ;; calculate indentation column after assign and ws, unless |
| 7288 | ;; our line contains an assignment operator |
| 7289 | (if (not assignp) |
| 7290 | (progn |
| 7291 | (forward-char) |
| 7292 | (skip-chars-forward " \t") |
| 7293 | (setq assignp 0))) |
| 7294 | (- (current-column) assignp curcol)) |
| 7295 | ))) |
| 7296 | |
| 7297 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7298 | ;; Progress reporting |
| 7299 | |
| 7300 | (defvar vhdl-progress-info nil |
| 7301 | "Array variable for progress information: 0 begin, 1 end, 2 time.") |
| 7302 | |
| 7303 | (defun vhdl-update-progress-info (string pos) |
| 7304 | "Update progress information." |
| 7305 | (when (and vhdl-progress-info (not noninteractive) |
| 7306 | (< vhdl-progress-interval |
| 7307 | (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) |
| 7308 | (let ((delta (- (aref vhdl-progress-info 1) |
| 7309 | (aref vhdl-progress-info 0)))) |
| 7310 | (if (= 0 delta) |
| 7311 | (message (concat string "... (100%s)") "%") |
| 7312 | (message (concat string "... (%2d%s)") |
| 7313 | (/ (* 100 (- pos (aref vhdl-progress-info 0))) |
| 7314 | delta) "%"))) |
| 7315 | (aset vhdl-progress-info 2 (nth 1 (current-time))))) |
| 7316 | |
| 7317 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7318 | ;; Indentation commands |
| 7319 | |
| 7320 | (defun vhdl-electric-tab (&optional prefix-arg) |
| 7321 | "If preceding character is part of a word or a paren then hippie-expand, |
| 7322 | else if right of non whitespace on line then insert tab, |
| 7323 | else if last command was a tab or return then dedent one step or if a comment |
| 7324 | toggle between normal indent and inline comment indent, |
| 7325 | else indent `correctly'." |
| 7326 | (interactive "*P") |
| 7327 | (vhdl-prepare-search-2 |
| 7328 | (cond |
| 7329 | ;; indent region if region is active |
| 7330 | ((and (not (featurep 'xemacs)) (use-region-p)) |
| 7331 | (vhdl-indent-region (region-beginning) (region-end) nil)) |
| 7332 | ;; expand word |
| 7333 | ((= (char-syntax (preceding-char)) ?w) |
| 7334 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 7335 | (case-replace nil) |
| 7336 | (hippie-expand-only-buffers |
| 7337 | (or (and (boundp 'hippie-expand-only-buffers) |
| 7338 | hippie-expand-only-buffers) |
| 7339 | '(vhdl-mode)))) |
| 7340 | (vhdl-expand-abbrev prefix-arg))) |
| 7341 | ;; expand parenthesis |
| 7342 | ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) |
| 7343 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 7344 | (case-replace nil)) |
| 7345 | (vhdl-expand-paren prefix-arg))) |
| 7346 | ;; insert tab |
| 7347 | ((> (current-column) (current-indentation)) |
| 7348 | (insert-tab)) |
| 7349 | ;; toggle comment indent |
| 7350 | ((and (looking-at "--") |
| 7351 | (or (eq last-command 'vhdl-electric-tab) |
| 7352 | (eq last-command 'vhdl-electric-return))) |
| 7353 | (cond ((= (current-indentation) 0) ; no indent |
| 7354 | (indent-to 1) |
| 7355 | (indent-according-to-mode)) |
| 7356 | ((< (current-indentation) comment-column) ; normal indent |
| 7357 | (indent-to comment-column) |
| 7358 | (indent-according-to-mode)) |
| 7359 | (t ; inline comment indent |
| 7360 | (delete-region (line-beginning-position) (point))))) |
| 7361 | ;; dedent |
| 7362 | ((and (>= (current-indentation) vhdl-basic-offset) |
| 7363 | (or (eq last-command 'vhdl-electric-tab) |
| 7364 | (eq last-command 'vhdl-electric-return))) |
| 7365 | (backward-delete-char-untabify vhdl-basic-offset nil)) |
| 7366 | ;; indent line |
| 7367 | (t (indent-according-to-mode))) |
| 7368 | (setq this-command 'vhdl-electric-tab))) |
| 7369 | |
| 7370 | (defun vhdl-electric-return () |
| 7371 | "newline-and-indent or indent-new-comment-line if in comment and preceding |
| 7372 | character is a space." |
| 7373 | (interactive) |
| 7374 | (if (and (= (preceding-char) ? ) (vhdl-in-comment-p)) |
| 7375 | (indent-new-comment-line) |
| 7376 | (when (and (>= (preceding-char) ?a) (<= (preceding-char) ?z) |
| 7377 | (not (vhdl-in-comment-p))) |
| 7378 | (vhdl-fix-case-word -1)) |
| 7379 | (newline-and-indent))) |
| 7380 | |
| 7381 | (defun vhdl-indent-line () |
| 7382 | "Indent the current line as VHDL code. Returns the amount of |
| 7383 | indentation change." |
| 7384 | (interactive) |
| 7385 | (let* ((syntax (and vhdl-indent-syntax-based (vhdl-get-syntactic-context))) |
| 7386 | (pos (- (point-max) (point))) |
| 7387 | (is-comment nil) |
| 7388 | (indent |
| 7389 | (if syntax |
| 7390 | ;; indent syntax-based |
| 7391 | (if (and (eq (caar syntax) 'comment) |
| 7392 | (>= (vhdl-get-offset (car syntax)) comment-column)) |
| 7393 | ;; special case: comments at or right of comment-column |
| 7394 | (vhdl-get-offset (car syntax)) |
| 7395 | ;; align comments like following code line |
| 7396 | (when vhdl-indent-comment-like-next-code-line |
| 7397 | (save-excursion |
| 7398 | (while (eq (caar syntax) 'comment) |
| 7399 | (setq is-comment t) |
| 7400 | (beginning-of-line 2) |
| 7401 | (setq syntax (vhdl-get-syntactic-context))))) |
| 7402 | (when is-comment |
| 7403 | (push (cons 'comment nil) syntax)) |
| 7404 | (apply '+ (mapcar 'vhdl-get-offset syntax))) |
| 7405 | ;; indent like previous nonblank line |
| 7406 | (save-excursion (beginning-of-line) |
| 7407 | (re-search-backward "^[^\n]" nil t) |
| 7408 | (current-indentation)))) |
| 7409 | (shift-amt (- indent (current-indentation)))) |
| 7410 | (and vhdl-echo-syntactic-information-p |
| 7411 | (message "syntax: %s, indent= %d" syntax indent)) |
| 7412 | (let ((has-formfeed |
| 7413 | (save-excursion (beginning-of-line) (looking-at "\\s-*\f")))) |
| 7414 | (when (or (not (zerop shift-amt)) has-formfeed) |
| 7415 | (delete-region (vhdl-point 'bol) (vhdl-point 'boi)) |
| 7416 | (beginning-of-line) |
| 7417 | (when has-formfeed (insert "\f")) |
| 7418 | (indent-to indent))) |
| 7419 | (if (< (point) (vhdl-point 'boi)) |
| 7420 | (back-to-indentation) |
| 7421 | ;; If initial point was within line's indentation, position after |
| 7422 | ;; the indentation. Else stay at same point in text. |
| 7423 | (when (> (- (point-max) pos) (point)) |
| 7424 | (goto-char (- (point-max) pos)))) |
| 7425 | (run-hooks 'vhdl-special-indent-hook) |
| 7426 | (vhdl-update-progress-info "Indenting" (vhdl-current-line)) |
| 7427 | shift-amt)) |
| 7428 | |
| 7429 | (defun vhdl-indent-region (beg end &optional column) |
| 7430 | "Indent region as VHDL code. |
| 7431 | Adds progress reporting to `indent-region'." |
| 7432 | (interactive "r\nP") |
| 7433 | (when vhdl-progress-interval |
| 7434 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7435 | (count-lines (point-min) end) 0))) |
| 7436 | (indent-region beg end column) |
| 7437 | (when vhdl-progress-interval (message "Indenting...done")) |
| 7438 | (setq vhdl-progress-info nil)) |
| 7439 | |
| 7440 | (defun vhdl-indent-buffer () |
| 7441 | "Indent whole buffer as VHDL code. |
| 7442 | Calls `indent-region' for whole buffer and adds progress reporting." |
| 7443 | (interactive) |
| 7444 | (vhdl-indent-region (point-min) (point-max))) |
| 7445 | |
| 7446 | (defun vhdl-indent-group () |
| 7447 | "Indent group of lines between empty lines." |
| 7448 | (interactive) |
| 7449 | (let ((beg (save-excursion |
| 7450 | (if (re-search-backward vhdl-align-group-separate nil t) |
| 7451 | (point-marker) |
| 7452 | (point-min-marker)))) |
| 7453 | (end (save-excursion |
| 7454 | (if (re-search-forward vhdl-align-group-separate nil t) |
| 7455 | (point-marker) |
| 7456 | (point-max-marker))))) |
| 7457 | (vhdl-indent-region beg end))) |
| 7458 | |
| 7459 | (defun vhdl-indent-sexp (&optional endpos) |
| 7460 | "Indent each line of the list starting just after point. |
| 7461 | If optional arg ENDPOS is given, indent each line, stopping when |
| 7462 | ENDPOS is encountered." |
| 7463 | (interactive) |
| 7464 | (save-excursion |
| 7465 | (let ((beg (point)) |
| 7466 | (end (progn (vhdl-forward-sexp nil endpos) (point)))) |
| 7467 | (indent-region beg end nil)))) |
| 7468 | |
| 7469 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7470 | ;; Miscellaneous commands |
| 7471 | |
| 7472 | (defun vhdl-show-syntactic-information () |
| 7473 | "Show syntactic information for current line." |
| 7474 | (interactive) |
| 7475 | (message "Syntactic analysis: %s" (vhdl-get-syntactic-context)) |
| 7476 | (vhdl-keep-region-active)) |
| 7477 | |
| 7478 | ;; Verification and regression functions: |
| 7479 | |
| 7480 | (defun vhdl-regress-line (&optional arg) |
| 7481 | "Check syntactic information for current line." |
| 7482 | (interactive "P") |
| 7483 | (let ((expected (save-excursion |
| 7484 | (end-of-line) |
| 7485 | (when (search-backward " -- ((" (vhdl-point 'bol) t) |
| 7486 | (forward-char 4) |
| 7487 | (read (current-buffer))))) |
| 7488 | (actual (vhdl-get-syntactic-context)) |
| 7489 | (expurgated)) |
| 7490 | ;; remove the library unit symbols |
| 7491 | (mapc |
| 7492 | (function |
| 7493 | (lambda (elt) |
| 7494 | (if (memq (car elt) '(entity configuration package |
| 7495 | package-body architecture)) |
| 7496 | nil |
| 7497 | (setq expurgated (append expurgated (list elt)))))) |
| 7498 | actual) |
| 7499 | (if (and (not arg) expected (listp expected)) |
| 7500 | (if (not (equal expected expurgated)) |
| 7501 | (error "ERROR: Should be: %s, is: %s" expected expurgated)) |
| 7502 | (save-excursion |
| 7503 | (beginning-of-line) |
| 7504 | (when (not (looking-at "^\\s-*\\(--.*\\)?$")) |
| 7505 | (end-of-line) |
| 7506 | (if (search-backward " -- ((" (vhdl-point 'bol) t) |
| 7507 | (delete-region (point) (line-end-position))) |
| 7508 | (insert " -- ") |
| 7509 | (insert (format "%s" expurgated)))))) |
| 7510 | (vhdl-keep-region-active)) |
| 7511 | |
| 7512 | |
| 7513 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7514 | ;;; Alignment, beautifying |
| 7515 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7516 | |
| 7517 | (defconst vhdl-align-alist |
| 7518 | '( |
| 7519 | ;; after some keywords |
| 7520 | (vhdl-mode "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)[ \t]" |
| 7521 | "^\\s-*\\(across\\|constant\\|quantity\\|signal\\|subtype\\|terminal\\|through\\|type\\|variable\\)\\([ \t]+\\)" 2) |
| 7522 | ;; before ':' |
| 7523 | (vhdl-mode ":[^=]" "\\([ \t]*\\):[^=]") |
| 7524 | ;; after direction specifications |
| 7525 | (vhdl-mode ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\>" |
| 7526 | ":[ \t]*\\(in\\|out\\|inout\\|buffer\\|\\)\\([ \t]+\\)" 2) |
| 7527 | ;; before "==", ":=", "=>", and "<=" |
| 7528 | (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "<= ... =>" can occur |
| 7529 | (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) |
| 7530 | (vhdl-mode "[<:=]=" "\\([ \t]*\\)\\??[<:=]=" 1) ; since "=> ... <=" can occur |
| 7531 | ;; before some keywords |
| 7532 | (vhdl-mode "[ \t]after\\>" "[^ \t]\\([ \t]+\\)after\\>" 1) |
| 7533 | (vhdl-mode "[ \t]when\\>" "[^ \t]\\([ \t]+\\)when\\>" 1) |
| 7534 | (vhdl-mode "[ \t]else\\>" "[^ \t]\\([ \t]+\\)else\\>" 1) |
| 7535 | (vhdl-mode "[ \t]across\\>" "[^ \t]\\([ \t]+\\)across\\>" 1) |
| 7536 | (vhdl-mode "[ \t]through\\>" "[^ \t]\\([ \t]+\\)through\\>" 1) |
| 7537 | ;; before "=>" since "when/else ... =>" can occur |
| 7538 | (vhdl-mode "=>" "\\([ \t]*\\)=>" 1) |
| 7539 | ) |
| 7540 | "The format of this alist is (MODES [or MODE] REGEXP ALIGN-PATTERN SUBEXP). |
| 7541 | It is searched in order. If REGEXP is found anywhere in the first |
| 7542 | line of a region to be aligned, ALIGN-PATTERN will be used for that |
| 7543 | region. ALIGN-PATTERN must include the whitespace to be expanded or |
| 7544 | contracted. It may also provide regexps for the text surrounding the |
| 7545 | whitespace. SUBEXP specifies which sub-expression of |
| 7546 | ALIGN-PATTERN matches the white space to be expanded/contracted.") |
| 7547 | |
| 7548 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7549 | ;; Align code |
| 7550 | |
| 7551 | (defvar vhdl-align-try-all-clauses t |
| 7552 | "If REGEXP is not found on the first line of the region that clause |
| 7553 | is ignored. If this variable is non-nil, then the clause is tried anyway.") |
| 7554 | |
| 7555 | (defun vhdl-do-group (function &optional spacing) |
| 7556 | "Apply FUNCTION on group of lines between empty lines." |
| 7557 | (let |
| 7558 | ;; search for group beginning |
| 7559 | ((beg (save-excursion |
| 7560 | (if (re-search-backward vhdl-align-group-separate nil t) |
| 7561 | (progn (beginning-of-line 2) (back-to-indentation) (point)) |
| 7562 | (point-min)))) |
| 7563 | ;; search for group end |
| 7564 | (end (save-excursion |
| 7565 | (if (re-search-forward vhdl-align-group-separate nil t) |
| 7566 | (progn (beginning-of-line) (point)) |
| 7567 | (point-max))))) |
| 7568 | ;; run FUNCTION |
| 7569 | (funcall function beg end spacing))) |
| 7570 | |
| 7571 | (defun vhdl-do-list (function &optional spacing) |
| 7572 | "Apply FUNCTION to the lines of a list surrounded by a balanced group of |
| 7573 | parentheses." |
| 7574 | (let (beg end) |
| 7575 | (save-excursion |
| 7576 | ;; search for beginning of balanced group of parentheses |
| 7577 | (setq beg (vhdl-re-search-backward "[()]" nil t)) |
| 7578 | (while (looking-at ")") |
| 7579 | (forward-char) (backward-sexp) |
| 7580 | (setq beg (vhdl-re-search-backward "[()]" nil t))) |
| 7581 | ;; search for end of balanced group of parentheses |
| 7582 | (when beg |
| 7583 | (forward-list) |
| 7584 | (setq end (point)) |
| 7585 | (goto-char (1+ beg)) |
| 7586 | (skip-chars-forward " \t\n\r\f") |
| 7587 | (setq beg (point)))) |
| 7588 | ;; run FUNCTION |
| 7589 | (if beg |
| 7590 | (funcall function beg end spacing) |
| 7591 | (error "ERROR: Not within a list enclosed by a pair of parentheses")))) |
| 7592 | |
| 7593 | (defun vhdl-do-same-indent (function &optional spacing) |
| 7594 | "Apply FUNCTION to block of lines with same indent." |
| 7595 | (let ((indent (current-indentation)) |
| 7596 | beg end) |
| 7597 | ;; search for first line with same indent |
| 7598 | (save-excursion |
| 7599 | (while (and (not (bobp)) |
| 7600 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7601 | (= (current-indentation) indent))) |
| 7602 | (unless (looking-at "^\\s-*$") |
| 7603 | (back-to-indentation) (setq beg (point))) |
| 7604 | (beginning-of-line -0))) |
| 7605 | ;; search for last line with same indent |
| 7606 | (save-excursion |
| 7607 | (while (and (not (eobp)) |
| 7608 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7609 | (= (current-indentation) indent))) |
| 7610 | (if (looking-at "^\\s-*$") |
| 7611 | (beginning-of-line 2) |
| 7612 | (beginning-of-line 2) |
| 7613 | (setq end (point))))) |
| 7614 | ;; run FUNCTION |
| 7615 | (funcall function beg end spacing))) |
| 7616 | |
| 7617 | (defun vhdl-align-region-1 (begin end &optional spacing alignment-list indent) |
| 7618 | "Attempt to align a range of lines based on the content of the |
| 7619 | lines. The definition of `alignment-list' determines the matching |
| 7620 | order and the manner in which the lines are aligned. If ALIGNMENT-LIST |
| 7621 | is not specified `vhdl-align-alist' is used. If INDENT is non-nil, |
| 7622 | indentation is done before aligning." |
| 7623 | (interactive "r\np") |
| 7624 | (setq alignment-list (or alignment-list vhdl-align-alist)) |
| 7625 | (setq spacing (or spacing 1)) |
| 7626 | (save-excursion |
| 7627 | (let (bol indent) |
| 7628 | (goto-char end) |
| 7629 | (setq end (point-marker)) |
| 7630 | (goto-char begin) |
| 7631 | (setq bol (setq begin (progn (beginning-of-line) (point)))) |
| 7632 | (when indent |
| 7633 | (indent-region bol end nil)))) |
| 7634 | (let ((copy (copy-alist alignment-list))) |
| 7635 | (vhdl-prepare-search-2 |
| 7636 | (while copy |
| 7637 | (save-excursion |
| 7638 | (goto-char begin) |
| 7639 | (let (element |
| 7640 | (eol (point-at-eol))) |
| 7641 | (setq element (nth 0 copy)) |
| 7642 | (when (and (or (and (listp (car element)) |
| 7643 | (memq major-mode (car element))) |
| 7644 | (eq major-mode (car element))) |
| 7645 | (or vhdl-align-try-all-clauses |
| 7646 | (re-search-forward (car (cdr element)) eol t))) |
| 7647 | (vhdl-align-region-2 begin end (car (cdr (cdr element))) |
| 7648 | (car (cdr (cdr (cdr element)))) spacing)) |
| 7649 | (setq copy (cdr copy)))))))) |
| 7650 | |
| 7651 | (defun vhdl-align-region-2 (begin end match &optional substr spacing) |
| 7652 | "Align a range of lines from BEGIN to END. The regular expression |
| 7653 | MATCH must match exactly one field: the whitespace to be |
| 7654 | contracted/expanded. The alignment column will equal the |
| 7655 | rightmost column of the widest whitespace block. SPACING is |
| 7656 | the amount of extra spaces to add to the calculated maximum required. |
| 7657 | SPACING defaults to 1 so that at least one space is inserted after |
| 7658 | the token in MATCH." |
| 7659 | (setq spacing (or spacing 1)) |
| 7660 | (setq substr (or substr 1)) |
| 7661 | (save-excursion |
| 7662 | (let (distance (max 0) (lines 0) bol eol width) |
| 7663 | ;; Determine the greatest whitespace distance to the alignment |
| 7664 | ;; character |
| 7665 | (goto-char begin) |
| 7666 | (setq eol (point-at-eol) |
| 7667 | bol (setq begin (progn (beginning-of-line) (point)))) |
| 7668 | (while (< bol end) |
| 7669 | (save-excursion |
| 7670 | (when (and (vhdl-re-search-forward match eol t) |
| 7671 | (save-excursion |
| 7672 | (goto-char (match-beginning 0)) |
| 7673 | (forward-char) |
| 7674 | (and (not (vhdl-in-literal)) |
| 7675 | (not (vhdl-in-quote-p)) |
| 7676 | (not (vhdl-in-extended-identifier-p)))) |
| 7677 | (not (looking-at "\\s-*$"))) |
| 7678 | (setq distance (- (match-beginning substr) bol)) |
| 7679 | (when (> distance max) |
| 7680 | (setq max distance)))) |
| 7681 | (forward-line) |
| 7682 | (setq bol (point) |
| 7683 | eol (point-at-eol)) |
| 7684 | (setq lines (1+ lines))) |
| 7685 | ;; Now insert enough maxs to push each assignment operator to |
| 7686 | ;; the same column. We need to use 'lines' as a counter, since |
| 7687 | ;; the location of the mark may change |
| 7688 | (goto-char (setq bol begin)) |
| 7689 | (setq eol (point-at-eol)) |
| 7690 | (while (> lines 0) |
| 7691 | (when (and (vhdl-re-search-forward match eol t) |
| 7692 | (save-excursion |
| 7693 | (goto-char (match-beginning 0)) |
| 7694 | (forward-char) |
| 7695 | (and (not (vhdl-in-literal)) |
| 7696 | (not (vhdl-in-quote-p)) |
| 7697 | (not (vhdl-in-extended-identifier-p)))) |
| 7698 | (not (looking-at "\\s-*$")) |
| 7699 | (> (match-beginning 0) ; not if at boi |
| 7700 | (save-excursion (back-to-indentation) (point)))) |
| 7701 | (setq width (- (match-end substr) (match-beginning substr))) |
| 7702 | (setq distance (- (match-beginning substr) bol)) |
| 7703 | (goto-char (match-beginning substr)) |
| 7704 | (delete-char width) |
| 7705 | (insert-char ? (+ (- max distance) spacing))) |
| 7706 | (beginning-of-line) |
| 7707 | (forward-line) |
| 7708 | (setq bol (point) |
| 7709 | eol (point-at-eol)) |
| 7710 | (setq lines (1- lines)))))) |
| 7711 | |
| 7712 | (defun vhdl-align-region-groups (beg end &optional spacing |
| 7713 | no-message no-comments) |
| 7714 | "Align region, treat groups of lines separately." |
| 7715 | (interactive "r\nP") |
| 7716 | (save-excursion |
| 7717 | (let (orig pos) |
| 7718 | (goto-char beg) |
| 7719 | (beginning-of-line) |
| 7720 | (setq orig (point-marker)) |
| 7721 | (setq beg (point)) |
| 7722 | (goto-char end) |
| 7723 | (setq end (point-marker)) |
| 7724 | (untabify beg end) |
| 7725 | (unless no-message |
| 7726 | (when vhdl-progress-interval |
| 7727 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7728 | (count-lines (point-min) end) 0)))) |
| 7729 | (when (nth 0 vhdl-beautify-options) |
| 7730 | (vhdl-fixup-whitespace-region beg end t)) |
| 7731 | (goto-char beg) |
| 7732 | (if (not vhdl-align-groups) |
| 7733 | ;; align entire region |
| 7734 | (progn (vhdl-align-region-1 beg end spacing) |
| 7735 | (unless no-comments |
| 7736 | (vhdl-align-inline-comment-region-1 beg end))) |
| 7737 | ;; align groups |
| 7738 | (while (and (< beg end) |
| 7739 | (re-search-forward vhdl-align-group-separate end t)) |
| 7740 | (setq pos (point-marker)) |
| 7741 | (vhdl-align-region-1 beg pos spacing) |
| 7742 | (unless no-comments (vhdl-align-inline-comment-region-1 beg pos)) |
| 7743 | (vhdl-update-progress-info "Aligning" (vhdl-current-line)) |
| 7744 | (setq beg (1+ pos)) |
| 7745 | (goto-char beg)) |
| 7746 | ;; align last group |
| 7747 | (when (< beg end) |
| 7748 | (vhdl-align-region-1 beg end spacing) |
| 7749 | (unless no-comments (vhdl-align-inline-comment-region-1 beg end)) |
| 7750 | (vhdl-update-progress-info "Aligning" (vhdl-current-line)))) |
| 7751 | (when vhdl-indent-tabs-mode |
| 7752 | (tabify orig end)) |
| 7753 | (unless no-message |
| 7754 | (when vhdl-progress-interval (message "Aligning...done")) |
| 7755 | (setq vhdl-progress-info nil))))) |
| 7756 | |
| 7757 | (defun vhdl-align-region (beg end &optional spacing) |
| 7758 | "Align region, treat blocks with same indent and argument lists separately." |
| 7759 | (interactive "r\nP") |
| 7760 | (if (not vhdl-align-same-indent) |
| 7761 | ;; align entire region |
| 7762 | (vhdl-align-region-groups beg end spacing) |
| 7763 | ;; align blocks with same indent and argument lists |
| 7764 | (save-excursion |
| 7765 | (let ((cur-beg beg) |
| 7766 | indent cur-end) |
| 7767 | (when vhdl-progress-interval |
| 7768 | (setq vhdl-progress-info (vector (count-lines (point-min) beg) |
| 7769 | (count-lines (point-min) end) 0))) |
| 7770 | (goto-char end) |
| 7771 | (setq end (point-marker)) |
| 7772 | (goto-char cur-beg) |
| 7773 | (while (< (point) end) |
| 7774 | ;; is argument list opening? |
| 7775 | (if (setq cur-beg (nth 1 (save-excursion (parse-partial-sexp |
| 7776 | (point) (vhdl-point 'eol))))) |
| 7777 | ;; determine region for argument list |
| 7778 | (progn (goto-char cur-beg) |
| 7779 | (forward-sexp) |
| 7780 | (setq cur-end (point)) |
| 7781 | (beginning-of-line 2)) |
| 7782 | ;; determine region with same indent |
| 7783 | (setq indent (current-indentation)) |
| 7784 | (setq cur-beg (point)) |
| 7785 | (setq cur-end (vhdl-point 'bonl)) |
| 7786 | (beginning-of-line 2) |
| 7787 | (while (and (< (point) end) |
| 7788 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 7789 | (= (current-indentation) indent)) |
| 7790 | (<= (save-excursion |
| 7791 | (nth 0 (parse-partial-sexp |
| 7792 | (point) (vhdl-point 'eol)))) 0)) |
| 7793 | (unless (looking-at "^\\s-*$") |
| 7794 | (setq cur-end (vhdl-point 'bonl))) |
| 7795 | (beginning-of-line 2))) |
| 7796 | ;; align region |
| 7797 | (vhdl-align-region-groups cur-beg cur-end spacing t t)) |
| 7798 | (vhdl-align-inline-comment-region beg end spacing noninteractive) |
| 7799 | (when vhdl-progress-interval (message "Aligning...done")) |
| 7800 | (setq vhdl-progress-info nil))))) |
| 7801 | |
| 7802 | (defun vhdl-align-group (&optional spacing) |
| 7803 | "Align group of lines between empty lines." |
| 7804 | (interactive) |
| 7805 | (vhdl-do-group 'vhdl-align-region spacing)) |
| 7806 | |
| 7807 | (defun vhdl-align-list (&optional spacing) |
| 7808 | "Align the lines of a list surrounded by a balanced group of parentheses." |
| 7809 | (interactive) |
| 7810 | (vhdl-do-list 'vhdl-align-region-groups spacing)) |
| 7811 | |
| 7812 | (defun vhdl-align-same-indent (&optional spacing) |
| 7813 | "Align block of lines with same indent." |
| 7814 | (interactive) |
| 7815 | (vhdl-do-same-indent 'vhdl-align-region-groups spacing)) |
| 7816 | |
| 7817 | (defun vhdl-align-declarations (&optional spacing) |
| 7818 | "Align the lines within the declarative part of a design unit." |
| 7819 | (interactive) |
| 7820 | (let (beg end) |
| 7821 | (vhdl-prepare-search-2 |
| 7822 | (save-excursion |
| 7823 | ;; search for declarative part |
| 7824 | (when (and (re-search-backward "^\\(architecture\\|begin\\|configuration\\|end\\|entity\\|package\\)\\>" nil t) |
| 7825 | (not (member (upcase (match-string 1)) '("BEGIN" "END")))) |
| 7826 | (setq beg (point)) |
| 7827 | (re-search-forward "^\\(begin\\|end\\)\\>" nil t) |
| 7828 | (setq end (point))))) |
| 7829 | (if beg |
| 7830 | (vhdl-align-region-groups beg end spacing) |
| 7831 | (error "ERROR: Not within the declarative part of a design unit")))) |
| 7832 | |
| 7833 | (defun vhdl-align-buffer () |
| 7834 | "Align buffer." |
| 7835 | (interactive) |
| 7836 | (vhdl-align-region (point-min) (point-max))) |
| 7837 | |
| 7838 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7839 | ;; Align inline comments |
| 7840 | |
| 7841 | (defun vhdl-align-inline-comment-region-1 (beg end &optional spacing) |
| 7842 | "Align inline comments in region." |
| 7843 | (save-excursion |
| 7844 | (let ((start-max comment-column) |
| 7845 | (length-max 0) |
| 7846 | comment-list start-list tmp-list start length |
| 7847 | cur-start prev-start no-code) |
| 7848 | (setq spacing (or spacing 2)) |
| 7849 | (vhdl-prepare-search-2 |
| 7850 | (goto-char beg) |
| 7851 | ;; search for comment start positions and lengths |
| 7852 | (while (< (point) end) |
| 7853 | (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) |
| 7854 | (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\s-*\\(--.*\\)$") |
| 7855 | (not (save-excursion (goto-char (match-beginning 2)) |
| 7856 | (vhdl-in-literal)))) |
| 7857 | (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) |
| 7858 | (setq length (- (match-end 2) (match-beginning 2))) |
| 7859 | (setq start-max (max start start-max)) |
| 7860 | (setq length-max (max length length-max)) |
| 7861 | (push (cons start length) comment-list)) |
| 7862 | (beginning-of-line 2)) |
| 7863 | (setq comment-list |
| 7864 | (sort comment-list (function (lambda (a b) (> (car a) (car b)))))) |
| 7865 | ;; reduce start positions |
| 7866 | (setq start-list (list (caar comment-list))) |
| 7867 | (setq comment-list (cdr comment-list)) |
| 7868 | (while comment-list |
| 7869 | (unless (or (= (caar comment-list) (car start-list)) |
| 7870 | (<= (+ (car start-list) (cdar comment-list)) |
| 7871 | end-comment-column)) |
| 7872 | (push (caar comment-list) start-list)) |
| 7873 | (setq comment-list (cdr comment-list))) |
| 7874 | ;; align lines as nicely as possible |
| 7875 | (goto-char beg) |
| 7876 | (while (< (point) end) |
| 7877 | (setq cur-start nil) |
| 7878 | (when (and (not (looking-at "^\\s-*\\(begin\\|end\\)\\>")) |
| 7879 | (or (and (looking-at "^\\(.*?[^ \t\n\r\f-]+\\)\\(\\s-*\\)\\(--.*\\)$") |
| 7880 | (not (save-excursion |
| 7881 | (goto-char (match-beginning 3)) |
| 7882 | (vhdl-in-literal)))) |
| 7883 | (and (looking-at "^\\(\\)\\(\\s-*\\)\\(--.*\\)$") |
| 7884 | (>= (- (match-end 2) (match-beginning 2)) |
| 7885 | comment-column)))) |
| 7886 | (setq start (+ (- (match-end 1) (match-beginning 1)) spacing)) |
| 7887 | (setq length (- (match-end 3) (match-beginning 3))) |
| 7888 | (setq no-code (= (match-beginning 1) (match-end 1))) |
| 7889 | ;; insert minimum whitespace |
| 7890 | (goto-char (match-end 2)) |
| 7891 | (delete-region (match-beginning 2) (match-end 2)) |
| 7892 | (insert-char ?\ spacing) |
| 7893 | (setq tmp-list start-list) |
| 7894 | ;; insert additional whitespace to align |
| 7895 | (setq cur-start |
| 7896 | (cond |
| 7897 | ;; align comment-only line to inline comment of previous line |
| 7898 | ((and no-code prev-start |
| 7899 | (<= length (- end-comment-column prev-start))) |
| 7900 | prev-start) |
| 7901 | ;; align all comments at `start-max' if this is possible |
| 7902 | ((<= (+ start-max length-max) end-comment-column) |
| 7903 | start-max) |
| 7904 | ;; align at `comment-column' if possible |
| 7905 | ((and (<= start comment-column) |
| 7906 | (<= length (- end-comment-column comment-column))) |
| 7907 | comment-column) |
| 7908 | ;; align at left-most possible start position otherwise |
| 7909 | (t |
| 7910 | (while (and tmp-list (< (car tmp-list) start)) |
| 7911 | (setq tmp-list (cdr tmp-list))) |
| 7912 | (car tmp-list)))) |
| 7913 | (indent-to cur-start)) |
| 7914 | (setq prev-start cur-start) |
| 7915 | (beginning-of-line 2)))))) |
| 7916 | |
| 7917 | (defun vhdl-align-inline-comment-region (beg end &optional spacing no-message) |
| 7918 | "Align inline comments within a region. Groups of code lines separated by |
| 7919 | empty lines are aligned individually, if `vhdl-align-groups' is non-nil." |
| 7920 | (interactive "r\nP") |
| 7921 | (save-excursion |
| 7922 | (let (orig pos) |
| 7923 | (goto-char beg) |
| 7924 | (beginning-of-line) |
| 7925 | (setq orig (point-marker)) |
| 7926 | (setq beg (point)) |
| 7927 | (goto-char end) |
| 7928 | (setq end (point-marker)) |
| 7929 | (untabify beg end) |
| 7930 | (unless no-message (message "Aligning inline comments...")) |
| 7931 | (goto-char beg) |
| 7932 | (if (not vhdl-align-groups) |
| 7933 | ;; align entire region |
| 7934 | (vhdl-align-inline-comment-region-1 beg end spacing) |
| 7935 | ;; align groups |
| 7936 | (while (and (< beg end) |
| 7937 | (re-search-forward vhdl-align-group-separate end t)) |
| 7938 | (setq pos (point-marker)) |
| 7939 | (vhdl-align-inline-comment-region-1 beg pos spacing) |
| 7940 | (setq beg (1+ pos)) |
| 7941 | (goto-char beg)) |
| 7942 | ;; align last group |
| 7943 | (when (< beg end) |
| 7944 | (vhdl-align-inline-comment-region-1 beg end spacing))) |
| 7945 | (when vhdl-indent-tabs-mode |
| 7946 | (tabify orig end)) |
| 7947 | (unless no-message (message "Aligning inline comments...done"))))) |
| 7948 | |
| 7949 | (defun vhdl-align-inline-comment-group (&optional spacing) |
| 7950 | "Align inline comments within a group of lines between empty lines." |
| 7951 | (interactive) |
| 7952 | (save-excursion |
| 7953 | (let ((start (point)) |
| 7954 | beg end) |
| 7955 | (setq end (if (re-search-forward vhdl-align-group-separate nil t) |
| 7956 | (point-marker) (point-max))) |
| 7957 | (goto-char start) |
| 7958 | (setq beg (if (re-search-backward vhdl-align-group-separate nil t) |
| 7959 | (point) (point-min))) |
| 7960 | (untabify beg end) |
| 7961 | (message "Aligning inline comments...") |
| 7962 | (vhdl-align-inline-comment-region-1 beg end) |
| 7963 | (when vhdl-indent-tabs-mode |
| 7964 | (tabify beg end)) |
| 7965 | (message "Aligning inline comments...done")))) |
| 7966 | |
| 7967 | (defun vhdl-align-inline-comment-buffer () |
| 7968 | "Align inline comments within buffer. Groups of code lines separated by |
| 7969 | empty lines are aligned individually, if `vhdl-align-groups' is non-nil." |
| 7970 | (interactive) |
| 7971 | (vhdl-align-inline-comment-region (point-min) (point-max))) |
| 7972 | |
| 7973 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 7974 | ;; Fixup whitespace |
| 7975 | |
| 7976 | (defun vhdl-fixup-whitespace-region (beg end &optional no-message) |
| 7977 | "Fixup whitespace in region. Surround operator symbols by one space, |
| 7978 | eliminate multiple spaces (except at beginning of line), eliminate spaces at |
| 7979 | end of line, do nothing in comments and strings." |
| 7980 | (interactive "r") |
| 7981 | (unless no-message (message "Fixing up whitespace...")) |
| 7982 | (save-excursion |
| 7983 | (goto-char end) |
| 7984 | (setq end (point-marker)) |
| 7985 | ;; have no space before and one space after `,' and ';' |
| 7986 | (goto-char beg) |
| 7987 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\s-*\\([,;]\\)\\)" end t) |
| 7988 | (if (match-string 1) |
| 7989 | (goto-char (match-end 1)) |
| 7990 | (replace-match "\\3 " nil nil nil 2))) |
| 7991 | ;; have no space after `(' |
| 7992 | (goto-char beg) |
| 7993 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\((\\)\\s-+" end t) |
| 7994 | (if (match-string 1) |
| 7995 | (goto-char (match-end 1)) |
| 7996 | (replace-match "\\2"))) |
| 7997 | ;; have no space before `)' |
| 7998 | (goto-char beg) |
| 7999 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\|^\\s-+\\)\\|\\s-+\\()\\)" end t) |
| 8000 | (if (match-string 1) |
| 8001 | (goto-char (match-end 1)) |
| 8002 | (replace-match "\\2"))) |
| 8003 | ;; surround operator symbols by one space |
| 8004 | (goto-char beg) |
| 8005 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\|\'.\'\\|\\\\[^\\\n]*[\\\n]\\)\\|\\(\\([^/:<>=\n]\\)\\(:\\|\\??=\\|\\??<<\\|\\??>>\\|\\??<\\|\\??>\\|:=\\|\\??<=\\|\\??>=\\|=>\\|\\??/=\\|\\?\\?\\)\\([^=>\n]\\|$\\)\\)" end t) |
| 8006 | (if (or (match-string 1) |
| 8007 | (<= (match-beginning 0) ; not if at boi |
| 8008 | (save-excursion (back-to-indentation) (point)))) |
| 8009 | (goto-char (match-end 0)) |
| 8010 | (replace-match "\\3 \\4 \\5") |
| 8011 | (goto-char (match-end 2)))) |
| 8012 | ;; eliminate multiple spaces and spaces at end of line |
| 8013 | (goto-char beg) |
| 8014 | (while (or (and (looking-at "--.*\n") (re-search-forward "--.*\n" end t)) |
| 8015 | (and (looking-at "--.*") (re-search-forward "--.*" end t)) |
| 8016 | (and (looking-at "\"") (re-search-forward "\"[^\"\n]*[\"\n]" end t)) |
| 8017 | (and (looking-at "\\s-+$") (re-search-forward "\\s-+$" end t) |
| 8018 | (progn (replace-match "" nil nil) t)) |
| 8019 | (and (looking-at "\\s-+;") (re-search-forward "\\s-+;" end t) |
| 8020 | (progn (replace-match ";" nil nil) t)) |
| 8021 | (and (looking-at "^\\s-+") (re-search-forward "^\\s-+" end t)) |
| 8022 | (and (looking-at "\\s-+--") (re-search-forward "\\s-+" end t) |
| 8023 | (progn (replace-match " " nil nil) t)) |
| 8024 | (and (looking-at "\\s-+") (re-search-forward "\\s-+" end t) |
| 8025 | (progn (replace-match " " nil nil) t)) |
| 8026 | (and (looking-at "-") (re-search-forward "-" end t)) |
| 8027 | (re-search-forward "[^ \t\"-]+" end t)))) |
| 8028 | (unless no-message (message "Fixing up whitespace...done"))) |
| 8029 | |
| 8030 | (defun vhdl-fixup-whitespace-buffer () |
| 8031 | "Fixup whitespace in buffer. Surround operator symbols by one space, |
| 8032 | eliminate multiple spaces (except at beginning of line), eliminate spaces at |
| 8033 | end of line, do nothing in comments." |
| 8034 | (interactive) |
| 8035 | (vhdl-fixup-whitespace-region (point-min) (point-max))) |
| 8036 | |
| 8037 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8038 | ;; Case fixing |
| 8039 | |
| 8040 | (defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count) |
| 8041 | "Convert all words matching WORD-REGEXP in region to lower or upper case, |
| 8042 | depending on parameter UPPER-CASE." |
| 8043 | (let ((case-replace nil) |
| 8044 | (last-update 0)) |
| 8045 | (vhdl-prepare-search-2 |
| 8046 | (save-excursion |
| 8047 | (goto-char end) |
| 8048 | (setq end (point-marker)) |
| 8049 | (goto-char beg) |
| 8050 | (while (re-search-forward word-regexp end t) |
| 8051 | (or (vhdl-in-literal) |
| 8052 | (if upper-case |
| 8053 | (upcase-word -1) |
| 8054 | (downcase-word -1))) |
| 8055 | (when (and count vhdl-progress-interval (not noninteractive) |
| 8056 | (< vhdl-progress-interval |
| 8057 | (- (nth 1 (current-time)) last-update))) |
| 8058 | (message "Fixing case... (%2d%s)" |
| 8059 | (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) |
| 8060 | "%") |
| 8061 | (setq last-update (nth 1 (current-time))))) |
| 8062 | (goto-char end))))) |
| 8063 | |
| 8064 | (defun vhdl-fix-case-region (beg end &optional arg) |
| 8065 | "Convert all VHDL words in region to lower or upper case, depending on |
| 8066 | options vhdl-upper-case-{keywords,types,attributes,enum-values}." |
| 8067 | (interactive "r\nP") |
| 8068 | (vhdl-fix-case-region-1 |
| 8069 | beg end vhdl-upper-case-keywords vhdl-keywords-regexp 0) |
| 8070 | (vhdl-fix-case-region-1 |
| 8071 | beg end vhdl-upper-case-types vhdl-types-regexp 1) |
| 8072 | (vhdl-fix-case-region-1 |
| 8073 | beg end vhdl-upper-case-attributes (concat "'" vhdl-attributes-regexp) 2) |
| 8074 | (vhdl-fix-case-region-1 |
| 8075 | beg end vhdl-upper-case-enum-values vhdl-enum-values-regexp 3) |
| 8076 | (vhdl-fix-case-region-1 |
| 8077 | beg end vhdl-upper-case-constants vhdl-constants-regexp 4) |
| 8078 | (when vhdl-progress-interval (message "Fixing case...done"))) |
| 8079 | |
| 8080 | (defun vhdl-fix-case-buffer () |
| 8081 | "Convert all VHDL words in buffer to lower or upper case, depending on |
| 8082 | options vhdl-upper-case-{keywords,types,attributes,enum-values}." |
| 8083 | (interactive) |
| 8084 | (vhdl-fix-case-region (point-min) (point-max))) |
| 8085 | |
| 8086 | (defun vhdl-fix-case-word (&optional arg) |
| 8087 | "Convert word after cursor to upper case if necessary." |
| 8088 | (interactive "p") |
| 8089 | (save-excursion |
| 8090 | (when arg (backward-word 1)) |
| 8091 | (vhdl-prepare-search-1 |
| 8092 | (when (and vhdl-upper-case-keywords |
| 8093 | (looking-at vhdl-keywords-regexp)) |
| 8094 | (upcase-word 1)) |
| 8095 | (when (and vhdl-upper-case-types |
| 8096 | (looking-at vhdl-types-regexp)) |
| 8097 | (upcase-word 1)) |
| 8098 | (when (and vhdl-upper-case-attributes |
| 8099 | (looking-at vhdl-attributes-regexp)) |
| 8100 | (upcase-word 1)) |
| 8101 | (when (and vhdl-upper-case-enum-values |
| 8102 | (looking-at vhdl-enum-values-regexp)) |
| 8103 | (upcase-word 1)) |
| 8104 | (when (and vhdl-upper-case-constants |
| 8105 | (looking-at vhdl-constants-regexp)) |
| 8106 | (upcase-word 1))))) |
| 8107 | |
| 8108 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8109 | ;; Fix statements |
| 8110 | ;; - force each statement to be on a separate line except when on same line |
| 8111 | ;; with 'end' keyword |
| 8112 | |
| 8113 | (defun vhdl-fix-statement-region (beg end &optional arg) |
| 8114 | "Force statements in region on separate line except when on same line |
| 8115 | with 'end' keyword (necessary for correct indentation). |
| 8116 | Currently supported keywords: 'begin', 'if'." |
| 8117 | (interactive "r\nP") |
| 8118 | (vhdl-prepare-search-2 |
| 8119 | (let (point) |
| 8120 | (save-excursion |
| 8121 | (goto-char end) |
| 8122 | (setq end (point-marker)) |
| 8123 | (goto-char beg) |
| 8124 | ;; `begin' keyword |
| 8125 | (while (re-search-forward |
| 8126 | "^\\s-*[^ \t\n].*?\\(\\<begin\\>\\)\\(.*\\<end\\>\\)?" end t) |
| 8127 | (goto-char (match-end 0)) |
| 8128 | (setq point (point-marker)) |
| 8129 | (when (and (match-string 1) |
| 8130 | (or (not (match-string 2)) |
| 8131 | (save-excursion (goto-char (match-end 2)) |
| 8132 | (vhdl-in-literal))) |
| 8133 | (not (save-excursion (goto-char (match-beginning 1)) |
| 8134 | (vhdl-in-literal)))) |
| 8135 | (goto-char (match-beginning 1)) |
| 8136 | (insert "\n") |
| 8137 | (indent-according-to-mode)) |
| 8138 | (goto-char point)) |
| 8139 | (goto-char beg) |
| 8140 | ;; `for', `if' keywords |
| 8141 | (while (re-search-forward "\\<\\(for\\|if\\)\\>" end t) |
| 8142 | (goto-char (match-end 1)) |
| 8143 | (setq point (point-marker)) |
| 8144 | ;; exception: in literal or preceded by `end', `wait' or label |
| 8145 | (when (and (not (save-excursion (goto-char (match-beginning 1)) |
| 8146 | (vhdl-in-literal))) |
| 8147 | (save-excursion |
| 8148 | (beginning-of-line 1) |
| 8149 | (save-match-data |
| 8150 | (and (re-search-forward "^\\s-*\\([^ \t\n].*\\)" |
| 8151 | (match-beginning 1) t) |
| 8152 | (not (string-match |
| 8153 | "\\(\\<end\\>\\|\\<wait .*\\|\\w+\\s-*:\\)\\s-*$" |
| 8154 | (match-string 1))))))) |
| 8155 | (goto-char (match-beginning 1)) |
| 8156 | (insert "\n") |
| 8157 | (indent-according-to-mode)) |
| 8158 | (goto-char point)))))) |
| 8159 | |
| 8160 | (defun vhdl-fix-statement-buffer () |
| 8161 | "Force statements in buffer on separate line except when on same line |
| 8162 | with 'end' keyword (necessary for correct indentation)." |
| 8163 | (interactive) |
| 8164 | (vhdl-fix-statement-region (point-min) (point-max))) |
| 8165 | |
| 8166 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8167 | ;; Trailing spaces |
| 8168 | |
| 8169 | (defun vhdl-remove-trailing-spaces-region (beg end &optional arg) |
| 8170 | "Remove trailing spaces in region." |
| 8171 | (interactive "r\nP") |
| 8172 | (save-excursion |
| 8173 | (goto-char end) |
| 8174 | (setq end (point-marker)) |
| 8175 | (goto-char beg) |
| 8176 | (while (re-search-forward "[ \t]+$" end t) |
| 8177 | (unless (vhdl-in-literal) |
| 8178 | (replace-match "" nil nil))))) |
| 8179 | |
| 8180 | (defun vhdl-remove-trailing-spaces () |
| 8181 | "Remove trailing spaces in buffer." |
| 8182 | (interactive) |
| 8183 | (vhdl-remove-trailing-spaces-region (point-min) (point-max))) |
| 8184 | |
| 8185 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8186 | ;; Beautify |
| 8187 | |
| 8188 | (defun vhdl-beautify-region (beg end) |
| 8189 | "Beautify region by applying indentation, whitespace fixup, alignment, and |
| 8190 | case fixing to a region. Calls functions `vhdl-indent-buffer', |
| 8191 | `vhdl-align-buffer' (option `vhdl-align-groups' set to non-nil), and |
| 8192 | `vhdl-fix-case-buffer'." |
| 8193 | (interactive "r") |
| 8194 | (setq end (save-excursion (goto-char end) (point-marker))) |
| 8195 | (save-excursion ; remove DOS EOL characters in UNIX file |
| 8196 | (goto-char beg) |
| 8197 | (while (search-forward "\r" nil t) |
| 8198 | (replace-match "" nil t))) |
| 8199 | (when (nth 0 vhdl-beautify-options) (vhdl-fixup-whitespace-region beg end t)) |
| 8200 | (when (nth 1 vhdl-beautify-options) (vhdl-fix-statement-region beg end)) |
| 8201 | (when (nth 2 vhdl-beautify-options) (vhdl-indent-region beg end)) |
| 8202 | (when (nth 3 vhdl-beautify-options) |
| 8203 | (let ((vhdl-align-groups t)) (vhdl-align-region beg end))) |
| 8204 | (when (nth 4 vhdl-beautify-options) (vhdl-fix-case-region beg end)) |
| 8205 | (when (nth 0 vhdl-beautify-options) |
| 8206 | (vhdl-remove-trailing-spaces-region beg end) |
| 8207 | (if vhdl-indent-tabs-mode (tabify beg end) (untabify beg end)))) |
| 8208 | |
| 8209 | (defun vhdl-beautify-buffer () |
| 8210 | "Beautify buffer by applying indentation, whitespace fixup, alignment, and |
| 8211 | case fixing to entire buffer. Calls `vhdl-beautify-region' for the entire |
| 8212 | buffer." |
| 8213 | (interactive) |
| 8214 | (vhdl-beautify-region (point-min) (point-max)) |
| 8215 | (when noninteractive (save-buffer))) |
| 8216 | |
| 8217 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8218 | ;; Code filling |
| 8219 | |
| 8220 | (defun vhdl-fill-region (beg end &optional arg) |
| 8221 | "Fill lines for a region of code." |
| 8222 | (interactive "r\np") |
| 8223 | (save-excursion |
| 8224 | (goto-char beg) |
| 8225 | (let ((margin (if arg (current-indentation) (current-column)))) |
| 8226 | (goto-char end) |
| 8227 | (setq end (point-marker)) |
| 8228 | ;; remove inline comments, newlines and whitespace |
| 8229 | (vhdl-comment-kill-region beg end) |
| 8230 | (vhdl-comment-kill-inline-region beg end) |
| 8231 | (subst-char-in-region beg (1- end) ?\n ?\ ) |
| 8232 | (vhdl-fixup-whitespace-region beg end) |
| 8233 | ;; wrap and end-comment-column |
| 8234 | (goto-char beg) |
| 8235 | (while (re-search-forward "\\s-" end t) |
| 8236 | (when(> (current-column) vhdl-end-comment-column) |
| 8237 | (backward-char) |
| 8238 | (when (re-search-backward "\\s-" beg t) |
| 8239 | (replace-match "\n") |
| 8240 | (indent-to margin))))))) |
| 8241 | |
| 8242 | (defun vhdl-fill-group () |
| 8243 | "Fill group of lines between empty lines." |
| 8244 | (interactive) |
| 8245 | (vhdl-do-group 'vhdl-fill-region)) |
| 8246 | |
| 8247 | (defun vhdl-fill-list () |
| 8248 | "Fill the lines of a list surrounded by a balanced group of parentheses." |
| 8249 | (interactive) |
| 8250 | (vhdl-do-list 'vhdl-fill-region)) |
| 8251 | |
| 8252 | (defun vhdl-fill-same-indent () |
| 8253 | "Fill the lines of block of lines with same indent." |
| 8254 | (interactive) |
| 8255 | (vhdl-do-same-indent 'vhdl-fill-region)) |
| 8256 | |
| 8257 | |
| 8258 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8259 | ;;; Code updating/fixing |
| 8260 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8261 | |
| 8262 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8263 | ;; Sensitivity list update |
| 8264 | |
| 8265 | ;; Strategy: |
| 8266 | ;; - no sensitivity list is generated for processes with wait statements |
| 8267 | ;; - otherwise, do the following: |
| 8268 | ;; 1. scan for all local signals (ports, signals declared in arch./blocks) |
| 8269 | ;; 2. scan for all signals already in the sensitivity list (in order to catch |
| 8270 | ;; manually entered global signals) |
| 8271 | ;; 3. signals from 1. and 2. form the list of visible signals |
| 8272 | ;; 4. search for if/elsif conditions containing an event (sequential code) |
| 8273 | ;; 5. scan for strings that are within syntactical regions where signals are |
| 8274 | ;; read but not within sequential code, and that correspond to visible |
| 8275 | ;; signals |
| 8276 | ;; 6. replace sensitivity list by list of signals from 5. |
| 8277 | |
| 8278 | (defun vhdl-update-sensitivity-list-process () |
| 8279 | "Update sensitivity list of current process." |
| 8280 | (interactive) |
| 8281 | (save-excursion |
| 8282 | (vhdl-prepare-search-2 |
| 8283 | (end-of-line) |
| 8284 | ;; look whether in process |
| 8285 | (if (not (and (re-search-backward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|end\\s-+process\\)\\>" nil t) |
| 8286 | (equal (upcase (match-string 2)) "PROCESS") |
| 8287 | (save-excursion (re-search-forward "^\\s-*end\\s-+process\\>" nil t)))) |
| 8288 | (error "ERROR: Not within a process") |
| 8289 | (message "Updating sensitivity list...") |
| 8290 | (vhdl-update-sensitivity-list) |
| 8291 | (message "Updating sensitivity list...done"))))) |
| 8292 | |
| 8293 | (defun vhdl-update-sensitivity-list-buffer () |
| 8294 | "Update sensitivity list of all processes in current buffer." |
| 8295 | (interactive) |
| 8296 | (save-excursion |
| 8297 | (vhdl-prepare-search-2 |
| 8298 | (goto-char (point-min)) |
| 8299 | (message "Updating sensitivity lists...") |
| 8300 | (while (re-search-forward "^\\s-*\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?process\\>" nil t) |
| 8301 | (goto-char (match-beginning 0)) |
| 8302 | (condition-case nil (vhdl-update-sensitivity-list) (error ""))) |
| 8303 | (message "Updating sensitivity lists...done"))) |
| 8304 | (when noninteractive (save-buffer))) |
| 8305 | |
| 8306 | (defun vhdl-update-sensitivity-list () |
| 8307 | "Update sensitivity list." |
| 8308 | (let ((proc-beg (point)) |
| 8309 | (proc-end (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) |
| 8310 | (proc-mid (vhdl-re-search-backward |
| 8311 | "\\(\\(\\<begin\\>\\)\\|^\\s-*process\\>\\)" nil t)) |
| 8312 | seq-region-list) |
| 8313 | (cond |
| 8314 | ;; error if 'begin' keyword missing |
| 8315 | ((not (match-string 2)) |
| 8316 | (error "ERROR: No 'begin' keyword found")) |
| 8317 | ;; search for wait statement (no sensitivity list allowed) |
| 8318 | ((progn (goto-char proc-mid) |
| 8319 | (vhdl-re-search-forward "\\<wait\\>" proc-end t)) |
| 8320 | (error "ERROR: Process with wait statement, sensitivity list not generated")) |
| 8321 | ;; combinational process (update sensitivity list) |
| 8322 | (t |
| 8323 | (let |
| 8324 | ;; scan for visible signals |
| 8325 | ((visible-list (vhdl-get-visible-signals)) |
| 8326 | ;; define syntactic regions where signals are read |
| 8327 | (scan-regions-list |
| 8328 | '(;; right-hand side of signal/variable assignment |
| 8329 | ;; (special case: "<=" is relational operator in a condition) |
| 8330 | ((vhdl-re-search-forward "[<:]=" proc-end t) |
| 8331 | (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) |
| 8332 | ;; if condition |
| 8333 | ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) |
| 8334 | (vhdl-re-search-forward "\\<then\\>" proc-end t)) |
| 8335 | ;; elsif condition |
| 8336 | ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) |
| 8337 | (vhdl-re-search-forward "\\<then\\>" proc-end t)) |
| 8338 | ;; while loop condition |
| 8339 | ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) |
| 8340 | (vhdl-re-search-forward "\\<loop\\>" proc-end t)) |
| 8341 | ;; exit/next condition |
| 8342 | ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) |
| 8343 | (vhdl-re-search-forward ";" proc-end t)) |
| 8344 | ;; assert condition |
| 8345 | ((vhdl-re-search-forward "\\<assert\\>" proc-end t) |
| 8346 | (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) |
| 8347 | ;; case expression |
| 8348 | ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) |
| 8349 | (vhdl-re-search-forward "\\<is\\>" proc-end t)) |
| 8350 | ;; parameter list of procedure call, array index |
| 8351 | ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) |
| 8352 | (1- (point))) |
| 8353 | (progn (backward-char) (forward-sexp) |
| 8354 | (while (looking-at "(") (forward-sexp)) (point))))) |
| 8355 | name field read-list sens-list signal-list tmp-list |
| 8356 | sens-beg sens-end beg end margin) |
| 8357 | ;; scan for signals in old sensitivity list |
| 8358 | (goto-char proc-beg) |
| 8359 | (vhdl-re-search-forward "\\<process\\>" proc-mid t) |
| 8360 | (if (not (looking-at "[ \t\n\r\f]*(")) |
| 8361 | (setq sens-beg (point)) |
| 8362 | (setq sens-beg (vhdl-re-search-forward "\\([ \t\n\r\f]*\\)([ \t\n\r\f]*" nil t)) |
| 8363 | (goto-char (match-end 1)) |
| 8364 | (forward-sexp) |
| 8365 | (setq sens-end (1- (point))) |
| 8366 | (goto-char sens-beg) |
| 8367 | (while (and (vhdl-re-search-forward "\\(\\w+\\)" sens-end t) |
| 8368 | (setq sens-list |
| 8369 | (cons (downcase (match-string 0)) sens-list)) |
| 8370 | (vhdl-re-search-forward "\\s-*,\\s-*" sens-end t)))) |
| 8371 | (setq signal-list (append visible-list sens-list)) |
| 8372 | ;; search for sequential parts |
| 8373 | (goto-char proc-mid) |
| 8374 | (while (setq beg (re-search-forward "^\\s-*\\(els\\)?if\\>" proc-end t)) |
| 8375 | (setq end (vhdl-re-search-forward "\\<then\\>" proc-end t)) |
| 8376 | (when (vhdl-re-search-backward "\\('event\\|\\<\\(falling\\|rising\\)_edge\\)\\>" beg t) |
| 8377 | (goto-char end) |
| 8378 | (backward-word 1) |
| 8379 | (vhdl-forward-sexp) |
| 8380 | (push (cons end (point)) seq-region-list) |
| 8381 | (beginning-of-line))) |
| 8382 | ;; scan for signals read in process |
| 8383 | (while scan-regions-list |
| 8384 | (goto-char proc-mid) |
| 8385 | (while (and (setq beg (eval (nth 0 (car scan-regions-list)))) |
| 8386 | (setq end (eval (nth 1 (car scan-regions-list))))) |
| 8387 | (goto-char beg) |
| 8388 | (unless (or (vhdl-in-literal) |
| 8389 | (and seq-region-list |
| 8390 | (let ((tmp-list seq-region-list)) |
| 8391 | (while (and tmp-list |
| 8392 | (< (point) (caar tmp-list))) |
| 8393 | (setq tmp-list (cdr tmp-list))) |
| 8394 | (and tmp-list (< (point) (cdar tmp-list)))))) |
| 8395 | (while (vhdl-re-search-forward "[^'\".]\\<\\([a-zA-Z]\\w*\\)\\(\\(\\.\\w+\\|[ \t\n\r\f]*([^)]*)\\)*\\)[ \t\n\r\f]*\\('\\(\\w+\\)\\|\\(=>\\)\\)?" end t) |
| 8396 | (setq name (match-string 1)) |
| 8397 | ;; get array index range |
| 8398 | (when vhdl-array-index-record-field-in-sensitivity-list |
| 8399 | (setq field (match-string 2)) |
| 8400 | ;; not use if it includes a variable name |
| 8401 | (save-match-data |
| 8402 | (setq tmp-list visible-list) |
| 8403 | (while (and field tmp-list) |
| 8404 | (when (string-match |
| 8405 | (concat "\\<" (car tmp-list) "\\>") field) |
| 8406 | (setq field nil)) |
| 8407 | (setq tmp-list (cdr tmp-list))))) |
| 8408 | (when (and (not (match-string 6)) ; not when formal parameter |
| 8409 | (not (and (match-string 5) ; not event attribute |
| 8410 | (not (member (downcase (match-string 5)) |
| 8411 | '("event" "last_event" "transaction"))))) |
| 8412 | (member (downcase name) signal-list)) |
| 8413 | ;; not add if name or name+field already exists |
| 8414 | (unless |
| 8415 | (or (member-ignore-case name read-list) |
| 8416 | (member-ignore-case (concat name field) read-list)) |
| 8417 | (push (concat name field) read-list)) |
| 8418 | (setq tmp-list read-list) |
| 8419 | ;; remove existing name+field if name is added |
| 8420 | (save-match-data |
| 8421 | (while tmp-list |
| 8422 | (when (string-match (concat "^" name field "[(.]") |
| 8423 | (car tmp-list)) |
| 8424 | (setq read-list (delete (car tmp-list) read-list))) |
| 8425 | (setq tmp-list (cdr tmp-list))))) |
| 8426 | (goto-char (match-end 1))))) |
| 8427 | (setq scan-regions-list (cdr scan-regions-list))) |
| 8428 | ;; update sensitivity list |
| 8429 | (goto-char sens-beg) |
| 8430 | (if sens-end |
| 8431 | (delete-region sens-beg sens-end) |
| 8432 | (when read-list |
| 8433 | (insert " ()") (backward-char))) |
| 8434 | (setq read-list (sort read-list 'string<)) |
| 8435 | (when read-list |
| 8436 | (setq margin (current-column)) |
| 8437 | (insert (car read-list)) |
| 8438 | (setq read-list (cdr read-list)) |
| 8439 | (while read-list |
| 8440 | (insert ",") |
| 8441 | (if (<= (+ (current-column) (length (car read-list)) 2) |
| 8442 | end-comment-column) |
| 8443 | (insert " ") |
| 8444 | (insert "\n") (indent-to margin)) |
| 8445 | (insert (car read-list)) |
| 8446 | (setq read-list (cdr read-list))))))))) |
| 8447 | |
| 8448 | (defun vhdl-get-visible-signals () |
| 8449 | "Get all signals visible in the current block." |
| 8450 | (let (beg end signal-list entity-name file-name) |
| 8451 | (vhdl-prepare-search-2 |
| 8452 | ;; get entity name |
| 8453 | (save-excursion |
| 8454 | (unless (and (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) |
| 8455 | (not (equal "END" (upcase (match-string 1)))) |
| 8456 | (setq entity-name (match-string 2))) |
| 8457 | (error "ERROR: Not within an architecture"))) |
| 8458 | ;; search for signals declared in entity port clause |
| 8459 | (save-excursion |
| 8460 | (goto-char (point-min)) |
| 8461 | (unless (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t) |
| 8462 | (setq file-name |
| 8463 | (concat (vhdl-replace-string vhdl-entity-file-name entity-name t) |
| 8464 | "." (file-name-extension (buffer-file-name))))) |
| 8465 | (vhdl-visit-file |
| 8466 | file-name t |
| 8467 | (vhdl-prepare-search-2 |
| 8468 | (goto-char (point-min)) |
| 8469 | (if (not (re-search-forward (concat "^entity\\s-+" entity-name "\\>") nil t)) |
| 8470 | (error "ERROR: Entity \"%s\" not found:\n --> see option `vhdl-entity-file-name'" entity-name) |
| 8471 | (when (setq beg (vhdl-re-search-forward |
| 8472 | "\\<port[ \t\n\r\f]*(" |
| 8473 | (save-excursion |
| 8474 | (re-search-forward "^end\\>" nil t)) t)) |
| 8475 | (setq end (save-excursion |
| 8476 | (backward-char) (forward-sexp) (point))) |
| 8477 | (vhdl-forward-syntactic-ws) |
| 8478 | (while (< (point) end) |
| 8479 | (when (looking-at "signal[ \t\n\r\f]+") |
| 8480 | (goto-char (match-end 0))) |
| 8481 | (while (looking-at "\\([a-zA-Z]\\w*\\)[ \t\n\r\f,]+") |
| 8482 | (setq signal-list |
| 8483 | (cons (downcase (match-string 1)) signal-list)) |
| 8484 | (goto-char (match-end 0)) |
| 8485 | (vhdl-forward-syntactic-ws)) |
| 8486 | (re-search-forward ";" end 1) |
| 8487 | (vhdl-forward-syntactic-ws))))))) |
| 8488 | ;; search for signals declared in architecture declarative part |
| 8489 | (save-excursion |
| 8490 | (if (not (and (setq beg (re-search-backward "^\\(architecture\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)) |
| 8491 | (not (equal "END" (upcase (match-string 1)))) |
| 8492 | (setq end (re-search-forward "^begin\\>" nil t)))) |
| 8493 | (error "ERROR: No architecture declarative part found") |
| 8494 | ;; scan for all declared signal and alias names |
| 8495 | (goto-char beg) |
| 8496 | (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) |
| 8497 | (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) |
| 8498 | (if (match-string 2) |
| 8499 | ;; scan signal name |
| 8500 | (while (looking-at "[ \t\n\r\f,]+\\([a-zA-Z]\\w*\\)") |
| 8501 | (setq signal-list |
| 8502 | (cons (downcase (match-string 1)) signal-list)) |
| 8503 | (goto-char (match-end 0))) |
| 8504 | ;; scan alias name, check is alias of (declared) signal |
| 8505 | (when (and (looking-at "[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)[^;]*\\<is[ \t\n\r\f]+\\([a-zA-Z]\\w*\\)") |
| 8506 | (member (downcase (match-string 2)) signal-list)) |
| 8507 | (setq signal-list |
| 8508 | (cons (downcase (match-string 1)) signal-list)) |
| 8509 | (goto-char (match-end 0)))) |
| 8510 | (setq beg (point)))))) |
| 8511 | ;; search for signals declared in surrounding block declarative parts |
| 8512 | (save-excursion |
| 8513 | (while (and (progn (while (and (setq beg (re-search-backward "^\\s-*\\(\\w+\\s-*:\\s-*\\(block\\|\\(for\\|if\\).*\\<generate\\>\\)\\|\\(end\\)\\s-+block\\)\\>" nil t)) |
| 8514 | (match-string 4)) |
| 8515 | (goto-char (match-end 4)) |
| 8516 | (vhdl-backward-sexp) |
| 8517 | (re-search-backward "^\\s-*\\w+\\s-*:\\s-*\\(block\\|generate\\)\\>" nil t)) |
| 8518 | beg) |
| 8519 | (setq end (re-search-forward "^\\s-*begin\\>" nil t))) |
| 8520 | ;; scan for all declared signal names |
| 8521 | (goto-char beg) |
| 8522 | (while (re-search-forward "^\\s-*\\(\\(signal\\)\\|alias\\)\\>" end t) |
| 8523 | (when (= 0 (nth 0 (parse-partial-sexp beg (point)))) |
| 8524 | (if (match-string 2) |
| 8525 | ;; scan signal name |
| 8526 | (while (looking-at "[ \t\n,]+\\(\\w+\\)") |
| 8527 | (setq signal-list |
| 8528 | (cons (downcase (match-string 1)) signal-list)) |
| 8529 | (goto-char (match-end 0))) |
| 8530 | ;; scan alias name, check is alias of (declared) signal |
| 8531 | (when (and (looking-at "[ \t\n]+\\(\\w+\\)[^;]*\\<is[ \t\n]+\\(\\w+\\)") |
| 8532 | (member (downcase (match-string 2)) signal-list)) |
| 8533 | (setq signal-list |
| 8534 | (cons (downcase (match-string 1)) signal-list)) |
| 8535 | (goto-char (match-end 0)))))) |
| 8536 | (goto-char beg))) |
| 8537 | signal-list))) |
| 8538 | |
| 8539 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8540 | ;; Generic/port clause fixing |
| 8541 | |
| 8542 | (defun vhdl-fix-clause-buffer () |
| 8543 | "Fix all generic/port clauses in current buffer." |
| 8544 | (interactive) |
| 8545 | (save-excursion |
| 8546 | (vhdl-prepare-search-2 |
| 8547 | (goto-char (point-min)) |
| 8548 | (message "Fixing generic/port clauses...") |
| 8549 | (while (re-search-forward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t) |
| 8550 | (goto-char (match-end 0)) |
| 8551 | (condition-case nil (vhdl-fix-clause) (error ""))) |
| 8552 | (message "Fixing generic/port clauses...done")))) |
| 8553 | |
| 8554 | (defun vhdl-fix-clause () |
| 8555 | "Fix closing parenthesis within generic/port clause." |
| 8556 | (interactive) |
| 8557 | (save-excursion |
| 8558 | (vhdl-prepare-search-2 |
| 8559 | (let ((pos (point)) |
| 8560 | beg end) |
| 8561 | (end-of-line) |
| 8562 | (if (not (re-search-backward "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(" nil t)) |
| 8563 | (error "ERROR: Not within a generic/port clause") |
| 8564 | ;; search for end of clause |
| 8565 | (goto-char (match-end 0)) |
| 8566 | (setq beg (1- (point))) |
| 8567 | (vhdl-forward-syntactic-ws) |
| 8568 | (while (looking-at "\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*[ \t\n\r\f]*:[ \t\n\r\f]*\\w+[^;]*;") |
| 8569 | (goto-char (1- (match-end 0))) |
| 8570 | (setq end (point-marker)) |
| 8571 | (forward-char) |
| 8572 | (vhdl-forward-syntactic-ws)) |
| 8573 | (goto-char end) |
| 8574 | (when (> pos (point-at-eol)) |
| 8575 | (error "ERROR: Not within a generic/port clause")) |
| 8576 | ;; delete closing parenthesis on separate line (not supported style) |
| 8577 | (when (save-excursion (beginning-of-line) (looking-at "^\\s-*);")) |
| 8578 | (vhdl-line-kill) |
| 8579 | (vhdl-backward-syntactic-ws) |
| 8580 | (setq end (point-marker)) |
| 8581 | (insert ";")) |
| 8582 | ;; delete superfluous parentheses |
| 8583 | (while (progn (goto-char beg) |
| 8584 | (condition-case () (forward-sexp) |
| 8585 | (error (goto-char (point-max)))) |
| 8586 | (< (point) end)) |
| 8587 | (delete-char -1)) |
| 8588 | ;; add closing parenthesis |
| 8589 | (when (> (point) end) |
| 8590 | (goto-char end) |
| 8591 | (insert ")"))))))) |
| 8592 | |
| 8593 | |
| 8594 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8595 | ;;; Electrification |
| 8596 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8597 | |
| 8598 | (defconst vhdl-template-prompt-syntax "[^ =<>][^<>@.\n]*[^ =<>]" |
| 8599 | "Syntax of prompt inserted by template generators.") |
| 8600 | |
| 8601 | (defvar vhdl-template-invoked-by-hook nil |
| 8602 | "Indicates whether a template has been invoked by a hook or by key or menu. |
| 8603 | Used for undoing after template abortion.") |
| 8604 | |
| 8605 | ;; correct different behavior of function `unread-command-events' in XEmacs |
| 8606 | (defun vhdl-character-to-event (arg)) |
| 8607 | (defalias 'vhdl-character-to-event |
| 8608 | (if (fboundp 'character-to-event) 'character-to-event 'identity)) |
| 8609 | |
| 8610 | (defun vhdl-work-library () |
| 8611 | "Return the working library name of the current project or \"work\" if no |
| 8612 | project is defined." |
| 8613 | (vhdl-resolve-env-variable |
| 8614 | (or (nth 6 (vhdl-aget vhdl-project-alist vhdl-project)) |
| 8615 | vhdl-default-library))) |
| 8616 | |
| 8617 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8618 | ;; Enabling/disabling |
| 8619 | |
| 8620 | (define-minor-mode vhdl-electric-mode |
| 8621 | "Toggle VHDL electric mode. |
| 8622 | With a prefix argument ARG, enable the mode if ARG is positive, |
| 8623 | and disable it otherwise. If called from Lisp, enable it if ARG |
| 8624 | is omitted or nil." |
| 8625 | :global t :group 'vhdl-mode) |
| 8626 | |
| 8627 | (define-minor-mode vhdl-stutter-mode |
| 8628 | "Toggle VHDL stuttering mode. |
| 8629 | With a prefix argument ARG, enable the mode if ARG is positive, |
| 8630 | and disable it otherwise. If called from Lisp, enable it if ARG |
| 8631 | is omitted or nil." |
| 8632 | :global t :group 'vhdl-mode) |
| 8633 | |
| 8634 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8635 | ;; Stuttering |
| 8636 | |
| 8637 | (defun vhdl-electric-dash (count) |
| 8638 | "-- starts a comment, --- draws a horizontal line, |
| 8639 | ---- starts a display comment." |
| 8640 | (interactive "p") |
| 8641 | (if (and vhdl-stutter-mode (not (vhdl-in-literal))) |
| 8642 | (cond |
| 8643 | ((and abbrev-start-location (= abbrev-start-location (point))) |
| 8644 | (setq abbrev-start-location nil) |
| 8645 | (goto-char last-abbrev-location) |
| 8646 | (beginning-of-line nil) |
| 8647 | (vhdl-comment-display)) |
| 8648 | ((/= (preceding-char) ?-) ; standard dash (minus) |
| 8649 | (self-insert-command count)) |
| 8650 | (t (self-insert-command count) |
| 8651 | (message "Enter '-' for horiz. line, 'CR' for commenting-out code, else enter comment") |
| 8652 | (let ((next-input (read-char))) |
| 8653 | (if (= next-input ?-) ; triple dash |
| 8654 | (progn |
| 8655 | (vhdl-comment-display-line) |
| 8656 | (message |
| 8657 | "Enter '-' for display comment, else continue coding") |
| 8658 | (let ((next-input (read-char))) |
| 8659 | (if (= next-input ?-) ; four dashes |
| 8660 | (vhdl-comment-display t) |
| 8661 | (setq unread-command-events ; pushback the char |
| 8662 | (list (vhdl-character-to-event next-input)))))) |
| 8663 | (setq unread-command-events ; pushback the char |
| 8664 | (list (vhdl-character-to-event next-input))) |
| 8665 | (vhdl-comment-insert))))) |
| 8666 | (self-insert-command count))) |
| 8667 | |
| 8668 | (defun vhdl-electric-open-bracket (count) "'[' --> '(', '([' --> '['" |
| 8669 | (interactive "p") |
| 8670 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8671 | (if (= (preceding-char) ?\() |
| 8672 | (progn (delete-char -1) (insert-char ?\[ 1)) |
| 8673 | (insert-char ?\( 1)) |
| 8674 | (self-insert-command count))) |
| 8675 | |
| 8676 | (defun vhdl-electric-close-bracket (count) "']' --> ')', ')]' --> ']'" |
| 8677 | (interactive "p") |
| 8678 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8679 | (progn |
| 8680 | (if (= (preceding-char) ?\)) |
| 8681 | (progn (delete-char -1) (insert-char ?\] 1)) |
| 8682 | (insert-char ?\) 1)) |
| 8683 | (blink-matching-open)) |
| 8684 | (self-insert-command count))) |
| 8685 | |
| 8686 | (defun vhdl-electric-quote (count) "'' --> \"" |
| 8687 | (interactive "p") |
| 8688 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8689 | (if (= (preceding-char) vhdl-last-input-event) |
| 8690 | (progn (delete-char -1) (insert-char ?\" 1)) |
| 8691 | (insert-char ?\' 1)) |
| 8692 | (self-insert-command count))) |
| 8693 | |
| 8694 | (defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '" |
| 8695 | (interactive "p") |
| 8696 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8697 | (cond ((= (preceding-char) vhdl-last-input-event) |
| 8698 | (progn (delete-char -1) |
| 8699 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8700 | (insert ": ") |
| 8701 | (setq this-command 'vhdl-electric-colon))) |
| 8702 | ((and |
| 8703 | (eq last-command 'vhdl-electric-colon) (= (preceding-char) ? )) |
| 8704 | (progn (delete-char -1) (insert "= "))) |
| 8705 | (t (insert-char ?\; 1))) |
| 8706 | (self-insert-command count))) |
| 8707 | |
| 8708 | (defun vhdl-electric-comma (count) "',,' --> ' <= '" |
| 8709 | (interactive "p") |
| 8710 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8711 | (cond ((= (preceding-char) vhdl-last-input-event) |
| 8712 | (progn (delete-char -1) |
| 8713 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8714 | (insert "<= "))) |
| 8715 | (t (insert-char ?\, 1))) |
| 8716 | (self-insert-command count))) |
| 8717 | |
| 8718 | (defun vhdl-electric-period (count) "'..' --> ' => '" |
| 8719 | (interactive "p") |
| 8720 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8721 | (cond ((= (preceding-char) vhdl-last-input-event) |
| 8722 | (progn (delete-char -1) |
| 8723 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8724 | (insert "=> "))) |
| 8725 | (t (insert-char ?\. 1))) |
| 8726 | (self-insert-command count))) |
| 8727 | |
| 8728 | (defun vhdl-electric-equal (count) "'==' --> ' == '" |
| 8729 | (interactive "p") |
| 8730 | (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) |
| 8731 | (cond ((= (preceding-char) vhdl-last-input-event) |
| 8732 | (progn (delete-char -1) |
| 8733 | (unless (eq (preceding-char) ? ) (insert " ")) |
| 8734 | (insert "== "))) |
| 8735 | (t (insert-char ?\= 1))) |
| 8736 | (self-insert-command count))) |
| 8737 | |
| 8738 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 8739 | ;; VHDL templates |
| 8740 | |
| 8741 | (defun vhdl-template-paired-parens () |
| 8742 | "Insert a pair of round parentheses, placing point between them." |
| 8743 | (interactive) |
| 8744 | (insert "()") |
| 8745 | (backward-char)) |
| 8746 | |
| 8747 | (defun vhdl-template-alias () |
| 8748 | "Insert alias declaration." |
| 8749 | (interactive) |
| 8750 | (let ((start (point))) |
| 8751 | (vhdl-insert-keyword "ALIAS ") |
| 8752 | (when (vhdl-template-field "name" nil t start (point)) |
| 8753 | (insert " : ") |
| 8754 | (unless (vhdl-template-field |
| 8755 | (concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]") |
| 8756 | nil t) |
| 8757 | (delete-char -3)) |
| 8758 | (vhdl-insert-keyword " IS ") |
| 8759 | (vhdl-template-field "name" ";") |
| 8760 | (vhdl-comment-insert-inline)))) |
| 8761 | |
| 8762 | (defun vhdl-template-architecture () |
| 8763 | "Insert architecture." |
| 8764 | (interactive) |
| 8765 | (let ((margin (current-indentation)) |
| 8766 | (start (point)) |
| 8767 | arch-name) |
| 8768 | (vhdl-insert-keyword "ARCHITECTURE ") |
| 8769 | (when (setq arch-name |
| 8770 | (vhdl-template-field "name" nil t start (point))) |
| 8771 | (vhdl-insert-keyword " OF ") |
| 8772 | (if (save-excursion |
| 8773 | (vhdl-prepare-search-1 |
| 8774 | (vhdl-re-search-backward "\\<entity \\(\\w+\\) is\\>" nil t))) |
| 8775 | (insert (match-string 1)) |
| 8776 | (vhdl-template-field "entity name")) |
| 8777 | (vhdl-insert-keyword " IS\n") |
| 8778 | (vhdl-template-begin-end |
| 8779 | (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name margin |
| 8780 | (memq vhdl-insert-empty-lines '(unit all)))))) |
| 8781 | |
| 8782 | (defun vhdl-template-array (kind &optional secondary) |
| 8783 | "Insert array type definition." |
| 8784 | (interactive) |
| 8785 | (let ((start (point))) |
| 8786 | (vhdl-insert-keyword "ARRAY (") |
| 8787 | (when (or (vhdl-template-field "range" nil (not secondary) start (point)) |
| 8788 | secondary) |
| 8789 | (vhdl-insert-keyword ") OF ") |
| 8790 | (vhdl-template-field (if (eq kind 'type) "type" "nature")) |
| 8791 | (vhdl-insert-keyword ";")))) |
| 8792 | |
| 8793 | (defun vhdl-template-assert () |
| 8794 | "Insert an assertion statement." |
| 8795 | (interactive) |
| 8796 | (let ((start (point))) |
| 8797 | (vhdl-insert-keyword "ASSERT ") |
| 8798 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8799 | (when (vhdl-template-field "condition (negated)" nil t start (point)) |
| 8800 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8801 | (setq start (point)) |
| 8802 | (vhdl-insert-keyword " REPORT ") |
| 8803 | (unless (vhdl-template-field "string expression" nil nil nil nil t) |
| 8804 | (delete-region start (point))) |
| 8805 | (setq start (point)) |
| 8806 | (vhdl-insert-keyword " SEVERITY ") |
| 8807 | (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) |
| 8808 | (delete-region start (point))) |
| 8809 | (insert ";")))) |
| 8810 | |
| 8811 | (defun vhdl-template-attribute () |
| 8812 | "Insert an attribute declaration or specification." |
| 8813 | (interactive) |
| 8814 | (if (eq (vhdl-decision-query |
| 8815 | "attribute" "(d)eclaration or (s)pecification?" t) ?s) |
| 8816 | (vhdl-template-attribute-spec) |
| 8817 | (vhdl-template-attribute-decl))) |
| 8818 | |
| 8819 | (defun vhdl-template-attribute-decl () |
| 8820 | "Insert an attribute declaration." |
| 8821 | (interactive) |
| 8822 | (let ((start (point))) |
| 8823 | (vhdl-insert-keyword "ATTRIBUTE ") |
| 8824 | (when (vhdl-template-field "name" " : " t start (point)) |
| 8825 | (vhdl-template-field "type" ";") |
| 8826 | (vhdl-comment-insert-inline)))) |
| 8827 | |
| 8828 | (defun vhdl-template-attribute-spec () |
| 8829 | "Insert an attribute specification." |
| 8830 | (interactive) |
| 8831 | (let ((start (point))) |
| 8832 | (vhdl-insert-keyword "ATTRIBUTE ") |
| 8833 | (when (vhdl-template-field "name" nil t start (point)) |
| 8834 | (vhdl-insert-keyword " OF ") |
| 8835 | (vhdl-template-field "entity names | OTHERS | ALL" " : ") |
| 8836 | (vhdl-template-field "entity class") |
| 8837 | (vhdl-insert-keyword " IS ") |
| 8838 | (vhdl-template-field "expression" ";")))) |
| 8839 | |
| 8840 | (defun vhdl-template-block () |
| 8841 | "Insert a block." |
| 8842 | (interactive) |
| 8843 | (let ((margin (current-indentation)) |
| 8844 | (start (point)) |
| 8845 | label) |
| 8846 | (vhdl-insert-keyword ": BLOCK ") |
| 8847 | (goto-char start) |
| 8848 | (when (setq label (vhdl-template-field "label" nil t start (+ (point) 8))) |
| 8849 | (forward-word 1) |
| 8850 | (forward-char 1) |
| 8851 | (insert "(") |
| 8852 | (if (vhdl-template-field "[guard expression]" nil t) |
| 8853 | (insert ")") |
| 8854 | (delete-char -2)) |
| 8855 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 8856 | (insert "\n") |
| 8857 | (vhdl-template-begin-end "BLOCK" label margin) |
| 8858 | (vhdl-comment-block)))) |
| 8859 | |
| 8860 | (defun vhdl-template-block-configuration () |
| 8861 | "Insert a block configuration statement." |
| 8862 | (interactive) |
| 8863 | (let ((margin (current-indentation)) |
| 8864 | (start (point))) |
| 8865 | (vhdl-insert-keyword "FOR ") |
| 8866 | (when (vhdl-template-field "block name" nil t start (point)) |
| 8867 | (vhdl-insert-keyword "\n\n") |
| 8868 | (indent-to margin) |
| 8869 | (vhdl-insert-keyword "END FOR;") |
| 8870 | (end-of-line 0) |
| 8871 | (indent-to (+ margin vhdl-basic-offset))))) |
| 8872 | |
| 8873 | (defun vhdl-template-break () |
| 8874 | "Insert a break statement." |
| 8875 | (interactive) |
| 8876 | (let (position) |
| 8877 | (vhdl-insert-keyword "BREAK") |
| 8878 | (setq position (point)) |
| 8879 | (insert " ") |
| 8880 | (while (or |
| 8881 | (progn (vhdl-insert-keyword "FOR ") |
| 8882 | (if (vhdl-template-field "[quantity name]" " USE " t) |
| 8883 | (progn (vhdl-template-field "quantity name" " => ") t) |
| 8884 | (delete-region (point) |
| 8885 | (progn (forward-word -1) (point))) |
| 8886 | nil)) |
| 8887 | (vhdl-template-field "[quantity name]" " => " t)) |
| 8888 | (vhdl-template-field "expression") |
| 8889 | (setq position (point)) |
| 8890 | (insert ", ")) |
| 8891 | (delete-region position (point)) |
| 8892 | (unless (vhdl-sequential-statement-p) |
| 8893 | (vhdl-insert-keyword " ON ") |
| 8894 | (if (vhdl-template-field "[sensitivity list]" nil t) |
| 8895 | (setq position (point)) |
| 8896 | (delete-region position (point)))) |
| 8897 | (vhdl-insert-keyword " WHEN ") |
| 8898 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 8899 | (if (vhdl-template-field "[condition]" nil t) |
| 8900 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 8901 | (delete-region position (point))) |
| 8902 | (insert ";"))) |
| 8903 | |
| 8904 | (defun vhdl-template-case (&optional kind) |
| 8905 | "Insert a case statement." |
| 8906 | (interactive) |
| 8907 | (let ((margin (current-indentation)) |
| 8908 | (start (point)) |
| 8909 | label) |
| 8910 | (unless kind (setq kind (if (or (vhdl-sequential-statement-p) |
| 8911 | (not (vhdl-standard-p 'ams))) 'is 'use))) |
| 8912 | (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) |
| 8913 | (vhdl-insert-keyword "CASE ") |
| 8914 | (vhdl-insert-keyword ": CASE ") |
| 8915 | (goto-char start) |
| 8916 | (setq label (vhdl-template-field "[label]" nil t)) |
| 8917 | (unless label (delete-char 2)) |
| 8918 | (forward-word 1) |
| 8919 | (forward-char 1)) |
| 8920 | (when (vhdl-template-field "expression" nil t start (point)) |
| 8921 | (vhdl-insert-keyword (concat " " (if (eq kind 'is) "IS" "USE") "\n\n")) |
| 8922 | (indent-to margin) |
| 8923 | (vhdl-insert-keyword "END CASE") |
| 8924 | (when label (insert " " label)) |
| 8925 | (insert ";") |
| 8926 | (forward-line -1) |
| 8927 | (indent-to (+ margin vhdl-basic-offset)) |
| 8928 | (vhdl-insert-keyword "WHEN ") |
| 8929 | (let ((position (point))) |
| 8930 | (insert " => ;\n") |
| 8931 | (indent-to (+ margin vhdl-basic-offset)) |
| 8932 | (vhdl-insert-keyword "WHEN OTHERS => null;") |
| 8933 | (goto-char position))))) |
| 8934 | |
| 8935 | (defun vhdl-template-case-is () |
| 8936 | "Insert a sequential case statement." |
| 8937 | (interactive) |
| 8938 | (vhdl-template-case 'is)) |
| 8939 | |
| 8940 | (defun vhdl-template-case-use () |
| 8941 | "Insert a simultaneous case statement." |
| 8942 | (interactive) |
| 8943 | (vhdl-template-case 'use)) |
| 8944 | |
| 8945 | (defun vhdl-template-component () |
| 8946 | "Insert a component declaration." |
| 8947 | (interactive) |
| 8948 | (vhdl-template-component-decl)) |
| 8949 | |
| 8950 | (defun vhdl-template-component-conf () |
| 8951 | "Insert a component configuration (uses `vhdl-template-configuration-spec' |
| 8952 | since these are almost equivalent)." |
| 8953 | (interactive) |
| 8954 | (let ((margin (current-indentation)) |
| 8955 | (result (vhdl-template-configuration-spec t))) |
| 8956 | (when result |
| 8957 | (insert "\n") |
| 8958 | (indent-to margin) |
| 8959 | (vhdl-insert-keyword "END FOR;") |
| 8960 | (when (eq result 'no-use) |
| 8961 | (end-of-line -0))))) |
| 8962 | |
| 8963 | (defun vhdl-template-component-decl () |
| 8964 | "Insert a component declaration." |
| 8965 | (interactive) |
| 8966 | (let ((margin (current-indentation)) |
| 8967 | (start (point)) |
| 8968 | name end-column) |
| 8969 | (vhdl-insert-keyword "COMPONENT ") |
| 8970 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 8971 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 8972 | (insert "\n\n") |
| 8973 | (indent-to margin) |
| 8974 | (vhdl-insert-keyword "END COMPONENT") |
| 8975 | (unless (vhdl-standard-p '87) (insert " " name)) |
| 8976 | (insert ";") |
| 8977 | (setq end-column (current-column)) |
| 8978 | (end-of-line -0) |
| 8979 | (indent-to (+ margin vhdl-basic-offset)) |
| 8980 | (vhdl-template-generic-list t t) |
| 8981 | (insert "\n") |
| 8982 | (indent-to (+ margin vhdl-basic-offset)) |
| 8983 | (vhdl-template-port-list t) |
| 8984 | (beginning-of-line 2) |
| 8985 | (forward-char end-column)))) |
| 8986 | |
| 8987 | (defun vhdl-template-component-inst () |
| 8988 | "Insert a component instantiation statement." |
| 8989 | (interactive) |
| 8990 | (let ((margin (current-indentation)) |
| 8991 | (start (point)) |
| 8992 | unit position) |
| 8993 | (when (vhdl-template-field "instance label" nil t start (point)) |
| 8994 | (insert ": ") |
| 8995 | (if (not (vhdl-use-direct-instantiation)) |
| 8996 | (vhdl-template-field "component name") |
| 8997 | ;; direct instantiation |
| 8998 | (setq unit (vhdl-template-field |
| 8999 | "[COMPONENT | ENTITY | CONFIGURATION]" " " t)) |
| 9000 | (setq unit (upcase (or unit ""))) |
| 9001 | (cond ((equal unit "ENTITY") |
| 9002 | (let ((begin (point))) |
| 9003 | (vhdl-template-field "library name" "." t begin (point) nil |
| 9004 | (vhdl-work-library)) |
| 9005 | (vhdl-template-field "entity name" "(") |
| 9006 | (if (vhdl-template-field "[architecture name]" nil t) |
| 9007 | (insert ")") |
| 9008 | (delete-char -1)))) |
| 9009 | ((equal unit "CONFIGURATION") |
| 9010 | (vhdl-template-field "library name" "." nil nil nil nil |
| 9011 | (vhdl-work-library)) |
| 9012 | (vhdl-template-field "configuration name")) |
| 9013 | (t (vhdl-template-field "component name")))) |
| 9014 | (insert "\n") |
| 9015 | (indent-to (+ margin vhdl-basic-offset)) |
| 9016 | (setq position (point)) |
| 9017 | (vhdl-insert-keyword "GENERIC ") |
| 9018 | (when (vhdl-template-map position t t) |
| 9019 | (insert "\n") |
| 9020 | (indent-to (+ margin vhdl-basic-offset))) |
| 9021 | (setq position (point)) |
| 9022 | (vhdl-insert-keyword "PORT ") |
| 9023 | (unless (vhdl-template-map position t t) |
| 9024 | (delete-region (line-beginning-position) (point)) |
| 9025 | (delete-char -1)) |
| 9026 | (insert ";")))) |
| 9027 | |
| 9028 | (defun vhdl-template-conditional-signal-asst () |
| 9029 | "Insert a conditional signal assignment." |
| 9030 | (interactive) |
| 9031 | (when (vhdl-template-field "target signal") |
| 9032 | (insert " <= ") |
| 9033 | (let ((margin (current-column)) |
| 9034 | (start (point)) |
| 9035 | position) |
| 9036 | (vhdl-template-field "waveform") |
| 9037 | (setq position (point)) |
| 9038 | (vhdl-insert-keyword " WHEN ") |
| 9039 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9040 | (while (and (vhdl-template-field "[condition]" nil t) |
| 9041 | (progn |
| 9042 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9043 | (setq position (point)) |
| 9044 | (vhdl-insert-keyword " ELSE") |
| 9045 | (insert "\n") |
| 9046 | (indent-to margin) |
| 9047 | (vhdl-template-field "[waveform]" nil t))) |
| 9048 | (setq position (point)) |
| 9049 | (vhdl-insert-keyword " WHEN ") |
| 9050 | (when vhdl-conditions-in-parenthesis (insert "("))) |
| 9051 | (delete-region position (point)) |
| 9052 | (insert ";") |
| 9053 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 9054 | |
| 9055 | (defun vhdl-template-configuration () |
| 9056 | "Insert a configuration specification if within an architecture, |
| 9057 | a block or component configuration if within a configuration declaration, |
| 9058 | a configuration declaration if not within a design unit." |
| 9059 | (interactive) |
| 9060 | (vhdl-prepare-search-1 |
| 9061 | (cond |
| 9062 | ((and (save-excursion ; architecture body |
| 9063 | (re-search-backward "^\\(architecture\\|end\\)\\>" nil t)) |
| 9064 | (equal "ARCHITECTURE" (upcase (match-string 1)))) |
| 9065 | (vhdl-template-configuration-spec)) |
| 9066 | ((and (save-excursion ; configuration declaration |
| 9067 | (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) |
| 9068 | (equal "CONFIGURATION" (upcase (match-string 1)))) |
| 9069 | (if (eq (vhdl-decision-query |
| 9070 | "configuration" "(b)lock or (c)omponent configuration?" t) ?c) |
| 9071 | (vhdl-template-component-conf) |
| 9072 | (vhdl-template-block-configuration))) |
| 9073 | (t (vhdl-template-configuration-decl))))) ; otherwise |
| 9074 | |
| 9075 | (defun vhdl-template-configuration-spec (&optional optional-use) |
| 9076 | "Insert a configuration specification." |
| 9077 | (interactive) |
| 9078 | (let ((margin (current-indentation)) |
| 9079 | (start (point)) |
| 9080 | aspect position) |
| 9081 | (vhdl-insert-keyword "FOR ") |
| 9082 | (when (vhdl-template-field "instance names | OTHERS | ALL" " : " |
| 9083 | t start (point)) |
| 9084 | (vhdl-template-field "component name" "\n") |
| 9085 | (indent-to (+ margin vhdl-basic-offset)) |
| 9086 | (setq start (point)) |
| 9087 | (vhdl-insert-keyword "USE ") |
| 9088 | (if (and optional-use |
| 9089 | (not (setq aspect (vhdl-template-field |
| 9090 | "[ENTITY | CONFIGURATION | OPEN]" " " t)))) |
| 9091 | (progn (delete-region start (point)) 'no-use) |
| 9092 | (unless optional-use |
| 9093 | (setq aspect (vhdl-template-field |
| 9094 | "ENTITY | CONFIGURATION | OPEN" " "))) |
| 9095 | (setq aspect (upcase (or aspect ""))) |
| 9096 | (cond ((equal aspect "ENTITY") |
| 9097 | (vhdl-template-field "library name" "." nil nil nil nil |
| 9098 | (vhdl-work-library)) |
| 9099 | (vhdl-template-field "entity name" "(") |
| 9100 | (if (vhdl-template-field "[architecture name]" nil t) |
| 9101 | (insert ")") |
| 9102 | (delete-char -1)) |
| 9103 | (insert "\n") |
| 9104 | (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 9105 | (setq position (point)) |
| 9106 | (vhdl-insert-keyword "GENERIC ") |
| 9107 | (when (vhdl-template-map position t t) |
| 9108 | (insert "\n") |
| 9109 | (indent-to (+ margin (* 2 vhdl-basic-offset)))) |
| 9110 | (setq position (point)) |
| 9111 | (vhdl-insert-keyword "PORT ") |
| 9112 | (unless (vhdl-template-map position t t) |
| 9113 | (delete-region (line-beginning-position) (point)) |
| 9114 | (delete-char -1)) |
| 9115 | (insert ";") |
| 9116 | t) |
| 9117 | ((equal aspect "CONFIGURATION") |
| 9118 | (vhdl-template-field "library name" "." nil nil nil nil |
| 9119 | (vhdl-work-library)) |
| 9120 | (vhdl-template-field "configuration name" ";")) |
| 9121 | (t (delete-char -1) (insert ";") t)))))) |
| 9122 | |
| 9123 | |
| 9124 | (defun vhdl-template-configuration-decl () |
| 9125 | "Insert a configuration declaration." |
| 9126 | (interactive) |
| 9127 | (let ((margin (current-indentation)) |
| 9128 | (start (point)) |
| 9129 | entity-exists string name position) |
| 9130 | (vhdl-insert-keyword "CONFIGURATION ") |
| 9131 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9132 | (vhdl-insert-keyword " OF ") |
| 9133 | (save-excursion |
| 9134 | (vhdl-prepare-search-1 |
| 9135 | (setq entity-exists (vhdl-re-search-backward |
| 9136 | "\\<entity \\(\\w*\\) is\\>" nil t)) |
| 9137 | (setq string (match-string 1)))) |
| 9138 | (if (and entity-exists (not (equal string ""))) |
| 9139 | (insert string) |
| 9140 | (vhdl-template-field "entity name")) |
| 9141 | (vhdl-insert-keyword " IS\n") |
| 9142 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9143 | (indent-to (+ margin vhdl-basic-offset)) |
| 9144 | (setq position (point)) |
| 9145 | (insert "\n") |
| 9146 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9147 | (indent-to margin) |
| 9148 | (vhdl-insert-keyword "END ") |
| 9149 | (unless (vhdl-standard-p '87) |
| 9150 | (vhdl-insert-keyword "CONFIGURATION ")) |
| 9151 | (insert name ";") |
| 9152 | (goto-char position)))) |
| 9153 | |
| 9154 | (defun vhdl-template-constant () |
| 9155 | "Insert a constant declaration." |
| 9156 | (interactive) |
| 9157 | (let ((start (point)) |
| 9158 | (in-arglist (vhdl-in-argument-list-p))) |
| 9159 | (vhdl-insert-keyword "CONSTANT ") |
| 9160 | (when (vhdl-template-field "name" nil t start (point)) |
| 9161 | (insert " : ") |
| 9162 | (when in-arglist (vhdl-insert-keyword "IN ")) |
| 9163 | (vhdl-template-field "type") |
| 9164 | (if in-arglist |
| 9165 | (progn (insert ";") |
| 9166 | (vhdl-comment-insert-inline)) |
| 9167 | (let ((position (point))) |
| 9168 | (insert " := ") |
| 9169 | (unless (vhdl-template-field "[initialization]" nil t) |
| 9170 | (delete-region position (point))) |
| 9171 | (insert ";") |
| 9172 | (vhdl-comment-insert-inline)))))) |
| 9173 | |
| 9174 | (defun vhdl-template-default () |
| 9175 | "Insert nothing." |
| 9176 | (interactive) |
| 9177 | (insert " ") |
| 9178 | (unexpand-abbrev) |
| 9179 | (backward-word 1) |
| 9180 | (vhdl-case-word 1) |
| 9181 | (forward-char 1)) |
| 9182 | |
| 9183 | (defun vhdl-template-default-indent () |
| 9184 | "Insert nothing and indent." |
| 9185 | (interactive) |
| 9186 | (insert " ") |
| 9187 | (unexpand-abbrev) |
| 9188 | (backward-word 1) |
| 9189 | (vhdl-case-word 1) |
| 9190 | (forward-char 1) |
| 9191 | (indent-according-to-mode)) |
| 9192 | |
| 9193 | (defun vhdl-template-disconnect () |
| 9194 | "Insert a disconnect statement." |
| 9195 | (interactive) |
| 9196 | (let ((start (point))) |
| 9197 | (vhdl-insert-keyword "DISCONNECT ") |
| 9198 | (when (vhdl-template-field "signal names | OTHERS | ALL" |
| 9199 | " : " t start (point)) |
| 9200 | (vhdl-template-field "type") |
| 9201 | (vhdl-insert-keyword " AFTER ") |
| 9202 | (vhdl-template-field "time expression" ";")))) |
| 9203 | |
| 9204 | (defun vhdl-template-else () |
| 9205 | "Insert an else statement." |
| 9206 | (interactive) |
| 9207 | (let (margin) |
| 9208 | (vhdl-prepare-search-1 |
| 9209 | (vhdl-insert-keyword "ELSE") |
| 9210 | (if (and (save-excursion (vhdl-re-search-backward "\\(\\<when\\>\\|;\\)" nil t)) |
| 9211 | (equal "WHEN" (upcase (match-string 1)))) |
| 9212 | (insert " ") |
| 9213 | (indent-according-to-mode) |
| 9214 | (setq margin (current-indentation)) |
| 9215 | (insert "\n") |
| 9216 | (indent-to (+ margin vhdl-basic-offset)))))) |
| 9217 | |
| 9218 | (defun vhdl-template-elsif () |
| 9219 | "Insert an elsif statement." |
| 9220 | (interactive) |
| 9221 | (let ((start (point)) |
| 9222 | margin) |
| 9223 | (vhdl-insert-keyword "ELSIF ") |
| 9224 | (when (or (vhdl-sequential-statement-p) (vhdl-standard-p 'ams)) |
| 9225 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9226 | (when (vhdl-template-field "condition" nil t start (point)) |
| 9227 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9228 | (indent-according-to-mode) |
| 9229 | (setq margin (current-indentation)) |
| 9230 | (vhdl-insert-keyword |
| 9231 | (concat " " (if (vhdl-sequential-statement-p) "THEN" "USE") "\n")) |
| 9232 | (indent-to (+ margin vhdl-basic-offset)))))) |
| 9233 | |
| 9234 | (defun vhdl-template-entity () |
| 9235 | "Insert an entity." |
| 9236 | (interactive) |
| 9237 | (let ((margin (current-indentation)) |
| 9238 | (start (point)) |
| 9239 | name end-column) |
| 9240 | (vhdl-insert-keyword "ENTITY ") |
| 9241 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9242 | (vhdl-insert-keyword " IS\n\n") |
| 9243 | (indent-to margin) |
| 9244 | (vhdl-insert-keyword "END ") |
| 9245 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 9246 | (insert name ";") |
| 9247 | (setq end-column (current-column)) |
| 9248 | (end-of-line -0) |
| 9249 | (indent-to (+ margin vhdl-basic-offset)) |
| 9250 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9251 | (indent-to (+ margin vhdl-basic-offset)) |
| 9252 | (when (vhdl-template-generic-list t) |
| 9253 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) |
| 9254 | (insert "\n") |
| 9255 | (indent-to (+ margin vhdl-basic-offset)) |
| 9256 | (when (vhdl-template-port-list t) |
| 9257 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))) |
| 9258 | (beginning-of-line 2) |
| 9259 | (forward-char end-column)))) |
| 9260 | |
| 9261 | (defun vhdl-template-exit () |
| 9262 | "Insert an exit statement." |
| 9263 | (interactive) |
| 9264 | (let ((start (point))) |
| 9265 | (vhdl-insert-keyword "EXIT ") |
| 9266 | (if (vhdl-template-field "[loop label]" nil t start (point)) |
| 9267 | (let ((position (point))) |
| 9268 | (vhdl-insert-keyword " WHEN ") |
| 9269 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9270 | (if (vhdl-template-field "[condition]" nil t) |
| 9271 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9272 | (delete-region position (point)))) |
| 9273 | (delete-char -1)) |
| 9274 | (insert ";"))) |
| 9275 | |
| 9276 | (defun vhdl-template-file () |
| 9277 | "Insert a file declaration." |
| 9278 | (interactive) |
| 9279 | (let ((start (point))) |
| 9280 | (vhdl-insert-keyword "FILE ") |
| 9281 | (when (vhdl-template-field "name" nil t start (point)) |
| 9282 | (insert " : ") |
| 9283 | (vhdl-template-field "type") |
| 9284 | (unless (vhdl-standard-p '87) |
| 9285 | (vhdl-insert-keyword " OPEN ") |
| 9286 | (unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]" |
| 9287 | nil t) |
| 9288 | (delete-char -6))) |
| 9289 | (vhdl-insert-keyword " IS ") |
| 9290 | (when (vhdl-standard-p '87) |
| 9291 | (vhdl-template-field "[IN | OUT]" " " t)) |
| 9292 | (vhdl-template-field "filename-string" nil nil nil nil t) |
| 9293 | (insert ";") |
| 9294 | (vhdl-comment-insert-inline)))) |
| 9295 | |
| 9296 | (defun vhdl-template-for () |
| 9297 | "Insert a block or component configuration if within a configuration |
| 9298 | declaration, a configuration specification if within an architecture |
| 9299 | declarative part (and not within a subprogram), a for-loop if within a |
| 9300 | sequential statement part (subprogram or process), and a for-generate |
| 9301 | otherwise." |
| 9302 | (interactive) |
| 9303 | (vhdl-prepare-search-1 |
| 9304 | (cond |
| 9305 | ((vhdl-sequential-statement-p) ; sequential statement |
| 9306 | (vhdl-template-for-loop)) |
| 9307 | ((and (save-excursion ; configuration declaration |
| 9308 | (re-search-backward "^\\(configuration\\|end\\)\\>" nil t)) |
| 9309 | (equal "CONFIGURATION" (upcase (match-string 1)))) |
| 9310 | (if (eq (vhdl-decision-query |
| 9311 | "for" "(b)lock or (c)omponent configuration?" t) ?c) |
| 9312 | (vhdl-template-component-conf) |
| 9313 | (vhdl-template-block-configuration))) |
| 9314 | ((and (save-excursion |
| 9315 | (re-search-backward ; architecture declarative part |
| 9316 | "^\\(architecture\\|entity\\|begin\\|end\\)\\>" nil t)) |
| 9317 | (equal "ARCHITECTURE" (upcase (match-string 1)))) |
| 9318 | (vhdl-template-configuration-spec)) |
| 9319 | (t (vhdl-template-for-generate))))) ; concurrent statement |
| 9320 | |
| 9321 | (defun vhdl-template-for-generate () |
| 9322 | "Insert a for-generate." |
| 9323 | (interactive) |
| 9324 | (let ((margin (current-indentation)) |
| 9325 | (start (point)) |
| 9326 | label position) |
| 9327 | (vhdl-insert-keyword ": FOR ") |
| 9328 | (setq position (point-marker)) |
| 9329 | (goto-char start) |
| 9330 | (when (setq label (vhdl-template-field "label" nil t start position)) |
| 9331 | (goto-char position) |
| 9332 | (vhdl-template-field "loop variable") |
| 9333 | (vhdl-insert-keyword " IN ") |
| 9334 | (vhdl-template-field "range") |
| 9335 | (vhdl-template-generate-body margin label)))) |
| 9336 | |
| 9337 | (defun vhdl-template-for-loop () |
| 9338 | "Insert a for loop." |
| 9339 | (interactive) |
| 9340 | (let ((margin (current-indentation)) |
| 9341 | (start (point)) |
| 9342 | label index) |
| 9343 | (if (not (eq vhdl-optional-labels 'all)) |
| 9344 | (vhdl-insert-keyword "FOR ") |
| 9345 | (vhdl-insert-keyword ": FOR ") |
| 9346 | (goto-char start) |
| 9347 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9348 | (unless label (delete-char 2)) |
| 9349 | (forward-word 1) |
| 9350 | (forward-char 1)) |
| 9351 | (when (setq index (vhdl-template-field "loop variable" |
| 9352 | nil t start (point))) |
| 9353 | (vhdl-insert-keyword " IN ") |
| 9354 | (vhdl-template-field "range") |
| 9355 | (vhdl-insert-keyword " LOOP\n\n") |
| 9356 | (indent-to margin) |
| 9357 | (vhdl-insert-keyword "END LOOP") |
| 9358 | (if label |
| 9359 | (insert " " label ";") |
| 9360 | (insert ";") |
| 9361 | (when vhdl-self-insert-comments (insert " -- " index))) |
| 9362 | (forward-line -1) |
| 9363 | (indent-to (+ margin vhdl-basic-offset))))) |
| 9364 | |
| 9365 | (defun vhdl-template-function (&optional kind) |
| 9366 | "Insert a function declaration or body." |
| 9367 | (interactive) |
| 9368 | (let ((margin (current-indentation)) |
| 9369 | (start (point)) |
| 9370 | name) |
| 9371 | (vhdl-insert-keyword "FUNCTION ") |
| 9372 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9373 | (vhdl-template-argument-list t) |
| 9374 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 9375 | (end-of-line) |
| 9376 | (insert "\n") |
| 9377 | (indent-to (+ margin vhdl-basic-offset)) |
| 9378 | (vhdl-insert-keyword "RETURN ") |
| 9379 | (vhdl-template-field "type") |
| 9380 | (if (if kind (eq kind 'body) |
| 9381 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) |
| 9382 | (progn (vhdl-insert-keyword " IS\n") |
| 9383 | (vhdl-template-begin-end |
| 9384 | (unless (vhdl-standard-p '87) "FUNCTION") name margin) |
| 9385 | (vhdl-comment-block)) |
| 9386 | (insert ";"))))) |
| 9387 | |
| 9388 | (defun vhdl-template-function-decl () |
| 9389 | "Insert a function declaration." |
| 9390 | (interactive) |
| 9391 | (vhdl-template-function 'decl)) |
| 9392 | |
| 9393 | (defun vhdl-template-function-body () |
| 9394 | "Insert a function declaration." |
| 9395 | (interactive) |
| 9396 | (vhdl-template-function 'body)) |
| 9397 | |
| 9398 | (defun vhdl-template-generate () |
| 9399 | "Insert a generation scheme." |
| 9400 | (interactive) |
| 9401 | (if (eq (vhdl-decision-query nil "(f)or or (i)f?" t) ?i) |
| 9402 | (vhdl-template-if-generate) |
| 9403 | (vhdl-template-for-generate))) |
| 9404 | |
| 9405 | (defun vhdl-template-generic () |
| 9406 | "Insert generic declaration, or generic map in instantiation statements." |
| 9407 | (interactive) |
| 9408 | (let ((start (point))) |
| 9409 | (vhdl-prepare-search-1 |
| 9410 | (cond |
| 9411 | ((and (save-excursion ; entity declaration |
| 9412 | (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) |
| 9413 | (equal "ENTITY" (upcase (match-string 1)))) |
| 9414 | (vhdl-template-generic-list nil)) |
| 9415 | ((or (save-excursion |
| 9416 | (or (beginning-of-line) |
| 9417 | (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) |
| 9418 | (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) |
| 9419 | (vhdl-insert-keyword "GENERIC ") |
| 9420 | (vhdl-template-map start)) |
| 9421 | (t (vhdl-template-generic-list nil t)))))) |
| 9422 | |
| 9423 | (defun vhdl-template-group () |
| 9424 | "Insert group or group template declaration." |
| 9425 | (interactive) |
| 9426 | (let ((start (point))) |
| 9427 | (if (eq (vhdl-decision-query |
| 9428 | "group" "(d)eclaration or (t)emplate declaration?" t) ?t) |
| 9429 | (vhdl-template-group-template) |
| 9430 | (vhdl-template-group-decl)))) |
| 9431 | |
| 9432 | (defun vhdl-template-group-decl () |
| 9433 | "Insert group declaration." |
| 9434 | (interactive) |
| 9435 | (let ((start (point))) |
| 9436 | (vhdl-insert-keyword "GROUP ") |
| 9437 | (when (vhdl-template-field "name" " : " t start (point)) |
| 9438 | (vhdl-template-field "template name" " (") |
| 9439 | (vhdl-template-field "constituent list" ");") |
| 9440 | (vhdl-comment-insert-inline)))) |
| 9441 | |
| 9442 | (defun vhdl-template-group-template () |
| 9443 | "Insert group template declaration." |
| 9444 | (interactive) |
| 9445 | (let ((start (point))) |
| 9446 | (vhdl-insert-keyword "GROUP ") |
| 9447 | (when (vhdl-template-field "template name" nil t start (point)) |
| 9448 | (vhdl-insert-keyword " IS (") |
| 9449 | (vhdl-template-field "entity class list" ");") |
| 9450 | (vhdl-comment-insert-inline)))) |
| 9451 | |
| 9452 | (defun vhdl-template-if () |
| 9453 | "Insert a sequential if statement or an if-generate statement." |
| 9454 | (interactive) |
| 9455 | (if (vhdl-sequential-statement-p) |
| 9456 | (vhdl-template-if-then) |
| 9457 | (if (and (vhdl-standard-p 'ams) |
| 9458 | (eq (vhdl-decision-query "if" "(g)enerate or (u)se?" t) ?u)) |
| 9459 | (vhdl-template-if-use) |
| 9460 | (vhdl-template-if-generate)))) |
| 9461 | |
| 9462 | (defun vhdl-template-if-generate () |
| 9463 | "Insert an if-generate." |
| 9464 | (interactive) |
| 9465 | (let ((margin (current-indentation)) |
| 9466 | (start (point)) |
| 9467 | label position) |
| 9468 | (vhdl-insert-keyword ": IF ") |
| 9469 | (setq position (point-marker)) |
| 9470 | (goto-char start) |
| 9471 | (when (setq label (vhdl-template-field "label" nil t start position)) |
| 9472 | (goto-char position) |
| 9473 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9474 | (vhdl-template-field "condition") |
| 9475 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9476 | (vhdl-template-generate-body margin label)))) |
| 9477 | |
| 9478 | (defun vhdl-template-if-then-use (kind) |
| 9479 | "Insert a sequential if statement." |
| 9480 | (interactive) |
| 9481 | (let ((margin (current-indentation)) |
| 9482 | (start (point)) |
| 9483 | label) |
| 9484 | (if (or (not (eq vhdl-optional-labels 'all)) (vhdl-standard-p '87)) |
| 9485 | (vhdl-insert-keyword "IF ") |
| 9486 | (vhdl-insert-keyword ": IF ") |
| 9487 | (goto-char start) |
| 9488 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9489 | (unless label (delete-char 2)) |
| 9490 | (forward-word 1) |
| 9491 | (forward-char 1)) |
| 9492 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9493 | (when (vhdl-template-field "condition" nil t start (point)) |
| 9494 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9495 | (vhdl-insert-keyword |
| 9496 | (concat " " (if (eq kind 'then) "THEN" "USE") "\n\n")) |
| 9497 | (indent-to margin) |
| 9498 | (vhdl-insert-keyword (concat "END " (if (eq kind 'then) "IF" "USE"))) |
| 9499 | (when label (insert " " label)) |
| 9500 | (insert ";") |
| 9501 | (forward-line -1) |
| 9502 | (indent-to (+ margin vhdl-basic-offset))))) |
| 9503 | |
| 9504 | (defun vhdl-template-if-then () |
| 9505 | "Insert a sequential if statement." |
| 9506 | (interactive) |
| 9507 | (vhdl-template-if-then-use 'then)) |
| 9508 | |
| 9509 | (defun vhdl-template-if-use () |
| 9510 | "Insert a simultaneous if statement." |
| 9511 | (interactive) |
| 9512 | (vhdl-template-if-then-use 'use)) |
| 9513 | |
| 9514 | (defun vhdl-template-instance () |
| 9515 | "Insert a component instantiation statement." |
| 9516 | (interactive) |
| 9517 | (vhdl-template-component-inst)) |
| 9518 | |
| 9519 | (defun vhdl-template-library () |
| 9520 | "Insert a library specification." |
| 9521 | (interactive) |
| 9522 | (let ((margin (current-indentation)) |
| 9523 | (start (point)) |
| 9524 | name end-pos) |
| 9525 | (vhdl-insert-keyword "LIBRARY ") |
| 9526 | (when (setq name (vhdl-template-field "names" nil t start (point))) |
| 9527 | (insert ";") |
| 9528 | (unless (string-match "," name) |
| 9529 | (setq end-pos (point)) |
| 9530 | (insert "\n") |
| 9531 | (indent-to margin) |
| 9532 | (vhdl-insert-keyword "USE ") |
| 9533 | (insert name) |
| 9534 | (vhdl-insert-keyword "..ALL;") |
| 9535 | (backward-char 5) |
| 9536 | (if (vhdl-template-field "package name") |
| 9537 | (forward-char 5) |
| 9538 | (delete-region end-pos (+ (point) 5))))))) |
| 9539 | |
| 9540 | (defun vhdl-template-limit () |
| 9541 | "Insert a limit." |
| 9542 | (interactive) |
| 9543 | (let ((start (point))) |
| 9544 | (vhdl-insert-keyword "LIMIT ") |
| 9545 | (when (vhdl-template-field "quantity names | OTHERS | ALL" " : " |
| 9546 | t start (point)) |
| 9547 | (vhdl-template-field "type") |
| 9548 | (vhdl-insert-keyword " WITH ") |
| 9549 | (vhdl-template-field "real expression" ";")))) |
| 9550 | |
| 9551 | (defun vhdl-template-loop () |
| 9552 | "Insert a loop." |
| 9553 | (interactive) |
| 9554 | (let ((char (vhdl-decision-query nil "(w)hile, (f)or, or (b)are?" t))) |
| 9555 | (cond ((eq char ?w) |
| 9556 | (vhdl-template-while-loop)) |
| 9557 | ((eq char ?f) |
| 9558 | (vhdl-template-for-loop)) |
| 9559 | (t (vhdl-template-bare-loop))))) |
| 9560 | |
| 9561 | (defun vhdl-template-bare-loop () |
| 9562 | "Insert a loop." |
| 9563 | (interactive) |
| 9564 | (let ((margin (current-indentation)) |
| 9565 | (start (point)) |
| 9566 | label) |
| 9567 | (if (not (eq vhdl-optional-labels 'all)) |
| 9568 | (vhdl-insert-keyword "LOOP ") |
| 9569 | (vhdl-insert-keyword ": LOOP ") |
| 9570 | (goto-char start) |
| 9571 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9572 | (unless label (delete-char 2)) |
| 9573 | (forward-word 1) |
| 9574 | (delete-char 1)) |
| 9575 | (insert "\n\n") |
| 9576 | (indent-to margin) |
| 9577 | (vhdl-insert-keyword "END LOOP") |
| 9578 | (insert (if label (concat " " label ";") ";")) |
| 9579 | (forward-line -1) |
| 9580 | (indent-to (+ margin vhdl-basic-offset)))) |
| 9581 | |
| 9582 | (defun vhdl-template-map (&optional start optional secondary) |
| 9583 | "Insert a map specification with association list." |
| 9584 | (interactive) |
| 9585 | (let ((start (or start (point))) |
| 9586 | margin end-pos) |
| 9587 | (vhdl-insert-keyword "MAP (") |
| 9588 | (if (not vhdl-association-list-with-formals) |
| 9589 | (if (vhdl-template-field |
| 9590 | (concat (and optional "[") "association list" (and optional "]")) |
| 9591 | ")" (or (not secondary) optional) |
| 9592 | (and (not secondary) start) (point)) |
| 9593 | t |
| 9594 | (if (and optional secondary) (delete-region start (point))) |
| 9595 | nil) |
| 9596 | (if vhdl-argument-list-indent |
| 9597 | (setq margin (current-column)) |
| 9598 | (setq margin (+ (current-indentation) vhdl-basic-offset)) |
| 9599 | (insert "\n") |
| 9600 | (indent-to margin)) |
| 9601 | (if (vhdl-template-field |
| 9602 | (concat (and optional "[") "formal" (and optional "]")) |
| 9603 | " => " (or (not secondary) optional) |
| 9604 | (and (not secondary) start) (point)) |
| 9605 | (progn |
| 9606 | (vhdl-template-field "actual" ",") |
| 9607 | (setq end-pos (point)) |
| 9608 | (insert "\n") |
| 9609 | (indent-to margin) |
| 9610 | (while (vhdl-template-field "[formal]" " => " t) |
| 9611 | (vhdl-template-field "actual" ",") |
| 9612 | (setq end-pos (point)) |
| 9613 | (insert "\n") |
| 9614 | (indent-to margin)) |
| 9615 | (delete-region end-pos (point)) |
| 9616 | (delete-char -1) |
| 9617 | (insert ")") |
| 9618 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 9619 | t) |
| 9620 | (when (and optional secondary) (delete-region start (point))) |
| 9621 | nil)))) |
| 9622 | |
| 9623 | (defun vhdl-template-modify (&optional noerror) |
| 9624 | "Actualize modification date." |
| 9625 | (interactive) |
| 9626 | (vhdl-prepare-search-2 |
| 9627 | (save-excursion |
| 9628 | (goto-char (point-min)) |
| 9629 | (if (re-search-forward vhdl-modify-date-prefix-string nil t) |
| 9630 | (progn (delete-region (point) (progn (end-of-line) (point))) |
| 9631 | (vhdl-template-insert-date)) |
| 9632 | (unless noerror |
| 9633 | (error "ERROR: Modification date prefix string \"%s\" not found" |
| 9634 | vhdl-modify-date-prefix-string)))))) |
| 9635 | |
| 9636 | |
| 9637 | (defun vhdl-template-modify-noerror () |
| 9638 | "Call `vhdl-template-modify' with NOERROR non-nil." |
| 9639 | (vhdl-template-modify t)) |
| 9640 | |
| 9641 | (defun vhdl-template-nature () |
| 9642 | "Insert a nature declaration." |
| 9643 | (interactive) |
| 9644 | (let ((start (point)) |
| 9645 | name mid-pos end-pos) |
| 9646 | (vhdl-insert-keyword "NATURE ") |
| 9647 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9648 | (vhdl-insert-keyword " IS ") |
| 9649 | (let ((definition |
| 9650 | (upcase |
| 9651 | (or (vhdl-template-field |
| 9652 | "across type | ARRAY | RECORD") |
| 9653 | "")))) |
| 9654 | (cond ((equal definition "") |
| 9655 | (insert ";")) |
| 9656 | ((equal definition "ARRAY") |
| 9657 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9658 | (vhdl-template-array 'nature t)) |
| 9659 | ((equal definition "RECORD") |
| 9660 | (setq mid-pos (point-marker)) |
| 9661 | (delete-region (point) (progn (forward-word -1) (point))) |
| 9662 | (vhdl-template-record 'nature name t)) |
| 9663 | (t |
| 9664 | (vhdl-insert-keyword " ACROSS ") |
| 9665 | (vhdl-template-field "through type") |
| 9666 | (vhdl-insert-keyword " THROUGH ") |
| 9667 | (vhdl-template-field "reference name") |
| 9668 | (vhdl-insert-keyword " REFERENCE;"))) |
| 9669 | (when mid-pos |
| 9670 | (setq end-pos (point-marker)) |
| 9671 | (goto-char mid-pos) |
| 9672 | (end-of-line)) |
| 9673 | (vhdl-comment-insert-inline) |
| 9674 | (when end-pos (goto-char end-pos)))))) |
| 9675 | |
| 9676 | (defun vhdl-template-next () |
| 9677 | "Insert a next statement." |
| 9678 | (interactive) |
| 9679 | (let ((start (point))) |
| 9680 | (vhdl-insert-keyword "NEXT ") |
| 9681 | (if (vhdl-template-field "[loop label]" nil t start (point)) |
| 9682 | (let ((position (point))) |
| 9683 | (vhdl-insert-keyword " WHEN ") |
| 9684 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 9685 | (if (vhdl-template-field "[condition]" nil t) |
| 9686 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 9687 | (delete-region position (point)))) |
| 9688 | (delete-char -1)) |
| 9689 | (insert ";"))) |
| 9690 | |
| 9691 | (defun vhdl-template-others () |
| 9692 | "Insert an others aggregate." |
| 9693 | (interactive) |
| 9694 | (let ((start (point))) |
| 9695 | (if (or (= (preceding-char) ?\() (not vhdl-template-invoked-by-hook)) |
| 9696 | (progn (unless vhdl-template-invoked-by-hook (insert "(")) |
| 9697 | (vhdl-insert-keyword "OTHERS => '") |
| 9698 | (when (vhdl-template-field "value" nil t start (point)) |
| 9699 | (insert "')"))) |
| 9700 | (vhdl-insert-keyword "OTHERS ")))) |
| 9701 | |
| 9702 | (defun vhdl-template-package (&optional kind) |
| 9703 | "Insert a package specification or body." |
| 9704 | (interactive) |
| 9705 | (let ((margin (current-indentation)) |
| 9706 | (start (point)) |
| 9707 | name body position) |
| 9708 | (vhdl-insert-keyword "PACKAGE ") |
| 9709 | (setq body (if kind (eq kind 'body) |
| 9710 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b))) |
| 9711 | (when body |
| 9712 | (vhdl-insert-keyword "BODY ") |
| 9713 | (when (save-excursion |
| 9714 | (vhdl-prepare-search-1 |
| 9715 | (vhdl-re-search-backward "\\<package \\(\\w+\\) is\\>" nil t))) |
| 9716 | (insert (setq name (match-string 1))))) |
| 9717 | (when (or name |
| 9718 | (setq name (vhdl-template-field "name" nil t start (point)))) |
| 9719 | (vhdl-insert-keyword " IS\n") |
| 9720 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9721 | (indent-to (+ margin vhdl-basic-offset)) |
| 9722 | (setq position (point)) |
| 9723 | (insert "\n") |
| 9724 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 9725 | (indent-to margin) |
| 9726 | (vhdl-insert-keyword "END ") |
| 9727 | (unless (vhdl-standard-p '87) |
| 9728 | (vhdl-insert-keyword (concat "PACKAGE " (and body "BODY ")))) |
| 9729 | (insert (or name "") ";") |
| 9730 | (goto-char position)))) |
| 9731 | |
| 9732 | (defun vhdl-template-package-decl () |
| 9733 | "Insert a package specification." |
| 9734 | (interactive) |
| 9735 | (vhdl-template-package 'decl)) |
| 9736 | |
| 9737 | (defun vhdl-template-package-body () |
| 9738 | "Insert a package body." |
| 9739 | (interactive) |
| 9740 | (vhdl-template-package 'body)) |
| 9741 | |
| 9742 | (defun vhdl-template-port () |
| 9743 | "Insert a port declaration, or port map in instantiation statements." |
| 9744 | (interactive) |
| 9745 | (let ((start (point))) |
| 9746 | (vhdl-prepare-search-1 |
| 9747 | (cond |
| 9748 | ((and (save-excursion ; entity declaration |
| 9749 | (re-search-backward "^\\(entity\\|end\\)\\>" nil t)) |
| 9750 | (equal "ENTITY" (upcase (match-string 1)))) |
| 9751 | (vhdl-template-port-list nil)) |
| 9752 | ((or (save-excursion |
| 9753 | (or (beginning-of-line) |
| 9754 | (looking-at "^\\s-*\\w+\\s-*:\\s-*\\w+"))) |
| 9755 | (equal 'statement-cont (caar (vhdl-get-syntactic-context)))) |
| 9756 | (vhdl-insert-keyword "PORT ") |
| 9757 | (vhdl-template-map start)) |
| 9758 | (t (vhdl-template-port-list nil)))))) |
| 9759 | |
| 9760 | (defun vhdl-template-procedural () |
| 9761 | "Insert a procedural." |
| 9762 | (interactive) |
| 9763 | (let ((margin (current-indentation)) |
| 9764 | (start (point)) |
| 9765 | (case-fold-search t) |
| 9766 | label) |
| 9767 | (vhdl-insert-keyword "PROCEDURAL ") |
| 9768 | (when (memq vhdl-optional-labels '(process all)) |
| 9769 | (goto-char start) |
| 9770 | (insert ": ") |
| 9771 | (goto-char start) |
| 9772 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9773 | (unless label (delete-char 2)) |
| 9774 | (forward-word 1) |
| 9775 | (forward-char 1)) |
| 9776 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "IS")) |
| 9777 | (insert "\n") |
| 9778 | (vhdl-template-begin-end "PROCEDURAL" label margin) |
| 9779 | (vhdl-comment-block))) |
| 9780 | |
| 9781 | (defun vhdl-template-procedure (&optional kind) |
| 9782 | "Insert a procedure declaration or body." |
| 9783 | (interactive) |
| 9784 | (let ((margin (current-indentation)) |
| 9785 | (start (point)) |
| 9786 | name) |
| 9787 | (vhdl-insert-keyword "PROCEDURE ") |
| 9788 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 9789 | (vhdl-template-argument-list) |
| 9790 | (if (if kind (eq kind 'body) |
| 9791 | (eq (vhdl-decision-query nil "(d)eclaration or (b)ody?") ?b)) |
| 9792 | (progn (vhdl-insert-keyword " IS") |
| 9793 | (when vhdl-auto-align |
| 9794 | (vhdl-align-region-groups start (point) 1)) |
| 9795 | (end-of-line) (insert "\n") |
| 9796 | (vhdl-template-begin-end |
| 9797 | (unless (vhdl-standard-p '87) "PROCEDURE") |
| 9798 | name margin) |
| 9799 | (vhdl-comment-block)) |
| 9800 | (insert ";") |
| 9801 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 9802 | (end-of-line))))) |
| 9803 | |
| 9804 | (defun vhdl-template-procedure-decl () |
| 9805 | "Insert a procedure declaration." |
| 9806 | (interactive) |
| 9807 | (vhdl-template-procedure 'decl)) |
| 9808 | |
| 9809 | (defun vhdl-template-procedure-body () |
| 9810 | "Insert a procedure body." |
| 9811 | (interactive) |
| 9812 | (vhdl-template-procedure 'body)) |
| 9813 | |
| 9814 | (defun vhdl-template-process (&optional kind) |
| 9815 | "Insert a process." |
| 9816 | (interactive) |
| 9817 | (let ((margin (current-indentation)) |
| 9818 | (start (point)) |
| 9819 | (reset-kind vhdl-reset-kind) |
| 9820 | label seq input-signals clock reset final-pos) |
| 9821 | (setq seq (if kind (eq kind 'seq) |
| 9822 | (eq (vhdl-decision-query |
| 9823 | "process" "(c)ombinational or (s)equential?" t) ?s))) |
| 9824 | (vhdl-insert-keyword "PROCESS ") |
| 9825 | (when (memq vhdl-optional-labels '(process all)) |
| 9826 | (goto-char start) |
| 9827 | (insert ": ") |
| 9828 | (goto-char start) |
| 9829 | (setq label (vhdl-template-field "[label]" nil t)) |
| 9830 | (unless label (delete-char 2)) |
| 9831 | (forward-word 1) |
| 9832 | (forward-char 1)) |
| 9833 | (insert "(") |
| 9834 | (if (not seq) |
| 9835 | (unless (setq input-signals |
| 9836 | (vhdl-template-field "[sensitivity list]" ")" t)) |
| 9837 | (setq input-signals "") |
| 9838 | (delete-char -2)) |
| 9839 | (setq clock (or (and (not (equal "" vhdl-clock-name)) |
| 9840 | (progn (insert vhdl-clock-name) vhdl-clock-name)) |
| 9841 | (vhdl-template-field "clock name") "<clock>")) |
| 9842 | (when (eq reset-kind 'query) |
| 9843 | (setq reset-kind |
| 9844 | (if (eq (vhdl-decision-query |
| 9845 | "" "(a)synchronous or (s)ynchronous reset?" t) ?a) |
| 9846 | 'async |
| 9847 | 'sync))) |
| 9848 | (when (eq reset-kind 'async) |
| 9849 | (insert ", ") |
| 9850 | (setq reset (or (and (not (equal "" vhdl-reset-name)) |
| 9851 | (progn (insert vhdl-reset-name) vhdl-reset-name)) |
| 9852 | (vhdl-template-field "reset name") "<reset>"))) |
| 9853 | (insert ")")) |
| 9854 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " IS")) |
| 9855 | (insert "\n") |
| 9856 | (vhdl-template-begin-end "PROCESS" label margin) |
| 9857 | (when seq (setq reset (vhdl-template-seq-process clock reset reset-kind))) |
| 9858 | (when vhdl-prompt-for-comments |
| 9859 | (setq final-pos (point-marker)) |
| 9860 | (vhdl-prepare-search-2 |
| 9861 | (when (and (vhdl-re-search-backward "\\<begin\\>" nil t) |
| 9862 | (vhdl-re-search-backward "\\<process\\>" nil t)) |
| 9863 | (end-of-line -0) |
| 9864 | (if (bobp) |
| 9865 | (progn (insert "\n") (forward-line -1)) |
| 9866 | (insert "\n")) |
| 9867 | (indent-to margin) |
| 9868 | (insert "-- purpose: ") |
| 9869 | (if (not (vhdl-template-field "[description]" nil t)) |
| 9870 | (vhdl-line-kill-entire) |
| 9871 | (insert "\n") |
| 9872 | (indent-to margin) |
| 9873 | (insert "-- type : ") |
| 9874 | (insert (if seq "sequential" "combinational") "\n") |
| 9875 | (indent-to margin) |
| 9876 | (insert "-- inputs : ") |
| 9877 | (if (not seq) |
| 9878 | (insert input-signals) |
| 9879 | (insert clock ", ") |
| 9880 | (when reset (insert reset ", ")) |
| 9881 | (unless (vhdl-template-field "[signal names]" nil t) |
| 9882 | (delete-char -2))) |
| 9883 | (insert "\n") |
| 9884 | (indent-to margin) |
| 9885 | (insert "-- outputs: ") |
| 9886 | (vhdl-template-field "[signal names]" nil t)))) |
| 9887 | (goto-char final-pos)))) |
| 9888 | |
| 9889 | (defun vhdl-template-process-comb () |
| 9890 | "Insert a combinational process." |
| 9891 | (interactive) |
| 9892 | (vhdl-template-process 'comb)) |
| 9893 | |
| 9894 | (defun vhdl-template-process-seq () |
| 9895 | "Insert a sequential process." |
| 9896 | (interactive) |
| 9897 | (vhdl-template-process 'seq)) |
| 9898 | |
| 9899 | (defun vhdl-template-quantity () |
| 9900 | "Insert a quantity declaration." |
| 9901 | (interactive) |
| 9902 | (if (vhdl-in-argument-list-p) |
| 9903 | (let ((start (point))) |
| 9904 | (vhdl-insert-keyword "QUANTITY ") |
| 9905 | (when (vhdl-template-field "names" nil t start (point)) |
| 9906 | (insert " : ") |
| 9907 | (vhdl-template-field "[IN | OUT]" " " t) |
| 9908 | (vhdl-template-field "type") |
| 9909 | (insert ";") |
| 9910 | (vhdl-comment-insert-inline))) |
| 9911 | (let ((char (vhdl-decision-query |
| 9912 | "quantity" "(f)ree, (b)ranch, or (s)ource quantity?" t))) |
| 9913 | (cond ((eq char ?f) (vhdl-template-quantity-free)) |
| 9914 | ((eq char ?b) (vhdl-template-quantity-branch)) |
| 9915 | ((eq char ?s) (vhdl-template-quantity-source)) |
| 9916 | (t (vhdl-template-undo (point) (point))))))) |
| 9917 | |
| 9918 | (defun vhdl-template-quantity-free () |
| 9919 | "Insert a free quantity declaration." |
| 9920 | (interactive) |
| 9921 | (vhdl-insert-keyword "QUANTITY ") |
| 9922 | (vhdl-template-field "names") |
| 9923 | (insert " : ") |
| 9924 | (vhdl-template-field "type") |
| 9925 | (let ((position (point))) |
| 9926 | (insert " := ") |
| 9927 | (unless (vhdl-template-field "[initialization]" nil t) |
| 9928 | (delete-region position (point))) |
| 9929 | (insert ";") |
| 9930 | (vhdl-comment-insert-inline))) |
| 9931 | |
| 9932 | (defun vhdl-template-quantity-branch () |
| 9933 | "Insert a branch quantity declaration." |
| 9934 | (interactive) |
| 9935 | (let (position) |
| 9936 | (vhdl-insert-keyword "QUANTITY ") |
| 9937 | (when (vhdl-template-field "[across names]" " " t) |
| 9938 | (vhdl-insert-keyword "ACROSS ")) |
| 9939 | (when (vhdl-template-field "[through names]" " " t) |
| 9940 | (vhdl-insert-keyword "THROUGH ")) |
| 9941 | (vhdl-template-field "plus terminal name") |
| 9942 | (setq position (point)) |
| 9943 | (vhdl-insert-keyword " TO ") |
| 9944 | (unless (vhdl-template-field "[minus terminal name]" nil t) |
| 9945 | (delete-region position (point))) |
| 9946 | (insert ";") |
| 9947 | (vhdl-comment-insert-inline))) |
| 9948 | |
| 9949 | (defun vhdl-template-quantity-source () |
| 9950 | "Insert a source quantity declaration." |
| 9951 | (interactive) |
| 9952 | (vhdl-insert-keyword "QUANTITY ") |
| 9953 | (vhdl-template-field "names") |
| 9954 | (insert " : ") |
| 9955 | (vhdl-template-field "type" " ") |
| 9956 | (if (eq (vhdl-decision-query nil "(s)pectrum or (n)oise?") ?n) |
| 9957 | (progn (vhdl-insert-keyword "NOISE ") |
| 9958 | (vhdl-template-field "power expression")) |
| 9959 | (vhdl-insert-keyword "SPECTRUM ") |
| 9960 | (vhdl-template-field "magnitude expression" ", ") |
| 9961 | (vhdl-template-field "phase expression")) |
| 9962 | (insert ";") |
| 9963 | (vhdl-comment-insert-inline)) |
| 9964 | |
| 9965 | (defun vhdl-template-record (kind &optional name secondary) |
| 9966 | "Insert a record type declaration." |
| 9967 | (interactive) |
| 9968 | (let ((margin (current-indentation)) |
| 9969 | (start (point)) |
| 9970 | (first t)) |
| 9971 | (vhdl-insert-keyword "RECORD\n") |
| 9972 | (indent-to (+ margin vhdl-basic-offset)) |
| 9973 | (when (or (vhdl-template-field "element names" |
| 9974 | nil (not secondary) start (point)) |
| 9975 | secondary) |
| 9976 | (while (or first (vhdl-template-field "[element names]" nil t)) |
| 9977 | (insert " : ") |
| 9978 | (vhdl-template-field (if (eq kind 'type) "type" "nature") ";") |
| 9979 | (vhdl-comment-insert-inline) |
| 9980 | (insert "\n") |
| 9981 | (indent-to (+ margin vhdl-basic-offset)) |
| 9982 | (setq first nil)) |
| 9983 | (delete-region (line-beginning-position) (point)) |
| 9984 | (indent-to margin) |
| 9985 | (vhdl-insert-keyword "END RECORD") |
| 9986 | (unless (vhdl-standard-p '87) (and name (insert " " name))) |
| 9987 | (insert ";") |
| 9988 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 9989 | |
| 9990 | (defun vhdl-template-report () |
| 9991 | "Insert a report statement." |
| 9992 | (interactive) |
| 9993 | (let ((start (point))) |
| 9994 | (vhdl-insert-keyword "REPORT ") |
| 9995 | (if (equal "\"\"" (vhdl-template-field |
| 9996 | "string expression" nil t start (point) t)) |
| 9997 | (delete-char -2) |
| 9998 | (setq start (point)) |
| 9999 | (vhdl-insert-keyword " SEVERITY ") |
| 10000 | (unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t) |
| 10001 | (delete-region start (point))) |
| 10002 | (insert ";")))) |
| 10003 | |
| 10004 | (defun vhdl-template-return () |
| 10005 | "Insert a return statement." |
| 10006 | (interactive) |
| 10007 | (let ((start (point))) |
| 10008 | (vhdl-insert-keyword "RETURN ") |
| 10009 | (unless (vhdl-template-field "[expression]" nil t start (point)) |
| 10010 | (delete-char -1)) |
| 10011 | (insert ";"))) |
| 10012 | |
| 10013 | (defun vhdl-template-selected-signal-asst () |
| 10014 | "Insert a selected signal assignment." |
| 10015 | (interactive) |
| 10016 | (let ((margin (current-indentation)) |
| 10017 | (start (point)) |
| 10018 | (choices t)) |
| 10019 | (let ((position (point))) |
| 10020 | (vhdl-insert-keyword " SELECT ") |
| 10021 | (goto-char position)) |
| 10022 | (vhdl-insert-keyword "WITH ") |
| 10023 | (when (vhdl-template-field "selector expression" |
| 10024 | nil t start (+ (point) 7)) |
| 10025 | (forward-word 1) |
| 10026 | (delete-char 1) |
| 10027 | (insert "\n") |
| 10028 | (indent-to (+ margin vhdl-basic-offset)) |
| 10029 | (vhdl-template-field "target signal" " <= ") |
| 10030 | (insert "\n") |
| 10031 | (indent-to (+ margin vhdl-basic-offset)) |
| 10032 | (vhdl-template-field "waveform") |
| 10033 | (vhdl-insert-keyword " WHEN ") |
| 10034 | (vhdl-template-field "choices" ",") |
| 10035 | (insert "\n") |
| 10036 | (indent-to (+ margin vhdl-basic-offset)) |
| 10037 | (while (and choices (vhdl-template-field "[waveform]" nil t)) |
| 10038 | (vhdl-insert-keyword " WHEN ") |
| 10039 | (if (setq choices (vhdl-template-field "[choices]" "," t)) |
| 10040 | (progn (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 10041 | (vhdl-insert-keyword "OTHERS"))) |
| 10042 | (when choices |
| 10043 | (fixup-whitespace) |
| 10044 | (delete-char -2)) |
| 10045 | (insert ";") |
| 10046 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 10047 | |
| 10048 | (defun vhdl-template-signal () |
| 10049 | "Insert a signal declaration." |
| 10050 | (interactive) |
| 10051 | (let ((start (point)) |
| 10052 | (in-arglist (vhdl-in-argument-list-p))) |
| 10053 | (vhdl-insert-keyword "SIGNAL ") |
| 10054 | (when (vhdl-template-field "names" nil t start (point)) |
| 10055 | (insert " : ") |
| 10056 | (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) |
| 10057 | (vhdl-template-field "type") |
| 10058 | (if in-arglist |
| 10059 | (progn (insert ";") |
| 10060 | (vhdl-comment-insert-inline)) |
| 10061 | (let ((position (point))) |
| 10062 | (insert " := ") |
| 10063 | (unless (vhdl-template-field "[initialization]" nil t) |
| 10064 | (delete-region position (point))) |
| 10065 | (insert ";") |
| 10066 | (vhdl-comment-insert-inline)))))) |
| 10067 | |
| 10068 | (defun vhdl-template-subnature () |
| 10069 | "Insert a subnature declaration." |
| 10070 | (interactive) |
| 10071 | (let ((start (point)) |
| 10072 | position) |
| 10073 | (vhdl-insert-keyword "SUBNATURE ") |
| 10074 | (when (vhdl-template-field "name" nil t start (point)) |
| 10075 | (vhdl-insert-keyword " IS ") |
| 10076 | (vhdl-template-field "nature" " (") |
| 10077 | (if (vhdl-template-field "[index range]" nil t) |
| 10078 | (insert ")") |
| 10079 | (delete-char -2)) |
| 10080 | (setq position (point)) |
| 10081 | (vhdl-insert-keyword " TOLERANCE ") |
| 10082 | (if (equal "\"\"" (vhdl-template-field "[string expression]" |
| 10083 | nil t nil nil t)) |
| 10084 | (delete-region position (point)) |
| 10085 | (vhdl-insert-keyword " ACROSS ") |
| 10086 | (vhdl-template-field "string expression" nil nil nil nil t) |
| 10087 | (vhdl-insert-keyword " THROUGH")) |
| 10088 | (insert ";") |
| 10089 | (vhdl-comment-insert-inline)))) |
| 10090 | |
| 10091 | (defun vhdl-template-subprogram-body () |
| 10092 | "Insert a subprogram body." |
| 10093 | (interactive) |
| 10094 | (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) |
| 10095 | (vhdl-template-function-body) |
| 10096 | (vhdl-template-procedure-body))) |
| 10097 | |
| 10098 | (defun vhdl-template-subprogram-decl () |
| 10099 | "Insert a subprogram declaration." |
| 10100 | (interactive) |
| 10101 | (if (eq (vhdl-decision-query nil "(p)rocedure or (f)unction?" t) ?f) |
| 10102 | (vhdl-template-function-decl) |
| 10103 | (vhdl-template-procedure-decl))) |
| 10104 | |
| 10105 | (defun vhdl-template-subtype () |
| 10106 | "Insert a subtype declaration." |
| 10107 | (interactive) |
| 10108 | (let ((start (point))) |
| 10109 | (vhdl-insert-keyword "SUBTYPE ") |
| 10110 | (when (vhdl-template-field "name" nil t start (point)) |
| 10111 | (vhdl-insert-keyword " IS ") |
| 10112 | (vhdl-template-field "type" " ") |
| 10113 | (unless |
| 10114 | (vhdl-template-field "[RANGE value range | ( index range )]" nil t) |
| 10115 | (delete-char -1)) |
| 10116 | (insert ";") |
| 10117 | (vhdl-comment-insert-inline)))) |
| 10118 | |
| 10119 | (defun vhdl-template-terminal () |
| 10120 | "Insert a terminal declaration." |
| 10121 | (interactive) |
| 10122 | (let ((start (point))) |
| 10123 | (vhdl-insert-keyword "TERMINAL ") |
| 10124 | (when (vhdl-template-field "names" nil t start (point)) |
| 10125 | (insert " : ") |
| 10126 | (vhdl-template-field "nature") |
| 10127 | (insert ";") |
| 10128 | (vhdl-comment-insert-inline)))) |
| 10129 | |
| 10130 | (defun vhdl-template-type () |
| 10131 | "Insert a type declaration." |
| 10132 | (interactive) |
| 10133 | (let ((start (point)) |
| 10134 | name mid-pos end-pos) |
| 10135 | (vhdl-insert-keyword "TYPE ") |
| 10136 | (when (setq name (vhdl-template-field "name" nil t start (point))) |
| 10137 | (vhdl-insert-keyword " IS ") |
| 10138 | (let ((definition |
| 10139 | (upcase |
| 10140 | (or (vhdl-template-field |
| 10141 | "[scalar type | ARRAY | RECORD | ACCESS | FILE | ENUM]" nil t) |
| 10142 | "")))) |
| 10143 | (cond ((equal definition "") |
| 10144 | (delete-char -4) |
| 10145 | (insert ";")) |
| 10146 | ((equal definition "ARRAY") |
| 10147 | (delete-region (point) (progn (forward-word -1) (point))) |
| 10148 | (vhdl-template-array 'type t)) |
| 10149 | ((equal definition "RECORD") |
| 10150 | (setq mid-pos (point-marker)) |
| 10151 | (delete-region (point) (progn (forward-word -1) (point))) |
| 10152 | (vhdl-template-record 'type name t)) |
| 10153 | ((equal definition "ACCESS") |
| 10154 | (insert " ") |
| 10155 | (vhdl-template-field "type" ";")) |
| 10156 | ((equal definition "FILE") |
| 10157 | (vhdl-insert-keyword " OF ") |
| 10158 | (vhdl-template-field "type" ";")) |
| 10159 | ((equal definition "ENUM") |
| 10160 | (kill-word -1) |
| 10161 | (insert "(") |
| 10162 | (setq end-pos (point-marker)) |
| 10163 | (insert ");")) |
| 10164 | (t (insert ";"))) |
| 10165 | (when mid-pos |
| 10166 | (setq end-pos (point-marker)) |
| 10167 | (goto-char mid-pos) |
| 10168 | (end-of-line)) |
| 10169 | (vhdl-comment-insert-inline) |
| 10170 | (when end-pos (goto-char end-pos)))))) |
| 10171 | |
| 10172 | (defun vhdl-template-use () |
| 10173 | "Insert a use clause." |
| 10174 | (interactive) |
| 10175 | (let ((start (point))) |
| 10176 | (vhdl-prepare-search-1 |
| 10177 | (vhdl-insert-keyword "USE ") |
| 10178 | (when (save-excursion (beginning-of-line) (looking-at "^\\s-*use\\>")) |
| 10179 | (vhdl-insert-keyword "..ALL;") |
| 10180 | (backward-char 6) |
| 10181 | (when (vhdl-template-field "library name" nil t start (+ (point) 6)) |
| 10182 | (forward-char 1) |
| 10183 | (vhdl-template-field "package name") |
| 10184 | (forward-char 5)))))) |
| 10185 | |
| 10186 | (defun vhdl-template-variable () |
| 10187 | "Insert a variable declaration." |
| 10188 | (interactive) |
| 10189 | (let ((start (point)) |
| 10190 | (in-arglist (vhdl-in-argument-list-p))) |
| 10191 | (vhdl-prepare-search-2 |
| 10192 | (if (or (save-excursion |
| 10193 | (progn (vhdl-beginning-of-block) |
| 10194 | (looking-at "\\s-*\\(\\w+\\s-*:\\s-*\\)?\\<\\(\\<function\\|procedure\\|process\\|procedural\\)\\>"))) |
| 10195 | (save-excursion (backward-word 1) (looking-at "\\<shared\\>"))) |
| 10196 | (vhdl-insert-keyword "VARIABLE ") |
| 10197 | (if (vhdl-standard-p '87) |
| 10198 | (error "ERROR: Not within sequential block") |
| 10199 | (vhdl-insert-keyword "SHARED VARIABLE ")))) |
| 10200 | (when (vhdl-template-field "names" nil t start (point)) |
| 10201 | (insert " : ") |
| 10202 | (when in-arglist (vhdl-template-field "[IN | OUT | INOUT]" " " t)) |
| 10203 | (vhdl-template-field "type") |
| 10204 | (if in-arglist |
| 10205 | (progn (insert ";") |
| 10206 | (vhdl-comment-insert-inline)) |
| 10207 | (let ((position (point))) |
| 10208 | (insert " := ") |
| 10209 | (unless (vhdl-template-field "[initialization]" nil t) |
| 10210 | (delete-region position (point))) |
| 10211 | (insert ";") |
| 10212 | (vhdl-comment-insert-inline)))))) |
| 10213 | |
| 10214 | (defun vhdl-template-wait () |
| 10215 | "Insert a wait statement." |
| 10216 | (interactive) |
| 10217 | (vhdl-insert-keyword "WAIT ") |
| 10218 | (unless (vhdl-template-field |
| 10219 | "[ON sensitivity list] [UNTIL condition] [FOR time expression]" |
| 10220 | nil t) |
| 10221 | (delete-char -1)) |
| 10222 | (insert ";")) |
| 10223 | |
| 10224 | (defun vhdl-template-when () |
| 10225 | "Indent correctly if within a case statement." |
| 10226 | (interactive) |
| 10227 | (let ((position (point)) |
| 10228 | margin) |
| 10229 | (vhdl-prepare-search-2 |
| 10230 | (if (and (= (current-column) (current-indentation)) |
| 10231 | (vhdl-re-search-forward "\\<end\\>" nil t) |
| 10232 | (looking-at "\\s-*\\<case\\>")) |
| 10233 | (progn |
| 10234 | (setq margin (current-indentation)) |
| 10235 | (goto-char position) |
| 10236 | (delete-horizontal-space) |
| 10237 | (indent-to (+ margin vhdl-basic-offset))) |
| 10238 | (goto-char position))) |
| 10239 | (vhdl-insert-keyword "WHEN "))) |
| 10240 | |
| 10241 | (defun vhdl-template-while-loop () |
| 10242 | "Insert a while loop." |
| 10243 | (interactive) |
| 10244 | (let* ((margin (current-indentation)) |
| 10245 | (start (point)) |
| 10246 | label) |
| 10247 | (if (not (eq vhdl-optional-labels 'all)) |
| 10248 | (vhdl-insert-keyword "WHILE ") |
| 10249 | (vhdl-insert-keyword ": WHILE ") |
| 10250 | (goto-char start) |
| 10251 | (setq label (vhdl-template-field "[label]" nil t)) |
| 10252 | (unless label (delete-char 2)) |
| 10253 | (forward-word 1) |
| 10254 | (forward-char 1)) |
| 10255 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 10256 | (when (vhdl-template-field "condition" nil t start (point)) |
| 10257 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 10258 | (vhdl-insert-keyword " LOOP\n\n") |
| 10259 | (indent-to margin) |
| 10260 | (vhdl-insert-keyword "END LOOP") |
| 10261 | (insert (if label (concat " " label ";") ";")) |
| 10262 | (forward-line -1) |
| 10263 | (indent-to (+ margin vhdl-basic-offset))))) |
| 10264 | |
| 10265 | (defun vhdl-template-with () |
| 10266 | "Insert a with statement (i.e. selected signal assignment)." |
| 10267 | (interactive) |
| 10268 | (vhdl-prepare-search-1 |
| 10269 | (if (and (save-excursion (vhdl-re-search-backward "\\(\\<limit\\>\\|;\\)")) |
| 10270 | (equal ";" (match-string 1))) |
| 10271 | (vhdl-template-selected-signal-asst) |
| 10272 | (vhdl-insert-keyword "WITH ")))) |
| 10273 | |
| 10274 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10275 | ;; Special templates |
| 10276 | |
| 10277 | (defun vhdl-template-clocked-wait () |
| 10278 | "Insert a wait statement for rising/falling clock edge." |
| 10279 | (interactive) |
| 10280 | (let ((start (point)) |
| 10281 | clock) |
| 10282 | (vhdl-insert-keyword "WAIT UNTIL ") |
| 10283 | (when (setq clock |
| 10284 | (or (and (not (equal "" vhdl-clock-name)) |
| 10285 | (progn (insert vhdl-clock-name) vhdl-clock-name)) |
| 10286 | (vhdl-template-field "clock name" nil t start (point)))) |
| 10287 | (insert "'event") |
| 10288 | (vhdl-insert-keyword " AND ") |
| 10289 | (insert clock) |
| 10290 | (insert |
| 10291 | " = " (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string) ";") |
| 10292 | (vhdl-comment-insert-inline |
| 10293 | (concat (if vhdl-clock-rising-edge "rising" "falling") |
| 10294 | " clock edge"))))) |
| 10295 | |
| 10296 | (defun vhdl-template-seq-process (clock reset reset-kind) |
| 10297 | "Insert a template for the body of a sequential process." |
| 10298 | (let ((margin (current-indentation)) |
| 10299 | position) |
| 10300 | (vhdl-insert-keyword "IF ") |
| 10301 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 10302 | (when (eq reset-kind 'async) |
| 10303 | (insert reset " = " |
| 10304 | (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) |
| 10305 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 10306 | (vhdl-insert-keyword " THEN") |
| 10307 | (vhdl-comment-insert-inline |
| 10308 | (concat "asynchronous reset (active " |
| 10309 | (if vhdl-reset-active-high "high" "low") ")")) |
| 10310 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 10311 | (setq position (point)) |
| 10312 | (insert "\n") (indent-to margin) |
| 10313 | (vhdl-insert-keyword "ELSIF ") |
| 10314 | (when vhdl-conditions-in-parenthesis (insert "("))) |
| 10315 | (if (eq vhdl-clock-edge-condition 'function) |
| 10316 | (insert (if vhdl-clock-rising-edge "rising" "falling") |
| 10317 | "_edge(" clock ")") |
| 10318 | (insert clock "'event") |
| 10319 | (vhdl-insert-keyword " AND ") |
| 10320 | (insert clock " = " |
| 10321 | (if vhdl-clock-rising-edge vhdl-one-string vhdl-zero-string))) |
| 10322 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 10323 | (vhdl-insert-keyword " THEN") |
| 10324 | (vhdl-comment-insert-inline |
| 10325 | (concat (if vhdl-clock-rising-edge "rising" "falling") " clock edge")) |
| 10326 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 10327 | (when (eq reset-kind 'sync) |
| 10328 | (vhdl-insert-keyword "IF ") |
| 10329 | (when vhdl-conditions-in-parenthesis (insert "(")) |
| 10330 | (setq reset (or (and (not (equal "" vhdl-reset-name)) |
| 10331 | (progn (insert vhdl-reset-name) vhdl-reset-name)) |
| 10332 | (vhdl-template-field "reset name") "<reset>")) |
| 10333 | (insert " = " |
| 10334 | (if vhdl-reset-active-high vhdl-one-string vhdl-zero-string)) |
| 10335 | (when vhdl-conditions-in-parenthesis (insert ")")) |
| 10336 | (vhdl-insert-keyword " THEN") |
| 10337 | (vhdl-comment-insert-inline |
| 10338 | (concat "synchronous reset (active " |
| 10339 | (if vhdl-reset-active-high "high" "low") ")")) |
| 10340 | (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 10341 | (setq position (point)) |
| 10342 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 10343 | (vhdl-insert-keyword "ELSE") |
| 10344 | (insert "\n") (indent-to (+ margin (* 2 vhdl-basic-offset))) |
| 10345 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 10346 | (vhdl-insert-keyword "END IF;")) |
| 10347 | (when (eq reset-kind 'none) |
| 10348 | (setq position (point))) |
| 10349 | (insert "\n") (indent-to margin) |
| 10350 | (vhdl-insert-keyword "END IF;") |
| 10351 | (goto-char position) |
| 10352 | reset)) |
| 10353 | |
| 10354 | (defun vhdl-template-standard-package (library package) |
| 10355 | "Insert specification of a standard package. Include a library |
| 10356 | specification, if not already there." |
| 10357 | (let ((margin (current-indentation))) |
| 10358 | (unless (equal library "std") |
| 10359 | (unless (or (save-excursion |
| 10360 | (vhdl-prepare-search-1 |
| 10361 | (and (not (bobp)) |
| 10362 | (re-search-backward |
| 10363 | (concat "^\\s-*\\(\\(library\\)\\s-+\\(\\w+\\s-*,\\s-*\\)*" |
| 10364 | library "\\|end\\)\\>") nil t) |
| 10365 | (match-string 2)))) |
| 10366 | (equal (downcase library) "work")) |
| 10367 | (vhdl-insert-keyword "LIBRARY ") |
| 10368 | (insert library ";") |
| 10369 | (when package |
| 10370 | (insert "\n") |
| 10371 | (indent-to margin)))) |
| 10372 | (when package |
| 10373 | (vhdl-insert-keyword "USE ") |
| 10374 | (insert library "." package) |
| 10375 | (vhdl-insert-keyword ".ALL;")))) |
| 10376 | |
| 10377 | (defun vhdl-template-package-numeric-bit () |
| 10378 | "Insert specification of `numeric_bit' package." |
| 10379 | (interactive) |
| 10380 | (vhdl-template-standard-package "ieee" "numeric_bit")) |
| 10381 | |
| 10382 | (defun vhdl-template-package-numeric-std () |
| 10383 | "Insert specification of `numeric_std' package." |
| 10384 | (interactive) |
| 10385 | (vhdl-template-standard-package "ieee" "numeric_std")) |
| 10386 | |
| 10387 | (defun vhdl-template-package-std-logic-1164 () |
| 10388 | "Insert specification of `std_logic_1164' package." |
| 10389 | (interactive) |
| 10390 | (vhdl-template-standard-package "ieee" "std_logic_1164")) |
| 10391 | |
| 10392 | (defun vhdl-template-package-std-logic-arith () |
| 10393 | "Insert specification of `std_logic_arith' package." |
| 10394 | (interactive) |
| 10395 | (vhdl-template-standard-package "ieee" "std_logic_arith")) |
| 10396 | |
| 10397 | (defun vhdl-template-package-std-logic-misc () |
| 10398 | "Insert specification of `std_logic_misc' package." |
| 10399 | (interactive) |
| 10400 | (vhdl-template-standard-package "ieee" "std_logic_misc")) |
| 10401 | |
| 10402 | (defun vhdl-template-package-std-logic-signed () |
| 10403 | "Insert specification of `std_logic_signed' package." |
| 10404 | (interactive) |
| 10405 | (vhdl-template-standard-package "ieee" "std_logic_signed")) |
| 10406 | |
| 10407 | (defun vhdl-template-package-std-logic-textio () |
| 10408 | "Insert specification of `std_logic_textio' package." |
| 10409 | (interactive) |
| 10410 | (vhdl-template-standard-package "ieee" "std_logic_textio")) |
| 10411 | |
| 10412 | (defun vhdl-template-package-std-logic-unsigned () |
| 10413 | "Insert specification of `std_logic_unsigned' package." |
| 10414 | (interactive) |
| 10415 | (vhdl-template-standard-package "ieee" "std_logic_unsigned")) |
| 10416 | |
| 10417 | (defun vhdl-template-package-textio () |
| 10418 | "Insert specification of `textio' package." |
| 10419 | (interactive) |
| 10420 | (vhdl-template-standard-package "std" "textio")) |
| 10421 | |
| 10422 | (defun vhdl-template-package-fundamental-constants () |
| 10423 | "Insert specification of `fundamental_constants' package." |
| 10424 | (interactive) |
| 10425 | (vhdl-template-standard-package "ieee" "fundamental_constants")) |
| 10426 | |
| 10427 | (defun vhdl-template-package-material-constants () |
| 10428 | "Insert specification of `material_constants' package." |
| 10429 | (interactive) |
| 10430 | (vhdl-template-standard-package "ieee" "material_constants")) |
| 10431 | |
| 10432 | (defun vhdl-template-package-energy-systems () |
| 10433 | "Insert specification of `energy_systems' package." |
| 10434 | (interactive) |
| 10435 | (vhdl-template-standard-package "ieee" "energy_systems")) |
| 10436 | |
| 10437 | (defun vhdl-template-package-electrical-systems () |
| 10438 | "Insert specification of `electrical_systems' package." |
| 10439 | (interactive) |
| 10440 | (vhdl-template-standard-package "ieee" "electrical_systems")) |
| 10441 | |
| 10442 | (defun vhdl-template-package-mechanical-systems () |
| 10443 | "Insert specification of `mechanical_systems' package." |
| 10444 | (interactive) |
| 10445 | (vhdl-template-standard-package "ieee" "mechanical_systems")) |
| 10446 | |
| 10447 | (defun vhdl-template-package-radiant-systems () |
| 10448 | "Insert specification of `radiant_systems' package." |
| 10449 | (interactive) |
| 10450 | (vhdl-template-standard-package "ieee" "radiant_systems")) |
| 10451 | |
| 10452 | (defun vhdl-template-package-thermal-systems () |
| 10453 | "Insert specification of `thermal_systems' package." |
| 10454 | (interactive) |
| 10455 | (vhdl-template-standard-package "ieee" "thermal_systems")) |
| 10456 | |
| 10457 | (defun vhdl-template-package-fluidic-systems () |
| 10458 | "Insert specification of `fluidic_systems' package." |
| 10459 | (interactive) |
| 10460 | (vhdl-template-standard-package "ieee" "fluidic_systems")) |
| 10461 | |
| 10462 | (defun vhdl-template-package-math-complex () |
| 10463 | "Insert specification of `math_complex' package." |
| 10464 | (interactive) |
| 10465 | (vhdl-template-standard-package "ieee" "math_complex")) |
| 10466 | |
| 10467 | (defun vhdl-template-package-math-real () |
| 10468 | "Insert specification of `math_real' package." |
| 10469 | (interactive) |
| 10470 | (vhdl-template-standard-package "ieee" "math_real")) |
| 10471 | |
| 10472 | (defun vhdl-template-directive (directive) |
| 10473 | "Insert directive." |
| 10474 | (unless (= (current-indentation) (current-column)) |
| 10475 | (delete-horizontal-space) |
| 10476 | (insert " ")) |
| 10477 | (insert "-- pragma " directive)) |
| 10478 | |
| 10479 | (defun vhdl-template-directive-translate-on () |
| 10480 | "Insert directive 'translate_on'." |
| 10481 | (interactive) |
| 10482 | (vhdl-template-directive "translate_on")) |
| 10483 | |
| 10484 | (defun vhdl-template-directive-translate-off () |
| 10485 | "Insert directive 'translate_off'." |
| 10486 | (interactive) |
| 10487 | (vhdl-template-directive "translate_off")) |
| 10488 | |
| 10489 | (defun vhdl-template-directive-synthesis-on () |
| 10490 | "Insert directive 'synthesis_on'." |
| 10491 | (interactive) |
| 10492 | (vhdl-template-directive "synthesis_on")) |
| 10493 | |
| 10494 | (defun vhdl-template-directive-synthesis-off () |
| 10495 | "Insert directive 'synthesis_off'." |
| 10496 | (interactive) |
| 10497 | (vhdl-template-directive "synthesis_off")) |
| 10498 | |
| 10499 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10500 | ;; Header and footer templates |
| 10501 | |
| 10502 | (defun vhdl-template-header (&optional file-title) |
| 10503 | "Insert a VHDL file header." |
| 10504 | (interactive) |
| 10505 | (unless (equal vhdl-file-header "") |
| 10506 | (let (pos) |
| 10507 | (save-excursion |
| 10508 | (goto-char (point-min)) |
| 10509 | (vhdl-insert-string-or-file vhdl-file-header) |
| 10510 | (setq pos (point-marker))) |
| 10511 | (vhdl-template-replace-header-keywords |
| 10512 | (point-min-marker) pos file-title)))) |
| 10513 | |
| 10514 | (defun vhdl-template-footer () |
| 10515 | "Insert a VHDL file footer." |
| 10516 | (interactive) |
| 10517 | (unless (equal vhdl-file-footer "") |
| 10518 | (let (pos) |
| 10519 | (save-excursion |
| 10520 | (goto-char (point-max)) |
| 10521 | (setq pos (point-marker)) |
| 10522 | (vhdl-insert-string-or-file vhdl-file-footer) |
| 10523 | (unless (= (preceding-char) ?\n) |
| 10524 | (insert "\n"))) |
| 10525 | (vhdl-template-replace-header-keywords pos (point-max-marker))))) |
| 10526 | |
| 10527 | (defun vhdl-template-replace-header-keywords (beg end &optional file-title |
| 10528 | is-model) |
| 10529 | "Replace keywords in header and footer." |
| 10530 | (let ((project-title (or (nth 0 (vhdl-aget vhdl-project-alist vhdl-project)) |
| 10531 | "")) |
| 10532 | (project-desc (or (nth 9 (vhdl-aget vhdl-project-alist vhdl-project)) |
| 10533 | "")) |
| 10534 | pos) |
| 10535 | (vhdl-prepare-search-2 |
| 10536 | (save-excursion |
| 10537 | (goto-char beg) |
| 10538 | (while (search-forward "<projectdesc>" end t) |
| 10539 | (replace-match project-desc t t)) |
| 10540 | (goto-char beg) |
| 10541 | (while (search-forward "<filename>" end t) |
| 10542 | (replace-match (buffer-name) t t)) |
| 10543 | (goto-char beg) |
| 10544 | (while (search-forward "<copyright>" end t) |
| 10545 | (replace-match vhdl-copyright-string t t)) |
| 10546 | (goto-char beg) |
| 10547 | (while (search-forward "<author>" end t) |
| 10548 | (replace-match "" t t) |
| 10549 | (insert (user-full-name)) |
| 10550 | (when user-mail-address (insert " <" user-mail-address ">"))) |
| 10551 | (goto-char beg) |
| 10552 | (while (search-forward "<authorfull>" end t) |
| 10553 | (replace-match (user-full-name) t t)) |
| 10554 | (goto-char beg) |
| 10555 | (while (search-forward "<login>" end t) |
| 10556 | (replace-match (user-login-name) t t)) |
| 10557 | (goto-char beg) |
| 10558 | (while (search-forward "<project>" end t) |
| 10559 | (replace-match project-title t t)) |
| 10560 | (goto-char beg) |
| 10561 | (while (search-forward "<company>" end t) |
| 10562 | (replace-match vhdl-company-name t t)) |
| 10563 | (goto-char beg) |
| 10564 | (while (search-forward "<platform>" end t) |
| 10565 | (replace-match vhdl-platform-spec t t)) |
| 10566 | (goto-char beg) |
| 10567 | (while (search-forward "<standard>" end t) |
| 10568 | (replace-match |
| 10569 | (concat "VHDL" (cond ((vhdl-standard-p '87) "'87") |
| 10570 | ((vhdl-standard-p '93) "'93/02")) |
| 10571 | (when (vhdl-standard-p 'ams) ", VHDL-AMS") |
| 10572 | (when (vhdl-standard-p 'math) ", Math Packages")) t t)) |
| 10573 | (goto-char beg) |
| 10574 | ;; Replace <RCS> with $, so that RCS for the source is |
| 10575 | ;; not over-enthusiastic with replacements |
| 10576 | (while (search-forward "<RCS>" end t) |
| 10577 | (replace-match "$" nil t)) |
| 10578 | (goto-char beg) |
| 10579 | (while (search-forward "<date>" end t) |
| 10580 | (replace-match "" t t) |
| 10581 | (vhdl-template-insert-date)) |
| 10582 | (goto-char beg) |
| 10583 | (while (search-forward "<year>" end t) |
| 10584 | (replace-match (format-time-string "%Y" nil) t t)) |
| 10585 | (goto-char beg) |
| 10586 | (when file-title |
| 10587 | (while (search-forward "<title string>" end t) |
| 10588 | (replace-match file-title t t)) |
| 10589 | (goto-char beg)) |
| 10590 | (let (string) |
| 10591 | (while (re-search-forward "<\\(\\(\\w\\|\\s_\\)*\\) string>" end t) |
| 10592 | (save-match-data |
| 10593 | (setq string (read-string (concat (match-string 1) ": ")))) |
| 10594 | (replace-match string t t))) |
| 10595 | (goto-char beg) |
| 10596 | (when (and (not is-model) (search-forward "<cursor>" end t)) |
| 10597 | (replace-match "" t t) |
| 10598 | (setq pos (point)))) |
| 10599 | (when pos (goto-char pos)) |
| 10600 | (unless is-model |
| 10601 | (when (or (not project-title) (equal project-title "")) |
| 10602 | (message "You can specify a project title in user option `vhdl-project-alist'")) |
| 10603 | (when (or (not project-desc) (equal project-desc "")) |
| 10604 | (message "You can specify a project description in user option `vhdl-project-alist'")) |
| 10605 | (when (equal vhdl-platform-spec "") |
| 10606 | (message "You can specify a platform in user option `vhdl-platform-spec'")) |
| 10607 | (when (equal vhdl-company-name "") |
| 10608 | (message "You can specify a company name in user option `vhdl-company-name'")))))) |
| 10609 | |
| 10610 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10611 | ;; Comment templates and functions |
| 10612 | |
| 10613 | (defun vhdl-comment-indent () |
| 10614 | "Indent comments." |
| 10615 | (let* ((position (point)) |
| 10616 | (col |
| 10617 | (progn |
| 10618 | (forward-line -1) |
| 10619 | (if (re-search-forward "--" position t) |
| 10620 | (- (current-column) 2) ; existing comment at bol stays there |
| 10621 | (goto-char position) |
| 10622 | (skip-chars-backward " \t") |
| 10623 | (max comment-column ; else indent to comment column |
| 10624 | (1+ (current-column))))))) ; except leave at least one space |
| 10625 | (goto-char position) |
| 10626 | col)) |
| 10627 | |
| 10628 | (defun vhdl-comment-insert () |
| 10629 | "Start a comment at the end of the line. |
| 10630 | If on line with code, indent at least `comment-column'. |
| 10631 | If starting after end-comment-column, start a new line." |
| 10632 | (interactive) |
| 10633 | (when (> (current-column) end-comment-column) (newline-and-indent)) |
| 10634 | (if (or (looking-at "\\s-*$") ; end of line |
| 10635 | (and (not unread-command-events) ; called with key binding or menu |
| 10636 | (not (end-of-line)))) |
| 10637 | (let (margin) |
| 10638 | (while (= (preceding-char) ?-) (delete-char -1)) |
| 10639 | (setq margin (current-column)) |
| 10640 | (delete-horizontal-space) |
| 10641 | (if (bolp) |
| 10642 | (progn (indent-to margin) (insert "--")) |
| 10643 | (insert " ") |
| 10644 | (indent-to comment-column) |
| 10645 | (insert "--")) |
| 10646 | (if (not unread-command-events) (insert " "))) |
| 10647 | ;; else code following current point implies commenting out code |
| 10648 | (let (next-input code) |
| 10649 | (while (= (preceding-char) ?-) (delete-char -2)) |
| 10650 | (while (= (setq next-input (read-char)) 13) ; CR |
| 10651 | (insert "--") ; or have a space after it? |
| 10652 | (forward-char -2) |
| 10653 | (forward-line 1) |
| 10654 | (message "Enter CR if commenting out a line of code.") |
| 10655 | (setq code t)) |
| 10656 | (unless code |
| 10657 | (insert "--")) ; hardwire to 1 space or use vhdl-basic-offset? |
| 10658 | (setq unread-command-events |
| 10659 | (list (vhdl-character-to-event next-input)))))) ; pushback the char |
| 10660 | |
| 10661 | (defun vhdl-comment-display (&optional line-exists) |
| 10662 | "Add 2 comment lines at the current indent, making a display comment." |
| 10663 | (interactive) |
| 10664 | (let ((margin (current-indentation))) |
| 10665 | (unless line-exists (vhdl-comment-display-line)) |
| 10666 | (insert "\n") (indent-to margin) |
| 10667 | (insert "\n") (indent-to margin) |
| 10668 | (vhdl-comment-display-line) |
| 10669 | (end-of-line -0) |
| 10670 | (insert "-- "))) |
| 10671 | |
| 10672 | (defun vhdl-comment-display-line () |
| 10673 | "Displays one line of dashes." |
| 10674 | (interactive) |
| 10675 | (while (= (preceding-char) ?-) (delete-char -2)) |
| 10676 | (insert "--") |
| 10677 | (let* ((col (current-column)) |
| 10678 | (len (- end-comment-column col))) |
| 10679 | (insert-char vhdl-comment-display-line-char len))) |
| 10680 | |
| 10681 | (defun vhdl-comment-append-inline () |
| 10682 | "Append empty inline comment to current line." |
| 10683 | (interactive) |
| 10684 | (end-of-line) |
| 10685 | (delete-horizontal-space) |
| 10686 | (insert " ") |
| 10687 | (indent-to comment-column) |
| 10688 | (insert "-- ")) |
| 10689 | |
| 10690 | (defun vhdl-comment-insert-inline (&optional string always-insert) |
| 10691 | "Insert inline comment." |
| 10692 | (when (or (and string (or vhdl-self-insert-comments always-insert)) |
| 10693 | (and (not string) vhdl-prompt-for-comments)) |
| 10694 | (let ((position (point))) |
| 10695 | (insert " ") |
| 10696 | (indent-to comment-column) |
| 10697 | (insert "-- ") |
| 10698 | (if (not (or (and string (progn (insert string) t)) |
| 10699 | (vhdl-template-field "[comment]" nil t))) |
| 10700 | (delete-region position (point)) |
| 10701 | (while (= (preceding-char) ?\ ) (delete-char -1)))))) |
| 10702 | |
| 10703 | (defun vhdl-comment-block () |
| 10704 | "Insert comment for code block." |
| 10705 | (when vhdl-prompt-for-comments |
| 10706 | (let ((final-pos (point-marker))) |
| 10707 | (vhdl-prepare-search-2 |
| 10708 | (when (and (re-search-backward "^\\s-*begin\\>" nil t) |
| 10709 | (re-search-backward "\\<\\(architecture\\|block\\|function\\|procedure\\|process\\|procedural\\)\\>" nil t)) |
| 10710 | (let (margin) |
| 10711 | (back-to-indentation) |
| 10712 | (setq margin (current-column)) |
| 10713 | (end-of-line -0) |
| 10714 | (if (bobp) |
| 10715 | (progn (insert "\n") (forward-line -1)) |
| 10716 | (insert "\n")) |
| 10717 | (indent-to margin) |
| 10718 | (insert "-- purpose: ") |
| 10719 | (unless (vhdl-template-field "[description]" nil t) |
| 10720 | (vhdl-line-kill-entire))))) |
| 10721 | (goto-char final-pos)))) |
| 10722 | |
| 10723 | (defun vhdl-comment-uncomment-region (beg end &optional arg) |
| 10724 | "Comment out region if not commented out, uncomment otherwise." |
| 10725 | (interactive "r\nP") |
| 10726 | (save-excursion |
| 10727 | (goto-char (1- end)) |
| 10728 | (end-of-line) |
| 10729 | (setq end (point-marker)) |
| 10730 | (goto-char beg) |
| 10731 | (beginning-of-line) |
| 10732 | (setq beg (point)) |
| 10733 | (if (looking-at (concat "\\s-*" comment-start)) |
| 10734 | (comment-region beg end '(4)) |
| 10735 | (comment-region beg end)))) |
| 10736 | |
| 10737 | (defun vhdl-comment-uncomment-line (&optional arg) |
| 10738 | "Comment out line if not commented out, uncomment otherwise." |
| 10739 | (interactive "p") |
| 10740 | (save-excursion |
| 10741 | (beginning-of-line) |
| 10742 | (let ((position (point))) |
| 10743 | (forward-line (or arg 1)) |
| 10744 | (vhdl-comment-uncomment-region position (point))))) |
| 10745 | |
| 10746 | (defun vhdl-comment-kill-region (beg end) |
| 10747 | "Kill comments in region." |
| 10748 | (interactive "r") |
| 10749 | (save-excursion |
| 10750 | (goto-char end) |
| 10751 | (setq end (point-marker)) |
| 10752 | (goto-char beg) |
| 10753 | (beginning-of-line) |
| 10754 | (while (< (point) end) |
| 10755 | (if (looking-at "^\\(\\s-*--.*\n\\)") |
| 10756 | (progn (delete-region (match-beginning 1) (match-end 1))) |
| 10757 | (beginning-of-line 2))))) |
| 10758 | |
| 10759 | (defun vhdl-comment-kill-inline-region (beg end) |
| 10760 | "Kill inline comments in region." |
| 10761 | (interactive "r") |
| 10762 | (save-excursion |
| 10763 | (goto-char end) |
| 10764 | (setq end (point-marker)) |
| 10765 | (goto-char beg) |
| 10766 | (beginning-of-line) |
| 10767 | (while (< (point) end) |
| 10768 | (when (looking-at "^.*[^ \t\n\r\f-]+\\(\\s-*--.*\\)$") |
| 10769 | (delete-region (match-beginning 1) (match-end 1))) |
| 10770 | (beginning-of-line 2)))) |
| 10771 | |
| 10772 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10773 | ;; Subtemplates |
| 10774 | |
| 10775 | (defun vhdl-template-begin-end (construct name margin &optional empty-lines) |
| 10776 | "Insert a begin ... end pair with optional name after the end. |
| 10777 | Point is left between them." |
| 10778 | (let (position) |
| 10779 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10780 | (indent-to margin) |
| 10781 | (vhdl-insert-keyword "BEGIN") |
| 10782 | (when (and (or construct name) vhdl-self-insert-comments) |
| 10783 | (insert " --") |
| 10784 | (when construct (insert " ") (vhdl-insert-keyword construct)) |
| 10785 | (when name (insert " " name))) |
| 10786 | (insert "\n") |
| 10787 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10788 | (indent-to (+ margin vhdl-basic-offset)) |
| 10789 | (setq position (point)) |
| 10790 | (insert "\n") |
| 10791 | (when (or empty-lines (eq vhdl-insert-empty-lines 'all)) (insert "\n")) |
| 10792 | (indent-to margin) |
| 10793 | (vhdl-insert-keyword "END") |
| 10794 | (when construct (insert " ") (vhdl-insert-keyword construct)) |
| 10795 | (insert (if name (concat " " name) "") ";") |
| 10796 | (goto-char position))) |
| 10797 | |
| 10798 | (defun vhdl-template-argument-list (&optional is-function) |
| 10799 | "Read from user a procedure or function argument list." |
| 10800 | (insert " (") |
| 10801 | (let ((margin (current-column)) |
| 10802 | (start (point)) |
| 10803 | (end-pos (point)) |
| 10804 | not-empty interface semicolon-pos) |
| 10805 | (unless vhdl-argument-list-indent |
| 10806 | (setq margin (+ (current-indentation) vhdl-basic-offset)) |
| 10807 | (insert "\n") |
| 10808 | (indent-to margin)) |
| 10809 | (setq interface (vhdl-template-field |
| 10810 | (concat "[CONSTANT | SIGNAL" |
| 10811 | (unless is-function " | VARIABLE") "]") " " t)) |
| 10812 | (while (vhdl-template-field "[names]" nil t) |
| 10813 | (setq not-empty t) |
| 10814 | (insert " : ") |
| 10815 | (unless is-function |
| 10816 | (if (and interface (equal (upcase interface) "CONSTANT")) |
| 10817 | (vhdl-insert-keyword "IN ") |
| 10818 | (vhdl-template-field "[IN | OUT | INOUT]" " " t))) |
| 10819 | (vhdl-template-field "type") |
| 10820 | (setq semicolon-pos (point)) |
| 10821 | (insert ";") |
| 10822 | (vhdl-comment-insert-inline) |
| 10823 | (setq end-pos (point)) |
| 10824 | (insert "\n") |
| 10825 | (indent-to margin) |
| 10826 | (setq interface (vhdl-template-field |
| 10827 | (concat "[CONSTANT | SIGNAL" |
| 10828 | (unless is-function " | VARIABLE") "]") " " t))) |
| 10829 | (delete-region end-pos (point)) |
| 10830 | (when semicolon-pos (goto-char semicolon-pos)) |
| 10831 | (if not-empty |
| 10832 | (progn (delete-char 1) (insert ")")) |
| 10833 | (delete-char -2)))) |
| 10834 | |
| 10835 | (defun vhdl-template-generic-list (optional &optional no-value) |
| 10836 | "Read from user a generic spec argument list." |
| 10837 | (let (margin |
| 10838 | (start (point))) |
| 10839 | (vhdl-insert-keyword "GENERIC (") |
| 10840 | (setq margin (current-column)) |
| 10841 | (unless vhdl-argument-list-indent |
| 10842 | (let ((position (point))) |
| 10843 | (back-to-indentation) |
| 10844 | (setq margin (+ (current-column) vhdl-basic-offset)) |
| 10845 | (goto-char position) |
| 10846 | (insert "\n") |
| 10847 | (indent-to margin))) |
| 10848 | (let ((vhdl-generics (vhdl-template-field |
| 10849 | (concat (and optional "[") "name" |
| 10850 | (and no-value "s") (and optional "]")) |
| 10851 | nil optional))) |
| 10852 | (if (not vhdl-generics) |
| 10853 | (if optional |
| 10854 | (progn (vhdl-line-kill-entire) (end-of-line -0) |
| 10855 | (unless vhdl-argument-list-indent |
| 10856 | (vhdl-line-kill-entire) (end-of-line -0))) |
| 10857 | (vhdl-template-undo start (point)) |
| 10858 | nil ) |
| 10859 | (insert " : ") |
| 10860 | (let (semicolon-pos end-pos) |
| 10861 | (while vhdl-generics |
| 10862 | (vhdl-template-field "type") |
| 10863 | (if no-value |
| 10864 | (progn (setq semicolon-pos (point)) |
| 10865 | (insert ";")) |
| 10866 | (insert " := ") |
| 10867 | (unless (vhdl-template-field "[value]" nil t) |
| 10868 | (delete-char -4)) |
| 10869 | (setq semicolon-pos (point)) |
| 10870 | (insert ";")) |
| 10871 | (vhdl-comment-insert-inline) |
| 10872 | (setq end-pos (point)) |
| 10873 | (insert "\n") |
| 10874 | (indent-to margin) |
| 10875 | (setq vhdl-generics (vhdl-template-field |
| 10876 | (concat "[name" (and no-value "s") "]") |
| 10877 | " : " t))) |
| 10878 | (delete-region end-pos (point)) |
| 10879 | (goto-char semicolon-pos) |
| 10880 | (insert ")") |
| 10881 | (end-of-line) |
| 10882 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)) |
| 10883 | t))))) |
| 10884 | |
| 10885 | (defun vhdl-template-port-list (optional) |
| 10886 | "Read from user a port spec argument list." |
| 10887 | (let ((start (point)) |
| 10888 | margin vhdl-ports object) |
| 10889 | (vhdl-insert-keyword "PORT (") |
| 10890 | (setq margin (current-column)) |
| 10891 | (unless vhdl-argument-list-indent |
| 10892 | (let ((position (point))) |
| 10893 | (back-to-indentation) |
| 10894 | (setq margin (+ (current-column) vhdl-basic-offset)) |
| 10895 | (goto-char position) |
| 10896 | (insert "\n") |
| 10897 | (indent-to margin))) |
| 10898 | (when (vhdl-standard-p 'ams) |
| 10899 | (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" |
| 10900 | " " t))) |
| 10901 | (setq vhdl-ports (vhdl-template-field |
| 10902 | (concat (and optional "[") "names" (and optional "]")) |
| 10903 | nil optional)) |
| 10904 | (if (not vhdl-ports) |
| 10905 | (if optional |
| 10906 | (progn (vhdl-line-kill-entire) (end-of-line -0) |
| 10907 | (unless vhdl-argument-list-indent |
| 10908 | (vhdl-line-kill-entire) (end-of-line -0))) |
| 10909 | (vhdl-template-undo start (point)) |
| 10910 | nil) |
| 10911 | (insert " : ") |
| 10912 | (let (semicolon-pos end-pos) |
| 10913 | (while vhdl-ports |
| 10914 | (cond ((or (null object) (equal "SIGNAL" (upcase object))) |
| 10915 | (vhdl-template-field "IN | OUT | INOUT" " ")) |
| 10916 | ((equal "QUANTITY" (upcase object)) |
| 10917 | (vhdl-template-field "[IN | OUT]" " " t))) |
| 10918 | (vhdl-template-field |
| 10919 | (if (and object (equal "TERMINAL" (upcase object))) |
| 10920 | "nature" "type")) |
| 10921 | (setq semicolon-pos (point)) |
| 10922 | (insert ";") |
| 10923 | (vhdl-comment-insert-inline) |
| 10924 | (setq end-pos (point)) |
| 10925 | (insert "\n") |
| 10926 | (indent-to margin) |
| 10927 | (when (vhdl-standard-p 'ams) |
| 10928 | (setq object (vhdl-template-field "[SIGNAL | TERMINAL | QUANTITY]" |
| 10929 | " " t))) |
| 10930 | (setq vhdl-ports (vhdl-template-field "[names]" " : " t))) |
| 10931 | (delete-region end-pos (point)) |
| 10932 | (goto-char semicolon-pos) |
| 10933 | (insert ")") |
| 10934 | (end-of-line) |
| 10935 | (when vhdl-auto-align (vhdl-align-region-groups start end-pos 1)) |
| 10936 | t)))) |
| 10937 | |
| 10938 | (defun vhdl-template-generate-body (margin label) |
| 10939 | "Insert body for generate template." |
| 10940 | (vhdl-insert-keyword " GENERATE") |
| 10941 | (insert "\n\n") |
| 10942 | (indent-to margin) |
| 10943 | (vhdl-insert-keyword "END GENERATE ") |
| 10944 | (insert label ";") |
| 10945 | (end-of-line 0) |
| 10946 | (indent-to (+ margin vhdl-basic-offset))) |
| 10947 | |
| 10948 | (defun vhdl-template-insert-date () |
| 10949 | "Insert date in appropriate format." |
| 10950 | (interactive) |
| 10951 | (insert |
| 10952 | (cond |
| 10953 | ;; 'american, 'european, 'scientific kept for backward compatibility |
| 10954 | ((eq vhdl-date-format 'american) (format-time-string "%m/%d/%Y" nil)) |
| 10955 | ((eq vhdl-date-format 'european) (format-time-string "%d.%m.%Y" nil)) |
| 10956 | ((eq vhdl-date-format 'scientific) (format-time-string "%Y/%m/%d" nil)) |
| 10957 | (t (format-time-string vhdl-date-format nil))))) |
| 10958 | |
| 10959 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 10960 | ;; Help functions |
| 10961 | |
| 10962 | (defun vhdl-electric-space (count) |
| 10963 | "Expand abbreviations and self-insert space(s), do indent-new-comment-line |
| 10964 | if in comment and past end-comment-column." |
| 10965 | (interactive "p") |
| 10966 | (cond ((vhdl-in-comment-p) |
| 10967 | (self-insert-command count) |
| 10968 | (cond ((>= (current-column) (+ 2 end-comment-column)) |
| 10969 | (backward-char 1) |
| 10970 | (skip-chars-backward "^ \t\n\r\f") |
| 10971 | (indent-new-comment-line) |
| 10972 | (skip-chars-forward "^ \t\n\r\f") |
| 10973 | (forward-char 1)) |
| 10974 | ((>= (current-column) end-comment-column) |
| 10975 | (indent-new-comment-line)) |
| 10976 | (t nil))) |
| 10977 | ((or (and (>= (preceding-char) ?a) (<= (preceding-char) ?z)) |
| 10978 | (and (>= (preceding-char) ?A) (<= (preceding-char) ?Z))) |
| 10979 | (vhdl-prepare-search-1 |
| 10980 | (or (expand-abbrev) (vhdl-fix-case-word -1))) |
| 10981 | (self-insert-command count)) |
| 10982 | (t (self-insert-command count)))) |
| 10983 | |
| 10984 | (defun vhdl-template-field (prompt &optional follow-string optional |
| 10985 | begin end is-string default) |
| 10986 | "Prompt for string and insert it in buffer with optional FOLLOW-STRING. |
| 10987 | If OPTIONAL is nil, the prompt is left if an empty string is inserted. If |
| 10988 | an empty string is inserted, return nil and call `vhdl-template-undo' for |
| 10989 | the region between BEGIN and END. IS-STRING indicates whether a string |
| 10990 | with double-quotes is to be inserted. DEFAULT specifies a default string." |
| 10991 | (let ((position (point)) |
| 10992 | string) |
| 10993 | (insert "<" prompt ">") |
| 10994 | (setq string |
| 10995 | (condition-case () |
| 10996 | (read-from-minibuffer (concat prompt ": ") |
| 10997 | (or (and is-string '("\"\"" . 2)) default) |
| 10998 | vhdl-minibuffer-local-map) |
| 10999 | (quit (if (and optional begin end) |
| 11000 | (progn (beep) "") |
| 11001 | (keyboard-quit))))) |
| 11002 | (when (or (not (equal string "")) optional) |
| 11003 | (delete-region position (point))) |
| 11004 | (when (and (equal string "") optional begin end) |
| 11005 | (vhdl-template-undo begin end) |
| 11006 | (message "Template aborted")) |
| 11007 | (unless (equal string "") |
| 11008 | (insert string) |
| 11009 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-keywords |
| 11010 | vhdl-keywords-regexp) |
| 11011 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-types |
| 11012 | vhdl-types-regexp) |
| 11013 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-attributes |
| 11014 | (concat "'" vhdl-attributes-regexp)) |
| 11015 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-enum-values |
| 11016 | vhdl-enum-values-regexp) |
| 11017 | (vhdl-fix-case-region-1 position (point) vhdl-upper-case-constants |
| 11018 | vhdl-constants-regexp)) |
| 11019 | (when (or (not (equal string "")) (not optional)) |
| 11020 | (insert (or follow-string ""))) |
| 11021 | (if (equal string "") nil string))) |
| 11022 | |
| 11023 | (defun vhdl-decision-query (string prompt &optional optional) |
| 11024 | "Query a decision from the user." |
| 11025 | (let ((start (point))) |
| 11026 | (when string (vhdl-insert-keyword (concat string " "))) |
| 11027 | (message "%s" (or prompt "")) |
| 11028 | (let ((char (read-char))) |
| 11029 | (delete-region start (point)) |
| 11030 | (if (and optional (eq char ?\r)) |
| 11031 | (progn (insert " ") |
| 11032 | (unexpand-abbrev) |
| 11033 | (throw 'abort "ERROR: Template aborted")) |
| 11034 | char)))) |
| 11035 | |
| 11036 | (defun vhdl-insert-keyword (keyword) |
| 11037 | "Insert KEYWORD and adjust case." |
| 11038 | (insert (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))) |
| 11039 | |
| 11040 | (defun vhdl-case-keyword (keyword) |
| 11041 | "Adjust case of KEYWORD." |
| 11042 | (if vhdl-upper-case-keywords (upcase keyword) (downcase keyword))) |
| 11043 | |
| 11044 | (defun vhdl-case-word (num) |
| 11045 | "Adjust case of following NUM words." |
| 11046 | (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num))) |
| 11047 | |
| 11048 | (defun vhdl-minibuffer-tab (&optional prefix-arg) |
| 11049 | "If preceding character is part of a word or a paren then hippie-expand, |
| 11050 | else insert tab (used for word completion in VHDL minibuffer)." |
| 11051 | (interactive "P") |
| 11052 | (cond |
| 11053 | ;; expand word |
| 11054 | ((= (char-syntax (preceding-char)) ?w) |
| 11055 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 11056 | (case-replace nil) |
| 11057 | (hippie-expand-only-buffers |
| 11058 | (or (and (boundp 'hippie-expand-only-buffers) |
| 11059 | hippie-expand-only-buffers) |
| 11060 | '(vhdl-mode)))) |
| 11061 | (vhdl-expand-abbrev prefix-arg))) |
| 11062 | ;; expand parenthesis |
| 11063 | ((or (= (preceding-char) ?\() (= (preceding-char) ?\))) |
| 11064 | (let ((case-fold-search (not vhdl-word-completion-case-sensitive)) |
| 11065 | (case-replace nil)) |
| 11066 | (vhdl-expand-paren prefix-arg))) |
| 11067 | ;; insert tab |
| 11068 | (t (insert-tab)))) |
| 11069 | |
| 11070 | (defun vhdl-template-search-prompt () |
| 11071 | "Search for left out template prompts and query again." |
| 11072 | (interactive) |
| 11073 | (vhdl-prepare-search-2 |
| 11074 | (when (or (re-search-forward |
| 11075 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t) |
| 11076 | (re-search-backward |
| 11077 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)) |
| 11078 | (let ((string (match-string 1))) |
| 11079 | (replace-match "") |
| 11080 | (vhdl-template-field string))))) |
| 11081 | |
| 11082 | (defun vhdl-template-undo (begin end) |
| 11083 | "Undo aborted template by deleting region and unexpanding the keyword." |
| 11084 | (cond (vhdl-template-invoked-by-hook |
| 11085 | (goto-char end) |
| 11086 | (insert " ") |
| 11087 | (delete-region begin end) |
| 11088 | (unexpand-abbrev)) |
| 11089 | (t (delete-region begin end)))) |
| 11090 | |
| 11091 | (defun vhdl-insert-string-or-file (string) |
| 11092 | "Insert STRING or file contents if STRING is an existing file name." |
| 11093 | (unless (equal string "") |
| 11094 | (let ((file-name |
| 11095 | (progn (string-match "^\\([^\n]+\\)" string) |
| 11096 | (vhdl-resolve-env-variable (match-string 1 string))))) |
| 11097 | (if (file-exists-p file-name) |
| 11098 | (forward-char (cadr (insert-file-contents file-name))) |
| 11099 | (insert string))))) |
| 11100 | |
| 11101 | (defun vhdl-beginning-of-block () |
| 11102 | "Move cursor to the beginning of the enclosing block." |
| 11103 | (let (pos) |
| 11104 | (vhdl-prepare-search-2 |
| 11105 | (save-excursion |
| 11106 | (beginning-of-line) |
| 11107 | ;; search backward for block beginning or end |
| 11108 | (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) |
| 11109 | ;; not consider subprogram declarations |
| 11110 | (or (and (match-string 5) |
| 11111 | (save-match-data |
| 11112 | (save-excursion |
| 11113 | (goto-char (match-end 5)) |
| 11114 | (forward-word 1) |
| 11115 | (vhdl-forward-syntactic-ws) |
| 11116 | (when (looking-at "(") |
| 11117 | (forward-sexp)) |
| 11118 | (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) |
| 11119 | (match-string 1))) |
| 11120 | ;; not consider configuration specifications |
| 11121 | (and (match-string 6) |
| 11122 | (save-match-data |
| 11123 | (save-excursion |
| 11124 | (vhdl-end-of-block) |
| 11125 | (beginning-of-line) |
| 11126 | (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) |
| 11127 | (match-string 2)) |
| 11128 | ;; skip subblock if block end found |
| 11129 | (vhdl-beginning-of-block)))) |
| 11130 | (when pos (goto-char pos)))) |
| 11131 | |
| 11132 | (defun vhdl-end-of-block () |
| 11133 | "Move cursor to the end of the enclosing block." |
| 11134 | (let (pos) |
| 11135 | (vhdl-prepare-search-2 |
| 11136 | (save-excursion |
| 11137 | (end-of-line) |
| 11138 | ;; search forward for block beginning or end |
| 11139 | (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|type[ \t\n\r\f]+\\w+[ \t\n\r\f]+is[ \t\n\r\f]+\\(record\\|protected\\(\\s-+body\\)?\\)\\|units\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(postponed[ \t\n\r\f]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\|loop\\)\\)\\>" nil t)) |
| 11140 | ;; not consider subprogram declarations |
| 11141 | (or (and (match-string 5) |
| 11142 | (save-match-data |
| 11143 | (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t)) |
| 11144 | (match-string 1))) |
| 11145 | ;; not consider configuration specifications |
| 11146 | (and (match-string 6) |
| 11147 | (save-match-data |
| 11148 | (save-excursion |
| 11149 | (vhdl-end-of-block) |
| 11150 | (beginning-of-line) |
| 11151 | (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>")))))))) |
| 11152 | (not (match-string 2))) |
| 11153 | ;; skip subblock if block beginning found |
| 11154 | (vhdl-end-of-block)))) |
| 11155 | (when pos (goto-char pos)))) |
| 11156 | |
| 11157 | (defun vhdl-sequential-statement-p () |
| 11158 | "Check if point is within sequential statement part." |
| 11159 | (let ((start (point))) |
| 11160 | (save-excursion |
| 11161 | (vhdl-prepare-search-2 |
| 11162 | ;; is sequential statement if ... |
| 11163 | (and (re-search-backward "^\\s-*begin\\>" nil t) |
| 11164 | ;; ... point is between "begin" and "end" of ... |
| 11165 | (progn (vhdl-end-of-block) |
| 11166 | (< start (point))) |
| 11167 | ;; ... a sequential block |
| 11168 | (progn (vhdl-beginning-of-block) |
| 11169 | (looking-at "^\\s-*\\(\\(\\w+[ \t\n\r\f]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(\\w+[ \t\n\r\f]+\\)?\\(procedural\\|process\\)\\)\\>"))))))) |
| 11170 | |
| 11171 | (defun vhdl-in-argument-list-p () |
| 11172 | "Check if within an argument list." |
| 11173 | (save-excursion |
| 11174 | (vhdl-prepare-search-2 |
| 11175 | (or (string-match "arglist" |
| 11176 | (format "%s" (caar (vhdl-get-syntactic-context)))) |
| 11177 | (progn (beginning-of-line) |
| 11178 | (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?(")))))) |
| 11179 | |
| 11180 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11181 | ;; Abbrev hooks |
| 11182 | |
| 11183 | (defun vhdl-hooked-abbrev (func) |
| 11184 | "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev, |
| 11185 | but not if inside a comment or quote." |
| 11186 | (if (or (vhdl-in-literal) |
| 11187 | (save-excursion |
| 11188 | (forward-word -1) |
| 11189 | (and (looking-at "\\<end\\>") (not (looking-at "\\<end;"))))) |
| 11190 | (progn |
| 11191 | (insert " ") |
| 11192 | (unexpand-abbrev) |
| 11193 | (backward-word 1) |
| 11194 | (vhdl-case-word 1) |
| 11195 | (delete-char 1)) |
| 11196 | (if (not vhdl-electric-mode) |
| 11197 | (progn |
| 11198 | (insert " ") |
| 11199 | (unexpand-abbrev) |
| 11200 | (backward-word 1) |
| 11201 | (vhdl-case-word 1) |
| 11202 | (delete-char 1)) |
| 11203 | (let ((invoke-char vhdl-last-input-event) |
| 11204 | (abbrev-mode -1) |
| 11205 | (vhdl-template-invoked-by-hook t)) |
| 11206 | (let ((caught (catch 'abort |
| 11207 | (funcall func)))) |
| 11208 | (when (stringp caught) (message "%s" caught))) |
| 11209 | (when (= invoke-char ?-) (setq abbrev-start-location (point))) |
| 11210 | ;; delete CR which is still in event queue |
| 11211 | (if (fboundp 'enqueue-eval-event) |
| 11212 | (enqueue-eval-event 'delete-char -1) |
| 11213 | (setq unread-command-events ; push back a delete char |
| 11214 | (list (vhdl-character-to-event ?\177)))))))) |
| 11215 | |
| 11216 | (defun vhdl-template-alias-hook () |
| 11217 | (vhdl-hooked-abbrev 'vhdl-template-alias)) |
| 11218 | (defun vhdl-template-architecture-hook () |
| 11219 | (vhdl-hooked-abbrev 'vhdl-template-architecture)) |
| 11220 | (defun vhdl-template-assert-hook () |
| 11221 | (vhdl-hooked-abbrev 'vhdl-template-assert)) |
| 11222 | (defun vhdl-template-attribute-hook () |
| 11223 | (vhdl-hooked-abbrev 'vhdl-template-attribute)) |
| 11224 | (defun vhdl-template-block-hook () |
| 11225 | (vhdl-hooked-abbrev 'vhdl-template-block)) |
| 11226 | (defun vhdl-template-break-hook () |
| 11227 | (vhdl-hooked-abbrev 'vhdl-template-break)) |
| 11228 | (defun vhdl-template-case-hook () |
| 11229 | (vhdl-hooked-abbrev 'vhdl-template-case)) |
| 11230 | (defun vhdl-template-component-hook () |
| 11231 | (vhdl-hooked-abbrev 'vhdl-template-component)) |
| 11232 | (defun vhdl-template-instance-hook () |
| 11233 | (vhdl-hooked-abbrev 'vhdl-template-instance)) |
| 11234 | (defun vhdl-template-conditional-signal-asst-hook () |
| 11235 | (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst)) |
| 11236 | (defun vhdl-template-configuration-hook () |
| 11237 | (vhdl-hooked-abbrev 'vhdl-template-configuration)) |
| 11238 | (defun vhdl-template-constant-hook () |
| 11239 | (vhdl-hooked-abbrev 'vhdl-template-constant)) |
| 11240 | (defun vhdl-template-disconnect-hook () |
| 11241 | (vhdl-hooked-abbrev 'vhdl-template-disconnect)) |
| 11242 | (defun vhdl-template-display-comment-hook () |
| 11243 | (vhdl-hooked-abbrev 'vhdl-comment-display)) |
| 11244 | (defun vhdl-template-else-hook () |
| 11245 | (vhdl-hooked-abbrev 'vhdl-template-else)) |
| 11246 | (defun vhdl-template-elsif-hook () |
| 11247 | (vhdl-hooked-abbrev 'vhdl-template-elsif)) |
| 11248 | (defun vhdl-template-entity-hook () |
| 11249 | (vhdl-hooked-abbrev 'vhdl-template-entity)) |
| 11250 | (defun vhdl-template-exit-hook () |
| 11251 | (vhdl-hooked-abbrev 'vhdl-template-exit)) |
| 11252 | (defun vhdl-template-file-hook () |
| 11253 | (vhdl-hooked-abbrev 'vhdl-template-file)) |
| 11254 | (defun vhdl-template-for-hook () |
| 11255 | (vhdl-hooked-abbrev 'vhdl-template-for)) |
| 11256 | (defun vhdl-template-function-hook () |
| 11257 | (vhdl-hooked-abbrev 'vhdl-template-function)) |
| 11258 | (defun vhdl-template-generic-hook () |
| 11259 | (vhdl-hooked-abbrev 'vhdl-template-generic)) |
| 11260 | (defun vhdl-template-group-hook () |
| 11261 | (vhdl-hooked-abbrev 'vhdl-template-group)) |
| 11262 | (defun vhdl-template-library-hook () |
| 11263 | (vhdl-hooked-abbrev 'vhdl-template-library)) |
| 11264 | (defun vhdl-template-limit-hook () |
| 11265 | (vhdl-hooked-abbrev 'vhdl-template-limit)) |
| 11266 | (defun vhdl-template-if-hook () |
| 11267 | (vhdl-hooked-abbrev 'vhdl-template-if)) |
| 11268 | (defun vhdl-template-bare-loop-hook () |
| 11269 | (vhdl-hooked-abbrev 'vhdl-template-bare-loop)) |
| 11270 | (defun vhdl-template-map-hook () |
| 11271 | (vhdl-hooked-abbrev 'vhdl-template-map)) |
| 11272 | (defun vhdl-template-nature-hook () |
| 11273 | (vhdl-hooked-abbrev 'vhdl-template-nature)) |
| 11274 | (defun vhdl-template-next-hook () |
| 11275 | (vhdl-hooked-abbrev 'vhdl-template-next)) |
| 11276 | (defun vhdl-template-others-hook () |
| 11277 | (vhdl-hooked-abbrev 'vhdl-template-others)) |
| 11278 | (defun vhdl-template-package-hook () |
| 11279 | (vhdl-hooked-abbrev 'vhdl-template-package)) |
| 11280 | (defun vhdl-template-port-hook () |
| 11281 | (vhdl-hooked-abbrev 'vhdl-template-port)) |
| 11282 | (defun vhdl-template-procedural-hook () |
| 11283 | (vhdl-hooked-abbrev 'vhdl-template-procedural)) |
| 11284 | (defun vhdl-template-procedure-hook () |
| 11285 | (vhdl-hooked-abbrev 'vhdl-template-procedure)) |
| 11286 | (defun vhdl-template-process-hook () |
| 11287 | (vhdl-hooked-abbrev 'vhdl-template-process)) |
| 11288 | (defun vhdl-template-quantity-hook () |
| 11289 | (vhdl-hooked-abbrev 'vhdl-template-quantity)) |
| 11290 | (defun vhdl-template-report-hook () |
| 11291 | (vhdl-hooked-abbrev 'vhdl-template-report)) |
| 11292 | (defun vhdl-template-return-hook () |
| 11293 | (vhdl-hooked-abbrev 'vhdl-template-return)) |
| 11294 | (defun vhdl-template-selected-signal-asst-hook () |
| 11295 | (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst)) |
| 11296 | (defun vhdl-template-signal-hook () |
| 11297 | (vhdl-hooked-abbrev 'vhdl-template-signal)) |
| 11298 | (defun vhdl-template-subnature-hook () |
| 11299 | (vhdl-hooked-abbrev 'vhdl-template-subnature)) |
| 11300 | (defun vhdl-template-subtype-hook () |
| 11301 | (vhdl-hooked-abbrev 'vhdl-template-subtype)) |
| 11302 | (defun vhdl-template-terminal-hook () |
| 11303 | (vhdl-hooked-abbrev 'vhdl-template-terminal)) |
| 11304 | (defun vhdl-template-type-hook () |
| 11305 | (vhdl-hooked-abbrev 'vhdl-template-type)) |
| 11306 | (defun vhdl-template-use-hook () |
| 11307 | (vhdl-hooked-abbrev 'vhdl-template-use)) |
| 11308 | (defun vhdl-template-variable-hook () |
| 11309 | (vhdl-hooked-abbrev 'vhdl-template-variable)) |
| 11310 | (defun vhdl-template-wait-hook () |
| 11311 | (vhdl-hooked-abbrev 'vhdl-template-wait)) |
| 11312 | (defun vhdl-template-when-hook () |
| 11313 | (vhdl-hooked-abbrev 'vhdl-template-when)) |
| 11314 | (defun vhdl-template-while-loop-hook () |
| 11315 | (vhdl-hooked-abbrev 'vhdl-template-while-loop)) |
| 11316 | (defun vhdl-template-with-hook () |
| 11317 | (vhdl-hooked-abbrev 'vhdl-template-with)) |
| 11318 | (defun vhdl-template-and-hook () |
| 11319 | (vhdl-hooked-abbrev 'vhdl-template-and)) |
| 11320 | (defun vhdl-template-or-hook () |
| 11321 | (vhdl-hooked-abbrev 'vhdl-template-or)) |
| 11322 | (defun vhdl-template-nand-hook () |
| 11323 | (vhdl-hooked-abbrev 'vhdl-template-nand)) |
| 11324 | (defun vhdl-template-nor-hook () |
| 11325 | (vhdl-hooked-abbrev 'vhdl-template-nor)) |
| 11326 | (defun vhdl-template-xor-hook () |
| 11327 | (vhdl-hooked-abbrev 'vhdl-template-xor)) |
| 11328 | (defun vhdl-template-xnor-hook () |
| 11329 | (vhdl-hooked-abbrev 'vhdl-template-xnor)) |
| 11330 | (defun vhdl-template-not-hook () |
| 11331 | (vhdl-hooked-abbrev 'vhdl-template-not)) |
| 11332 | |
| 11333 | (defun vhdl-template-default-hook () |
| 11334 | (vhdl-hooked-abbrev 'vhdl-template-default)) |
| 11335 | (defun vhdl-template-default-indent-hook () |
| 11336 | (vhdl-hooked-abbrev 'vhdl-template-default-indent)) |
| 11337 | |
| 11338 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11339 | ;; Template insertion from completion list |
| 11340 | |
| 11341 | (defun vhdl-template-insert-construct (name) |
| 11342 | "Insert the built-in construct template with NAME." |
| 11343 | (interactive |
| 11344 | (list (let ((completion-ignore-case t)) |
| 11345 | (completing-read "Construct name: " |
| 11346 | vhdl-template-construct-alist nil t)))) |
| 11347 | (vhdl-template-insert-fun |
| 11348 | (cadr (assoc name vhdl-template-construct-alist)))) |
| 11349 | |
| 11350 | (defun vhdl-template-insert-package (name) |
| 11351 | "Insert the built-in package template with NAME." |
| 11352 | (interactive |
| 11353 | (list (let ((completion-ignore-case t)) |
| 11354 | (completing-read "Package name: " |
| 11355 | vhdl-template-package-alist nil t)))) |
| 11356 | (vhdl-template-insert-fun |
| 11357 | (cadr (assoc name vhdl-template-package-alist)))) |
| 11358 | |
| 11359 | (defun vhdl-template-insert-directive (name) |
| 11360 | "Insert the built-in directive template with NAME." |
| 11361 | (interactive |
| 11362 | (list (let ((completion-ignore-case t)) |
| 11363 | (completing-read "Directive name: " |
| 11364 | vhdl-template-directive-alist nil t)))) |
| 11365 | (vhdl-template-insert-fun |
| 11366 | (cadr (assoc name vhdl-template-directive-alist)))) |
| 11367 | |
| 11368 | (defun vhdl-template-insert-fun (fun) |
| 11369 | "Call FUN to insert a built-in template." |
| 11370 | (let ((caught (catch 'abort (when fun (funcall fun))))) |
| 11371 | (when (stringp caught) (message "%s" caught)))) |
| 11372 | |
| 11373 | |
| 11374 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11375 | ;;; Models |
| 11376 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11377 | |
| 11378 | (defun vhdl-model-insert (model-name) |
| 11379 | "Insert the user model with name MODEL-NAME." |
| 11380 | (interactive |
| 11381 | (let ((completion-ignore-case t)) |
| 11382 | (list (completing-read "Model name: " vhdl-model-alist)))) |
| 11383 | (indent-according-to-mode) |
| 11384 | (let ((start (point-marker)) |
| 11385 | (margin (current-indentation)) |
| 11386 | model position prompt string end) |
| 11387 | (vhdl-prepare-search-2 |
| 11388 | (when (setq model (assoc model-name vhdl-model-alist)) |
| 11389 | ;; insert model |
| 11390 | (beginning-of-line) |
| 11391 | (delete-horizontal-space) |
| 11392 | (goto-char start) |
| 11393 | (vhdl-insert-string-or-file (nth 1 model)) |
| 11394 | (setq end (point-marker)) |
| 11395 | ;; indent code |
| 11396 | (goto-char start) |
| 11397 | (beginning-of-line) |
| 11398 | (while (< (point) end) |
| 11399 | (unless (looking-at "^$") |
| 11400 | (insert-char ? margin)) |
| 11401 | (beginning-of-line 2)) |
| 11402 | (goto-char start) |
| 11403 | ;; insert clock |
| 11404 | (unless (equal "" vhdl-clock-name) |
| 11405 | (while (re-search-forward "<clock>" end t) |
| 11406 | (replace-match vhdl-clock-name))) |
| 11407 | (goto-char start) |
| 11408 | ;; insert reset |
| 11409 | (unless (equal "" vhdl-reset-name) |
| 11410 | (while (re-search-forward "<reset>" end t) |
| 11411 | (replace-match vhdl-reset-name))) |
| 11412 | ;; replace header prompts |
| 11413 | (vhdl-template-replace-header-keywords start end nil t) |
| 11414 | (goto-char start) |
| 11415 | ;; query other prompts |
| 11416 | (while (re-search-forward |
| 11417 | (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t) |
| 11418 | (unless (equal "cursor" (match-string 1)) |
| 11419 | (setq position (match-beginning 1)) |
| 11420 | (setq prompt (match-string 1)) |
| 11421 | (replace-match "") |
| 11422 | (setq string (vhdl-template-field prompt nil t)) |
| 11423 | ;; replace occurrences of same prompt |
| 11424 | (while (re-search-forward (concat "<\\(" prompt "\\)>") end t) |
| 11425 | (replace-match (or string ""))) |
| 11426 | (goto-char position))) |
| 11427 | (goto-char start) |
| 11428 | ;; goto final position |
| 11429 | (if (re-search-forward "<cursor>" end t) |
| 11430 | (replace-match "") |
| 11431 | (goto-char end)))))) |
| 11432 | |
| 11433 | (defun vhdl-model-defun () |
| 11434 | "Define help and hook functions for user models." |
| 11435 | (let ((model-alist vhdl-model-alist) |
| 11436 | model-name model-keyword) |
| 11437 | (while model-alist |
| 11438 | ;; define functions for user models that can be invoked from menu and key |
| 11439 | ;; bindings and which themselves call `vhdl-model-insert' with the model |
| 11440 | ;; name as argument |
| 11441 | (setq model-name (nth 0 (car model-alist))) |
| 11442 | (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) () |
| 11443 | ,(concat "Insert model for \"" model-name "\".") |
| 11444 | (interactive) |
| 11445 | (vhdl-model-insert ,model-name))) |
| 11446 | ;; define hooks for user models that are invoked from keyword abbrevs |
| 11447 | (setq model-keyword (nth 3 (car model-alist))) |
| 11448 | (unless (equal model-keyword "") |
| 11449 | (eval `(defun |
| 11450 | ,(vhdl-function-name |
| 11451 | "vhdl-model" model-name "hook") () |
| 11452 | (vhdl-hooked-abbrev |
| 11453 | ',(vhdl-function-name "vhdl-model" model-name))))) |
| 11454 | (setq model-alist (cdr model-alist))))) |
| 11455 | |
| 11456 | (vhdl-model-defun) |
| 11457 | |
| 11458 | |
| 11459 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11460 | ;;; Port translation |
| 11461 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 11462 | |
| 11463 | (defvar vhdl-port-list nil |
| 11464 | "Variable to hold last port map parsed.") |
| 11465 | ;; structure: (parenthesized expression means list of such entries) |
| 11466 | ;; (ent-name |
| 11467 | ;; ((generic-names) generic-type generic-init generic-comment group-comment) |
| 11468 | ;; ((port-names) port-object port-direct port-type port-comment group-comment) |
| 11469 | ;; (lib-name pack-key)) |
| 11470 | |
| 11471 | (defun vhdl-parse-string (string &optional optional) |
| 11472 | "Check that the text following point matches the regexp in STRING." |
| 11473 | (if (looking-at string) |
| 11474 | (progn (goto-char (match-end 0)) |
| 11475 | (when (vhdl-in-literal) |
| 11476 | (end-of-line)) |
| 11477 | (point)) |
| 11478 | (unless optional |
| 11479 | (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\"" |
| 11480 | (vhdl-current-line) string))) |
| 11481 | nil)) |
| 11482 | |
| 11483 | (defun vhdl-replace-string (regexp-cons string &optional adjust-case) |
| 11484 | "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS." |
| 11485 | (vhdl-prepare-search-1 |
| 11486 | (if (string-match (car regexp-cons) string) |
| 11487 | (if adjust-case |
| 11488 | (funcall vhdl-file-name-case |
| 11489 | (replace-match (cdr regexp-cons) t nil string)) |
| 11490 | (replace-match (cdr regexp-cons) t nil string)) |
| 11491 | string))) |
| 11492 | |
| 11493 | (defun vhdl-parse-group-comment () |
| 11494 | "Parse comment and empty lines between groups of lines." |
| 11495 | (let ((start (point)) |
| 11496 | string) |
| 11497 | (vhdl-forward-comment (point-max)) |
| 11498 | (setq string (buffer-substring-no-properties start (point))) |
| 11499 | (vhdl-forward-syntactic-ws) |
| 11500 | ;; strip off leading blanks and first newline |
| 11501 | (while (string-match "^\\(\\s-+\\)" string) |
| 11502 | (setq string (concat (substring string 0 (match-beginning 1)) |
| 11503 | (substring string (match-end 1))))) |
| 11504 | (if (and (not (equal string "")) (equal (substring string 0 1) "\n")) |
| 11505 | (substring string 1) |
| 11506 | string))) |
| 11507 | |
| 11508 | (defun vhdl-paste-group-comment (string indent) |
| 11509 | "Paste comment and empty lines from STRING between groups of lines |
| 11510 | with INDENT." |
| 11511 | (let ((pos (point-marker))) |
| 11512 | (when (> indent 0) |
| 11513 | (while (string-match "^\\(--\\)" string) |
| 11514 | (setq string (concat (substring string 0 (match-beginning 1)) |
| 11515 | (make-string indent ? ) |
| 11516 | (substring string (match-beginning 1)))))) |
| 11517 | (beginning-of-line) |
| 11518 | (insert string) |
| 11519 | (goto-char pos))) |
| 11520 | |
| 11521 | (defvar vhdl-port-flattened nil |
| 11522 | "Indicates whether a port has been flattened.") |
| 11523 | |
| 11524 | (defun vhdl-port-flatten (&optional as-alist) |
| 11525 | "Flatten port list so that only one generic/port exists per line. |
| 11526 | This operation is performed on an internally stored port and is only |
| 11527 | reflected in a subsequent paste operation." |
| 11528 | (interactive) |
| 11529 | (if (not vhdl-port-list) |
| 11530 | (error "ERROR: No port has been read") |
| 11531 | (message "Flattening port for next paste...") |
| 11532 | (let ((new-vhdl-port-list (list (car vhdl-port-list))) |
| 11533 | (old-vhdl-port-list (cdr vhdl-port-list)) |
| 11534 | old-port-list new-port-list old-port new-port names) |
| 11535 | ;; traverse port list and flatten entries |
| 11536 | (while (cdr old-vhdl-port-list) |
| 11537 | (setq old-port-list (car old-vhdl-port-list)) |
| 11538 | (setq new-port-list nil) |
| 11539 | (while old-port-list |
| 11540 | (setq old-port (car old-port-list)) |
| 11541 | (setq names (car old-port)) |
| 11542 | (while names |
| 11543 | (setq new-port (cons (if as-alist (car names) (list (car names))) |
| 11544 | (cdr old-port))) |
| 11545 | (setq new-port-list (append new-port-list (list new-port))) |
| 11546 | (setq names (cdr names))) |
| 11547 | (setq old-port-list (cdr old-port-list))) |
| 11548 | (setq old-vhdl-port-list (cdr old-vhdl-port-list)) |
| 11549 | (setq new-vhdl-port-list (append new-vhdl-port-list |
| 11550 | (list new-port-list)))) |
| 11551 | (setq vhdl-port-list |
| 11552 | (append new-vhdl-port-list (list old-vhdl-port-list)) |
| 11553 | vhdl-port-flattened t) |
| 11554 | (message "Flattening port for next paste...done")))) |
| 11555 | |
| 11556 | (defvar vhdl-port-reversed-direction nil |
| 11557 | "Indicates whether port directions are reversed.") |
| 11558 | |
| 11559 | (defun vhdl-port-reverse-direction () |
| 11560 | "Reverse direction for all ports (useful in testbenches). |
| 11561 | This operation is performed on an internally stored port and is only |
| 11562 | reflected in a subsequent paste operation." |
| 11563 | (interactive) |
| 11564 | (if (not vhdl-port-list) |
| 11565 | (error "ERROR: No port has been read") |
| 11566 | (message "Reversing port directions for next paste...") |
| 11567 | (let ((port-list (nth 2 vhdl-port-list)) |
| 11568 | port-dir-car port-dir) |
| 11569 | ;; traverse port list and reverse directions |
| 11570 | (while port-list |
| 11571 | (setq port-dir-car (cddr (car port-list)) |
| 11572 | port-dir (car port-dir-car)) |
| 11573 | (setcar port-dir-car |
| 11574 | (cond ((equal port-dir "in") "out") |
| 11575 | ((equal port-dir "IN") "OUT") |
| 11576 | ((equal port-dir "out") "in") |
| 11577 | ((equal port-dir "OUT") "IN") |
| 11578 | (t port-dir))) |
| 11579 | (setq port-list (cdr port-list))) |
| 11580 | (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction)) |
| 11581 | (message "Reversing port directions for next paste...done")))) |
| 11582 | |
| 11583 | (defun vhdl-port-copy () |
| 11584 | "Get generic and port information from an entity or component declaration." |
| 11585 | (interactive) |
| 11586 | (save-excursion |
| 11587 | (let (parse-error end-of-list |
| 11588 | decl-type name generic-list port-list context-clause |
| 11589 | object names direct type init comment group-comment) |
| 11590 | (vhdl-prepare-search-2 |
| 11591 | (setq |
| 11592 | parse-error |
| 11593 | (catch 'parse |
| 11594 | ;; check if within entity or component declaration |
| 11595 | (end-of-line) |
| 11596 | (when (or (not (re-search-backward |
| 11597 | "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t)) |
| 11598 | (equal "END" (upcase (match-string 1)))) |
| 11599 | (throw 'parse "ERROR: Not within an entity or component declaration")) |
| 11600 | (setq decl-type (downcase (match-string-no-properties 1))) |
| 11601 | (forward-word 1) |
| 11602 | (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?") |
| 11603 | (setq name (match-string-no-properties 1)) |
| 11604 | (message "Reading port of %s \"%s\"..." decl-type name) |
| 11605 | (vhdl-forward-syntactic-ws) |
| 11606 | ;; parse generic clause |
| 11607 | (when (vhdl-parse-string "generic[ \t\n\r\f]*(" t) |
| 11608 | ;; parse group comment and spacing |
| 11609 | (setq group-comment (vhdl-parse-group-comment)) |
| 11610 | (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) |
| 11611 | (while (not end-of-list) |
| 11612 | ;; parse names (accept extended identifiers) |
| 11613 | (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") |
| 11614 | (setq names (list (match-string-no-properties 1))) |
| 11615 | (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) |
| 11616 | (setq names |
| 11617 | (append names (list (match-string-no-properties 1))))) |
| 11618 | ;; parse type |
| 11619 | (vhdl-parse-string ":[ \t\n\r\f]*\\([^():;\n]+\\)") |
| 11620 | (setq type (match-string-no-properties 1)) |
| 11621 | (when (vhdl-in-comment-p) ; if stuck in comment |
| 11622 | (setq type (concat type (and (vhdl-parse-string ".*") |
| 11623 | (match-string-no-properties 0))))) |
| 11624 | (setq comment nil) |
| 11625 | (while (looking-at "(") |
| 11626 | (setq type |
| 11627 | (concat type |
| 11628 | (buffer-substring-no-properties |
| 11629 | (point) (progn (forward-sexp) (point))) |
| 11630 | (and (vhdl-parse-string "\\([^():;\n]*\\)" t) |
| 11631 | (match-string-no-properties 1))))) |
| 11632 | ;; special case: closing parenthesis is on separate line |
| 11633 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 11634 | (setq comment (substring type (match-beginning 2))) |
| 11635 | (setq type (substring type 0 (match-beginning 1)))) |
| 11636 | ;; strip of trailing group-comment |
| 11637 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 11638 | (setq type (substring type 0 (match-end 1))) |
| 11639 | ;; parse initialization expression |
| 11640 | (setq init nil) |
| 11641 | (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) |
| 11642 | (vhdl-parse-string "\\([^();\n]*\\)") |
| 11643 | (setq init (match-string-no-properties 1)) |
| 11644 | (while (looking-at "(") |
| 11645 | (setq init |
| 11646 | (concat init |
| 11647 | (buffer-substring-no-properties |
| 11648 | (point) (progn (forward-sexp) (point))) |
| 11649 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 11650 | (match-string-no-properties 1)))))) |
| 11651 | ;; special case: closing parenthesis is on separate line |
| 11652 | (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) |
| 11653 | (setq comment (substring init (match-beginning 2))) |
| 11654 | (setq init (substring init 0 (match-beginning 1))) |
| 11655 | (vhdl-forward-syntactic-ws)) |
| 11656 | (skip-chars-forward " \t") |
| 11657 | ;; parse inline comment, special case: as above, no initial. |
| 11658 | (unless comment |
| 11659 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11660 | (match-string-no-properties 1)))) |
| 11661 | (vhdl-forward-syntactic-ws) |
| 11662 | (setq end-of-list (vhdl-parse-string ")" t)) |
| 11663 | (vhdl-parse-string "\\s-*;\\s-*") |
| 11664 | ;; parse inline comment |
| 11665 | (unless comment |
| 11666 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11667 | (match-string-no-properties 1)))) |
| 11668 | ;; save everything in list |
| 11669 | (setq generic-list (append generic-list |
| 11670 | (list (list names type init |
| 11671 | comment group-comment)))) |
| 11672 | ;; parse group comment and spacing |
| 11673 | (setq group-comment (vhdl-parse-group-comment)))) |
| 11674 | ;; parse port clause |
| 11675 | (when (vhdl-parse-string "port[ \t\n\r\f]*(" t) |
| 11676 | ;; parse group comment and spacing |
| 11677 | (setq group-comment (vhdl-parse-group-comment)) |
| 11678 | (setq end-of-list (vhdl-parse-string ")[ \t\n\r\f]*;[ \t\n\r\f]*" t)) |
| 11679 | (while (not end-of-list) |
| 11680 | ;; parse object |
| 11681 | (setq object |
| 11682 | (and (vhdl-parse-string "\\<\\(signal\\|quantity\\|terminal\\)\\>[ \t\n\r\f]*" t) |
| 11683 | (match-string-no-properties 1))) |
| 11684 | ;; parse names (accept extended identifiers) |
| 11685 | (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") |
| 11686 | (setq names (list (match-string-no-properties 1))) |
| 11687 | (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) |
| 11688 | (setq names (append names (list (match-string-no-properties 1))))) |
| 11689 | ;; parse direction |
| 11690 | (vhdl-parse-string ":[ \t\n\r\f]*") |
| 11691 | (setq direct |
| 11692 | (and (vhdl-parse-string "\\<\\(in\\|out\\|inout\\|buffer\\|linkage\\)\\>[ \t\n\r\f]+" t) |
| 11693 | (match-string-no-properties 1))) |
| 11694 | ;; parse type |
| 11695 | (vhdl-parse-string "\\([^();\n]+\\)") |
| 11696 | (setq type (match-string-no-properties 1)) |
| 11697 | (when (vhdl-in-comment-p) ; if stuck in comment |
| 11698 | (setq type (concat type (and (vhdl-parse-string ".*") |
| 11699 | (match-string-no-properties 0))))) |
| 11700 | (setq comment nil) |
| 11701 | (while (looking-at "(") |
| 11702 | (setq type (concat type |
| 11703 | (buffer-substring-no-properties |
| 11704 | (point) (progn (forward-sexp) (point))) |
| 11705 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 11706 | (match-string-no-properties 1))))) |
| 11707 | ;; special case: closing parenthesis is on separate line |
| 11708 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 11709 | (setq comment (substring type (match-beginning 2))) |
| 11710 | (setq type (substring type 0 (match-beginning 1)))) |
| 11711 | ;; strip of trailing group-comment |
| 11712 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 11713 | (setq type (substring type 0 (match-end 1))) |
| 11714 | (vhdl-forward-syntactic-ws) |
| 11715 | (setq end-of-list (vhdl-parse-string ")" t)) |
| 11716 | (vhdl-parse-string "\\s-*;\\s-*") |
| 11717 | ;; parse inline comment |
| 11718 | (unless comment |
| 11719 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 11720 | (match-string-no-properties 1)))) |
| 11721 | ;; save everything in list |
| 11722 | (setq port-list (append port-list |
| 11723 | (list (list names object direct type |
| 11724 | comment group-comment)))) |
| 11725 | ;; parse group comment and spacing |
| 11726 | (setq group-comment (vhdl-parse-group-comment)))) |
| 11727 | ;; parse context clause |
| 11728 | (setq context-clause (vhdl-scan-context-clause)) |
| 11729 | ; ;; add surrounding package to context clause |
| 11730 | ; (when (and (equal decl-type "component") |
| 11731 | ; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t)) |
| 11732 | ; (setq context-clause |
| 11733 | ; (append context-clause |
| 11734 | ; (list (cons (vhdl-work-library) |
| 11735 | ; (match-string-no-properties 1)))))) |
| 11736 | (message "Reading port of %s \"%s\"...done" decl-type name) |
| 11737 | nil))) |
| 11738 | ;; finish parsing |
| 11739 | (if parse-error |
| 11740 | (error parse-error) |
| 11741 | (setq vhdl-port-list (list name generic-list port-list context-clause) |
| 11742 | vhdl-port-reversed-direction nil |
| 11743 | vhdl-port-flattened nil))))) |
| 11744 | |
| 11745 | (defun vhdl-port-paste-context-clause (&optional exclude-pack-name) |
| 11746 | "Paste a context clause." |
| 11747 | (let ((margin (current-indentation)) |
| 11748 | (clause-list (nth 3 vhdl-port-list)) |
| 11749 | clause) |
| 11750 | (while clause-list |
| 11751 | (setq clause (car clause-list)) |
| 11752 | (unless (or (and exclude-pack-name (equal (downcase (cdr clause)) |
| 11753 | (downcase exclude-pack-name))) |
| 11754 | (save-excursion |
| 11755 | (re-search-backward |
| 11756 | (concat "^\\s-*use\\s-+" (car clause) |
| 11757 | "\." (cdr clause) "\\>") nil t))) |
| 11758 | (vhdl-template-standard-package (car clause) (cdr clause)) |
| 11759 | (insert "\n")) |
| 11760 | (setq clause-list (cdr clause-list))))) |
| 11761 | |
| 11762 | (defun vhdl-port-paste-generic (&optional no-init) |
| 11763 | "Paste a generic clause." |
| 11764 | (let ((margin (current-indentation)) |
| 11765 | (generic-list (nth 1 vhdl-port-list)) |
| 11766 | list-margin start names generic) |
| 11767 | ;; paste generic clause |
| 11768 | (when generic-list |
| 11769 | (setq start (point)) |
| 11770 | (vhdl-insert-keyword "GENERIC (") |
| 11771 | (unless vhdl-argument-list-indent |
| 11772 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11773 | (setq list-margin (current-column)) |
| 11774 | (while generic-list |
| 11775 | (setq generic (car generic-list)) |
| 11776 | ;; paste group comment and spacing |
| 11777 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11778 | (vhdl-paste-group-comment (nth 4 generic) list-margin)) |
| 11779 | ;; paste names |
| 11780 | (setq names (nth 0 generic)) |
| 11781 | (while names |
| 11782 | (insert (car names)) |
| 11783 | (setq names (cdr names)) |
| 11784 | (when names (insert ", "))) |
| 11785 | ;; paste type |
| 11786 | (insert " : " (nth 1 generic)) |
| 11787 | ;; paste initialization |
| 11788 | (when (and (not no-init) (nth 2 generic)) |
| 11789 | (insert " := " (nth 2 generic))) |
| 11790 | (unless (cdr generic-list) (insert ")")) |
| 11791 | (insert ";") |
| 11792 | ;; paste comment |
| 11793 | (when (and vhdl-include-port-comments (nth 3 generic)) |
| 11794 | (vhdl-comment-insert-inline (nth 3 generic) t)) |
| 11795 | (setq generic-list (cdr generic-list)) |
| 11796 | (when generic-list (insert "\n") (indent-to list-margin))) |
| 11797 | ;; align generic clause |
| 11798 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))))) |
| 11799 | |
| 11800 | (defun vhdl-port-paste-port () |
| 11801 | "Paste a port clause." |
| 11802 | (let ((margin (current-indentation)) |
| 11803 | (port-list (nth 2 vhdl-port-list)) |
| 11804 | list-margin start names port) |
| 11805 | ;; paste port clause |
| 11806 | (when port-list |
| 11807 | (setq start (point)) |
| 11808 | (vhdl-insert-keyword "PORT (") |
| 11809 | (unless vhdl-argument-list-indent |
| 11810 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11811 | (setq list-margin (current-column)) |
| 11812 | (while port-list |
| 11813 | (setq port (car port-list)) |
| 11814 | ;; paste group comment and spacing |
| 11815 | (when (memq vhdl-include-group-comments '(decl always)) |
| 11816 | (vhdl-paste-group-comment (nth 5 port) list-margin)) |
| 11817 | ;; paste object |
| 11818 | (when (nth 1 port) (insert (nth 1 port) " ")) |
| 11819 | ;; paste names |
| 11820 | (setq names (nth 0 port)) |
| 11821 | (while names |
| 11822 | (insert (car names)) |
| 11823 | (setq names (cdr names)) |
| 11824 | (when names (insert ", "))) |
| 11825 | ;; paste direction |
| 11826 | (insert " : ") |
| 11827 | (when (nth 2 port) (insert (nth 2 port) " ")) |
| 11828 | ;; paste type |
| 11829 | (insert (nth 3 port)) |
| 11830 | (unless (cdr port-list) (insert ")")) |
| 11831 | (insert ";") |
| 11832 | ;; paste comment |
| 11833 | (when (and vhdl-include-port-comments (nth 4 port)) |
| 11834 | (vhdl-comment-insert-inline (nth 4 port) t)) |
| 11835 | (setq port-list (cdr port-list)) |
| 11836 | (when port-list (insert "\n") (indent-to list-margin))) |
| 11837 | ;; align port clause |
| 11838 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))) |
| 11839 | |
| 11840 | (defun vhdl-port-paste-declaration (kind &optional no-indent) |
| 11841 | "Paste as an entity or component declaration." |
| 11842 | (unless no-indent (indent-according-to-mode)) |
| 11843 | (let ((margin (current-indentation)) |
| 11844 | (name (nth 0 vhdl-port-list))) |
| 11845 | (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT ")) |
| 11846 | (insert name) |
| 11847 | (when (or (eq kind 'entity) (not (vhdl-standard-p '87))) |
| 11848 | (vhdl-insert-keyword " IS")) |
| 11849 | ;; paste generic and port clause |
| 11850 | (when (nth 1 vhdl-port-list) |
| 11851 | (insert "\n") |
| 11852 | (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) |
| 11853 | (insert "\n")) |
| 11854 | (indent-to (+ margin vhdl-basic-offset)) |
| 11855 | (vhdl-port-paste-generic (eq kind 'component))) |
| 11856 | (when (nth 2 vhdl-port-list) |
| 11857 | (insert "\n") |
| 11858 | (when (and (memq vhdl-insert-empty-lines '(unit all)) |
| 11859 | (eq kind 'entity)) |
| 11860 | (insert "\n")) |
| 11861 | (indent-to (+ margin vhdl-basic-offset))) |
| 11862 | (vhdl-port-paste-port) |
| 11863 | (insert "\n") |
| 11864 | (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity)) |
| 11865 | (insert "\n")) |
| 11866 | (indent-to margin) |
| 11867 | (vhdl-insert-keyword "END") |
| 11868 | (if (eq kind 'entity) |
| 11869 | (progn |
| 11870 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY")) |
| 11871 | (insert " " name)) |
| 11872 | (vhdl-insert-keyword " COMPONENT") |
| 11873 | (unless (vhdl-standard-p '87) (insert " " name))) |
| 11874 | (insert ";"))) |
| 11875 | |
| 11876 | (defun vhdl-port-paste-entity (&optional no-indent) |
| 11877 | "Paste as an entity declaration." |
| 11878 | (interactive) |
| 11879 | (if (not vhdl-port-list) |
| 11880 | (error "ERROR: No port read") |
| 11881 | (message "Pasting port as entity \"%s\"..." (car vhdl-port-list)) |
| 11882 | (vhdl-port-paste-declaration 'entity no-indent) |
| 11883 | (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list)))) |
| 11884 | |
| 11885 | (defun vhdl-port-paste-component (&optional no-indent) |
| 11886 | "Paste as a component declaration." |
| 11887 | (interactive) |
| 11888 | (if (not vhdl-port-list) |
| 11889 | (error "ERROR: No port read") |
| 11890 | (message "Pasting port as component \"%s\"..." (car vhdl-port-list)) |
| 11891 | (vhdl-port-paste-declaration 'component no-indent) |
| 11892 | (message "Pasting port as component \"%s\"...done" (car vhdl-port-list)))) |
| 11893 | |
| 11894 | (defun vhdl-port-paste-generic-map (&optional secondary no-constants) |
| 11895 | "Paste as a generic map." |
| 11896 | (interactive) |
| 11897 | (unless secondary (indent-according-to-mode)) |
| 11898 | (let ((margin (current-indentation)) |
| 11899 | list-margin start generic |
| 11900 | (generic-list (nth 1 vhdl-port-list))) |
| 11901 | (when generic-list |
| 11902 | (setq start (point)) |
| 11903 | (vhdl-insert-keyword "GENERIC MAP (") |
| 11904 | (if (not vhdl-association-list-with-formals) |
| 11905 | ;; paste list of actual generics |
| 11906 | (while generic-list |
| 11907 | (insert (if no-constants |
| 11908 | (car (nth 0 (car generic-list))) |
| 11909 | (or (nth 2 (car generic-list)) " "))) |
| 11910 | (setq generic-list (cdr generic-list)) |
| 11911 | (insert (if generic-list ", " ")")) |
| 11912 | (when (and (not generic-list) secondary |
| 11913 | (null (nth 2 vhdl-port-list))) |
| 11914 | (insert ";"))) |
| 11915 | (unless vhdl-argument-list-indent |
| 11916 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11917 | (setq list-margin (current-column)) |
| 11918 | (while generic-list |
| 11919 | (setq generic (car generic-list)) |
| 11920 | ;; paste group comment and spacing |
| 11921 | (when (eq vhdl-include-group-comments 'always) |
| 11922 | (vhdl-paste-group-comment (nth 4 generic) list-margin)) |
| 11923 | ;; paste formal and actual generic |
| 11924 | (insert (car (nth 0 generic)) " => " |
| 11925 | (if no-constants |
| 11926 | (vhdl-replace-string vhdl-actual-generic-name |
| 11927 | (car (nth 0 generic))) |
| 11928 | (or (nth 2 generic) ""))) |
| 11929 | (setq generic-list (cdr generic-list)) |
| 11930 | (insert (if generic-list "," ")")) |
| 11931 | (when (and (not generic-list) secondary |
| 11932 | (null (nth 2 vhdl-port-list))) |
| 11933 | (insert ";")) |
| 11934 | ;; paste comment |
| 11935 | (when (or vhdl-include-type-comments |
| 11936 | (and vhdl-include-port-comments (nth 3 generic))) |
| 11937 | (vhdl-comment-insert-inline |
| 11938 | (concat |
| 11939 | (when vhdl-include-type-comments |
| 11940 | (concat "[" (nth 1 generic) "] ")) |
| 11941 | (when vhdl-include-port-comments (nth 3 generic))) t)) |
| 11942 | (when generic-list (insert "\n") (indent-to list-margin))) |
| 11943 | ;; align generic map |
| 11944 | (when vhdl-auto-align |
| 11945 | (vhdl-align-region-groups start (point) 1 t)))))) |
| 11946 | |
| 11947 | (defun vhdl-port-paste-port-map () |
| 11948 | "Paste as a port map." |
| 11949 | (let ((margin (current-indentation)) |
| 11950 | list-margin start port |
| 11951 | (port-list (nth 2 vhdl-port-list))) |
| 11952 | (when port-list |
| 11953 | (setq start (point)) |
| 11954 | (vhdl-insert-keyword "PORT MAP (") |
| 11955 | (if (not vhdl-association-list-with-formals) |
| 11956 | ;; paste list of actual ports |
| 11957 | (while port-list |
| 11958 | (insert (vhdl-replace-string vhdl-actual-port-name |
| 11959 | (car (nth 0 (car port-list))))) |
| 11960 | (setq port-list (cdr port-list)) |
| 11961 | (insert (if port-list ", " ")"))) |
| 11962 | (unless vhdl-argument-list-indent |
| 11963 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 11964 | (setq list-margin (current-column)) |
| 11965 | (while port-list |
| 11966 | (setq port (car port-list)) |
| 11967 | ;; paste group comment and spacing |
| 11968 | (when (eq vhdl-include-group-comments 'always) |
| 11969 | (vhdl-paste-group-comment (nth 5 port) list-margin)) |
| 11970 | ;; paste formal and actual port |
| 11971 | (insert (car (nth 0 port)) " => ") |
| 11972 | (insert (vhdl-replace-string vhdl-actual-port-name |
| 11973 | (car (nth 0 port)))) |
| 11974 | (setq port-list (cdr port-list)) |
| 11975 | (insert (if port-list "," ");")) |
| 11976 | ;; paste comment |
| 11977 | (when (or (and vhdl-include-direction-comments (nth 2 port)) |
| 11978 | vhdl-include-type-comments |
| 11979 | (and vhdl-include-port-comments (nth 4 port))) |
| 11980 | (vhdl-comment-insert-inline |
| 11981 | (concat |
| 11982 | (cond ((and vhdl-include-direction-comments |
| 11983 | vhdl-include-type-comments) |
| 11984 | (concat "[" (format "%-4s" (concat (nth 2 port) " ")) |
| 11985 | (nth 3 port) "] ")) |
| 11986 | ((and vhdl-include-direction-comments (nth 2 port)) |
| 11987 | (format "%-6s" (concat "[" (nth 2 port) "] "))) |
| 11988 | (vhdl-include-direction-comments " ") |
| 11989 | (vhdl-include-type-comments |
| 11990 | (concat "[" (nth 3 port) "] "))) |
| 11991 | (when vhdl-include-port-comments (nth 4 port))) t)) |
| 11992 | (when port-list (insert "\n") (indent-to list-margin))) |
| 11993 | ;; align port clause |
| 11994 | (when vhdl-auto-align |
| 11995 | (vhdl-align-region-groups start (point) 1)))))) |
| 11996 | |
| 11997 | (defun vhdl-port-paste-instance (&optional name no-indent title) |
| 11998 | "Paste as an instantiation." |
| 11999 | (interactive) |
| 12000 | (if (not vhdl-port-list) |
| 12001 | (error "ERROR: No port read") |
| 12002 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 12003 | ;; flatten local copy of port list (must be flat for port mapping) |
| 12004 | (vhdl-port-flatten) |
| 12005 | (unless no-indent (indent-according-to-mode)) |
| 12006 | (let ((margin (current-indentation))) |
| 12007 | ;; paste instantiation |
| 12008 | (cond (name |
| 12009 | (insert name)) |
| 12010 | ((equal (cdr vhdl-instance-name) "") |
| 12011 | (setq name (vhdl-template-field "instance name"))) |
| 12012 | ((string-match "\%d" (cdr vhdl-instance-name)) |
| 12013 | (let ((n 1)) |
| 12014 | (while (save-excursion |
| 12015 | (setq name (format (vhdl-replace-string |
| 12016 | vhdl-instance-name |
| 12017 | (nth 0 vhdl-port-list)) n)) |
| 12018 | (goto-char (point-min)) |
| 12019 | (vhdl-re-search-forward name nil t)) |
| 12020 | (setq n (1+ n))) |
| 12021 | (insert name))) |
| 12022 | (t (insert (vhdl-replace-string vhdl-instance-name |
| 12023 | (nth 0 vhdl-port-list))))) |
| 12024 | (message "Pasting port as instantiation \"%s\"..." name) |
| 12025 | (insert ": ") |
| 12026 | (when title |
| 12027 | (save-excursion |
| 12028 | (beginning-of-line) |
| 12029 | (indent-to vhdl-basic-offset) |
| 12030 | (insert "-- instance \"" name "\"\n"))) |
| 12031 | (if (not (vhdl-use-direct-instantiation)) |
| 12032 | (insert (nth 0 vhdl-port-list)) |
| 12033 | (vhdl-insert-keyword "ENTITY ") |
| 12034 | (insert (vhdl-work-library) "." (nth 0 vhdl-port-list))) |
| 12035 | (when (nth 1 vhdl-port-list) |
| 12036 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 12037 | (vhdl-port-paste-generic-map t t)) |
| 12038 | (when (nth 2 vhdl-port-list) |
| 12039 | (insert "\n") (indent-to (+ margin vhdl-basic-offset)) |
| 12040 | (vhdl-port-paste-port-map)) |
| 12041 | (unless (or (nth 1 vhdl-port-list) (nth 2 vhdl-port-list)) |
| 12042 | (insert ";")) |
| 12043 | (message "Pasting port as instantiation \"%s\"...done" name)) |
| 12044 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 12045 | |
| 12046 | (defun vhdl-port-paste-constants (&optional no-indent) |
| 12047 | "Paste generics as constants." |
| 12048 | (interactive) |
| 12049 | (if (not vhdl-port-list) |
| 12050 | (error "ERROR: No port read") |
| 12051 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 12052 | (message "Pasting port as constants...") |
| 12053 | ;; flatten local copy of port list (must be flat for constant initial.) |
| 12054 | (vhdl-port-flatten) |
| 12055 | (unless no-indent (indent-according-to-mode)) |
| 12056 | (let ((margin (current-indentation)) |
| 12057 | start generic name |
| 12058 | (generic-list (nth 1 vhdl-port-list))) |
| 12059 | (when generic-list |
| 12060 | (setq start (point)) |
| 12061 | (while generic-list |
| 12062 | (setq generic (car generic-list)) |
| 12063 | ;; paste group comment and spacing |
| 12064 | (when (memq vhdl-include-group-comments '(decl always)) |
| 12065 | (vhdl-paste-group-comment (nth 4 generic) margin)) |
| 12066 | (vhdl-insert-keyword "CONSTANT ") |
| 12067 | ;; paste generic constants |
| 12068 | (setq name (nth 0 generic)) |
| 12069 | (when name |
| 12070 | (insert (vhdl-replace-string vhdl-actual-generic-name (car name))) |
| 12071 | ;; paste type |
| 12072 | (insert " : " (nth 1 generic)) |
| 12073 | ;; paste initialization |
| 12074 | (when (nth 2 generic) |
| 12075 | (insert " := " (nth 2 generic))) |
| 12076 | (insert ";") |
| 12077 | ;; paste comment |
| 12078 | (when (and vhdl-include-port-comments (nth 3 generic)) |
| 12079 | (vhdl-comment-insert-inline (nth 3 generic) t)) |
| 12080 | (setq generic-list (cdr generic-list)) |
| 12081 | (when generic-list (insert "\n") (indent-to margin)))) |
| 12082 | ;; align signal list |
| 12083 | (when vhdl-auto-align |
| 12084 | (vhdl-align-region-groups start (point) 1)))) |
| 12085 | (message "Pasting port as constants...done") |
| 12086 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 12087 | |
| 12088 | (defun vhdl-port-paste-signals (&optional initialize no-indent) |
| 12089 | "Paste ports as internal signals." |
| 12090 | (interactive) |
| 12091 | (if (not vhdl-port-list) |
| 12092 | (error "ERROR: No port read") |
| 12093 | (message "Pasting port as signals...") |
| 12094 | (unless no-indent (indent-according-to-mode)) |
| 12095 | (let ((margin (current-indentation)) |
| 12096 | start port names type generic-list port-name constant-name pos |
| 12097 | (port-list (nth 2 vhdl-port-list))) |
| 12098 | (when port-list |
| 12099 | (setq start (point)) |
| 12100 | (while port-list |
| 12101 | (setq port (car port-list)) |
| 12102 | ;; paste group comment and spacing |
| 12103 | (when (memq vhdl-include-group-comments '(decl always)) |
| 12104 | (vhdl-paste-group-comment (nth 5 port) margin)) |
| 12105 | ;; paste object |
| 12106 | (if (nth 1 port) |
| 12107 | (insert (nth 1 port) " ") |
| 12108 | (vhdl-insert-keyword "SIGNAL ")) |
| 12109 | ;; paste actual port signals |
| 12110 | (setq names (nth 0 port)) |
| 12111 | (while names |
| 12112 | (insert (vhdl-replace-string vhdl-actual-port-name (car names))) |
| 12113 | (setq names (cdr names)) |
| 12114 | (when names (insert ", "))) |
| 12115 | ;; paste type |
| 12116 | (setq type (nth 3 port)) |
| 12117 | (setq generic-list (nth 1 vhdl-port-list)) |
| 12118 | (vhdl-prepare-search-1 |
| 12119 | (setq pos 0) |
| 12120 | ;; replace formal by actual generics |
| 12121 | (while generic-list |
| 12122 | (setq port-name (car (nth 0 (car generic-list)))) |
| 12123 | (while (string-match (concat "\\<" port-name "\\>") type pos) |
| 12124 | (setq constant-name |
| 12125 | (save-match-data (vhdl-replace-string |
| 12126 | vhdl-actual-generic-name port-name))) |
| 12127 | (setq type (replace-match constant-name t nil type)) |
| 12128 | (setq pos (match-end 0))) |
| 12129 | (setq generic-list (cdr generic-list)))) |
| 12130 | (insert " : " type) |
| 12131 | ;; paste initialization (inputs only) |
| 12132 | (when (and initialize (nth 2 port) (equal "IN" (upcase (nth 2 port)))) |
| 12133 | (insert " := " |
| 12134 | (cond ((string-match "integer" (nth 3 port)) "0") |
| 12135 | ((string-match "natural" (nth 3 port)) "0") |
| 12136 | ((string-match "positive" (nth 3 port)) "0") |
| 12137 | ((string-match "real" (nth 3 port)) "0.0") |
| 12138 | ((string-match "(.+)" (nth 3 port)) "(others => '0')") |
| 12139 | (t "'0'")))) |
| 12140 | (insert ";") |
| 12141 | ;; paste comment |
| 12142 | (when (or (and vhdl-include-direction-comments (nth 2 port)) |
| 12143 | (and vhdl-include-port-comments (nth 4 port))) |
| 12144 | (vhdl-comment-insert-inline |
| 12145 | (concat |
| 12146 | (cond ((and vhdl-include-direction-comments (nth 2 port)) |
| 12147 | (format "%-6s" (concat "[" (nth 2 port) "] "))) |
| 12148 | (vhdl-include-direction-comments " ")) |
| 12149 | (when vhdl-include-port-comments (nth 4 port))) t)) |
| 12150 | (setq port-list (cdr port-list)) |
| 12151 | (when port-list (insert "\n") (indent-to margin))) |
| 12152 | ;; align signal list |
| 12153 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) |
| 12154 | (message "Pasting port as signals...done"))) |
| 12155 | |
| 12156 | (defun vhdl-port-paste-initializations (&optional no-indent) |
| 12157 | "Paste ports as signal initializations." |
| 12158 | (interactive) |
| 12159 | (if (not vhdl-port-list) |
| 12160 | (error "ERROR: No port read") |
| 12161 | (let ((orig-vhdl-port-list vhdl-port-list)) |
| 12162 | (message "Pasting port as initializations...") |
| 12163 | ;; flatten local copy of port list (must be flat for signal initial.) |
| 12164 | (vhdl-port-flatten) |
| 12165 | (unless no-indent (indent-according-to-mode)) |
| 12166 | (let ((margin (current-indentation)) |
| 12167 | start port name |
| 12168 | (port-list (nth 2 vhdl-port-list))) |
| 12169 | (when port-list |
| 12170 | (setq start (point)) |
| 12171 | (while port-list |
| 12172 | (setq port (car port-list)) |
| 12173 | ;; paste actual port signal (inputs only) |
| 12174 | (when (equal "IN" (upcase (nth 2 port))) |
| 12175 | (setq name (car (nth 0 port))) |
| 12176 | (insert (vhdl-replace-string vhdl-actual-port-name name)) |
| 12177 | ;; paste initialization |
| 12178 | (insert " <= " |
| 12179 | (cond ((string-match "integer" (nth 3 port)) "0") |
| 12180 | ((string-match "natural" (nth 3 port)) "0") |
| 12181 | ((string-match "positive" (nth 3 port)) "0") |
| 12182 | ((string-match "real" (nth 3 port)) "0.0") |
| 12183 | ((string-match "(.+)" (nth 3 port)) "(others => '0')") |
| 12184 | (t "'0'")) |
| 12185 | ";")) |
| 12186 | (setq port-list (cdr port-list)) |
| 12187 | (when (and port-list |
| 12188 | (equal "IN" (upcase (nth 2 (car port-list))))) |
| 12189 | (insert "\n") (indent-to margin))) |
| 12190 | ;; align signal list |
| 12191 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))) |
| 12192 | (message "Pasting port as initializations...done") |
| 12193 | (setq vhdl-port-list orig-vhdl-port-list)))) |
| 12194 | |
| 12195 | (defun vhdl-port-paste-testbench () |
| 12196 | "Paste as a bare-bones testbench." |
| 12197 | (interactive) |
| 12198 | (if (not vhdl-port-list) |
| 12199 | (error "ERROR: No port read") |
| 12200 | (let ((case-fold-search t) |
| 12201 | (ent-name (vhdl-replace-string vhdl-testbench-entity-name |
| 12202 | (nth 0 vhdl-port-list))) |
| 12203 | (source-buffer (current-buffer)) |
| 12204 | arch-name config-name ent-file-name arch-file-name |
| 12205 | ent-buffer arch-buffer position) |
| 12206 | ;; open entity file |
| 12207 | (unless (eq vhdl-testbench-create-files 'none) |
| 12208 | (setq ent-file-name |
| 12209 | (concat (vhdl-replace-string vhdl-testbench-entity-file-name |
| 12210 | ent-name t) |
| 12211 | "." (file-name-extension (buffer-file-name)))) |
| 12212 | (if (file-exists-p ent-file-name) |
| 12213 | (if (y-or-n-p |
| 12214 | (concat "File \"" ent-file-name "\" exists; overwrite? ")) |
| 12215 | (progn (find-file ent-file-name) |
| 12216 | (erase-buffer) |
| 12217 | (set-buffer-modified-p nil)) |
| 12218 | (if (eq vhdl-testbench-create-files 'separate) |
| 12219 | (setq ent-file-name nil) |
| 12220 | (error "ERROR: Pasting port as testbench...aborted"))) |
| 12221 | (find-file ent-file-name))) |
| 12222 | (unless (and (eq vhdl-testbench-create-files 'separate) |
| 12223 | (null ent-file-name)) |
| 12224 | ;; paste entity header |
| 12225 | (if vhdl-testbench-include-header |
| 12226 | (progn (vhdl-template-header |
| 12227 | (concat "Testbench for design \"" |
| 12228 | (nth 0 vhdl-port-list) "\"")) |
| 12229 | (goto-char (point-max))) |
| 12230 | (vhdl-comment-display-line) (insert "\n\n")) |
| 12231 | ;; paste std_logic_1164 package |
| 12232 | (when vhdl-testbench-include-library |
| 12233 | (vhdl-template-package-std-logic-1164) |
| 12234 | (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n")) |
| 12235 | ;; paste entity declaration |
| 12236 | (vhdl-insert-keyword "ENTITY ") |
| 12237 | (insert ent-name) |
| 12238 | (vhdl-insert-keyword " IS") |
| 12239 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 12240 | (insert "\n") |
| 12241 | (vhdl-insert-keyword "END ") |
| 12242 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 12243 | (insert ent-name ";") |
| 12244 | (insert "\n\n") |
| 12245 | (vhdl-comment-display-line) (insert "\n")) |
| 12246 | ;; get architecture name |
| 12247 | (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "") |
| 12248 | (read-from-minibuffer "architecture name: " |
| 12249 | nil vhdl-minibuffer-local-map) |
| 12250 | (vhdl-replace-string vhdl-testbench-architecture-name |
| 12251 | (nth 0 vhdl-port-list)))) |
| 12252 | (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name) |
| 12253 | ;; open architecture file |
| 12254 | (if (not (eq vhdl-testbench-create-files 'separate)) |
| 12255 | (insert "\n") |
| 12256 | (setq ent-buffer (current-buffer)) |
| 12257 | (setq arch-file-name |
| 12258 | (concat (vhdl-replace-string vhdl-testbench-architecture-file-name |
| 12259 | (concat ent-name " " arch-name) t) |
| 12260 | "." (file-name-extension (buffer-file-name)))) |
| 12261 | (when (and (file-exists-p arch-file-name) |
| 12262 | (not (y-or-n-p (concat "File \"" arch-file-name |
| 12263 | "\" exists; overwrite? ")))) |
| 12264 | (error "ERROR: Pasting port as testbench...aborted")) |
| 12265 | (find-file arch-file-name) |
| 12266 | (erase-buffer) |
| 12267 | (set-buffer-modified-p nil) |
| 12268 | ;; paste architecture header |
| 12269 | (if vhdl-testbench-include-header |
| 12270 | (progn (vhdl-template-header |
| 12271 | (concat "Testbench architecture for design \"" |
| 12272 | (nth 0 vhdl-port-list) "\"")) |
| 12273 | (goto-char (point-max))) |
| 12274 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 12275 | ;; paste architecture body |
| 12276 | (vhdl-insert-keyword "ARCHITECTURE ") |
| 12277 | (insert arch-name) |
| 12278 | (vhdl-insert-keyword " OF ") |
| 12279 | (insert ent-name) |
| 12280 | (vhdl-insert-keyword " IS") |
| 12281 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 12282 | ;; paste component declaration |
| 12283 | (unless (vhdl-use-direct-instantiation) |
| 12284 | (vhdl-port-paste-component t) |
| 12285 | (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 12286 | ;; paste constants |
| 12287 | (when (nth 1 vhdl-port-list) |
| 12288 | (insert "-- component generics\n") (indent-to vhdl-basic-offset) |
| 12289 | (vhdl-port-paste-constants t) |
| 12290 | (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 12291 | ;; paste internal signals |
| 12292 | (insert "-- component ports\n") (indent-to vhdl-basic-offset) |
| 12293 | (vhdl-port-paste-signals vhdl-testbench-initialize-signals t) |
| 12294 | (insert "\n") |
| 12295 | ;; paste custom declarations |
| 12296 | (unless (equal "" vhdl-testbench-declarations) |
| 12297 | (insert "\n") |
| 12298 | (setq position (point)) |
| 12299 | (vhdl-insert-string-or-file vhdl-testbench-declarations) |
| 12300 | (vhdl-indent-region position (point))) |
| 12301 | (setq position (point)) |
| 12302 | (insert "\n\n") |
| 12303 | (vhdl-comment-display-line) (insert "\n") |
| 12304 | (when vhdl-testbench-include-configuration |
| 12305 | (setq config-name (vhdl-replace-string |
| 12306 | vhdl-testbench-configuration-name |
| 12307 | (concat ent-name " " arch-name))) |
| 12308 | (insert "\n") |
| 12309 | (vhdl-insert-keyword "CONFIGURATION ") (insert config-name) |
| 12310 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 12311 | (vhdl-insert-keyword " IS\n") |
| 12312 | (indent-to vhdl-basic-offset) |
| 12313 | (vhdl-insert-keyword "FOR ") (insert arch-name "\n") |
| 12314 | (indent-to vhdl-basic-offset) |
| 12315 | (vhdl-insert-keyword "END FOR;\n") |
| 12316 | (vhdl-insert-keyword "END ") (insert config-name ";\n\n") |
| 12317 | (vhdl-comment-display-line) (insert "\n")) |
| 12318 | (goto-char position) |
| 12319 | (vhdl-template-begin-end |
| 12320 | (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t) |
| 12321 | ;; paste instantiation |
| 12322 | (insert "-- component instantiation\n") (indent-to vhdl-basic-offset) |
| 12323 | (vhdl-port-paste-instance |
| 12324 | (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t) |
| 12325 | (insert "\n") |
| 12326 | ;; paste custom statements |
| 12327 | (unless (equal "" vhdl-testbench-statements) |
| 12328 | (insert "\n") |
| 12329 | (setq position (point)) |
| 12330 | (vhdl-insert-string-or-file vhdl-testbench-statements) |
| 12331 | (vhdl-indent-region position (point))) |
| 12332 | (insert "\n") |
| 12333 | (indent-to vhdl-basic-offset) |
| 12334 | (unless (eq vhdl-testbench-create-files 'none) |
| 12335 | (setq arch-buffer (current-buffer)) |
| 12336 | (when ent-buffer (set-buffer ent-buffer) (save-buffer)) |
| 12337 | (set-buffer arch-buffer) (save-buffer)) |
| 12338 | (message "%s" |
| 12339 | (concat (format "Pasting port as testbench \"%s(%s)\"...done" |
| 12340 | ent-name arch-name) |
| 12341 | (and ent-file-name |
| 12342 | (format "\n File created: \"%s\"" ent-file-name)) |
| 12343 | (and arch-file-name |
| 12344 | (format "\n File created: \"%s\"" arch-file-name))))))) |
| 12345 | |
| 12346 | |
| 12347 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12348 | ;;; Subprogram interface translation |
| 12349 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12350 | |
| 12351 | (defvar vhdl-subprog-list nil |
| 12352 | "Variable to hold last subprogram interface parsed.") |
| 12353 | ;; structure: (parenthesized expression means list of such entries) |
| 12354 | ;; (subprog-name kind |
| 12355 | ;; ((names) object direct type init comment group-comment) |
| 12356 | ;; return-type return-comment group-comment) |
| 12357 | |
| 12358 | (defvar vhdl-subprog-flattened nil |
| 12359 | "Indicates whether an subprogram interface has been flattened.") |
| 12360 | |
| 12361 | (defun vhdl-subprog-flatten () |
| 12362 | "Flatten interface list so that only one parameter exists per line." |
| 12363 | (interactive) |
| 12364 | (if (not vhdl-subprog-list) |
| 12365 | (error "ERROR: No subprogram interface has been read") |
| 12366 | (message "Flattening subprogram interface...") |
| 12367 | (let ((old-subprog-list (nth 2 vhdl-subprog-list)) |
| 12368 | new-subprog-list old-subprog new-subprog names) |
| 12369 | ;; traverse parameter list and flatten entries |
| 12370 | (while old-subprog-list |
| 12371 | (setq old-subprog (car old-subprog-list)) |
| 12372 | (setq names (car old-subprog)) |
| 12373 | (while names |
| 12374 | (setq new-subprog (cons (list (car names)) (cdr old-subprog))) |
| 12375 | (setq new-subprog-list (append new-subprog-list (list new-subprog))) |
| 12376 | (setq names (cdr names))) |
| 12377 | (setq old-subprog-list (cdr old-subprog-list))) |
| 12378 | (setq vhdl-subprog-list |
| 12379 | (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list) |
| 12380 | new-subprog-list (nth 3 vhdl-subprog-list) |
| 12381 | (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list)) |
| 12382 | vhdl-subprog-flattened t) |
| 12383 | (message "Flattening subprogram interface...done")))) |
| 12384 | |
| 12385 | (defun vhdl-subprog-copy () |
| 12386 | "Get interface information from a subprogram specification." |
| 12387 | (interactive) |
| 12388 | (save-excursion |
| 12389 | (let (parse-error pos end-of-list |
| 12390 | name kind param-list object names direct type init |
| 12391 | comment group-comment |
| 12392 | return-type return-comment return-group-comment) |
| 12393 | (vhdl-prepare-search-2 |
| 12394 | (setq |
| 12395 | parse-error |
| 12396 | (catch 'parse |
| 12397 | ;; check if within function declaration |
| 12398 | (setq pos (point)) |
| 12399 | (end-of-line) |
| 12400 | (when (looking-at "[ \t\n\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0))) |
| 12401 | (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|is\\>\\)" nil t) |
| 12402 | (goto-char (match-end 0)) |
| 12403 | (save-excursion (backward-char) |
| 12404 | (forward-sexp) |
| 12405 | (<= pos (point)))) |
| 12406 | (throw 'parse "ERROR: Not within a subprogram specification")) |
| 12407 | (setq name (match-string-no-properties 5)) |
| 12408 | (setq kind (if (match-string 2) 'procedure 'function)) |
| 12409 | (setq end-of-list (not (match-string 7))) |
| 12410 | (message "Reading interface of subprogram \"%s\"..." name) |
| 12411 | ;; parse parameter list |
| 12412 | (setq group-comment (vhdl-parse-group-comment)) |
| 12413 | (setq end-of-list (or end-of-list |
| 12414 | (vhdl-parse-string ")[ \t\n\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t))) |
| 12415 | (while (not end-of-list) |
| 12416 | ;; parse object |
| 12417 | (setq object |
| 12418 | (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t) |
| 12419 | (match-string-no-properties 1))) |
| 12420 | ;; parse names (accept extended identifiers) |
| 12421 | (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*") |
| 12422 | (setq names (list (match-string-no-properties 1))) |
| 12423 | (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t) |
| 12424 | (setq names (append names (list (match-string-no-properties 1))))) |
| 12425 | ;; parse direction |
| 12426 | (vhdl-parse-string ":[ \t\n\r\f]*") |
| 12427 | (setq direct |
| 12428 | (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" t) |
| 12429 | (match-string-no-properties 1))) |
| 12430 | ;; parse type |
| 12431 | (vhdl-parse-string "\\([^():;\n]+\\)") |
| 12432 | (setq type (match-string-no-properties 1)) |
| 12433 | (setq comment nil) |
| 12434 | (while (looking-at "(") |
| 12435 | (setq type |
| 12436 | (concat type |
| 12437 | (buffer-substring-no-properties |
| 12438 | (point) (progn (forward-sexp) (point))) |
| 12439 | (and (vhdl-parse-string "\\([^():;\n]*\\)" t) |
| 12440 | (match-string-no-properties 1))))) |
| 12441 | ;; special case: closing parenthesis is on separate line |
| 12442 | (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type)) |
| 12443 | (setq comment (substring type (match-beginning 2))) |
| 12444 | (setq type (substring type 0 (match-beginning 1)))) |
| 12445 | ;; strip off trailing group-comment |
| 12446 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type) |
| 12447 | (setq type (substring type 0 (match-end 1))) |
| 12448 | ;; parse initialization expression |
| 12449 | (setq init nil) |
| 12450 | (when (vhdl-parse-string ":=[ \t\n\r\f]*" t) |
| 12451 | (vhdl-parse-string "\\([^();\n]*\\)") |
| 12452 | (setq init (match-string-no-properties 1)) |
| 12453 | (while (looking-at "(") |
| 12454 | (setq init |
| 12455 | (concat init |
| 12456 | (buffer-substring-no-properties |
| 12457 | (point) (progn (forward-sexp) (point))) |
| 12458 | (and (vhdl-parse-string "\\([^();\n]*\\)" t) |
| 12459 | (match-string-no-properties 1)))))) |
| 12460 | ;; special case: closing parenthesis is on separate line |
| 12461 | (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init)) |
| 12462 | (setq comment (substring init (match-beginning 2))) |
| 12463 | (setq init (substring init 0 (match-beginning 1))) |
| 12464 | (vhdl-forward-syntactic-ws)) |
| 12465 | (skip-chars-forward " \t") |
| 12466 | ;; parse inline comment, special case: as above, no initial. |
| 12467 | (unless comment |
| 12468 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 12469 | (match-string-no-properties 1)))) |
| 12470 | (vhdl-forward-syntactic-ws) |
| 12471 | (setq end-of-list (vhdl-parse-string ")\\s-*" t)) |
| 12472 | ;; parse inline comment |
| 12473 | (unless comment |
| 12474 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 12475 | (match-string-no-properties 1)))) |
| 12476 | (setq return-group-comment (vhdl-parse-group-comment)) |
| 12477 | (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*") |
| 12478 | ;; parse return type |
| 12479 | (when (match-string 3) |
| 12480 | (vhdl-parse-string "[ \t\n\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|is\\>\\)\\s-*") |
| 12481 | (setq return-type (match-string-no-properties 1)) |
| 12482 | (when (and return-type |
| 12483 | (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type)) |
| 12484 | (setq return-comment (substring return-type (match-beginning 2))) |
| 12485 | (setq return-type (substring return-type 0 (match-beginning 1)))) |
| 12486 | ;; strip of trailing group-comment |
| 12487 | (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type) |
| 12488 | (setq return-type (substring return-type 0 (match-end 1))) |
| 12489 | ;; parse return comment |
| 12490 | (unless return-comment |
| 12491 | (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 12492 | (match-string-no-properties 1))))) |
| 12493 | ;; parse inline comment |
| 12494 | (unless comment |
| 12495 | (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t) |
| 12496 | (match-string-no-properties 1)))) |
| 12497 | ;; save everything in list |
| 12498 | (setq param-list (append param-list |
| 12499 | (list (list names object direct type init |
| 12500 | comment group-comment)))) |
| 12501 | ;; parse group comment and spacing |
| 12502 | (setq group-comment (vhdl-parse-group-comment))) |
| 12503 | (message "Reading interface of subprogram \"%s\"...done" name) |
| 12504 | nil))) |
| 12505 | ;; finish parsing |
| 12506 | (if parse-error |
| 12507 | (error parse-error) |
| 12508 | (setq vhdl-subprog-list |
| 12509 | (list name kind param-list return-type return-comment |
| 12510 | return-group-comment) |
| 12511 | vhdl-subprog-flattened nil))))) |
| 12512 | |
| 12513 | (defun vhdl-subprog-paste-specification (kind) |
| 12514 | "Paste as a subprogram specification." |
| 12515 | (indent-according-to-mode) |
| 12516 | (let ((margin (current-column)) |
| 12517 | (param-list (nth 2 vhdl-subprog-list)) |
| 12518 | list-margin start names param) |
| 12519 | ;; paste keyword and name |
| 12520 | (vhdl-insert-keyword |
| 12521 | (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION ")) |
| 12522 | (insert (nth 0 vhdl-subprog-list)) |
| 12523 | (if (not param-list) |
| 12524 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) |
| 12525 | (setq start (point)) |
| 12526 | ;; paste parameter list |
| 12527 | (insert " (") |
| 12528 | (unless vhdl-argument-list-indent |
| 12529 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 12530 | (setq list-margin (current-column)) |
| 12531 | (while param-list |
| 12532 | (setq param (car param-list)) |
| 12533 | ;; paste group comment and spacing |
| 12534 | (when (memq vhdl-include-group-comments (list kind 'always)) |
| 12535 | (vhdl-paste-group-comment (nth 6 param) list-margin)) |
| 12536 | ;; paste object |
| 12537 | (when (nth 1 param) (insert (nth 1 param) " ")) |
| 12538 | ;; paste names |
| 12539 | (setq names (nth 0 param)) |
| 12540 | (while names |
| 12541 | (insert (car names)) |
| 12542 | (setq names (cdr names)) |
| 12543 | (when names (insert ", "))) |
| 12544 | ;; paste direction |
| 12545 | (insert " : ") |
| 12546 | (when (nth 2 param) (insert (nth 2 param) " ")) |
| 12547 | ;; paste type |
| 12548 | (insert (nth 3 param)) |
| 12549 | ;; paste initialization |
| 12550 | (when (nth 4 param) (insert " := " (nth 4 param))) |
| 12551 | ;; terminate line |
| 12552 | (if (cdr param-list) |
| 12553 | (insert ";") |
| 12554 | (insert ")") |
| 12555 | (when (null (nth 3 vhdl-subprog-list)) |
| 12556 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")))) |
| 12557 | ;; paste comment |
| 12558 | (when (and vhdl-include-port-comments (nth 5 param)) |
| 12559 | (vhdl-comment-insert-inline (nth 5 param) t)) |
| 12560 | (setq param-list (cdr param-list)) |
| 12561 | (when param-list (insert "\n") (indent-to list-margin))) |
| 12562 | (when (nth 3 vhdl-subprog-list) |
| 12563 | (insert "\n") (indent-to list-margin) |
| 12564 | ;; paste group comment and spacing |
| 12565 | (when (memq vhdl-include-group-comments (list kind 'always)) |
| 12566 | (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin)) |
| 12567 | ;; paste return type |
| 12568 | (insert "return " (nth 3 vhdl-subprog-list)) |
| 12569 | (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is")) |
| 12570 | (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list)) |
| 12571 | (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t))) |
| 12572 | ;; align parameter list |
| 12573 | (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t))) |
| 12574 | ;; paste body |
| 12575 | (when (eq kind 'body) |
| 12576 | (insert "\n") |
| 12577 | (vhdl-template-begin-end |
| 12578 | (unless (vhdl-standard-p '87) |
| 12579 | (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION")) |
| 12580 | (nth 0 vhdl-subprog-list) margin)))) |
| 12581 | |
| 12582 | (defun vhdl-subprog-paste-declaration () |
| 12583 | "Paste as a subprogram declaration." |
| 12584 | (interactive) |
| 12585 | (if (not vhdl-subprog-list) |
| 12586 | (error "ERROR: No subprogram interface read") |
| 12587 | (message "Pasting interface as subprogram declaration \"%s\"..." |
| 12588 | (car vhdl-subprog-list)) |
| 12589 | ;; paste specification |
| 12590 | (vhdl-subprog-paste-specification 'decl) |
| 12591 | (message "Pasting interface as subprogram declaration \"%s\"...done" |
| 12592 | (car vhdl-subprog-list)))) |
| 12593 | |
| 12594 | (defun vhdl-subprog-paste-body () |
| 12595 | "Paste as a subprogram body." |
| 12596 | (interactive) |
| 12597 | (if (not vhdl-subprog-list) |
| 12598 | (error "ERROR: No subprogram interface read") |
| 12599 | (message "Pasting interface as subprogram body \"%s\"..." |
| 12600 | (car vhdl-subprog-list)) |
| 12601 | ;; paste specification and body |
| 12602 | (vhdl-subprog-paste-specification 'body) |
| 12603 | (message "Pasting interface as subprogram body \"%s\"...done" |
| 12604 | (car vhdl-subprog-list)))) |
| 12605 | |
| 12606 | (defun vhdl-subprog-paste-call () |
| 12607 | "Paste as a subprogram call." |
| 12608 | (interactive) |
| 12609 | (if (not vhdl-subprog-list) |
| 12610 | (error "ERROR: No subprogram interface read") |
| 12611 | (let ((orig-vhdl-subprog-list vhdl-subprog-list) |
| 12612 | param-list margin list-margin param start) |
| 12613 | ;; flatten local copy of interface list (must be flat for parameter mapping) |
| 12614 | (vhdl-subprog-flatten) |
| 12615 | (setq param-list (nth 2 vhdl-subprog-list)) |
| 12616 | (indent-according-to-mode) |
| 12617 | (setq margin (current-indentation)) |
| 12618 | (message "Pasting interface as subprogram call \"%s\"..." |
| 12619 | (car vhdl-subprog-list)) |
| 12620 | ;; paste name |
| 12621 | (insert (nth 0 vhdl-subprog-list)) |
| 12622 | (if (not param-list) |
| 12623 | (insert ";") |
| 12624 | (setq start (point)) |
| 12625 | ;; paste parameter list |
| 12626 | (insert " (") |
| 12627 | (unless vhdl-argument-list-indent |
| 12628 | (insert "\n") (indent-to (+ margin vhdl-basic-offset))) |
| 12629 | (setq list-margin (current-column)) |
| 12630 | (while param-list |
| 12631 | (setq param (car param-list)) |
| 12632 | ;; paste group comment and spacing |
| 12633 | (when (eq vhdl-include-group-comments 'always) |
| 12634 | (vhdl-paste-group-comment (nth 6 param) list-margin)) |
| 12635 | ;; paste formal port |
| 12636 | (insert (car (nth 0 param)) " => ") |
| 12637 | (setq param-list (cdr param-list)) |
| 12638 | (insert (if param-list "," ");")) |
| 12639 | ;; paste comment |
| 12640 | (when (and vhdl-include-port-comments (nth 5 param)) |
| 12641 | (vhdl-comment-insert-inline (nth 5 param))) |
| 12642 | (when param-list (insert "\n") (indent-to list-margin))) |
| 12643 | ;; align parameter list |
| 12644 | (when vhdl-auto-align |
| 12645 | (vhdl-align-region-groups start (point) 1))) |
| 12646 | (message "Pasting interface as subprogram call \"%s\"...done" |
| 12647 | (car vhdl-subprog-list)) |
| 12648 | (setq vhdl-subprog-list orig-vhdl-subprog-list)))) |
| 12649 | |
| 12650 | |
| 12651 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12652 | ;;; Miscellaneous |
| 12653 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12654 | |
| 12655 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12656 | ;; Hippie expand customization |
| 12657 | |
| 12658 | (defvar vhdl-expand-upper-case nil) |
| 12659 | |
| 12660 | (defun vhdl-try-expand-abbrev (old) |
| 12661 | "Try expanding abbreviations from `vhdl-abbrev-list'." |
| 12662 | (unless old |
| 12663 | (he-init-string (he-dabbrev-beg) (point)) |
| 12664 | (setq he-expand-list |
| 12665 | (let ((abbrev-list vhdl-abbrev-list) |
| 12666 | (sel-abbrev-list '())) |
| 12667 | (while abbrev-list |
| 12668 | (when (or (not (stringp (car abbrev-list))) |
| 12669 | (string-match |
| 12670 | (concat "^" he-search-string) (car abbrev-list))) |
| 12671 | (setq sel-abbrev-list |
| 12672 | (cons (car abbrev-list) sel-abbrev-list))) |
| 12673 | (setq abbrev-list (cdr abbrev-list))) |
| 12674 | (nreverse sel-abbrev-list)))) |
| 12675 | (while (and he-expand-list |
| 12676 | (or (not (stringp (car he-expand-list))) |
| 12677 | (he-string-member (car he-expand-list) he-tried-table t))) |
| 12678 | (unless (stringp (car he-expand-list)) |
| 12679 | (setq vhdl-expand-upper-case (car he-expand-list))) |
| 12680 | (setq he-expand-list (cdr he-expand-list))) |
| 12681 | (if (null he-expand-list) |
| 12682 | (progn (when old (he-reset-string)) |
| 12683 | nil) |
| 12684 | (he-substitute-string |
| 12685 | (if vhdl-expand-upper-case |
| 12686 | (upcase (car he-expand-list)) |
| 12687 | (car he-expand-list)) |
| 12688 | t) |
| 12689 | (setq he-expand-list (cdr he-expand-list)) |
| 12690 | t)) |
| 12691 | |
| 12692 | (defun vhdl-he-list-beg () |
| 12693 | "Also looks at the word before `(' in order to better match parenthesized |
| 12694 | expressions (e.g. for index ranges of types and signals)." |
| 12695 | (save-excursion |
| 12696 | (condition-case () |
| 12697 | (progn (backward-up-list 1) |
| 12698 | (skip-syntax-backward "w_")) ; crashes in `viper-mode' |
| 12699 | (error ())) |
| 12700 | (point))) |
| 12701 | |
| 12702 | ;; override `he-list-beg' from `hippie-exp' |
| 12703 | (unless (and (boundp 'viper-mode) viper-mode) |
| 12704 | (defalias 'he-list-beg 'vhdl-he-list-beg)) |
| 12705 | |
| 12706 | ;; function for expanding abbrevs and dabbrevs |
| 12707 | (defalias 'vhdl-expand-abbrev (make-hippie-expand-function |
| 12708 | '(try-expand-dabbrev |
| 12709 | try-expand-dabbrev-all-buffers |
| 12710 | vhdl-try-expand-abbrev))) |
| 12711 | |
| 12712 | ;; function for expanding parenthesis |
| 12713 | (defalias 'vhdl-expand-paren (make-hippie-expand-function |
| 12714 | '(try-expand-list |
| 12715 | try-expand-list-all-buffers))) |
| 12716 | |
| 12717 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12718 | ;; Line handling functions |
| 12719 | |
| 12720 | (defun vhdl-current-line () |
| 12721 | "Return the line number of the line containing point." |
| 12722 | (save-restriction |
| 12723 | (widen) |
| 12724 | (1+ (count-lines (point-min) (point-at-bol))))) |
| 12725 | |
| 12726 | (defun vhdl-line-kill-entire (&optional arg) |
| 12727 | "Delete entire line." |
| 12728 | (interactive "p") |
| 12729 | (beginning-of-line) |
| 12730 | (kill-line (or arg 1))) |
| 12731 | |
| 12732 | (defun vhdl-line-kill (&optional arg) |
| 12733 | "Kill current line." |
| 12734 | (interactive "p") |
| 12735 | (vhdl-line-kill-entire arg)) |
| 12736 | |
| 12737 | (defun vhdl-line-copy (&optional arg) |
| 12738 | "Copy current line." |
| 12739 | (interactive "p") |
| 12740 | (save-excursion |
| 12741 | (let ((position (point-at-bol))) |
| 12742 | (forward-line (or arg 1)) |
| 12743 | (copy-region-as-kill position (point))))) |
| 12744 | |
| 12745 | (defun vhdl-line-yank () |
| 12746 | "Yank entire line." |
| 12747 | (interactive) |
| 12748 | (beginning-of-line) |
| 12749 | (yank)) |
| 12750 | |
| 12751 | (defun vhdl-line-expand (&optional prefix-arg) |
| 12752 | "Hippie-expand current line." |
| 12753 | (interactive "P") |
| 12754 | (require 'hippie-exp) |
| 12755 | (let ((case-fold-search t) (case-replace nil) |
| 12756 | (hippie-expand-try-functions-list |
| 12757 | '(try-expand-line try-expand-line-all-buffers))) |
| 12758 | (hippie-expand prefix-arg))) |
| 12759 | |
| 12760 | (defun vhdl-line-transpose-next (&optional arg) |
| 12761 | "Interchange this line with next line." |
| 12762 | (interactive "p") |
| 12763 | (forward-line 1) |
| 12764 | (transpose-lines (or arg 1)) |
| 12765 | (forward-line -1)) |
| 12766 | |
| 12767 | (defun vhdl-line-transpose-previous (&optional arg) |
| 12768 | "Interchange this line with previous line." |
| 12769 | (interactive "p") |
| 12770 | (forward-line 1) |
| 12771 | (transpose-lines (- 0 (or arg 0))) |
| 12772 | (forward-line -1)) |
| 12773 | |
| 12774 | (defun vhdl-line-open () |
| 12775 | "Open a new line and indent." |
| 12776 | (interactive) |
| 12777 | (end-of-line -0) |
| 12778 | (newline-and-indent)) |
| 12779 | |
| 12780 | (defun vhdl-delete-indentation () |
| 12781 | "Join lines. That is, call `delete-indentation' with `fill-prefix' so that |
| 12782 | it works within comments too." |
| 12783 | (interactive) |
| 12784 | (let ((fill-prefix "-- ")) |
| 12785 | (delete-indentation))) |
| 12786 | |
| 12787 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12788 | ;; Move functions |
| 12789 | |
| 12790 | (defun vhdl-forward-same-indent () |
| 12791 | "Move forward to next line with same indent." |
| 12792 | (interactive) |
| 12793 | (let ((pos (point)) |
| 12794 | (indent (current-indentation))) |
| 12795 | (beginning-of-line 2) |
| 12796 | (while (and (not (eobp)) |
| 12797 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 12798 | (> (current-indentation) indent))) |
| 12799 | (beginning-of-line 2)) |
| 12800 | (if (= (current-indentation) indent) |
| 12801 | (back-to-indentation) |
| 12802 | (message "No following line with same indent found in this block") |
| 12803 | (goto-char pos) |
| 12804 | nil))) |
| 12805 | |
| 12806 | (defun vhdl-backward-same-indent () |
| 12807 | "Move backward to previous line with same indent." |
| 12808 | (interactive) |
| 12809 | (let ((pos (point)) |
| 12810 | (indent (current-indentation))) |
| 12811 | (beginning-of-line -0) |
| 12812 | (while (and (not (bobp)) |
| 12813 | (or (looking-at "^\\s-*\\(--.*\\)?$") |
| 12814 | (> (current-indentation) indent))) |
| 12815 | (beginning-of-line -0)) |
| 12816 | (if (= (current-indentation) indent) |
| 12817 | (back-to-indentation) |
| 12818 | (message "No preceding line with same indent found in this block") |
| 12819 | (goto-char pos) |
| 12820 | nil))) |
| 12821 | |
| 12822 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12823 | ;; Statistics |
| 12824 | |
| 12825 | (defun vhdl-statistics-buffer () |
| 12826 | "Get some file statistics." |
| 12827 | (interactive) |
| 12828 | (let ((no-stats 0) |
| 12829 | (no-code-lines 0) |
| 12830 | (no-empty-lines 0) |
| 12831 | (no-comm-lines 0) |
| 12832 | (no-comments 0) |
| 12833 | (no-lines (count-lines (point-min) (point-max)))) |
| 12834 | (save-excursion |
| 12835 | ;; count statements |
| 12836 | (goto-char (point-min)) |
| 12837 | (while (re-search-forward "\\(--.*\n\\|\"[^\"\n]*[\"\n]\\)\\|;" nil t) |
| 12838 | (if (match-string 1) |
| 12839 | (goto-char (match-end 1)) |
| 12840 | (setq no-stats (1+ no-stats)))) |
| 12841 | ;; count code lines |
| 12842 | (goto-char (point-min)) |
| 12843 | (while (not (eobp)) |
| 12844 | (unless (looking-at "^\\s-*\\(--.*\\)?$") |
| 12845 | (setq no-code-lines (1+ no-code-lines))) |
| 12846 | (beginning-of-line 2)) |
| 12847 | ;; count empty lines |
| 12848 | (goto-char (point-min)) |
| 12849 | (while (and (re-search-forward "^\\s-*$" nil t) |
| 12850 | (not (eq (point) (point-max)))) |
| 12851 | (if (match-string 1) |
| 12852 | (goto-char (match-end 1)) |
| 12853 | (setq no-empty-lines (1+ no-empty-lines)) |
| 12854 | (unless (eq (point) (point-max)) |
| 12855 | (forward-char)))) |
| 12856 | ;; count comment-only lines |
| 12857 | (goto-char (point-min)) |
| 12858 | (while (re-search-forward "^\\s-*--.*" nil t) |
| 12859 | (if (match-string 1) |
| 12860 | (goto-char (match-end 1)) |
| 12861 | (setq no-comm-lines (1+ no-comm-lines)))) |
| 12862 | ;; count comments |
| 12863 | (goto-char (point-min)) |
| 12864 | (while (re-search-forward "--.*" nil t) |
| 12865 | (if (match-string 1) |
| 12866 | (goto-char (match-end 1)) |
| 12867 | (setq no-comments (1+ no-comments))))) |
| 12868 | ;; print results |
| 12869 | (message "\n\ |
| 12870 | File statistics: \"%s\"\n\ |
| 12871 | -----------------------\n\ |
| 12872 | # statements : %5d\n\ |
| 12873 | # code lines : %5d\n\ |
| 12874 | # empty lines : %5d\n\ |
| 12875 | # comment lines : %5d\n\ |
| 12876 | # comments : %5d\n\ |
| 12877 | # total lines : %5d\n\ " |
| 12878 | (buffer-file-name) no-stats no-code-lines no-empty-lines |
| 12879 | no-comm-lines no-comments no-lines) |
| 12880 | (unless vhdl-emacs-21 (vhdl-show-messages)))) |
| 12881 | |
| 12882 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12883 | ;; Help functions |
| 12884 | |
| 12885 | (defun vhdl-re-search-forward (regexp &optional bound noerror count) |
| 12886 | "Like `re-search-forward', but does not match within literals." |
| 12887 | (let (pos) |
| 12888 | (save-excursion |
| 12889 | (while (and (setq pos (re-search-forward regexp bound noerror count)) |
| 12890 | (vhdl-in-literal)))) |
| 12891 | (when pos (goto-char pos)) |
| 12892 | pos)) |
| 12893 | |
| 12894 | (defun vhdl-re-search-backward (regexp &optional bound noerror count) |
| 12895 | "Like `re-search-backward', but does not match within literals." |
| 12896 | (let (pos) |
| 12897 | (save-excursion |
| 12898 | (while (and (setq pos (re-search-backward regexp bound noerror count)) |
| 12899 | (vhdl-in-literal)))) |
| 12900 | (when pos (goto-char pos)) |
| 12901 | pos)) |
| 12902 | |
| 12903 | |
| 12904 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12905 | ;;; Project |
| 12906 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 12907 | |
| 12908 | (defun vhdl-set-project (name) |
| 12909 | "Set current project to NAME." |
| 12910 | (interactive |
| 12911 | (list (let ((completion-ignore-case t)) |
| 12912 | (completing-read "Project name: " vhdl-project-alist nil t)))) |
| 12913 | (cond ((equal name "") |
| 12914 | (setq vhdl-project nil) |
| 12915 | (message "Current VHDL project: None")) |
| 12916 | ((assoc name vhdl-project-alist) |
| 12917 | (setq vhdl-project name) |
| 12918 | (message "Current VHDL project: \"%s\"" name)) |
| 12919 | (t |
| 12920 | (vhdl-warning (format "Unknown VHDL project: \"%s\"" name)))) |
| 12921 | (vhdl-speedbar-update-current-project)) |
| 12922 | |
| 12923 | (defun vhdl-set-default-project () |
| 12924 | "Set current project as default on startup." |
| 12925 | (interactive) |
| 12926 | (customize-set-variable 'vhdl-project vhdl-project) |
| 12927 | (customize-save-customized)) |
| 12928 | |
| 12929 | (defun vhdl-toggle-project (name token indent) |
| 12930 | "Set current project to NAME or unset if NAME is current project." |
| 12931 | (vhdl-set-project (if (equal name vhdl-project) "" name))) |
| 12932 | |
| 12933 | (defun vhdl-export-project (file-name) |
| 12934 | "Write project setup for current project." |
| 12935 | (interactive |
| 12936 | (let ((name (vhdl-resolve-env-variable |
| 12937 | (vhdl-replace-string |
| 12938 | (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) |
| 12939 | (concat (subst-char-in-string |
| 12940 | ? ?_ (or (vhdl-project-p) |
| 12941 | (error "ERROR: No current project"))) |
| 12942 | " " (user-login-name)))))) |
| 12943 | (list (read-file-name |
| 12944 | "Write project file: " |
| 12945 | (when (file-name-absolute-p name) "") nil nil name)))) |
| 12946 | (setq file-name (abbreviate-file-name file-name)) |
| 12947 | (let ((orig-buffer (current-buffer))) |
| 12948 | (unless (file-exists-p (file-name-directory file-name)) |
| 12949 | (make-directory (file-name-directory file-name) t)) |
| 12950 | (if (not (file-writable-p file-name)) |
| 12951 | (error "ERROR: File not writable: \"%s\"" file-name) |
| 12952 | (set-buffer (find-file-noselect file-name t t)) |
| 12953 | (erase-buffer) |
| 12954 | (insert ";; -*- Emacs-Lisp -*-\n\n" |
| 12955 | ";;; " (file-name-nondirectory file-name) |
| 12956 | " - project setup file for Emacs VHDL Mode " vhdl-version "\n\n" |
| 12957 | ";; Project : " vhdl-project "\n" |
| 12958 | ";; Saved : " (format-time-string "%Y-%m-%d %T ") |
| 12959 | (user-login-name) "\n\n\n" |
| 12960 | ";; project name\n" |
| 12961 | "(setq vhdl-project \"" vhdl-project "\")\n\n" |
| 12962 | ";; project setup\n" |
| 12963 | "(vhdl-aput 'vhdl-project-alist vhdl-project\n'") |
| 12964 | (pp (vhdl-aget vhdl-project-alist vhdl-project) (current-buffer)) |
| 12965 | (insert ")\n") |
| 12966 | (save-buffer) |
| 12967 | (kill-buffer (current-buffer)) |
| 12968 | (set-buffer orig-buffer)))) |
| 12969 | |
| 12970 | (defun vhdl-import-project (file-name &optional auto not-make-current) |
| 12971 | "Read project setup and set current project." |
| 12972 | (interactive |
| 12973 | (let ((name (vhdl-resolve-env-variable |
| 12974 | (vhdl-replace-string |
| 12975 | (cons "\\(.*\\) \\(.*\\)" (car vhdl-project-file-name)) |
| 12976 | (concat "" " " (user-login-name)))))) |
| 12977 | (list (read-file-name |
| 12978 | "Read project file: " (when (file-name-absolute-p name) "") nil t |
| 12979 | (file-name-directory name))))) |
| 12980 | (when (file-exists-p file-name) |
| 12981 | (condition-case () |
| 12982 | (let ((current-project vhdl-project)) |
| 12983 | (load-file file-name) |
| 12984 | (when (/= (length (vhdl-aget vhdl-project-alist vhdl-project t)) 10) |
| 12985 | (vhdl-adelete 'vhdl-project-alist vhdl-project) |
| 12986 | (error "")) |
| 12987 | (when not-make-current |
| 12988 | (setq vhdl-project current-project)) |
| 12989 | (vhdl-update-mode-menu) |
| 12990 | (vhdl-speedbar-refresh) |
| 12991 | (unless not-make-current |
| 12992 | (message "Current VHDL project: \"%s\"%s" |
| 12993 | vhdl-project (if auto " (auto-loaded)" "")))) |
| 12994 | (error (vhdl-warning |
| 12995 | (format "ERROR: Invalid project setup file: \"%s\"" file-name)))))) |
| 12996 | |
| 12997 | (defun vhdl-duplicate-project () |
| 12998 | "Duplicate setup of current project." |
| 12999 | (interactive) |
| 13000 | (let ((new-name (read-from-minibuffer "New project name: ")) |
| 13001 | (project-entry (vhdl-aget vhdl-project-alist vhdl-project t))) |
| 13002 | (setq vhdl-project-alist |
| 13003 | (append vhdl-project-alist |
| 13004 | (list (cons new-name project-entry)))) |
| 13005 | (vhdl-update-mode-menu))) |
| 13006 | |
| 13007 | (defun vhdl-auto-load-project () |
| 13008 | "Automatically load project setup at startup." |
| 13009 | (let ((file-name-list vhdl-project-file-name) |
| 13010 | file-list list-length) |
| 13011 | (while file-name-list |
| 13012 | (setq file-list |
| 13013 | (append file-list |
| 13014 | (file-expand-wildcards |
| 13015 | (vhdl-resolve-env-variable |
| 13016 | (vhdl-replace-string |
| 13017 | (cons "\\(.*\\) \\(.*\\)" (car file-name-list)) |
| 13018 | (concat "\*" " " (user-login-name))))))) |
| 13019 | (setq list-length (or list-length (length file-list))) |
| 13020 | (setq file-name-list (cdr file-name-list))) |
| 13021 | (while file-list |
| 13022 | (vhdl-import-project (expand-file-name (car file-list)) t |
| 13023 | (not (> list-length 0))) |
| 13024 | (setq list-length (1- list-length)) |
| 13025 | (setq file-list (cdr file-list))))) |
| 13026 | |
| 13027 | ;; automatically load project setup when idle after startup |
| 13028 | (when (memq 'startup vhdl-project-auto-load) |
| 13029 | (if noninteractive |
| 13030 | (vhdl-auto-load-project) |
| 13031 | (vhdl-run-when-idle .1 nil 'vhdl-auto-load-project))) |
| 13032 | |
| 13033 | |
| 13034 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13035 | ;;; Hideshow |
| 13036 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13037 | ;; (using `hideshow.el') |
| 13038 | |
| 13039 | (defconst vhdl-hs-start-regexp |
| 13040 | (concat |
| 13041 | "\\(^\\)\\s-*\\(" |
| 13042 | ;; generic/port clause |
| 13043 | "\\(generic\\|port\\)[ \t\n\r\f]*(\\|" |
| 13044 | ;; component |
| 13045 | "component\\>\\|" |
| 13046 | ;; component instantiation |
| 13047 | "\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*" |
| 13048 | "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" |
| 13049 | "\\(\\w\\|\\s_\\)+\\([ \t\n\r\f]*(\\(\\w\\|\\s_\\)+)\\)?[ \t\n\r\f]*" |
| 13050 | "\\(generic\\|port\\)[ \t\n\r\f]+map[ \t\n\r\f]*(\\|" |
| 13051 | ;; subprogram |
| 13052 | "\\(function\\|procedure\\)\\>\\|" |
| 13053 | ;; process, block |
| 13054 | "\\(\\(\\w\\|\\s_\\)+[ \t\n\r\f]*:[ \t\n\r\f]*\\)?\\(process\\|block\\)\\>\\|" |
| 13055 | ;; configuration declaration |
| 13056 | "configuration\\>" |
| 13057 | "\\)") |
| 13058 | "Regexp to match start of construct to hide.") |
| 13059 | |
| 13060 | (defun vhdl-hs-forward-sexp-func (count) |
| 13061 | "Find end of construct to hide (for hideshow). Only searches forward." |
| 13062 | (let ((pos (point))) |
| 13063 | (vhdl-prepare-search-2 |
| 13064 | (beginning-of-line) |
| 13065 | (cond |
| 13066 | ;; generic/port clause |
| 13067 | ((looking-at "^\\s-*\\(generic\\|port\\)[ \t\n\r\f]*(") |
| 13068 | (goto-char (match-end 0)) |
| 13069 | (backward-char) |
| 13070 | (forward-sexp)) |
| 13071 | ;; component declaration |
| 13072 | ((looking-at "^\\s-*component\\>") |
| 13073 | (re-search-forward "^\\s-*end\\s-+component\\>" nil t)) |
| 13074 | ;; component instantiation |
| 13075 | ((looking-at |
| 13076 | (concat |
| 13077 | "^\\s-*\\w+\\s-*:[ \t\n\r\f]*" |
| 13078 | "\\(\\(component\\|configuration\\|entity\\)[ \t\n\r\f]+\\)?" |
| 13079 | "\\w+\\(\\s-*(\\w+)\\)?[ \t\n\r\f]*" |
| 13080 | "\\(generic\\|port\\)\\s-+map[ \t\n\r\f]*(")) |
| 13081 | (goto-char (match-end 0)) |
| 13082 | (backward-char) |
| 13083 | (forward-sexp) |
| 13084 | (setq pos (point)) |
| 13085 | (vhdl-forward-syntactic-ws) |
| 13086 | (when (looking-at "port\\s-+map[ \t\n\r\f]*(") |
| 13087 | (goto-char (match-end 0)) |
| 13088 | (backward-char) |
| 13089 | (forward-sexp) |
| 13090 | (setq pos (point))) |
| 13091 | (goto-char pos)) |
| 13092 | ;; subprogram declaration/body |
| 13093 | ((looking-at "^\\s-*\\(function\\|procedure\\)\\s-+\\(\\w+\\|\".+\"\\)") |
| 13094 | (goto-char (match-end 0)) |
| 13095 | (vhdl-forward-syntactic-ws) |
| 13096 | (when (looking-at "(") |
| 13097 | (forward-sexp)) |
| 13098 | (while (and (re-search-forward "\\(;\\)\\|\\(\\<is\\>\\)" nil t) |
| 13099 | (vhdl-in-literal))) |
| 13100 | ;; subprogram body |
| 13101 | (when (match-string 2) |
| 13102 | (re-search-forward "^\\s-*\\<begin\\>" nil t) |
| 13103 | (backward-word 1) |
| 13104 | (vhdl-forward-sexp))) |
| 13105 | ;; block (recursive) |
| 13106 | ((looking-at "^\\s-*\\w+\\s-*:\\s-*block\\>") |
| 13107 | (goto-char (match-end 0)) |
| 13108 | (while (and (re-search-forward "^\\s-*\\(\\(\\w+\\s-*:\\s-*block\\>\\)\\|\\(end\\s-+block\\>\\)\\)" nil t) |
| 13109 | (match-beginning 2)) |
| 13110 | (vhdl-hs-forward-sexp-func count))) |
| 13111 | ;; process |
| 13112 | ((looking-at "^\\s-*\\(\\w+\\s-*:\\s-*\\)?process\\>") |
| 13113 | (re-search-forward "^\\s-*end\\s-+process\\>" nil t)) |
| 13114 | ;; configuration declaration |
| 13115 | ((looking-at "^\\s-*configuration\\>") |
| 13116 | (forward-word 4) |
| 13117 | (vhdl-forward-sexp)) |
| 13118 | (t (goto-char pos)))))) |
| 13119 | |
| 13120 | (defun vhdl-hideshow-init () |
| 13121 | "Initialize `hideshow'." |
| 13122 | (when vhdl-hideshow-menu |
| 13123 | (vhdl-hs-minor-mode 1))) |
| 13124 | |
| 13125 | (defun vhdl-hs-minor-mode (&optional arg) |
| 13126 | "Toggle hideshow minor mode and update menu bar." |
| 13127 | (interactive "P") |
| 13128 | (require 'hideshow) |
| 13129 | ;; check for hideshow version 5.x |
| 13130 | (if (not (boundp 'hs-block-start-mdata-select)) |
| 13131 | (vhdl-warning-when-idle "Install included `hideshow.el' patch first (see INSTALL file)") |
| 13132 | ;; initialize hideshow |
| 13133 | (unless (assoc 'vhdl-mode hs-special-modes-alist) |
| 13134 | (setq hs-special-modes-alist |
| 13135 | (cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)" |
| 13136 | 'vhdl-hs-forward-sexp-func nil) |
| 13137 | hs-special-modes-alist))) |
| 13138 | (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook)) |
| 13139 | (if vhdl-hide-all-init |
| 13140 | (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t) |
| 13141 | (remove-hook 'hs-minor-mode-hook 'hs-hide-all t)) |
| 13142 | (hs-minor-mode arg) |
| 13143 | (force-mode-line-update))) ; hack to update menu bar |
| 13144 | |
| 13145 | |
| 13146 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13147 | ;;; Font locking |
| 13148 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13149 | ;; (using `font-lock.el') |
| 13150 | |
| 13151 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13152 | ;; Help functions |
| 13153 | |
| 13154 | (defun vhdl-within-translate-off () |
| 13155 | "Return point if within translate-off region, else nil." |
| 13156 | (and (save-excursion |
| 13157 | (re-search-backward |
| 13158 | "^\\s-*--\\s-*pragma\\s-*translate_\\(on\\|off\\)\\s-*\n" nil t)) |
| 13159 | (equal "off" (match-string 1)) |
| 13160 | (point))) |
| 13161 | |
| 13162 | (defun vhdl-start-translate-off (limit) |
| 13163 | "Return point before translate-off pragma if before LIMIT, else nil." |
| 13164 | (when (re-search-forward |
| 13165 | "^\\s-*--\\s-*pragma\\s-*translate_off\\s-*\n" limit t) |
| 13166 | (match-beginning 0))) |
| 13167 | |
| 13168 | (defun vhdl-end-translate-off (limit) |
| 13169 | "Return point after translate-on pragma if before LIMIT, else nil." |
| 13170 | (re-search-forward "^\\s-*--\\s-*pragma\\s-*translate_on\\s-*\n" limit t)) |
| 13171 | |
| 13172 | (defun vhdl-match-translate-off (limit) |
| 13173 | "Match a translate-off block, setting match-data and returning t, else nil." |
| 13174 | (when (< (point) limit) |
| 13175 | (let ((start (or (vhdl-within-translate-off) |
| 13176 | (vhdl-start-translate-off limit))) |
| 13177 | (case-fold-search t)) |
| 13178 | (when start |
| 13179 | (let ((end (or (vhdl-end-translate-off limit) limit))) |
| 13180 | (set-match-data (list start end)) |
| 13181 | (goto-char end)))))) |
| 13182 | |
| 13183 | (defun vhdl-font-lock-match-item (limit) |
| 13184 | "Match, and move over, any declaration item after point. Adapted from |
| 13185 | `font-lock-match-c-style-declaration-item-and-skip-to-next'." |
| 13186 | (condition-case nil |
| 13187 | (save-restriction |
| 13188 | (narrow-to-region (point-min) limit) |
| 13189 | ;; match item |
| 13190 | (when (looking-at "\\s-*\\([a-zA-Z]\\w*\\)") |
| 13191 | (save-match-data |
| 13192 | (goto-char (match-end 1)) |
| 13193 | ;; move to next item |
| 13194 | (if (looking-at "\\(\\s-*,\\)") |
| 13195 | (goto-char (match-end 1)) |
| 13196 | (end-of-line) t)))) |
| 13197 | (error t))) |
| 13198 | |
| 13199 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13200 | ;; Syntax definitions |
| 13201 | |
| 13202 | (defconst vhdl-font-lock-syntactic-keywords |
| 13203 | '(("\\(\'\\).\\(\'\\)" (1 (7 . ?\')) (2 (7 . ?\')))) |
| 13204 | "Mark single quotes as having string quote syntax in 'c' instances.") |
| 13205 | |
| 13206 | (defvar vhdl-font-lock-keywords nil |
| 13207 | "Regular expressions to highlight in VHDL Mode.") |
| 13208 | |
| 13209 | (defvar vhdl-font-lock-keywords-0 |
| 13210 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 13211 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13212 | This does highlighting of template prompts and directives (pragmas).") |
| 13213 | |
| 13214 | (defvar vhdl-font-lock-keywords-1 nil |
| 13215 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 13216 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13217 | This does highlighting of keywords and standard identifiers.") |
| 13218 | |
| 13219 | (defconst vhdl-font-lock-keywords-2 |
| 13220 | (list |
| 13221 | ;; highlight names of units, subprograms, and components when declared |
| 13222 | (list |
| 13223 | (concat |
| 13224 | "^\\s-*\\(" |
| 13225 | "architecture\\|configuration\\|entity\\|package\\(\\s-+body\\)?\\|" |
| 13226 | "\\(\\(impure\\|pure\\)\\s-+\\)?function\\|procedure\\|component" |
| 13227 | "\\)\\s-+\\(\\w+\\)") |
| 13228 | 5 'font-lock-function-name-face) |
| 13229 | |
| 13230 | ;; highlight entity names of architectures and configurations |
| 13231 | (list |
| 13232 | "^\\s-*\\(architecture\\|configuration\\)\\s-+\\w+\\s-+of\\s-+\\(\\w+\\)" |
| 13233 | 2 'font-lock-function-name-face) |
| 13234 | |
| 13235 | ;; highlight labels of common constructs |
| 13236 | (list |
| 13237 | (concat |
| 13238 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\(" |
| 13239 | "assert\\|block\\|case\\|exit\\|for\\|if\\|loop\\|next\\|null\\|" |
| 13240 | "postponed\\|process\\|" |
| 13241 | (when (vhdl-standard-p 'ams) "procedural\\|") |
| 13242 | "with\\|while" |
| 13243 | "\\)\\>\\|\\w+\\s-*\\(([^\n]*)\\|\\.\\w+\\)*\\s-*<=\\)") |
| 13244 | 1 'font-lock-function-name-face) |
| 13245 | |
| 13246 | ;; highlight label and component name of component instantiations |
| 13247 | (list |
| 13248 | (concat |
| 13249 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]*" |
| 13250 | "\\(--[^\n]*[ \t\n\r\f]+\\)*\\(generic\\|port\\)\\s-+map\\>") |
| 13251 | '(1 font-lock-function-name-face) '(2 font-lock-function-name-face)) |
| 13252 | |
| 13253 | ;; highlight label and instantiated unit of component instantiations |
| 13254 | (list |
| 13255 | (concat |
| 13256 | "^\\s-*\\(\\w+\\)\\s-*:[ \t\n\r\f]*" |
| 13257 | "\\(component\\|configuration\\|entity\\)\\s-+" |
| 13258 | "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\(\\s-*(\\(\\w+\\))\\)?") |
| 13259 | '(1 font-lock-function-name-face) '(3 font-lock-function-name-face) |
| 13260 | '(5 font-lock-function-name-face nil t) |
| 13261 | '(7 font-lock-function-name-face nil t)) |
| 13262 | |
| 13263 | ;; highlight names and labels at end of constructs |
| 13264 | (list |
| 13265 | (concat |
| 13266 | "^\\s-*end\\s-+\\(\\(" |
| 13267 | "architecture\\|block\\|case\\|component\\|configuration\\|entity\\|" |
| 13268 | "for\\|function\\|generate\\|if\\|loop\\|package\\(\\s-+body\\)?\\|" |
| 13269 | "procedure\\|\\(postponed\\s-+\\)?process\\|" |
| 13270 | (when (vhdl-standard-p 'ams) "procedural\\|") |
| 13271 | "units" |
| 13272 | "\\)\\s-+\\)?\\(\\w*\\)") |
| 13273 | 5 'font-lock-function-name-face) |
| 13274 | |
| 13275 | ;; highlight labels in exit and next statements |
| 13276 | (list |
| 13277 | (concat |
| 13278 | "^\\s-*\\(\\w+\\s-*:\\s-*\\)?\\(exit\\|next\\)\\s-+\\(\\w*\\)") |
| 13279 | 3 'font-lock-function-name-face) |
| 13280 | |
| 13281 | ;; highlight entity name in attribute specifications |
| 13282 | (list |
| 13283 | (concat |
| 13284 | "^\\s-*attribute\\s-+\\w+\\s-+of\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\s-*:") |
| 13285 | 1 'font-lock-function-name-face) |
| 13286 | |
| 13287 | ;; highlight labels in block and component specifications |
| 13288 | (list |
| 13289 | (concat |
| 13290 | "^\\s-*for\\s-+\\(\\w+\\(,\\s-*\\w+\\)*\\)\\>\\s-*" |
| 13291 | "\\(:[ \t\n\r\f]*\\(\\w+\\)\\|[^i \t]\\)") |
| 13292 | '(1 font-lock-function-name-face) '(4 font-lock-function-name-face nil t)) |
| 13293 | |
| 13294 | ;; highlight names in library clauses |
| 13295 | (list "^\\s-*library\\>" |
| 13296 | '(vhdl-font-lock-match-item nil nil (1 font-lock-function-name-face))) |
| 13297 | |
| 13298 | ;; highlight names in use clauses |
| 13299 | (list |
| 13300 | (concat |
| 13301 | "\\<use\\s-+\\(\\(entity\\|configuration\\)\\s-+\\)?" |
| 13302 | "\\(\\w+\\)\\(\\.\\(\\w+\\)\\)?\\((\\(\\w+\\))\\)?") |
| 13303 | '(3 font-lock-function-name-face) '(5 font-lock-function-name-face nil t) |
| 13304 | '(7 font-lock-function-name-face nil t)) |
| 13305 | |
| 13306 | ;; highlight attribute name in attribute declarations/specifications |
| 13307 | (list |
| 13308 | (concat |
| 13309 | "^\\s-*attribute\\s-+\\(\\w+\\)") |
| 13310 | 1 'vhdl-font-lock-attribute-face) |
| 13311 | |
| 13312 | ;; highlight type/nature name in (sub)type/(sub)nature declarations |
| 13313 | (list |
| 13314 | (concat |
| 13315 | "^\\s-*\\(\\(sub\\)?\\(nature\\|type\\)\\|end\\s-+\\(record\\|protected\\)\\)\\s-+\\(\\w+\\)") |
| 13316 | 5 'font-lock-type-face) |
| 13317 | |
| 13318 | ;; highlight signal/variable/constant declaration names |
| 13319 | (list "\\(:[^=]\\)" |
| 13320 | '(vhdl-font-lock-match-item |
| 13321 | (progn (goto-char (match-beginning 1)) |
| 13322 | (skip-syntax-backward " ") |
| 13323 | (skip-syntax-backward "w_") |
| 13324 | (skip-syntax-backward " ") |
| 13325 | (while (= (preceding-char) ?,) |
| 13326 | (backward-char 1) |
| 13327 | (skip-syntax-backward " ") |
| 13328 | (skip-syntax-backward "w_") |
| 13329 | (skip-syntax-backward " "))) |
| 13330 | (goto-char (match-end 1)) (1 font-lock-variable-name-face))) |
| 13331 | |
| 13332 | ;; highlight formal parameters in component instantiations and subprogram |
| 13333 | ;; calls |
| 13334 | (list "\\(=>\\)" |
| 13335 | '(vhdl-font-lock-match-item |
| 13336 | (progn (goto-char (match-beginning 1)) |
| 13337 | (skip-syntax-backward " ") |
| 13338 | (while (= (preceding-char) ?\)) (backward-sexp)) |
| 13339 | (skip-syntax-backward "w_") |
| 13340 | (skip-syntax-backward " ") |
| 13341 | (when (memq (preceding-char) '(?n ?N ?|)) |
| 13342 | (goto-char (point-max)))) |
| 13343 | (goto-char (match-end 1)) (1 font-lock-variable-name-face))) |
| 13344 | |
| 13345 | ;; highlight alias/group/quantity declaration names and for-loop/-generate |
| 13346 | ;; variables |
| 13347 | (list "\\<\\(alias\\|for\\|group\\|quantity\\)\\s-+\\w+\\s-+\\(across\\|in\\|is\\)\\>" |
| 13348 | '(vhdl-font-lock-match-item |
| 13349 | (progn (goto-char (match-end 1)) (match-beginning 2)) |
| 13350 | nil (1 font-lock-variable-name-face))) |
| 13351 | ) |
| 13352 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13353 | This does context sensitive highlighting of names and labels.") |
| 13354 | |
| 13355 | (defvar vhdl-font-lock-keywords-3 nil |
| 13356 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 13357 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13358 | This does highlighting of words with special syntax.") |
| 13359 | |
| 13360 | (defvar vhdl-font-lock-keywords-4 nil |
| 13361 | ;; set in `vhdl-font-lock-init' because dependent on user options |
| 13362 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13363 | This does highlighting of additional reserved words.") |
| 13364 | |
| 13365 | (defconst vhdl-font-lock-keywords-5 |
| 13366 | ;; background highlight translate-off regions |
| 13367 | '((vhdl-match-translate-off (0 vhdl-font-lock-translate-off-face append))) |
| 13368 | "For consideration as a value of `vhdl-font-lock-keywords'. |
| 13369 | This does background highlighting of translate-off regions.") |
| 13370 | |
| 13371 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13372 | ;; Font and color definitions |
| 13373 | |
| 13374 | (defvar vhdl-font-lock-prompt-face 'vhdl-font-lock-prompt-face |
| 13375 | "Face name to use for prompts.") |
| 13376 | |
| 13377 | (defvar vhdl-font-lock-attribute-face 'vhdl-font-lock-attribute-face |
| 13378 | "Face name to use for standardized attributes.") |
| 13379 | |
| 13380 | (defvar vhdl-font-lock-enumvalue-face 'vhdl-font-lock-enumvalue-face |
| 13381 | "Face name to use for standardized enumeration values.") |
| 13382 | |
| 13383 | (defvar vhdl-font-lock-function-face 'vhdl-font-lock-function-face |
| 13384 | "Face name to use for standardized functions and packages.") |
| 13385 | |
| 13386 | (defvar vhdl-font-lock-directive-face 'vhdl-font-lock-directive-face |
| 13387 | "Face name to use for directives.") |
| 13388 | |
| 13389 | (defvar vhdl-font-lock-reserved-words-face 'vhdl-font-lock-reserved-words-face |
| 13390 | "Face name to use for additional reserved words.") |
| 13391 | |
| 13392 | (defvar vhdl-font-lock-translate-off-face 'vhdl-font-lock-translate-off-face |
| 13393 | "Face name to use for translate-off regions.") |
| 13394 | |
| 13395 | ;; face names to use for words with special syntax. |
| 13396 | (let ((syntax-alist vhdl-special-syntax-alist) |
| 13397 | name) |
| 13398 | (while syntax-alist |
| 13399 | (setq name (vhdl-function-name |
| 13400 | "vhdl-font-lock" (nth 0 (car syntax-alist)) "face")) |
| 13401 | (eval `(defvar ,name ',name |
| 13402 | ,(concat "Face name to use for " |
| 13403 | (nth 0 (car syntax-alist)) "."))) |
| 13404 | (setq syntax-alist (cdr syntax-alist)))) |
| 13405 | |
| 13406 | (defgroup vhdl-highlight-faces nil |
| 13407 | "Faces for highlighting." |
| 13408 | :group 'vhdl-highlight) |
| 13409 | |
| 13410 | ;; add faces used from `font-lock' |
| 13411 | (custom-add-to-group |
| 13412 | 'vhdl-highlight-faces 'font-lock-comment-face 'custom-face) |
| 13413 | (custom-add-to-group |
| 13414 | 'vhdl-highlight-faces 'font-lock-string-face 'custom-face) |
| 13415 | (custom-add-to-group |
| 13416 | 'vhdl-highlight-faces 'font-lock-keyword-face 'custom-face) |
| 13417 | (custom-add-to-group |
| 13418 | 'vhdl-highlight-faces 'font-lock-type-face 'custom-face) |
| 13419 | (custom-add-to-group |
| 13420 | 'vhdl-highlight-faces 'font-lock-function-name-face 'custom-face) |
| 13421 | (custom-add-to-group |
| 13422 | 'vhdl-highlight-faces 'font-lock-variable-name-face 'custom-face) |
| 13423 | |
| 13424 | (defface vhdl-font-lock-prompt-face |
| 13425 | '((((min-colors 88) (class color) (background light)) |
| 13426 | (:foreground "Red1" :bold t)) |
| 13427 | (((class color) (background light)) (:foreground "Red" :bold t)) |
| 13428 | (((class color) (background dark)) (:foreground "Pink" :bold t)) |
| 13429 | (t (:inverse-video t))) |
| 13430 | "Font lock mode face used to highlight prompts." |
| 13431 | :group 'vhdl-highlight-faces) |
| 13432 | |
| 13433 | (defface vhdl-font-lock-attribute-face |
| 13434 | '((((class color) (background light)) (:foreground "Orchid")) |
| 13435 | (((class color) (background dark)) (:foreground "LightSteelBlue")) |
| 13436 | (t (:italic t :bold t))) |
| 13437 | "Font lock mode face used to highlight standardized attributes." |
| 13438 | :group 'vhdl-highlight-faces) |
| 13439 | |
| 13440 | (defface vhdl-font-lock-enumvalue-face |
| 13441 | '((((class color) (background light)) (:foreground "SaddleBrown")) |
| 13442 | (((class color) (background dark)) (:foreground "BurlyWood")) |
| 13443 | (t (:italic t :bold t))) |
| 13444 | "Font lock mode face used to highlight standardized enumeration values." |
| 13445 | :group 'vhdl-highlight-faces) |
| 13446 | |
| 13447 | (defface vhdl-font-lock-function-face |
| 13448 | '((((class color) (background light)) (:foreground "Cyan4")) |
| 13449 | (((class color) (background dark)) (:foreground "Orchid1")) |
| 13450 | (t (:italic t :bold t))) |
| 13451 | "Font lock mode face used to highlight standardized functions and packages." |
| 13452 | :group 'vhdl-highlight-faces) |
| 13453 | |
| 13454 | (defface vhdl-font-lock-directive-face |
| 13455 | '((((class color) (background light)) (:foreground "CadetBlue")) |
| 13456 | (((class color) (background dark)) (:foreground "Aquamarine")) |
| 13457 | (t (:italic t :bold t))) |
| 13458 | "Font lock mode face used to highlight directives." |
| 13459 | :group 'vhdl-highlight-faces) |
| 13460 | |
| 13461 | (defface vhdl-font-lock-reserved-words-face |
| 13462 | '((((class color) (background light)) (:foreground "Orange" :bold t)) |
| 13463 | (((min-colors 88) (class color) (background dark)) |
| 13464 | (:foreground "Yellow1" :bold t)) |
| 13465 | (((class color) (background dark)) (:foreground "Yellow" :bold t)) |
| 13466 | (t ())) |
| 13467 | "Font lock mode face used to highlight additional reserved words." |
| 13468 | :group 'vhdl-highlight-faces) |
| 13469 | |
| 13470 | (defface vhdl-font-lock-translate-off-face |
| 13471 | '((((class color) (background light)) (:background "LightGray")) |
| 13472 | (((class color) (background dark)) (:background "DimGray")) |
| 13473 | (t ())) |
| 13474 | "Font lock mode face used to background highlight translate-off regions." |
| 13475 | :group 'vhdl-highlight-faces) |
| 13476 | |
| 13477 | ;; font lock mode faces used to highlight words with special syntax. |
| 13478 | (let ((syntax-alist vhdl-special-syntax-alist)) |
| 13479 | (while syntax-alist |
| 13480 | (eval `(defface ,(vhdl-function-name |
| 13481 | "vhdl-font-lock" (caar syntax-alist) "face") |
| 13482 | '((((class color) (background light)) |
| 13483 | (:foreground ,(nth 2 (car syntax-alist)))) |
| 13484 | (((class color) (background dark)) |
| 13485 | (:foreground ,(nth 3 (car syntax-alist)))) |
| 13486 | (t ())) |
| 13487 | ,(concat "Font lock mode face used to highlight " |
| 13488 | (nth 0 (car syntax-alist)) ".") |
| 13489 | :group 'vhdl-highlight-faces)) |
| 13490 | (setq syntax-alist (cdr syntax-alist)))) |
| 13491 | |
| 13492 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13493 | ;; Font lock initialization |
| 13494 | |
| 13495 | (defun vhdl-font-lock-init () |
| 13496 | "Initialize fontification." |
| 13497 | ;; highlight template prompts and directives |
| 13498 | (setq vhdl-font-lock-keywords-0 |
| 13499 | (list (list (concat "\\(^\\|[ \t(.']\\)\\(<" |
| 13500 | vhdl-template-prompt-syntax ">\\)") |
| 13501 | 2 'vhdl-font-lock-prompt-face t) |
| 13502 | (list (concat "--\\s-*" |
| 13503 | vhdl-directive-keywords-regexp "\\s-+\\(.*\\)$") |
| 13504 | 2 'vhdl-font-lock-directive-face t) |
| 13505 | ;; highlight c-preprocessor directives |
| 13506 | (list "^#[ \t]*\\(\\w+\\)\\([ \t]+\\(\\w+\\)\\)?" |
| 13507 | '(1 font-lock-builtin-face) |
| 13508 | '(3 font-lock-variable-name-face nil t)))) |
| 13509 | ;; highlight keywords and standardized types, attributes, enumeration |
| 13510 | ;; values, and subprograms |
| 13511 | (setq vhdl-font-lock-keywords-1 |
| 13512 | (list |
| 13513 | (list (concat "'" vhdl-attributes-regexp) |
| 13514 | 1 'vhdl-font-lock-attribute-face) |
| 13515 | (list vhdl-types-regexp 1 'font-lock-type-face) |
| 13516 | (list vhdl-functions-regexp 1 'vhdl-font-lock-function-face) |
| 13517 | (list vhdl-packages-regexp 1 'vhdl-font-lock-function-face) |
| 13518 | (list vhdl-enum-values-regexp 1 'vhdl-font-lock-enumvalue-face) |
| 13519 | (list vhdl-constants-regexp 1 'font-lock-constant-face) |
| 13520 | (list vhdl-keywords-regexp 1 'font-lock-keyword-face))) |
| 13521 | ;; highlight words with special syntax. |
| 13522 | (setq vhdl-font-lock-keywords-3 |
| 13523 | (let ((syntax-alist vhdl-special-syntax-alist) |
| 13524 | keywords) |
| 13525 | (while syntax-alist |
| 13526 | (setq keywords |
| 13527 | (cons |
| 13528 | (list (concat "\\(" (nth 1 (car syntax-alist)) "\\)") 1 |
| 13529 | (vhdl-function-name |
| 13530 | "vhdl-font-lock" (nth 0 (car syntax-alist)) "face") |
| 13531 | (nth 4 (car syntax-alist))) |
| 13532 | keywords)) |
| 13533 | (setq syntax-alist (cdr syntax-alist))) |
| 13534 | keywords)) |
| 13535 | ;; highlight additional reserved words |
| 13536 | (setq vhdl-font-lock-keywords-4 |
| 13537 | (list (list vhdl-reserved-words-regexp 1 |
| 13538 | 'vhdl-font-lock-reserved-words-face))) |
| 13539 | ;; highlight everything together |
| 13540 | (setq vhdl-font-lock-keywords |
| 13541 | (append |
| 13542 | vhdl-font-lock-keywords-0 |
| 13543 | (when vhdl-highlight-keywords vhdl-font-lock-keywords-1) |
| 13544 | (when (or vhdl-highlight-forbidden-words |
| 13545 | vhdl-highlight-verilog-keywords) vhdl-font-lock-keywords-4) |
| 13546 | (when vhdl-highlight-special-words vhdl-font-lock-keywords-3) |
| 13547 | (when vhdl-highlight-names vhdl-font-lock-keywords-2) |
| 13548 | (when vhdl-highlight-translate-off vhdl-font-lock-keywords-5)))) |
| 13549 | |
| 13550 | ;; initialize fontification for VHDL Mode |
| 13551 | (vhdl-font-lock-init) |
| 13552 | |
| 13553 | (defun vhdl-fontify-buffer () |
| 13554 | "Re-initialize fontification and fontify buffer." |
| 13555 | (interactive) |
| 13556 | (setq font-lock-defaults |
| 13557 | `(vhdl-font-lock-keywords |
| 13558 | nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) |
| 13559 | beginning-of-line)) |
| 13560 | (when (fboundp 'font-lock-unset-defaults) |
| 13561 | (font-lock-unset-defaults)) ; not implemented in XEmacs |
| 13562 | (font-lock-set-defaults) |
| 13563 | (font-lock-mode nil) |
| 13564 | (font-lock-mode t)) |
| 13565 | |
| 13566 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13567 | ;; Initialization for PostScript printing |
| 13568 | |
| 13569 | (defun vhdl-ps-print-settings () |
| 13570 | "Initialize custom face and page settings for PostScript printing." |
| 13571 | ;; define custom face settings |
| 13572 | (unless (or (not vhdl-print-customize-faces) |
| 13573 | ps-print-color-p) |
| 13574 | (set (make-local-variable 'ps-bold-faces) |
| 13575 | '(font-lock-keyword-face |
| 13576 | font-lock-type-face |
| 13577 | vhdl-font-lock-attribute-face |
| 13578 | vhdl-font-lock-enumvalue-face |
| 13579 | vhdl-font-lock-directive-face)) |
| 13580 | (set (make-local-variable 'ps-italic-faces) |
| 13581 | '(font-lock-comment-face |
| 13582 | font-lock-function-name-face |
| 13583 | font-lock-type-face |
| 13584 | vhdl-font-lock-attribute-face |
| 13585 | vhdl-font-lock-enumvalue-face |
| 13586 | vhdl-font-lock-directive-face)) |
| 13587 | (set (make-local-variable 'ps-underlined-faces) |
| 13588 | '(font-lock-string-face)) |
| 13589 | (setq ps-always-build-face-reference t)) |
| 13590 | ;; define page settings, so that a line containing 79 characters (default) |
| 13591 | ;; fits into one column |
| 13592 | (when vhdl-print-two-column |
| 13593 | (set (make-local-variable 'ps-landscape-mode) t) |
| 13594 | (set (make-local-variable 'ps-number-of-columns) 2) |
| 13595 | (set (make-local-variable 'ps-font-size) 7.0) |
| 13596 | (set (make-local-variable 'ps-header-title-font-size) 10.0) |
| 13597 | (set (make-local-variable 'ps-header-font-size) 9.0) |
| 13598 | (set (make-local-variable 'ps-header-offset) 12.0) |
| 13599 | (when (eq ps-paper-type 'letter) |
| 13600 | (set (make-local-variable 'ps-inter-column) 40.0) |
| 13601 | (set (make-local-variable 'ps-left-margin) 40.0) |
| 13602 | (set (make-local-variable 'ps-right-margin) 40.0)))) |
| 13603 | |
| 13604 | (defun vhdl-ps-print-init () |
| 13605 | "Initialize PostScript printing." |
| 13606 | (if (featurep 'xemacs) |
| 13607 | (when (boundp 'ps-print-color-p) |
| 13608 | (vhdl-ps-print-settings)) |
| 13609 | (if (featurep 'xemacs) (make-local-hook 'ps-print-hook)) |
| 13610 | (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t))) |
| 13611 | |
| 13612 | |
| 13613 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13614 | ;;; Hierarchy browser (using `speedbar.el') |
| 13615 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13616 | ;; Allows displaying the hierarchy of all VHDL design units contained in a |
| 13617 | ;; directory by using the speedbar. |
| 13618 | |
| 13619 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13620 | ;; Variables |
| 13621 | |
| 13622 | (defvar vhdl-entity-alist nil |
| 13623 | "Cache with entities and corresponding architectures for each |
| 13624 | project/directory.") |
| 13625 | ;; structure: (parenthesized expression means list of such entries) |
| 13626 | ;; (cache-key |
| 13627 | ;; (ent-key ent-name ent-file ent-line |
| 13628 | ;; (arch-key arch-name arch-file arch-line |
| 13629 | ;; (inst-key inst-name inst-file inst-line inst-comp-name inst-ent-key |
| 13630 | ;; inst-arch-key inst-conf-key inst-lib-key inst-path) |
| 13631 | ;; (lib-name pack-key)) |
| 13632 | ;; mra-key (lib-name pack-key)) |
| 13633 | |
| 13634 | (defvar vhdl-config-alist nil |
| 13635 | "Cache with configurations for each project/directory.") |
| 13636 | ;; structure: (parenthesized expression means list of such entries) |
| 13637 | ;; (cache-key |
| 13638 | ;; (conf-key conf-name conf-file conf-line ent-key arch-key |
| 13639 | ;; (inst-key inst-comp-name inst-ent-key inst-arch-key |
| 13640 | ;; inst-conf-key inst-lib-key) |
| 13641 | ;; (lib-name pack-key))) |
| 13642 | |
| 13643 | (defvar vhdl-package-alist nil |
| 13644 | "Cache with packages for each project/directory.") |
| 13645 | ;; structure: (parenthesized expression means list of such entries) |
| 13646 | ;; (cache-key |
| 13647 | ;; (pack-key pack-name pack-file pack-line |
| 13648 | ;; (comp-key comp-name comp-file comp-line) |
| 13649 | ;; (func-key func-name func-file func-line) |
| 13650 | ;; (lib-name pack-key) |
| 13651 | ;; pack-body-file pack-body-line |
| 13652 | ;; (func-key func-name func-body-file func-body-line) |
| 13653 | ;; (lib-name pack-key))) |
| 13654 | |
| 13655 | (defvar vhdl-ent-inst-alist nil |
| 13656 | "Cache with instantiated entities for each project/directory.") |
| 13657 | ;; structure: (parenthesized expression means list of such entries) |
| 13658 | ;; (cache-key (inst-ent-key)) |
| 13659 | |
| 13660 | (defvar vhdl-file-alist nil |
| 13661 | "Cache with design units in each file for each project/directory.") |
| 13662 | ;; structure: (parenthesized expression means list of such entries) |
| 13663 | ;; (cache-key |
| 13664 | ;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list) |
| 13665 | ;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list)) |
| 13666 | |
| 13667 | (defvar vhdl-directory-alist nil |
| 13668 | "Cache with source directories for each project.") |
| 13669 | ;; structure: (parenthesized expression means list of such entries) |
| 13670 | ;; (cache-key (directory)) |
| 13671 | |
| 13672 | (defvar vhdl-speedbar-shown-unit-alist nil |
| 13673 | "Alist of design units simultaneously open in the current speedbar for each |
| 13674 | directory and project.") |
| 13675 | |
| 13676 | (defvar vhdl-speedbar-shown-project-list nil |
| 13677 | "List of projects simultaneously open in the current speedbar.") |
| 13678 | |
| 13679 | (defvar vhdl-updated-project-list nil |
| 13680 | "List of projects and directories with updated files.") |
| 13681 | |
| 13682 | (defvar vhdl-modified-file-list nil |
| 13683 | "List of modified files to be rescanned for hierarchy updating.") |
| 13684 | |
| 13685 | (defvar vhdl-speedbar-hierarchy-depth 0 |
| 13686 | "Depth of instantiation hierarchy to display.") |
| 13687 | |
| 13688 | (defvar vhdl-speedbar-show-projects nil |
| 13689 | "Non-nil means project hierarchy is displayed in speedbar, directory |
| 13690 | hierarchy otherwise.") |
| 13691 | |
| 13692 | (defun vhdl-get-end-of-unit () |
| 13693 | "Return position of end of current unit." |
| 13694 | (let ((pos (point))) |
| 13695 | (save-excursion |
| 13696 | (while (and (re-search-forward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil 1) |
| 13697 | (save-excursion |
| 13698 | (goto-char (match-beginning 0)) |
| 13699 | (vhdl-backward-syntactic-ws) |
| 13700 | (and (/= (preceding-char) ?\;) (not (bobp)))))) |
| 13701 | (re-search-backward "^[ \t]*end\\>" pos 1) |
| 13702 | (point)))) |
| 13703 | |
| 13704 | (defun vhdl-match-string-downcase (num &optional string) |
| 13705 | "Like `match-string-no-properties' with down-casing." |
| 13706 | (let ((match (match-string-no-properties num string))) |
| 13707 | (and match (downcase match)))) |
| 13708 | |
| 13709 | |
| 13710 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 13711 | ;; Scan functions |
| 13712 | |
| 13713 | (defun vhdl-scan-context-clause () |
| 13714 | "Scan the context clause that precedes a design unit." |
| 13715 | (let (lib-alist) |
| 13716 | (save-excursion |
| 13717 | (when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t) |
| 13718 | (while (and (re-search-backward "^[ \t]*\\(end\\|use\\)\\>" nil t) |
| 13719 | (equal "USE" (upcase (match-string 1)))) |
| 13720 | (when (looking-at "^[ \t]*use[ \t\n\r\f]*\\(\\w+\\)\\.\\(\\w+\\)\\.\\w+") |
| 13721 | (push (cons (match-string-no-properties 1) |
| 13722 | (vhdl-match-string-downcase 2)) |
| 13723 | lib-alist))))) |
| 13724 | lib-alist)) |
| 13725 | |
| 13726 | (defun vhdl-scan-directory-contents (name &optional project update num-string |
| 13727 | non-final) |
| 13728 | "Scan contents of VHDL files in directory or file pattern NAME." |
| 13729 | (string-match "\\(.*[/\\]\\)\\(.*\\)" name) |
| 13730 | (let* ((dir-name (match-string 1 name)) |
| 13731 | (file-pattern (match-string 2 name)) |
| 13732 | (is-directory (= 0 (length file-pattern))) |
| 13733 | (file-list |
| 13734 | (if update |
| 13735 | (list name) |
| 13736 | (if is-directory |
| 13737 | (vhdl-get-source-files t dir-name) |
| 13738 | (vhdl-directory-files |
| 13739 | dir-name t (wildcard-to-regexp file-pattern))))) |
| 13740 | (key (or project dir-name)) |
| 13741 | (file-exclude-regexp |
| 13742 | (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) |
| 13743 | (limit-design-file-size (nth 0 vhdl-speedbar-scan-limit)) |
| 13744 | (limit-hier-file-size (nth 0 (nth 1 vhdl-speedbar-scan-limit))) |
| 13745 | (limit-hier-inst-no (nth 1 (nth 1 vhdl-speedbar-scan-limit))) |
| 13746 | ent-alist conf-alist pack-alist ent-inst-list file-alist |
| 13747 | tmp-list tmp-entry no-files files-exist big-files) |
| 13748 | (when (or project update) |
| 13749 | (setq ent-alist (vhdl-aget vhdl-entity-alist key t) |
| 13750 | conf-alist (vhdl-aget vhdl-config-alist key t) |
| 13751 | pack-alist (vhdl-aget vhdl-package-alist key t) |
| 13752 | ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist key t)) |
| 13753 | file-alist (vhdl-aget vhdl-file-alist key t))) |
| 13754 | (when (and (not is-directory) (null file-list)) |
| 13755 | (message "No such file: \"%s\"" name)) |
| 13756 | (setq files-exist file-list) |
| 13757 | (when file-list |
| 13758 | (setq no-files (length file-list)) |
| 13759 | (message "Scanning %s %s\"%s\"..." |
| 13760 | (if is-directory "directory" "files") (or num-string "") name) |
| 13761 | ;; exclude files |
| 13762 | (unless (equal file-exclude-regexp "") |
| 13763 | (let ((case-fold-search nil) |
| 13764 | file-tmp-list) |
| 13765 | (while file-list |
| 13766 | (unless (string-match file-exclude-regexp (car file-list)) |
| 13767 | (push (car file-list) file-tmp-list)) |
| 13768 | (setq file-list (cdr file-list))) |
| 13769 | (setq file-list (nreverse file-tmp-list)))) |
| 13770 | ;; do for all files |
| 13771 | (while file-list |
| 13772 | (unless noninteractive |
| 13773 | (message "Scanning %s %s\"%s\"... (%2d%s)" |
| 13774 | (if is-directory "directory" "files") |
| 13775 | (or num-string "") name |
| 13776 | (/ (* 100 (- no-files (length file-list))) no-files) "%")) |
| 13777 | (let ((file-name (abbreviate-file-name (car file-list))) |
| 13778 | ent-list arch-list arch-ent-list conf-list |
| 13779 | pack-list pack-body-list inst-list inst-ent-list) |
| 13780 | ;; scan file |
| 13781 | (vhdl-visit-file |
| 13782 | file-name nil |
| 13783 | (vhdl-prepare-search-2 |
| 13784 | (save-excursion |
| 13785 | ;; scan for design units |
| 13786 | (if (and limit-design-file-size |
| 13787 | (< limit-design-file-size (buffer-size))) |
| 13788 | (progn (message "WARNING: Scan limit (design units: file size) reached in file:\n \"%s\"" file-name) |
| 13789 | (setq big-files t)) |
| 13790 | ;; scan for entities |
| 13791 | (goto-char (point-min)) |
| 13792 | (while (re-search-forward "^[ \t]*entity[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 13793 | (let* ((ent-name (match-string-no-properties 1)) |
| 13794 | (ent-key (downcase ent-name)) |
| 13795 | (ent-entry (vhdl-aget ent-alist ent-key t)) |
| 13796 | (lib-alist (vhdl-scan-context-clause))) |
| 13797 | (if (nth 1 ent-entry) |
| 13798 | (vhdl-warning-when-idle |
| 13799 | "Entity declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13800 | ent-name (nth 1 ent-entry) (nth 2 ent-entry) |
| 13801 | file-name (vhdl-current-line)) |
| 13802 | (push ent-key ent-list) |
| 13803 | (vhdl-aput 'ent-alist ent-key |
| 13804 | (list ent-name file-name (vhdl-current-line) |
| 13805 | (nth 3 ent-entry) (nth 4 ent-entry) |
| 13806 | lib-alist))))) |
| 13807 | ;; scan for architectures |
| 13808 | (goto-char (point-min)) |
| 13809 | (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 13810 | (let* ((arch-name (match-string-no-properties 1)) |
| 13811 | (arch-key (downcase arch-name)) |
| 13812 | (ent-name (match-string-no-properties 2)) |
| 13813 | (ent-key (downcase ent-name)) |
| 13814 | (ent-entry (vhdl-aget ent-alist ent-key t)) |
| 13815 | (arch-alist (nth 3 ent-entry)) |
| 13816 | (arch-entry (vhdl-aget arch-alist arch-key t)) |
| 13817 | (lib-arch-alist (vhdl-scan-context-clause))) |
| 13818 | (if arch-entry |
| 13819 | (vhdl-warning-when-idle |
| 13820 | "Architecture declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13821 | arch-name ent-name (nth 1 arch-entry) |
| 13822 | (nth 2 arch-entry) file-name (vhdl-current-line)) |
| 13823 | (setq arch-list (cons arch-key arch-list) |
| 13824 | arch-ent-list (cons ent-key arch-ent-list)) |
| 13825 | (vhdl-aput 'arch-alist arch-key |
| 13826 | (list arch-name file-name (vhdl-current-line) |
| 13827 | nil lib-arch-alist)) |
| 13828 | (vhdl-aput 'ent-alist ent-key |
| 13829 | (list (or (nth 0 ent-entry) ent-name) |
| 13830 | (nth 1 ent-entry) (nth 2 ent-entry) |
| 13831 | (vhdl-sort-alist arch-alist) |
| 13832 | arch-key (nth 5 ent-entry)))))) |
| 13833 | ;; scan for configurations |
| 13834 | (goto-char (point-min)) |
| 13835 | (while (re-search-forward "^[ \t]*configuration[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 13836 | (let* ((conf-name (match-string-no-properties 1)) |
| 13837 | (conf-key (downcase conf-name)) |
| 13838 | (conf-entry (vhdl-aget conf-alist conf-key t)) |
| 13839 | (ent-name (match-string-no-properties 2)) |
| 13840 | (ent-key (downcase ent-name)) |
| 13841 | (lib-alist (vhdl-scan-context-clause)) |
| 13842 | (conf-line (vhdl-current-line)) |
| 13843 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13844 | arch-key comp-conf-list inst-key-list |
| 13845 | inst-comp-key inst-ent-key inst-arch-key |
| 13846 | inst-conf-key inst-lib-key) |
| 13847 | (when (vhdl-re-search-forward "\\<for[ \t\n\r\f]+\\(\\w+\\)") |
| 13848 | (setq arch-key (vhdl-match-string-downcase 1))) |
| 13849 | (if conf-entry |
| 13850 | (vhdl-warning-when-idle |
| 13851 | "Configuration declared twice (used 1.): \"%s\" of \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13852 | conf-name ent-name (nth 1 conf-entry) |
| 13853 | (nth 2 conf-entry) file-name conf-line) |
| 13854 | (push conf-key conf-list) |
| 13855 | ;; scan for subconfigurations and subentities |
| 13856 | (while (re-search-forward "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+" end-of-unit t) |
| 13857 | (setq inst-comp-key (vhdl-match-string-downcase 3) |
| 13858 | inst-key-list (split-string |
| 13859 | (vhdl-match-string-downcase 1) |
| 13860 | "[ \t\n\r\f]*,[ \t\n\r\f]*")) |
| 13861 | (vhdl-forward-syntactic-ws) |
| 13862 | (when (looking-at "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\w+\\)\\.\\(\\w+\\)[ \t\n\r\f]*\\((\\(\\w+\\))\\)?") |
| 13863 | (setq |
| 13864 | inst-lib-key (vhdl-match-string-downcase 3) |
| 13865 | inst-ent-key (and (match-string 2) |
| 13866 | (vhdl-match-string-downcase 4)) |
| 13867 | inst-arch-key (and (match-string 2) |
| 13868 | (vhdl-match-string-downcase 6)) |
| 13869 | inst-conf-key (and (not (match-string 2)) |
| 13870 | (vhdl-match-string-downcase 4))) |
| 13871 | (while inst-key-list |
| 13872 | (setq comp-conf-list |
| 13873 | (cons (list (car inst-key-list) |
| 13874 | inst-comp-key inst-ent-key |
| 13875 | inst-arch-key inst-conf-key |
| 13876 | inst-lib-key) |
| 13877 | comp-conf-list)) |
| 13878 | (setq inst-key-list (cdr inst-key-list))))) |
| 13879 | (vhdl-aput 'conf-alist conf-key |
| 13880 | (list conf-name file-name conf-line ent-key |
| 13881 | arch-key comp-conf-list lib-alist))))) |
| 13882 | ;; scan for packages |
| 13883 | (goto-char (point-min)) |
| 13884 | (while (re-search-forward "^[ \t]*package[ \t\n\r\f]+\\(body[ \t\n\r\f]+\\)?\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 13885 | (let* ((pack-name (match-string-no-properties 2)) |
| 13886 | (pack-key (downcase pack-name)) |
| 13887 | (is-body (match-string-no-properties 1)) |
| 13888 | (pack-entry (vhdl-aget pack-alist pack-key t)) |
| 13889 | (pack-line (vhdl-current-line)) |
| 13890 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13891 | comp-name func-name comp-alist func-alist lib-alist) |
| 13892 | (if (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) |
| 13893 | (vhdl-warning-when-idle |
| 13894 | "Package%s declared twice (used 1.): \"%s\"\n 1. in \"%s\" (line %d)\n 2. in \"%s\" (line %d)" |
| 13895 | (if is-body " body" "") pack-name |
| 13896 | (if is-body (nth 6 pack-entry) (nth 1 pack-entry)) |
| 13897 | (if is-body (nth 7 pack-entry) (nth 2 pack-entry)) |
| 13898 | file-name (vhdl-current-line)) |
| 13899 | ;; scan for context clauses |
| 13900 | (setq lib-alist (vhdl-scan-context-clause)) |
| 13901 | ;; scan for component and subprogram declarations/bodies |
| 13902 | (while (re-search-forward "^[ \t]*\\(component\\|function\\|procedure\\)[ \t\n\r\f]+\\(\\w+\\|\".*\"\\)" end-of-unit t) |
| 13903 | (if (equal (upcase (match-string 1)) "COMPONENT") |
| 13904 | (setq comp-name (match-string-no-properties 2) |
| 13905 | comp-alist |
| 13906 | (cons (list (downcase comp-name) comp-name |
| 13907 | file-name (vhdl-current-line)) |
| 13908 | comp-alist)) |
| 13909 | (setq func-name (match-string-no-properties 2) |
| 13910 | func-alist |
| 13911 | (cons (list (downcase func-name) func-name |
| 13912 | file-name (vhdl-current-line)) |
| 13913 | func-alist)))) |
| 13914 | (setq func-alist (nreverse func-alist)) |
| 13915 | (setq comp-alist (nreverse comp-alist)) |
| 13916 | (if is-body |
| 13917 | (push pack-key pack-body-list) |
| 13918 | (push pack-key pack-list)) |
| 13919 | (vhdl-aput |
| 13920 | 'pack-alist pack-key |
| 13921 | (if is-body |
| 13922 | (list (or (nth 0 pack-entry) pack-name) |
| 13923 | (nth 1 pack-entry) (nth 2 pack-entry) |
| 13924 | (nth 3 pack-entry) (nth 4 pack-entry) |
| 13925 | (nth 5 pack-entry) |
| 13926 | file-name pack-line func-alist lib-alist) |
| 13927 | (list pack-name file-name pack-line |
| 13928 | comp-alist func-alist lib-alist |
| 13929 | (nth 6 pack-entry) (nth 7 pack-entry) |
| 13930 | (nth 8 pack-entry) (nth 9 pack-entry)))))))) |
| 13931 | ;; scan for hierarchy |
| 13932 | (if (and limit-hier-file-size |
| 13933 | (< limit-hier-file-size (buffer-size))) |
| 13934 | (progn (message "WARNING: Scan limit (hierarchy: file size) reached in file:\n \"%s\"" file-name) |
| 13935 | (setq big-files t)) |
| 13936 | ;; scan for architectures |
| 13937 | (goto-char (point-min)) |
| 13938 | (while (re-search-forward "^[ \t]*architecture[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 13939 | (let* ((ent-name (match-string-no-properties 2)) |
| 13940 | (ent-key (downcase ent-name)) |
| 13941 | (arch-name (match-string-no-properties 1)) |
| 13942 | (arch-key (downcase arch-name)) |
| 13943 | (ent-entry (vhdl-aget ent-alist ent-key t)) |
| 13944 | (arch-alist (nth 3 ent-entry)) |
| 13945 | (arch-entry (vhdl-aget arch-alist arch-key t)) |
| 13946 | (beg-of-unit (point)) |
| 13947 | (end-of-unit (vhdl-get-end-of-unit)) |
| 13948 | (inst-no 0) |
| 13949 | inst-alist inst-path) |
| 13950 | ;; scan for contained instantiations |
| 13951 | (while (and (re-search-forward |
| 13952 | (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" |
| 13953 | "\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(generic\\|port\\)[ \t\n\r\f]+map\\>\\|" |
| 13954 | "component[ \t\n\r\f]+\\(\\w+\\)\\|" |
| 13955 | "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?\\|" |
| 13956 | "\\(\\(for\\|if\\)\\>[^;:]+\\<generate\\>\\|block\\>\\)\\)\\|" |
| 13957 | "\\(^[ \t]*end[ \t\n\r\f]+\\(generate\\|block\\)\\>\\)") end-of-unit t) |
| 13958 | (or (not limit-hier-inst-no) |
| 13959 | (<= (if (or (match-string 14) |
| 13960 | (match-string 16)) |
| 13961 | inst-no |
| 13962 | (setq inst-no (1+ inst-no))) |
| 13963 | limit-hier-inst-no))) |
| 13964 | (cond |
| 13965 | ;; block/generate beginning found |
| 13966 | ((match-string 14) |
| 13967 | (setq inst-path |
| 13968 | (cons (match-string-no-properties 1) inst-path))) |
| 13969 | ;; block/generate end found |
| 13970 | ((match-string 16) |
| 13971 | (setq inst-path (cdr inst-path))) |
| 13972 | ;; instantiation found |
| 13973 | (t |
| 13974 | (let* ((inst-name (match-string-no-properties 1)) |
| 13975 | (inst-key (downcase inst-name)) |
| 13976 | (inst-comp-name |
| 13977 | (or (match-string-no-properties 3) |
| 13978 | (match-string-no-properties 6))) |
| 13979 | (inst-ent-key |
| 13980 | (or (and (match-string 8) |
| 13981 | (vhdl-match-string-downcase 11)) |
| 13982 | (and inst-comp-name |
| 13983 | (downcase inst-comp-name)))) |
| 13984 | (inst-arch-key (vhdl-match-string-downcase 13)) |
| 13985 | (inst-conf-key |
| 13986 | (and (not (match-string 8)) |
| 13987 | (vhdl-match-string-downcase 11))) |
| 13988 | (inst-lib-key (vhdl-match-string-downcase 10))) |
| 13989 | (goto-char (match-end 1)) |
| 13990 | (setq inst-list (cons inst-key inst-list) |
| 13991 | inst-ent-list |
| 13992 | (cons inst-ent-key inst-ent-list)) |
| 13993 | (setq inst-alist |
| 13994 | (append |
| 13995 | inst-alist |
| 13996 | (list (list inst-key inst-name file-name |
| 13997 | (vhdl-current-line) inst-comp-name |
| 13998 | inst-ent-key inst-arch-key |
| 13999 | inst-conf-key inst-lib-key |
| 14000 | (reverse inst-path))))))))) |
| 14001 | ;; scan for contained configuration specifications |
| 14002 | (goto-char beg-of-unit) |
| 14003 | (while (re-search-forward |
| 14004 | (concat "^[ \t]*for[ \t\n\r\f]+\\(\\w+\\([ \t\n\r\f]*,[ \t\n\r\f]*\\w+\\)*\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(\\w+\\)[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*" |
| 14005 | "use[ \t\n\r\f]+\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?") end-of-unit t) |
| 14006 | (let* ((inst-comp-name (match-string-no-properties 3)) |
| 14007 | (inst-ent-key |
| 14008 | (and (match-string 6) |
| 14009 | (vhdl-match-string-downcase 9))) |
| 14010 | (inst-arch-key (vhdl-match-string-downcase 11)) |
| 14011 | (inst-conf-key |
| 14012 | (and (not (match-string 6)) |
| 14013 | (vhdl-match-string-downcase 9))) |
| 14014 | (inst-lib-key (vhdl-match-string-downcase 8)) |
| 14015 | (inst-key-list |
| 14016 | (split-string (vhdl-match-string-downcase 1) |
| 14017 | "[ \t\n\r\f]*,[ \t\n\r\f]*")) |
| 14018 | (tmp-inst-alist inst-alist) |
| 14019 | inst-entry) |
| 14020 | (while tmp-inst-alist |
| 14021 | (when (and (or (equal "all" (car inst-key-list)) |
| 14022 | (member (nth 0 (car tmp-inst-alist)) |
| 14023 | inst-key-list)) |
| 14024 | (equal |
| 14025 | (downcase |
| 14026 | (or (nth 4 (car tmp-inst-alist)) "")) |
| 14027 | (downcase inst-comp-name))) |
| 14028 | (setq inst-entry (car tmp-inst-alist)) |
| 14029 | (setq inst-ent-list |
| 14030 | (cons (or inst-ent-key (nth 5 inst-entry)) |
| 14031 | (vhdl-delete |
| 14032 | (nth 5 inst-entry) inst-ent-list))) |
| 14033 | (setq inst-entry |
| 14034 | (list (nth 0 inst-entry) (nth 1 inst-entry) |
| 14035 | (nth 2 inst-entry) (nth 3 inst-entry) |
| 14036 | (nth 4 inst-entry) |
| 14037 | (or inst-ent-key (nth 5 inst-entry)) |
| 14038 | (or inst-arch-key (nth 6 inst-entry)) |
| 14039 | inst-conf-key inst-lib-key)) |
| 14040 | (setcar tmp-inst-alist inst-entry)) |
| 14041 | (setq tmp-inst-alist (cdr tmp-inst-alist))))) |
| 14042 | ;; save in cache |
| 14043 | (vhdl-aput 'arch-alist arch-key |
| 14044 | (list (nth 0 arch-entry) (nth 1 arch-entry) |
| 14045 | (nth 2 arch-entry) inst-alist |
| 14046 | (nth 4 arch-entry))) |
| 14047 | (vhdl-aput 'ent-alist ent-key |
| 14048 | (list (nth 0 ent-entry) (nth 1 ent-entry) |
| 14049 | (nth 2 ent-entry) |
| 14050 | (vhdl-sort-alist arch-alist) |
| 14051 | (nth 4 ent-entry) (nth 5 ent-entry))) |
| 14052 | (when (and limit-hier-inst-no |
| 14053 | (> inst-no limit-hier-inst-no)) |
| 14054 | (message "WARNING: Scan limit (hierarchy: instances per architecture) reached in file:\n \"%s\"" file-name) |
| 14055 | (setq big-files t)) |
| 14056 | (goto-char end-of-unit)))) |
| 14057 | ;; remember design units for this file |
| 14058 | (vhdl-aput 'file-alist file-name |
| 14059 | (list ent-list arch-list arch-ent-list conf-list |
| 14060 | pack-list pack-body-list |
| 14061 | inst-list inst-ent-list)) |
| 14062 | (setq ent-inst-list (append inst-ent-list ent-inst-list)))))) |
| 14063 | (setq file-list (cdr file-list)))) |
| 14064 | (when (or (and (not project) files-exist) |
| 14065 | (and project (not non-final))) |
| 14066 | ;; consistency checks: |
| 14067 | ;; check whether each architecture has a corresponding entity |
| 14068 | (setq tmp-list ent-alist) |
| 14069 | (while tmp-list |
| 14070 | (when (null (nth 2 (car tmp-list))) |
| 14071 | (setq tmp-entry (car (nth 4 (car tmp-list)))) |
| 14072 | (vhdl-warning-when-idle |
| 14073 | "Architecture of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" |
| 14074 | (nth 1 tmp-entry) (nth 1 (car tmp-list)) (nth 2 tmp-entry) |
| 14075 | (nth 3 tmp-entry))) |
| 14076 | (setq tmp-list (cdr tmp-list))) |
| 14077 | ;; check whether configuration has a corresponding entity/architecture |
| 14078 | (setq tmp-list conf-alist) |
| 14079 | (while tmp-list |
| 14080 | (if (setq tmp-entry (vhdl-aget ent-alist (nth 4 (car tmp-list)) t)) |
| 14081 | (unless (vhdl-aget (nth 3 tmp-entry) (nth 5 (car tmp-list)) t) |
| 14082 | (setq tmp-entry (car tmp-list)) |
| 14083 | (vhdl-warning-when-idle |
| 14084 | "Configuration of non-existing architecture: \"%s\" of \"%s(%s)\"\n in \"%s\" (line %d)" |
| 14085 | (nth 1 tmp-entry) (nth 4 tmp-entry) (nth 5 tmp-entry) |
| 14086 | (nth 2 tmp-entry) (nth 3 tmp-entry))) |
| 14087 | (setq tmp-entry (car tmp-list)) |
| 14088 | (vhdl-warning-when-idle |
| 14089 | "Configuration of non-existing entity: \"%s\" of \"%s\"\n in \"%s\" (line %d)" |
| 14090 | (nth 1 tmp-entry) (nth 4 tmp-entry) |
| 14091 | (nth 2 tmp-entry) (nth 3 tmp-entry))) |
| 14092 | (setq tmp-list (cdr tmp-list))) |
| 14093 | ;; check whether each package body has a package declaration |
| 14094 | (setq tmp-list pack-alist) |
| 14095 | (while tmp-list |
| 14096 | (when (null (nth 2 (car tmp-list))) |
| 14097 | (setq tmp-entry (car tmp-list)) |
| 14098 | (vhdl-warning-when-idle |
| 14099 | "Package body of non-existing package: \"%s\"\n in \"%s\" (line %d)" |
| 14100 | (nth 1 tmp-entry) (nth 7 tmp-entry) (nth 8 tmp-entry))) |
| 14101 | (setq tmp-list (cdr tmp-list))) |
| 14102 | ;; sort lists |
| 14103 | (setq ent-alist (vhdl-sort-alist ent-alist)) |
| 14104 | (setq conf-alist (vhdl-sort-alist conf-alist)) |
| 14105 | (setq pack-alist (vhdl-sort-alist pack-alist)) |
| 14106 | ;; remember updated directory/project |
| 14107 | (add-to-list 'vhdl-updated-project-list (or project dir-name))) |
| 14108 | ;; clear directory alists |
| 14109 | (unless project |
| 14110 | (vhdl-adelete 'vhdl-entity-alist key) |
| 14111 | (vhdl-adelete 'vhdl-config-alist key) |
| 14112 | (vhdl-adelete 'vhdl-package-alist key) |
| 14113 | (vhdl-adelete 'vhdl-ent-inst-alist key) |
| 14114 | (vhdl-adelete 'vhdl-file-alist key)) |
| 14115 | ;; put directory contents into cache |
| 14116 | (vhdl-aput 'vhdl-entity-alist key ent-alist) |
| 14117 | (vhdl-aput 'vhdl-config-alist key conf-alist) |
| 14118 | (vhdl-aput 'vhdl-package-alist key pack-alist) |
| 14119 | (vhdl-aput 'vhdl-ent-inst-alist key (list ent-inst-list)) |
| 14120 | (vhdl-aput 'vhdl-file-alist key file-alist) |
| 14121 | ;; final messages |
| 14122 | (message "Scanning %s %s\"%s\"...done" |
| 14123 | (if is-directory "directory" "files") (or num-string "") name) |
| 14124 | (unless project (message "Scanning directory...done")) |
| 14125 | (when big-files |
| 14126 | (vhdl-warning-when-idle "Scanning is incomplete.\n --> see user option `vhdl-speedbar-scan-limit'")) |
| 14127 | ;; save cache when scanned non-interactively |
| 14128 | (when (or (not project) (not non-final)) |
| 14129 | (when (and noninteractive vhdl-speedbar-save-cache) |
| 14130 | (vhdl-save-cache key))) |
| 14131 | t)) |
| 14132 | |
| 14133 | (defun vhdl-scan-project-contents (project) |
| 14134 | "Scan the contents of all VHDL files found in the directories and files |
| 14135 | of PROJECT." |
| 14136 | (let ((dir-list (or (nth 2 (vhdl-aget vhdl-project-alist project)) '(""))) |
| 14137 | (default-dir (vhdl-resolve-env-variable |
| 14138 | (nth 1 (vhdl-aget vhdl-project-alist project)))) |
| 14139 | (file-exclude-regexp |
| 14140 | (or (nth 3 (vhdl-aget vhdl-project-alist project)) "")) |
| 14141 | dir-list-tmp dir dir-name num-dir act-dir recursive) |
| 14142 | ;; clear project alists |
| 14143 | (vhdl-adelete 'vhdl-entity-alist project) |
| 14144 | (vhdl-adelete 'vhdl-config-alist project) |
| 14145 | (vhdl-adelete 'vhdl-package-alist project) |
| 14146 | (vhdl-adelete 'vhdl-ent-inst-alist project) |
| 14147 | (vhdl-adelete 'vhdl-file-alist project) |
| 14148 | ;; expand directory names by default-directory |
| 14149 | (message "Collecting source files...") |
| 14150 | (while dir-list |
| 14151 | (setq dir (vhdl-resolve-env-variable (car dir-list))) |
| 14152 | (string-match "\\(\\(-r \\)?\\)\\(.*\\)" dir) |
| 14153 | (setq recursive (match-string 1 dir) |
| 14154 | dir-name (match-string 3 dir)) |
| 14155 | (setq dir-list-tmp |
| 14156 | (cons (concat recursive |
| 14157 | (if (file-name-absolute-p dir-name) "" default-dir) |
| 14158 | dir-name) |
| 14159 | dir-list-tmp)) |
| 14160 | (setq dir-list (cdr dir-list))) |
| 14161 | ;; resolve path wildcards |
| 14162 | (setq dir-list-tmp (vhdl-resolve-paths dir-list-tmp)) |
| 14163 | ;; expand directories |
| 14164 | (while dir-list-tmp |
| 14165 | (setq dir (car dir-list-tmp)) |
| 14166 | ;; get subdirectories |
| 14167 | (if (string-match "-r \\(.*[/\\]\\)" dir) |
| 14168 | (setq dir-list (append dir-list (vhdl-get-subdirs |
| 14169 | (match-string 1 dir)))) |
| 14170 | (setq dir-list (append dir-list (list dir)))) |
| 14171 | (setq dir-list-tmp (cdr dir-list-tmp))) |
| 14172 | ;; exclude files |
| 14173 | (unless (equal file-exclude-regexp "") |
| 14174 | (let ((case-fold-search nil)) |
| 14175 | (while dir-list |
| 14176 | (unless (string-match file-exclude-regexp (car dir-list)) |
| 14177 | (push (car dir-list) dir-list-tmp)) |
| 14178 | (setq dir-list (cdr dir-list))) |
| 14179 | (setq dir-list (nreverse dir-list-tmp)))) |
| 14180 | (message "Collecting source files...done") |
| 14181 | ;; scan for design units for each directory in DIR-LIST |
| 14182 | (setq dir-list-tmp nil |
| 14183 | num-dir (length dir-list) |
| 14184 | act-dir 1) |
| 14185 | (while dir-list |
| 14186 | (setq dir-name (abbreviate-file-name |
| 14187 | (expand-file-name (car dir-list)))) |
| 14188 | (vhdl-scan-directory-contents dir-name project nil |
| 14189 | (format "(%s/%s) " act-dir num-dir) |
| 14190 | (cdr dir-list)) |
| 14191 | (add-to-list 'dir-list-tmp (file-name-directory dir-name)) |
| 14192 | (setq dir-list (cdr dir-list) |
| 14193 | act-dir (1+ act-dir))) |
| 14194 | (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) |
| 14195 | (message "Scanning project \"%s\"...done" project))) |
| 14196 | |
| 14197 | (defun vhdl-update-file-contents (file-name) |
| 14198 | "Update hierarchy information by contents of current buffer." |
| 14199 | (setq file-name (abbreviate-file-name file-name)) |
| 14200 | (let* ((dir-name (file-name-directory file-name)) |
| 14201 | (directory-alist vhdl-directory-alist) |
| 14202 | updated) |
| 14203 | (while directory-alist |
| 14204 | (when (member dir-name (nth 1 (car directory-alist))) |
| 14205 | (let* ((vhdl-project (nth 0 (car directory-alist))) |
| 14206 | (project (vhdl-project-p)) |
| 14207 | (ent-alist (vhdl-aget vhdl-entity-alist |
| 14208 | (or project dir-name) t)) |
| 14209 | (conf-alist (vhdl-aget vhdl-config-alist |
| 14210 | (or project dir-name) t)) |
| 14211 | (pack-alist (vhdl-aget vhdl-package-alist |
| 14212 | (or project dir-name) t)) |
| 14213 | (ent-inst-list (car (vhdl-aget vhdl-ent-inst-alist |
| 14214 | (or project dir-name) t))) |
| 14215 | (file-alist (vhdl-aget vhdl-file-alist (or project dir-name) t)) |
| 14216 | (file-entry (vhdl-aget file-alist file-name t)) |
| 14217 | (ent-list (nth 0 file-entry)) |
| 14218 | (arch-list (nth 1 file-entry)) |
| 14219 | (arch-ent-list (nth 2 file-entry)) |
| 14220 | (conf-list (nth 3 file-entry)) |
| 14221 | (pack-list (nth 4 file-entry)) |
| 14222 | (pack-body-list (nth 5 file-entry)) |
| 14223 | (inst-ent-list (nth 7 file-entry)) |
| 14224 | (cache-key (or project dir-name)) |
| 14225 | arch-alist key ent-key entry) |
| 14226 | ;; delete design units previously contained in this file: |
| 14227 | ;; entities |
| 14228 | (while ent-list |
| 14229 | (setq key (car ent-list) |
| 14230 | entry (vhdl-aget ent-alist key t)) |
| 14231 | (when (equal file-name (nth 1 entry)) |
| 14232 | (if (nth 3 entry) |
| 14233 | (vhdl-aput 'ent-alist key |
| 14234 | (list (nth 0 entry) nil nil (nth 3 entry) nil)) |
| 14235 | (vhdl-adelete 'ent-alist key))) |
| 14236 | (setq ent-list (cdr ent-list))) |
| 14237 | ;; architectures |
| 14238 | (while arch-list |
| 14239 | (setq key (car arch-list) |
| 14240 | ent-key (car arch-ent-list) |
| 14241 | entry (vhdl-aget ent-alist ent-key t) |
| 14242 | arch-alist (nth 3 entry)) |
| 14243 | (when (equal file-name (nth 1 (vhdl-aget arch-alist key t))) |
| 14244 | (vhdl-adelete 'arch-alist key) |
| 14245 | (if (or (nth 1 entry) arch-alist) |
| 14246 | (vhdl-aput 'ent-alist ent-key |
| 14247 | (list (nth 0 entry) (nth 1 entry) (nth 2 entry) |
| 14248 | arch-alist (nth 4 entry) (nth 5 entry))) |
| 14249 | (vhdl-adelete 'ent-alist ent-key))) |
| 14250 | (setq arch-list (cdr arch-list) |
| 14251 | arch-ent-list (cdr arch-ent-list))) |
| 14252 | ;; configurations |
| 14253 | (while conf-list |
| 14254 | (setq key (car conf-list)) |
| 14255 | (when (equal file-name (nth 1 (vhdl-aget conf-alist key t))) |
| 14256 | (vhdl-adelete 'conf-alist key)) |
| 14257 | (setq conf-list (cdr conf-list))) |
| 14258 | ;; package declarations |
| 14259 | (while pack-list |
| 14260 | (setq key (car pack-list) |
| 14261 | entry (vhdl-aget pack-alist key t)) |
| 14262 | (when (equal file-name (nth 1 entry)) |
| 14263 | (if (nth 6 entry) |
| 14264 | (vhdl-aput 'pack-alist key |
| 14265 | (list (nth 0 entry) nil nil nil nil nil |
| 14266 | (nth 6 entry) (nth 7 entry) (nth 8 entry) |
| 14267 | (nth 9 entry))) |
| 14268 | (vhdl-adelete 'pack-alist key))) |
| 14269 | (setq pack-list (cdr pack-list))) |
| 14270 | ;; package bodies |
| 14271 | (while pack-body-list |
| 14272 | (setq key (car pack-body-list) |
| 14273 | entry (vhdl-aget pack-alist key t)) |
| 14274 | (when (equal file-name (nth 6 entry)) |
| 14275 | (if (nth 1 entry) |
| 14276 | (vhdl-aput 'pack-alist key |
| 14277 | (list (nth 0 entry) (nth 1 entry) (nth 2 entry) |
| 14278 | (nth 3 entry) (nth 4 entry) (nth 5 entry) |
| 14279 | nil nil nil nil)) |
| 14280 | (vhdl-adelete 'pack-alist key))) |
| 14281 | (setq pack-body-list (cdr pack-body-list))) |
| 14282 | ;; instantiated entities |
| 14283 | (while inst-ent-list |
| 14284 | (setq ent-inst-list |
| 14285 | (vhdl-delete (car inst-ent-list) ent-inst-list)) |
| 14286 | (setq inst-ent-list (cdr inst-ent-list))) |
| 14287 | ;; update caches |
| 14288 | (vhdl-aput-delete-if-nil 'vhdl-entity-alist cache-key ent-alist) |
| 14289 | (vhdl-aput-delete-if-nil 'vhdl-config-alist cache-key conf-alist) |
| 14290 | (vhdl-aput-delete-if-nil 'vhdl-package-alist cache-key pack-alist) |
| 14291 | (vhdl-aput-delete-if-nil 'vhdl-ent-inst-alist cache-key (list ent-inst-list)) |
| 14292 | ;; scan file |
| 14293 | (vhdl-scan-directory-contents file-name project t) |
| 14294 | (when (or (and vhdl-speedbar-show-projects project) |
| 14295 | (and (not vhdl-speedbar-show-projects) (not project))) |
| 14296 | (vhdl-speedbar-refresh project)) |
| 14297 | (setq updated t))) |
| 14298 | (setq directory-alist (cdr directory-alist))) |
| 14299 | updated)) |
| 14300 | |
| 14301 | (defun vhdl-update-hierarchy () |
| 14302 | "Update directory and hierarchy information in speedbar." |
| 14303 | (let ((file-list (reverse vhdl-modified-file-list)) |
| 14304 | updated) |
| 14305 | (when (and vhdl-speedbar-update-on-saving file-list) |
| 14306 | (while file-list |
| 14307 | (setq updated |
| 14308 | (or (vhdl-update-file-contents (car file-list)) |
| 14309 | updated)) |
| 14310 | (setq file-list (cdr file-list))) |
| 14311 | (setq vhdl-modified-file-list nil) |
| 14312 | (vhdl-speedbar-update-current-unit) |
| 14313 | (when updated (message "Updating hierarchy...done"))))) |
| 14314 | |
| 14315 | ;; structure (parenthesized expression means list of such entries) |
| 14316 | ;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker |
| 14317 | ;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker |
| 14318 | ;; comp-lib-name level) |
| 14319 | (defun vhdl-get-hierarchy (ent-alist conf-alist ent-key arch-key conf-key |
| 14320 | conf-inst-alist level indent |
| 14321 | &optional include-top ent-hier) |
| 14322 | "Get instantiation hierarchy beginning in architecture ARCH-KEY of |
| 14323 | entity ENT-KEY." |
| 14324 | (let* ((ent-entry (vhdl-aget ent-alist ent-key t)) |
| 14325 | (arch-entry (if arch-key (vhdl-aget (nth 3 ent-entry) arch-key t) |
| 14326 | (cdar (last (nth 3 ent-entry))))) |
| 14327 | (inst-alist (nth 3 arch-entry)) |
| 14328 | inst-entry inst-ent-entry inst-arch-entry inst-conf-entry comp-entry |
| 14329 | hier-list subcomp-list tmp-list inst-key inst-comp-name |
| 14330 | inst-ent-key inst-arch-key inst-conf-key inst-lib-key) |
| 14331 | (when (= level 0) (message "Extract design hierarchy...")) |
| 14332 | (when include-top |
| 14333 | (setq level (1+ level))) |
| 14334 | (when (member ent-key ent-hier) |
| 14335 | (error "ERROR: Instantiation loop detected, component instantiates itself: \"%s\"" ent-key)) |
| 14336 | ;; process all instances |
| 14337 | (while inst-alist |
| 14338 | (setq inst-entry (car inst-alist) |
| 14339 | inst-key (nth 0 inst-entry) |
| 14340 | inst-comp-name (nth 4 inst-entry) |
| 14341 | inst-conf-key (nth 7 inst-entry)) |
| 14342 | ;; search entry in configuration's instantiations list |
| 14343 | (setq tmp-list conf-inst-alist) |
| 14344 | (while (and tmp-list |
| 14345 | (not (and (member (nth 0 (car tmp-list)) |
| 14346 | (list "all" inst-key)) |
| 14347 | (equal (nth 1 (car tmp-list)) |
| 14348 | (downcase (or inst-comp-name "")))))) |
| 14349 | (setq tmp-list (cdr tmp-list))) |
| 14350 | (setq inst-conf-key (or (nth 4 (car tmp-list)) inst-conf-key)) |
| 14351 | (setq inst-conf-entry (vhdl-aget conf-alist inst-conf-key t)) |
| 14352 | (when (and inst-conf-key (not inst-conf-entry)) |
| 14353 | (vhdl-warning-when-idle "Configuration not found: \"%s\"" inst-conf-key)) |
| 14354 | ;; determine entity |
| 14355 | (setq inst-ent-key |
| 14356 | (or (nth 2 (car tmp-list)) ; from configuration |
| 14357 | (nth 3 inst-conf-entry) ; from subconfiguration |
| 14358 | (nth 3 (vhdl-aget conf-alist (nth 7 inst-entry) t)) |
| 14359 | ; from configuration spec. |
| 14360 | (nth 5 inst-entry))) ; from direct instantiation |
| 14361 | (setq inst-ent-entry (vhdl-aget ent-alist inst-ent-key t)) |
| 14362 | ;; determine architecture |
| 14363 | (setq inst-arch-key |
| 14364 | (or (nth 3 (car tmp-list)) ; from configuration |
| 14365 | (nth 4 inst-conf-entry) ; from subconfiguration |
| 14366 | (nth 6 inst-entry) ; from direct instantiation |
| 14367 | (nth 4 (vhdl-aget conf-alist (nth 7 inst-entry))) |
| 14368 | ; from configuration spec. |
| 14369 | (nth 4 inst-ent-entry) ; MRA |
| 14370 | (caar (nth 3 inst-ent-entry)))) ; first alphabetically |
| 14371 | (setq inst-arch-entry (vhdl-aget (nth 3 inst-ent-entry) inst-arch-key t)) |
| 14372 | ;; set library |
| 14373 | (setq inst-lib-key |
| 14374 | (or (nth 5 (car tmp-list)) ; from configuration |
| 14375 | (nth 8 inst-entry))) ; from direct instantiation |
| 14376 | ;; gather information for this instance |
| 14377 | (setq comp-entry |
| 14378 | (list (nth 1 inst-entry) |
| 14379 | (cons (nth 2 inst-entry) (nth 3 inst-entry)) |
| 14380 | (or (nth 0 inst-ent-entry) (nth 4 inst-entry)) |
| 14381 | (cons (nth 1 inst-ent-entry) (nth 2 inst-ent-entry)) |
| 14382 | (or (nth 0 inst-arch-entry) inst-arch-key) |
| 14383 | (cons (nth 1 inst-arch-entry) (nth 2 inst-arch-entry)) |
| 14384 | (or (nth 0 inst-conf-entry) inst-conf-key) |
| 14385 | (cons (nth 1 inst-conf-entry) (nth 2 inst-conf-entry)) |
| 14386 | inst-lib-key level)) |
| 14387 | ;; get subcomponent hierarchy |
| 14388 | (setq subcomp-list (vhdl-get-hierarchy |
| 14389 | ent-alist conf-alist |
| 14390 | inst-ent-key inst-arch-key inst-conf-key |
| 14391 | (nth 5 inst-conf-entry) |
| 14392 | (1+ level) indent nil (cons ent-key ent-hier))) |
| 14393 | ;; add to list |
| 14394 | (setq hier-list (append hier-list (list comp-entry) subcomp-list)) |
| 14395 | (setq inst-alist (cdr inst-alist))) |
| 14396 | (when include-top |
| 14397 | (setq hier-list |
| 14398 | (cons (list nil nil (nth 0 ent-entry) |
| 14399 | (cons (nth 1 ent-entry) (nth 2 ent-entry)) |
| 14400 | (nth 0 arch-entry) |
| 14401 | (cons (nth 1 arch-entry) (nth 2 arch-entry)) |
| 14402 | nil nil |
| 14403 | nil (1- level)) |
| 14404 | hier-list))) |
| 14405 | (when (or (= level 0) (and include-top (= level 1))) (message "")) |
| 14406 | hier-list)) |
| 14407 | |
| 14408 | (defun vhdl-get-instantiations (ent-key indent) |
| 14409 | "Get all instantiations of entity ENT-KEY." |
| 14410 | (let ((ent-alist (vhdl-aget vhdl-entity-alist |
| 14411 | (vhdl-speedbar-line-key indent) t)) |
| 14412 | arch-alist inst-alist ent-inst-list |
| 14413 | ent-entry arch-entry inst-entry) |
| 14414 | (while ent-alist |
| 14415 | (setq ent-entry (car ent-alist)) |
| 14416 | (setq arch-alist (nth 4 ent-entry)) |
| 14417 | (while arch-alist |
| 14418 | (setq arch-entry (car arch-alist)) |
| 14419 | (setq inst-alist (nth 4 arch-entry)) |
| 14420 | (while inst-alist |
| 14421 | (setq inst-entry (car inst-alist)) |
| 14422 | (when (equal ent-key (nth 5 inst-entry)) |
| 14423 | (setq ent-inst-list |
| 14424 | (cons (list (nth 1 inst-entry) |
| 14425 | (cons (nth 2 inst-entry) (nth 3 inst-entry)) |
| 14426 | (nth 1 ent-entry) |
| 14427 | (cons (nth 2 ent-entry) (nth 3 ent-entry)) |
| 14428 | (nth 1 arch-entry) |
| 14429 | (cons (nth 2 arch-entry) (nth 3 arch-entry))) |
| 14430 | ent-inst-list))) |
| 14431 | (setq inst-alist (cdr inst-alist))) |
| 14432 | (setq arch-alist (cdr arch-alist))) |
| 14433 | (setq ent-alist (cdr ent-alist))) |
| 14434 | (nreverse ent-inst-list))) |
| 14435 | |
| 14436 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 14437 | ;; Caching in file |
| 14438 | |
| 14439 | (defun vhdl-save-caches () |
| 14440 | "Save all updated hierarchy caches to file." |
| 14441 | (interactive) |
| 14442 | (condition-case nil |
| 14443 | (when vhdl-speedbar-save-cache |
| 14444 | ;; update hierarchy |
| 14445 | (vhdl-update-hierarchy) |
| 14446 | (let ((project-list vhdl-updated-project-list)) |
| 14447 | (message "Saving hierarchy caches...") |
| 14448 | ;; write updated project caches |
| 14449 | (while project-list |
| 14450 | (vhdl-save-cache (car project-list)) |
| 14451 | (setq project-list (cdr project-list))) |
| 14452 | (message "Saving hierarchy caches...done"))) |
| 14453 | (error (progn (vhdl-warning "ERROR: An error occurred while saving the hierarchy caches") |
| 14454 | (sit-for 2))))) |
| 14455 | |
| 14456 | (defun vhdl-save-cache (key) |
| 14457 | "Save current hierarchy cache to file." |
| 14458 | (let* ((orig-buffer (current-buffer)) |
| 14459 | (vhdl-project key) |
| 14460 | (project (vhdl-project-p)) |
| 14461 | (default-directory key) |
| 14462 | (directory (abbreviate-file-name (vhdl-default-directory))) |
| 14463 | (file-name (vhdl-resolve-env-variable |
| 14464 | (vhdl-replace-string |
| 14465 | (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) |
| 14466 | (concat |
| 14467 | (subst-char-in-string ? ?_ (or project "dir")) |
| 14468 | " " (user-login-name))))) |
| 14469 | (file-dir-name (expand-file-name file-name directory)) |
| 14470 | (cache-key (or project directory)) |
| 14471 | (key (if project "project" "directory"))) |
| 14472 | (unless (file-exists-p (file-name-directory file-dir-name)) |
| 14473 | (make-directory (file-name-directory file-dir-name) t)) |
| 14474 | (if (not (file-writable-p file-dir-name)) |
| 14475 | (progn (vhdl-warning (format "File not writable: \"%s\"" |
| 14476 | (abbreviate-file-name file-dir-name))) |
| 14477 | (sit-for 2)) |
| 14478 | (message "Saving cache: \"%s\"" file-dir-name) |
| 14479 | (set-buffer (find-file-noselect file-dir-name t t)) |
| 14480 | (erase-buffer) |
| 14481 | (insert ";; -*- Emacs-Lisp -*-\n\n" |
| 14482 | ";;; " (file-name-nondirectory file-name) |
| 14483 | " - design hierarchy cache file for Emacs VHDL Mode " |
| 14484 | vhdl-version "\n") |
| 14485 | (insert "\n;; " (if project "Project " "Directory") " : ") |
| 14486 | (if project (insert project) (prin1 directory (current-buffer))) |
| 14487 | (insert "\n;; Saved : " (format-time-string "%Y-%m-%d %T ") |
| 14488 | (user-login-name) "\n\n" |
| 14489 | "\n;; version number\n" |
| 14490 | "(setq vhdl-cache-version \"" vhdl-version "\")\n" |
| 14491 | "\n;; " (if project "project" "directory") " name" |
| 14492 | "\n(setq " key " ") |
| 14493 | (prin1 (or project directory) (current-buffer)) |
| 14494 | (insert ")\n") |
| 14495 | (when (member 'hierarchy vhdl-speedbar-save-cache) |
| 14496 | (insert "\n;; entity and architecture cache\n" |
| 14497 | "(vhdl-aput 'vhdl-entity-alist " key " '") |
| 14498 | (print (vhdl-aget vhdl-entity-alist cache-key t) (current-buffer)) |
| 14499 | (insert ")\n\n;; configuration cache\n" |
| 14500 | "(vhdl-aput 'vhdl-config-alist " key " '") |
| 14501 | (print (vhdl-aget vhdl-config-alist cache-key t) (current-buffer)) |
| 14502 | (insert ")\n\n;; package cache\n" |
| 14503 | "(vhdl-aput 'vhdl-package-alist " key " '") |
| 14504 | (print (vhdl-aget vhdl-package-alist cache-key t) (current-buffer)) |
| 14505 | (insert ")\n\n;; instantiated entities cache\n" |
| 14506 | "(vhdl-aput 'vhdl-ent-inst-alist " key " '") |
| 14507 | (print (vhdl-aget vhdl-ent-inst-alist cache-key t) (current-buffer)) |
| 14508 | (insert ")\n\n;; design units per file cache\n" |
| 14509 | "(vhdl-aput 'vhdl-file-alist " key " '") |
| 14510 | (print (vhdl-aget vhdl-file-alist cache-key t) (current-buffer)) |
| 14511 | (when project |
| 14512 | (insert ")\n\n;; source directories in project cache\n" |
| 14513 | "(vhdl-aput 'vhdl-directory-alist " key " '") |
| 14514 | (print (vhdl-aget vhdl-directory-alist cache-key t) (current-buffer))) |
| 14515 | (insert ")\n")) |
| 14516 | (when (member 'display vhdl-speedbar-save-cache) |
| 14517 | (insert "\n;; shown design units cache\n" |
| 14518 | "(vhdl-aput 'vhdl-speedbar-shown-unit-alist " key " '") |
| 14519 | (print (vhdl-aget vhdl-speedbar-shown-unit-alist cache-key t) |
| 14520 | (current-buffer)) |
| 14521 | (insert ")\n")) |
| 14522 | (setq vhdl-updated-project-list |
| 14523 | (delete cache-key vhdl-updated-project-list)) |
| 14524 | (save-buffer) |
| 14525 | (kill-buffer (current-buffer)) |
| 14526 | (set-buffer orig-buffer)))) |
| 14527 | |
| 14528 | (defun vhdl-load-cache (key) |
| 14529 | "Load hierarchy cache information from file." |
| 14530 | (let* ((vhdl-project key) |
| 14531 | (default-directory key) |
| 14532 | (directory (vhdl-default-directory)) |
| 14533 | (file-name (vhdl-resolve-env-variable |
| 14534 | (vhdl-replace-string |
| 14535 | (cons "\\(.*\\) \\(.*\\)" vhdl-speedbar-cache-file-name) |
| 14536 | (concat |
| 14537 | (subst-char-in-string ? ?_ (or (vhdl-project-p) "dir")) |
| 14538 | " " (user-login-name))))) |
| 14539 | (file-dir-name (expand-file-name file-name directory)) |
| 14540 | vhdl-cache-version) |
| 14541 | (unless (memq 'vhdl-save-caches kill-emacs-hook) |
| 14542 | (add-hook 'kill-emacs-hook 'vhdl-save-caches)) |
| 14543 | (when (file-exists-p file-dir-name) |
| 14544 | (condition-case () |
| 14545 | (progn (load-file file-dir-name) |
| 14546 | (string< (mapconcat |
| 14547 | (lambda (a) (format "%3d" (string-to-number a))) |
| 14548 | (split-string "3.33" "\\.") "") |
| 14549 | (mapconcat |
| 14550 | (lambda (a) (format "%3d" (string-to-number a))) |
| 14551 | (split-string vhdl-cache-version "\\.") ""))) |
| 14552 | (error (progn (vhdl-warning (format "ERROR: Corrupted cache file: \"%s\"" file-dir-name)) |
| 14553 | nil)))))) |
| 14554 | |
| 14555 | (defun vhdl-require-hierarchy-info () |
| 14556 | "Make sure that hierarchy information is available. Load cache or scan files |
| 14557 | if required." |
| 14558 | (if (vhdl-project-p) |
| 14559 | (unless (or (assoc vhdl-project vhdl-file-alist) |
| 14560 | (vhdl-load-cache vhdl-project)) |
| 14561 | (vhdl-scan-project-contents vhdl-project)) |
| 14562 | (let ((directory (abbreviate-file-name default-directory))) |
| 14563 | (unless (or (assoc directory vhdl-file-alist) |
| 14564 | (vhdl-load-cache directory)) |
| 14565 | (vhdl-scan-directory-contents directory))))) |
| 14566 | |
| 14567 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 14568 | ;; Add hierarchy browser functionality to speedbar |
| 14569 | |
| 14570 | (defvar vhdl-speedbar-mode-map nil |
| 14571 | "Keymap used when in the VHDL hierarchy browser mode.") |
| 14572 | |
| 14573 | (defvar vhdl-speedbar-menu-items nil |
| 14574 | "Additional menu-items to add to speedbar frame.") |
| 14575 | |
| 14576 | (declare-function speedbar-add-supported-extension "speedbar" (extension)) |
| 14577 | (declare-function speedbar-add-mode-functions-list "speedbar" (new-list)) |
| 14578 | (declare-function speedbar-make-specialized-keymap "speedbar" ()) |
| 14579 | (declare-function speedbar-change-initial-expansion-list "speedbar" |
| 14580 | (new-default)) |
| 14581 | (declare-function speedbar-add-expansion-list "speedbar" (new-list)) |
| 14582 | |
| 14583 | (defun vhdl-speedbar-initialize () |
| 14584 | "Initialize speedbar." |
| 14585 | ;; general settings |
| 14586 | ;; VHDL file extensions (extracted from `auto-mode-alist') |
| 14587 | (let ((mode-alist auto-mode-alist)) |
| 14588 | (while mode-alist |
| 14589 | (when (eq (cdar mode-alist) 'vhdl-mode) |
| 14590 | (speedbar-add-supported-extension (caar mode-alist))) |
| 14591 | (setq mode-alist (cdr mode-alist)))) |
| 14592 | ;; hierarchy browser settings |
| 14593 | (when (boundp 'speedbar-mode-functions-list) |
| 14594 | ;; special functions |
| 14595 | (speedbar-add-mode-functions-list |
| 14596 | '("vhdl directory" |
| 14597 | (speedbar-item-info . vhdl-speedbar-item-info) |
| 14598 | (speedbar-line-directory . speedbar-files-line-path))) |
| 14599 | (speedbar-add-mode-functions-list |
| 14600 | '("vhdl project" |
| 14601 | (speedbar-item-info . vhdl-speedbar-item-info) |
| 14602 | (speedbar-line-directory . vhdl-speedbar-line-project))) |
| 14603 | ;; keymap |
| 14604 | (unless vhdl-speedbar-mode-map |
| 14605 | (setq vhdl-speedbar-mode-map (speedbar-make-specialized-keymap)) |
| 14606 | (define-key vhdl-speedbar-mode-map "e" 'speedbar-edit-line) |
| 14607 | (define-key vhdl-speedbar-mode-map "\C-m" 'speedbar-edit-line) |
| 14608 | (define-key vhdl-speedbar-mode-map "+" 'speedbar-expand-line) |
| 14609 | (define-key vhdl-speedbar-mode-map "=" 'speedbar-expand-line) |
| 14610 | (define-key vhdl-speedbar-mode-map "-" 'vhdl-speedbar-contract-level) |
| 14611 | (define-key vhdl-speedbar-mode-map "_" 'vhdl-speedbar-contract-all) |
| 14612 | (define-key vhdl-speedbar-mode-map "C" 'vhdl-speedbar-port-copy) |
| 14613 | (define-key vhdl-speedbar-mode-map "P" 'vhdl-speedbar-place-component) |
| 14614 | (define-key vhdl-speedbar-mode-map "F" 'vhdl-speedbar-configuration) |
| 14615 | (define-key vhdl-speedbar-mode-map "A" 'vhdl-speedbar-select-mra) |
| 14616 | (define-key vhdl-speedbar-mode-map "K" 'vhdl-speedbar-make-design) |
| 14617 | (define-key vhdl-speedbar-mode-map "R" 'vhdl-speedbar-rescan-hierarchy) |
| 14618 | (define-key vhdl-speedbar-mode-map "S" 'vhdl-save-caches) |
| 14619 | (let ((key 0)) |
| 14620 | (while (<= key 9) |
| 14621 | (define-key vhdl-speedbar-mode-map (int-to-string key) |
| 14622 | `(lambda () (interactive) (vhdl-speedbar-set-depth ,key))) |
| 14623 | (setq key (1+ key))))) |
| 14624 | (define-key speedbar-mode-map "h" |
| 14625 | (lambda () (interactive) |
| 14626 | (speedbar-change-initial-expansion-list "vhdl directory"))) |
| 14627 | (define-key speedbar-mode-map "H" |
| 14628 | (lambda () (interactive) |
| 14629 | (speedbar-change-initial-expansion-list "vhdl project"))) |
| 14630 | ;; menu |
| 14631 | (unless vhdl-speedbar-menu-items |
| 14632 | (setq |
| 14633 | vhdl-speedbar-menu-items |
| 14634 | `(["Edit" speedbar-edit-line t] |
| 14635 | ["Expand" speedbar-expand-line |
| 14636 | (save-excursion (beginning-of-line) (looking-at "[0-9]+: *.\\+. "))] |
| 14637 | ["Contract" vhdl-speedbar-contract-level t] |
| 14638 | ["Expand All" vhdl-speedbar-expand-all t] |
| 14639 | ["Contract All" vhdl-speedbar-contract-all t] |
| 14640 | ,(let ((key 0) (menu-list '("Hierarchy Depth"))) |
| 14641 | (while (<= key 9) |
| 14642 | (setq menu-list |
| 14643 | (cons `[,(if (= key 0) "All" (int-to-string key)) |
| 14644 | (vhdl-speedbar-set-depth ,key) |
| 14645 | :style radio |
| 14646 | :selected (= vhdl-speedbar-hierarchy-depth ,key) |
| 14647 | :keys ,(int-to-string key)] |
| 14648 | menu-list)) |
| 14649 | (setq key (1+ key))) |
| 14650 | (nreverse menu-list)) |
| 14651 | "--" |
| 14652 | ["Copy Port/Subprogram" vhdl-speedbar-port-copy |
| 14653 | (or (vhdl-speedbar-check-unit 'entity) |
| 14654 | (vhdl-speedbar-check-unit 'subprogram))] |
| 14655 | ["Place Component" vhdl-speedbar-place-component |
| 14656 | (vhdl-speedbar-check-unit 'entity)] |
| 14657 | ["Generate Configuration" vhdl-speedbar-configuration |
| 14658 | (vhdl-speedbar-check-unit 'architecture)] |
| 14659 | ["Select as MRA" vhdl-speedbar-select-mra |
| 14660 | (vhdl-speedbar-check-unit 'architecture)] |
| 14661 | ["Make" vhdl-speedbar-make-design |
| 14662 | (save-excursion (beginning-of-line) (looking-at "[0-9]+: *[[<]"))] |
| 14663 | ["Generate Makefile" vhdl-speedbar-generate-makefile |
| 14664 | (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))] |
| 14665 | ["Rescan Directory" vhdl-speedbar-rescan-hierarchy |
| 14666 | :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) |
| 14667 | ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)] |
| 14668 | ["Rescan Project" vhdl-speedbar-rescan-hierarchy |
| 14669 | :active (save-excursion (beginning-of-line) (looking-at "[0-9]+:")) |
| 14670 | ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects] |
| 14671 | ["Save Caches" vhdl-save-caches vhdl-updated-project-list]))) |
| 14672 | ;; hook-ups |
| 14673 | (speedbar-add-expansion-list |
| 14674 | '("vhdl directory" vhdl-speedbar-menu-items vhdl-speedbar-mode-map |
| 14675 | vhdl-speedbar-display-directory)) |
| 14676 | (speedbar-add-expansion-list |
| 14677 | '("vhdl project" vhdl-speedbar-menu-items vhdl-speedbar-mode-map |
| 14678 | vhdl-speedbar-display-projects)) |
| 14679 | (setq speedbar-stealthy-function-list |
| 14680 | (append |
| 14681 | '(("vhdl directory" vhdl-speedbar-update-current-unit) |
| 14682 | ("vhdl project" vhdl-speedbar-update-current-project |
| 14683 | vhdl-speedbar-update-current-unit)) |
| 14684 | speedbar-stealthy-function-list)) |
| 14685 | (when (eq vhdl-speedbar-display-mode 'directory) |
| 14686 | (setq speedbar-initial-expansion-list-name "vhdl directory")) |
| 14687 | (when (eq vhdl-speedbar-display-mode 'project) |
| 14688 | (setq speedbar-initial-expansion-list-name "vhdl project")) |
| 14689 | (add-hook 'speedbar-timer-hook 'vhdl-update-hierarchy))) |
| 14690 | |
| 14691 | (defun vhdl-speedbar (&optional arg) |
| 14692 | "Open/close speedbar." |
| 14693 | (interactive) |
| 14694 | (if (not (fboundp 'speedbar)) |
| 14695 | (error "WARNING: Speedbar is not available or not installed") |
| 14696 | (condition-case () |
| 14697 | (speedbar-frame-mode arg) |
| 14698 | (error (error "WARNING: An error occurred while opening speedbar"))))) |
| 14699 | |
| 14700 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 14701 | ;; Display functions |
| 14702 | |
| 14703 | (defvar vhdl-speedbar-last-selected-project nil |
| 14704 | "Name of last selected project.") |
| 14705 | |
| 14706 | ;; macros must be defined in the file they are used (copied from `speedbar.el') |
| 14707 | ;;; (defmacro speedbar-with-writable (&rest forms) |
| 14708 | ;;; "Allow the buffer to be writable and evaluate FORMS." |
| 14709 | ;;; (list 'let '((inhibit-read-only t)) |
| 14710 | ;;; (cons 'progn forms))) |
| 14711 | ;;; (put 'speedbar-with-writable 'lisp-indent-function 0) |
| 14712 | |
| 14713 | (declare-function speedbar-extension-list-to-regex "speedbar" (extlist)) |
| 14714 | (declare-function speedbar-directory-buttons "speedbar" (directory _index)) |
| 14715 | (declare-function speedbar-file-lists "speedbar" (directory)) |
| 14716 | |
| 14717 | (defun vhdl-speedbar-display-directory (directory depth &optional rescan) |
| 14718 | "Display directory and hierarchy information in speedbar." |
| 14719 | (setq vhdl-speedbar-show-projects nil) |
| 14720 | (setq speedbar-ignored-directory-regexp |
| 14721 | (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions)) |
| 14722 | (setq directory (abbreviate-file-name (file-name-as-directory directory))) |
| 14723 | (setq speedbar-last-selected-file nil) |
| 14724 | (speedbar-with-writable |
| 14725 | (condition-case nil |
| 14726 | (progn |
| 14727 | ;; insert directory path |
| 14728 | (speedbar-directory-buttons directory depth) |
| 14729 | ;; insert subdirectories |
| 14730 | (vhdl-speedbar-insert-dirs (speedbar-file-lists directory) depth) |
| 14731 | ;; scan and insert hierarchy of current directory |
| 14732 | (vhdl-speedbar-insert-dir-hierarchy directory depth |
| 14733 | speedbar-power-click) |
| 14734 | ;; expand subdirectories |
| 14735 | (when (= depth 0) (vhdl-speedbar-expand-dirs directory))) |
| 14736 | (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly"))))) |
| 14737 | |
| 14738 | (defun vhdl-speedbar-display-projects (project depth &optional rescan) |
| 14739 | "Display projects and hierarchy information in speedbar." |
| 14740 | (setq vhdl-speedbar-show-projects t) |
| 14741 | (setq speedbar-ignored-directory-regexp ".") |
| 14742 | (setq speedbar-last-selected-file nil) |
| 14743 | (setq vhdl-speedbar-last-selected-project nil) |
| 14744 | (speedbar-with-writable |
| 14745 | (condition-case nil |
| 14746 | ;; insert projects |
| 14747 | (vhdl-speedbar-insert-projects) |
| 14748 | (error (vhdl-warning-when-idle "ERROR: Invalid hierarchy information, unable to display correctly")))) |
| 14749 | (setq speedbar-full-text-cache nil)) ; prevent caching |
| 14750 | |
| 14751 | (declare-function speedbar-make-tag-line "speedbar" |
| 14752 | (type char func data tag tfunc tdata tface depth)) |
| 14753 | |
| 14754 | (defun vhdl-speedbar-insert-projects () |
| 14755 | "Insert all projects in speedbar." |
| 14756 | (vhdl-speedbar-make-title-line "Projects:") |
| 14757 | (let ((project-alist (if vhdl-project-sort |
| 14758 | (vhdl-sort-alist (copy-alist vhdl-project-alist)) |
| 14759 | vhdl-project-alist)) |
| 14760 | (vhdl-speedbar-update-current-unit nil)) |
| 14761 | ;; insert projects |
| 14762 | (while project-alist |
| 14763 | (speedbar-make-tag-line |
| 14764 | 'angle ?+ 'vhdl-speedbar-expand-project |
| 14765 | (caar project-alist) (caar project-alist) |
| 14766 | 'vhdl-toggle-project (caar project-alist) 'speedbar-directory-face 0) |
| 14767 | (setq project-alist (cdr project-alist))) |
| 14768 | (setq project-alist vhdl-project-alist) |
| 14769 | ;; expand projects |
| 14770 | (while project-alist |
| 14771 | (when (member (caar project-alist) vhdl-speedbar-shown-project-list) |
| 14772 | (goto-char (point-min)) |
| 14773 | (when (re-search-forward |
| 14774 | (concat "^\\([0-9]+:\\s-*<\\)[+]>\\s-+" (caar project-alist) "$") nil t) |
| 14775 | (goto-char (match-end 1)) |
| 14776 | (speedbar-do-function-pointer))) |
| 14777 | (setq project-alist (cdr project-alist))))) |
| 14778 | |
| 14779 | (defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan) |
| 14780 | "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil, |
| 14781 | otherwise use cached data." |
| 14782 | (when (or rescan (and (not (assoc project vhdl-file-alist)) |
| 14783 | (not (vhdl-load-cache project)))) |
| 14784 | (vhdl-scan-project-contents project)) |
| 14785 | ;; insert design hierarchy |
| 14786 | (vhdl-speedbar-insert-hierarchy |
| 14787 | (vhdl-aget vhdl-entity-alist project t) |
| 14788 | (vhdl-aget vhdl-config-alist project t) |
| 14789 | (vhdl-aget vhdl-package-alist project t) |
| 14790 | (car (vhdl-aget vhdl-ent-inst-alist project t)) indent) |
| 14791 | (insert (int-to-string indent) ":\n") |
| 14792 | (put-text-property (- (point) 3) (1- (point)) 'invisible t) |
| 14793 | (put-text-property (1- (point)) (point) 'invisible nil) |
| 14794 | ;; expand design units |
| 14795 | (vhdl-speedbar-expand-units project)) |
| 14796 | |
| 14797 | (defun vhdl-speedbar-insert-dir-hierarchy (directory depth &optional rescan) |
| 14798 | "Insert hierarchy of DIRECTORY. Rescan directory if RESCAN is non-nil, |
| 14799 | otherwise use cached data." |
| 14800 | (when (or rescan (and (not (assoc directory vhdl-file-alist)) |
| 14801 | (not (vhdl-load-cache directory)))) |
| 14802 | (vhdl-scan-directory-contents directory)) |
| 14803 | ;; insert design hierarchy |
| 14804 | (vhdl-speedbar-insert-hierarchy |
| 14805 | (vhdl-aget vhdl-entity-alist directory t) |
| 14806 | (vhdl-aget vhdl-config-alist directory t) |
| 14807 | (vhdl-aget vhdl-package-alist directory t) |
| 14808 | (car (vhdl-aget vhdl-ent-inst-alist directory t)) depth) |
| 14809 | ;; expand design units |
| 14810 | (vhdl-speedbar-expand-units directory) |
| 14811 | (vhdl-aput 'vhdl-directory-alist directory (list (list directory)))) |
| 14812 | |
| 14813 | (defun vhdl-speedbar-insert-hierarchy (ent-alist conf-alist pack-alist |
| 14814 | ent-inst-list depth) |
| 14815 | "Insert hierarchy of ENT-ALIST, CONF-ALIST, and PACK-ALIST." |
| 14816 | (if (not (or ent-alist conf-alist pack-alist)) |
| 14817 | (vhdl-speedbar-make-title-line "No VHDL design units!" depth) |
| 14818 | (let (ent-entry conf-entry pack-entry) |
| 14819 | ;; insert entities |
| 14820 | (when ent-alist (vhdl-speedbar-make-title-line "Entities:" depth)) |
| 14821 | (while ent-alist |
| 14822 | (setq ent-entry (car ent-alist)) |
| 14823 | (speedbar-make-tag-line |
| 14824 | 'bracket ?+ 'vhdl-speedbar-expand-entity (nth 0 ent-entry) |
| 14825 | (nth 1 ent-entry) 'vhdl-speedbar-find-file |
| 14826 | (cons (nth 2 ent-entry) (nth 3 ent-entry)) |
| 14827 | 'vhdl-speedbar-entity-face depth) |
| 14828 | (unless (nth 2 ent-entry) |
| 14829 | (end-of-line 0) (insert "!") (forward-char 1)) |
| 14830 | (unless (member (nth 0 ent-entry) ent-inst-list) |
| 14831 | (end-of-line 0) (insert " (top)") (forward-char 1)) |
| 14832 | (setq ent-alist (cdr ent-alist))) |
| 14833 | ;; insert configurations |
| 14834 | (when conf-alist (vhdl-speedbar-make-title-line "Configurations:" depth)) |
| 14835 | (while conf-alist |
| 14836 | (setq conf-entry (car conf-alist)) |
| 14837 | (speedbar-make-tag-line |
| 14838 | 'bracket ?+ 'vhdl-speedbar-expand-config (nth 0 conf-entry) |
| 14839 | (nth 1 conf-entry) 'vhdl-speedbar-find-file |
| 14840 | (cons (nth 2 conf-entry) (nth 3 conf-entry)) |
| 14841 | 'vhdl-speedbar-configuration-face depth) |
| 14842 | (setq conf-alist (cdr conf-alist))) |
| 14843 | ;; insert packages |
| 14844 | (when pack-alist (vhdl-speedbar-make-title-line "Packages:" depth)) |
| 14845 | (while pack-alist |
| 14846 | (setq pack-entry (car pack-alist)) |
| 14847 | (vhdl-speedbar-make-pack-line |
| 14848 | (nth 0 pack-entry) (nth 1 pack-entry) |
| 14849 | (cons (nth 2 pack-entry) (nth 3 pack-entry)) |
| 14850 | (cons (nth 7 pack-entry) (nth 8 pack-entry)) |
| 14851 | depth) |
| 14852 | (setq pack-alist (cdr pack-alist)))))) |
| 14853 | |
| 14854 | (declare-function speedbar-line-directory "speedbar" (&optional depth)) |
| 14855 | |
| 14856 | (defun vhdl-speedbar-rescan-hierarchy () |
| 14857 | "Rescan hierarchy for the directory or project under the cursor." |
| 14858 | (interactive) |
| 14859 | (let (key path) |
| 14860 | (cond |
| 14861 | ;; current project |
| 14862 | (vhdl-speedbar-show-projects |
| 14863 | (setq key (vhdl-speedbar-line-project)) |
| 14864 | (vhdl-scan-project-contents key)) |
| 14865 | ;; top-level directory |
| 14866 | ((save-excursion (beginning-of-line) (looking-at "[^0-9]")) |
| 14867 | (re-search-forward "[0-9]+:" nil t) |
| 14868 | (vhdl-scan-directory-contents |
| 14869 | (abbreviate-file-name (speedbar-line-directory)))) |
| 14870 | ;; current directory |
| 14871 | (t (setq path (speedbar-line-directory)) |
| 14872 | (string-match "^\\(.+[/\\]\\)" path) |
| 14873 | (vhdl-scan-directory-contents |
| 14874 | (abbreviate-file-name (match-string 1 path))))) |
| 14875 | (vhdl-speedbar-refresh key))) |
| 14876 | |
| 14877 | (declare-function speedbar-goto-this-file "speedbar" (file)) |
| 14878 | |
| 14879 | (defun vhdl-speedbar-expand-dirs (directory) |
| 14880 | "Expand subdirectories in DIRECTORY according to |
| 14881 | `speedbar-shown-directories'." |
| 14882 | ;; (nicked from `speedbar-default-directory-list') |
| 14883 | (let ((sf (cdr (reverse speedbar-shown-directories))) |
| 14884 | (vhdl-speedbar-update-current-unit nil)) |
| 14885 | (setq speedbar-shown-directories |
| 14886 | (list (expand-file-name default-directory))) |
| 14887 | (while sf |
| 14888 | (when (speedbar-goto-this-file (car sf)) |
| 14889 | (beginning-of-line) |
| 14890 | (when (looking-at "[0-9]+:\\s-*<") |
| 14891 | (goto-char (match-end 0)) |
| 14892 | (speedbar-do-function-pointer))) |
| 14893 | (setq sf (cdr sf)))) |
| 14894 | (vhdl-speedbar-update-current-unit nil t)) |
| 14895 | |
| 14896 | (defun vhdl-speedbar-expand-units (key) |
| 14897 | "Expand design units in directory/project KEY according to |
| 14898 | `vhdl-speedbar-shown-unit-alist'." |
| 14899 | (let ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) |
| 14900 | (vhdl-speedbar-update-current-unit nil) |
| 14901 | vhdl-updated-project-list) |
| 14902 | (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) |
| 14903 | (vhdl-prepare-search-1 |
| 14904 | (while unit-alist ; expand units |
| 14905 | (vhdl-speedbar-goto-this-unit key (caar unit-alist)) |
| 14906 | (beginning-of-line) |
| 14907 | (let ((arch-alist (nth 1 (car unit-alist))) |
| 14908 | position) |
| 14909 | (when (looking-at "^[0-9]+:\\s-*\\[") |
| 14910 | (goto-char (match-end 0)) |
| 14911 | (setq position (point)) |
| 14912 | (speedbar-do-function-pointer) |
| 14913 | (select-frame speedbar-frame) |
| 14914 | (while arch-alist ; expand architectures |
| 14915 | (goto-char position) |
| 14916 | (when (re-search-forward |
| 14917 | (concat "^[0-9]+:\\s-*\\(\\[\\|{.}\\s-+" |
| 14918 | (car arch-alist) "\\>\\)") nil t) |
| 14919 | (beginning-of-line) |
| 14920 | (when (looking-at "^[0-9]+:\\s-*{") |
| 14921 | (goto-char (match-end 0)) |
| 14922 | (speedbar-do-function-pointer) |
| 14923 | (select-frame speedbar-frame))) |
| 14924 | (setq arch-alist (cdr arch-alist)))) |
| 14925 | (setq unit-alist (cdr unit-alist)))))) |
| 14926 | (vhdl-speedbar-update-current-unit nil t)) |
| 14927 | |
| 14928 | (declare-function speedbar-center-buffer-smartly "speedbar" ()) |
| 14929 | |
| 14930 | (defun vhdl-speedbar-contract-level () |
| 14931 | "Contract current level in current directory/project." |
| 14932 | (interactive) |
| 14933 | (when (or (save-excursion |
| 14934 | (beginning-of-line) (looking-at "^[0-9]:\\s-*[[{<]-")) |
| 14935 | (and (save-excursion |
| 14936 | (beginning-of-line) (looking-at "^\\([0-9]+\\):")) |
| 14937 | (re-search-backward |
| 14938 | (format "^[0-%d]:\\s-*[[{<]-" |
| 14939 | (max (1- (string-to-number (match-string 1))) 0)) nil t))) |
| 14940 | (goto-char (match-end 0)) |
| 14941 | (speedbar-do-function-pointer) |
| 14942 | (speedbar-center-buffer-smartly))) |
| 14943 | |
| 14944 | (defun vhdl-speedbar-contract-all () |
| 14945 | "Contract all expanded design units in current directory/project." |
| 14946 | (interactive) |
| 14947 | (if (and vhdl-speedbar-show-projects |
| 14948 | (save-excursion (beginning-of-line) (looking-at "^0:"))) |
| 14949 | (progn (setq vhdl-speedbar-shown-project-list nil) |
| 14950 | (vhdl-speedbar-refresh)) |
| 14951 | (let ((key (vhdl-speedbar-line-key))) |
| 14952 | (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key) |
| 14953 | (vhdl-speedbar-refresh (and vhdl-speedbar-show-projects key)) |
| 14954 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14955 | (add-to-list 'vhdl-updated-project-list key))))) |
| 14956 | |
| 14957 | (defun vhdl-speedbar-expand-all () |
| 14958 | "Expand all design units in current directory/project." |
| 14959 | (interactive) |
| 14960 | (let* ((key (vhdl-speedbar-line-key)) |
| 14961 | (ent-alist (vhdl-aget vhdl-entity-alist key t)) |
| 14962 | (conf-alist (vhdl-aget vhdl-config-alist key t)) |
| 14963 | (pack-alist (vhdl-aget vhdl-package-alist key t)) |
| 14964 | arch-alist unit-alist subunit-alist) |
| 14965 | (add-to-list 'vhdl-speedbar-shown-project-list key) |
| 14966 | (while ent-alist |
| 14967 | (setq arch-alist (nth 4 (car ent-alist))) |
| 14968 | (setq subunit-alist nil) |
| 14969 | (while arch-alist |
| 14970 | (push (caar arch-alist) subunit-alist) |
| 14971 | (setq arch-alist (cdr arch-alist))) |
| 14972 | (push (list (caar ent-alist) subunit-alist) unit-alist) |
| 14973 | (setq ent-alist (cdr ent-alist))) |
| 14974 | (while conf-alist |
| 14975 | (push (list (caar conf-alist)) unit-alist) |
| 14976 | (setq conf-alist (cdr conf-alist))) |
| 14977 | (while pack-alist |
| 14978 | (push (list (caar pack-alist)) unit-alist) |
| 14979 | (setq pack-alist (cdr pack-alist))) |
| 14980 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 14981 | (vhdl-speedbar-refresh) |
| 14982 | (when (memq 'display vhdl-speedbar-save-cache) |
| 14983 | (add-to-list 'vhdl-updated-project-list key)))) |
| 14984 | |
| 14985 | (declare-function speedbar-change-expand-button-char "speedbar" (char)) |
| 14986 | (declare-function speedbar-delete-subblock "speedbar" (indent)) |
| 14987 | |
| 14988 | (defun vhdl-speedbar-expand-project (text token indent) |
| 14989 | "Expand/contract the project under the cursor." |
| 14990 | (cond |
| 14991 | ((string-match "+" text) ; expand project |
| 14992 | (speedbar-change-expand-button-char ?-) |
| 14993 | (unless (member token vhdl-speedbar-shown-project-list) |
| 14994 | (setq vhdl-speedbar-shown-project-list |
| 14995 | (cons token vhdl-speedbar-shown-project-list))) |
| 14996 | (speedbar-with-writable |
| 14997 | (save-excursion |
| 14998 | (end-of-line) (forward-char 1) |
| 14999 | (vhdl-speedbar-insert-project-hierarchy token (1+ indent) |
| 15000 | speedbar-power-click)))) |
| 15001 | ((string-match "-" text) ; contract project |
| 15002 | (speedbar-change-expand-button-char ?+) |
| 15003 | (setq vhdl-speedbar-shown-project-list |
| 15004 | (delete token vhdl-speedbar-shown-project-list)) |
| 15005 | (speedbar-delete-subblock indent)) |
| 15006 | (t (error "Nothing to display"))) |
| 15007 | (when (equal (selected-frame) speedbar-frame) |
| 15008 | (speedbar-center-buffer-smartly))) |
| 15009 | |
| 15010 | (defun vhdl-speedbar-expand-entity (text token indent) |
| 15011 | "Expand/contract the entity under the cursor." |
| 15012 | (cond |
| 15013 | ((string-match "+" text) ; expand entity |
| 15014 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15015 | (ent-alist (vhdl-aget vhdl-entity-alist key t)) |
| 15016 | (ent-entry (vhdl-aget ent-alist token t)) |
| 15017 | (arch-alist (nth 3 ent-entry)) |
| 15018 | (inst-alist (vhdl-get-instantiations token indent)) |
| 15019 | (subpack-alist (nth 5 ent-entry)) |
| 15020 | (multiple-arch (> (length arch-alist) 1)) |
| 15021 | arch-entry inst-entry) |
| 15022 | (if (not (or arch-alist inst-alist subpack-alist)) |
| 15023 | (speedbar-change-expand-button-char ??) |
| 15024 | (speedbar-change-expand-button-char ?-) |
| 15025 | ;; add entity to `vhdl-speedbar-shown-unit-alist' |
| 15026 | (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15027 | (vhdl-aput 'unit-alist token nil) |
| 15028 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 15029 | (speedbar-with-writable |
| 15030 | (save-excursion |
| 15031 | (end-of-line) (forward-char 1) |
| 15032 | ;; insert architectures |
| 15033 | (when arch-alist |
| 15034 | (vhdl-speedbar-make-title-line "Architectures:" (1+ indent))) |
| 15035 | (while arch-alist |
| 15036 | (setq arch-entry (car arch-alist)) |
| 15037 | (speedbar-make-tag-line |
| 15038 | 'curly ?+ 'vhdl-speedbar-expand-architecture |
| 15039 | (cons token (nth 0 arch-entry)) |
| 15040 | (nth 1 arch-entry) 'vhdl-speedbar-find-file |
| 15041 | (cons (nth 2 arch-entry) (nth 3 arch-entry)) |
| 15042 | 'vhdl-speedbar-architecture-face (1+ indent)) |
| 15043 | (when (and multiple-arch |
| 15044 | (equal (nth 0 arch-entry) (nth 4 ent-entry))) |
| 15045 | (end-of-line 0) (insert " (mra)") (forward-char 1)) |
| 15046 | (setq arch-alist (cdr arch-alist))) |
| 15047 | ;; insert instantiations |
| 15048 | (when inst-alist |
| 15049 | (vhdl-speedbar-make-title-line "Instantiated as:" (1+ indent))) |
| 15050 | (while inst-alist |
| 15051 | (setq inst-entry (car inst-alist)) |
| 15052 | (vhdl-speedbar-make-inst-line |
| 15053 | (nth 0 inst-entry) (nth 1 inst-entry) (nth 2 inst-entry) |
| 15054 | (nth 3 inst-entry) (nth 4 inst-entry) (nth 5 inst-entry) |
| 15055 | nil nil nil (1+ indent) 0 " in ") |
| 15056 | (setq inst-alist (cdr inst-alist))) |
| 15057 | ;; insert required packages |
| 15058 | (vhdl-speedbar-insert-subpackages |
| 15059 | subpack-alist (1+ indent) indent))) |
| 15060 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15061 | (add-to-list 'vhdl-updated-project-list key)) |
| 15062 | (vhdl-speedbar-update-current-unit t t)))) |
| 15063 | ((string-match "-" text) ; contract entity |
| 15064 | (speedbar-change-expand-button-char ?+) |
| 15065 | ;; remove entity from `vhdl-speedbar-shown-unit-alist' |
| 15066 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15067 | (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15068 | (vhdl-adelete 'unit-alist token) |
| 15069 | (if unit-alist |
| 15070 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 15071 | (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 15072 | (speedbar-delete-subblock indent) |
| 15073 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15074 | (add-to-list 'vhdl-updated-project-list key)))) |
| 15075 | (t (error "Nothing to display"))) |
| 15076 | (when (equal (selected-frame) speedbar-frame) |
| 15077 | (speedbar-center-buffer-smartly))) |
| 15078 | |
| 15079 | (defun vhdl-speedbar-expand-architecture (text token indent) |
| 15080 | "Expand/contract the architecture under the cursor." |
| 15081 | (cond |
| 15082 | ((string-match "+" text) ; expand architecture |
| 15083 | (let* ((key (vhdl-speedbar-line-key (1- indent))) |
| 15084 | (ent-alist (vhdl-aget vhdl-entity-alist key t)) |
| 15085 | (conf-alist (vhdl-aget vhdl-config-alist key t)) |
| 15086 | (hier-alist (vhdl-get-hierarchy |
| 15087 | ent-alist conf-alist (car token) (cdr token) nil nil |
| 15088 | 0 (1- indent))) |
| 15089 | (ent-entry (vhdl-aget ent-alist (car token) t)) |
| 15090 | (arch-entry (vhdl-aget (nth 3 ent-entry) (cdr token) t)) |
| 15091 | (subpack-alist (nth 4 arch-entry)) |
| 15092 | entry) |
| 15093 | (if (not (or hier-alist subpack-alist)) |
| 15094 | (speedbar-change-expand-button-char ??) |
| 15095 | (speedbar-change-expand-button-char ?-) |
| 15096 | ;; add architecture to `vhdl-speedbar-shown-unit-alist' |
| 15097 | (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) |
| 15098 | (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t)))) |
| 15099 | (vhdl-aput 'unit-alist (car token) |
| 15100 | (list (cons (cdr token) arch-alist))) |
| 15101 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 15102 | (speedbar-with-writable |
| 15103 | (save-excursion |
| 15104 | (end-of-line) (forward-char 1) |
| 15105 | ;; insert instance hierarchy |
| 15106 | (when hier-alist |
| 15107 | (vhdl-speedbar-make-title-line "Subcomponent hierarchy:" |
| 15108 | (1+ indent))) |
| 15109 | (while hier-alist |
| 15110 | (setq entry (car hier-alist)) |
| 15111 | (when (or (= vhdl-speedbar-hierarchy-depth 0) |
| 15112 | (< (nth 9 entry) vhdl-speedbar-hierarchy-depth)) |
| 15113 | (vhdl-speedbar-make-inst-line |
| 15114 | (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) |
| 15115 | (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) |
| 15116 | (nth 8 entry) (1+ indent) (1+ (nth 9 entry)) ": ")) |
| 15117 | (setq hier-alist (cdr hier-alist))) |
| 15118 | ;; insert required packages |
| 15119 | (vhdl-speedbar-insert-subpackages |
| 15120 | subpack-alist (1+ indent) (1- indent)))) |
| 15121 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15122 | (add-to-list 'vhdl-updated-project-list key)) |
| 15123 | (vhdl-speedbar-update-current-unit t t)))) |
| 15124 | ((string-match "-" text) ; contract architecture |
| 15125 | (speedbar-change-expand-button-char ?+) |
| 15126 | ;; remove architecture from `vhdl-speedbar-shown-unit-alist' |
| 15127 | (let* ((key (vhdl-speedbar-line-key (1- indent))) |
| 15128 | (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t)) |
| 15129 | (arch-alist (nth 0 (vhdl-aget unit-alist (car token) t)))) |
| 15130 | (vhdl-aput 'unit-alist (car token) (list (delete (cdr token) arch-alist))) |
| 15131 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 15132 | (speedbar-delete-subblock indent) |
| 15133 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15134 | (add-to-list 'vhdl-updated-project-list key)))) |
| 15135 | (t (error "Nothing to display"))) |
| 15136 | (when (equal (selected-frame) speedbar-frame) |
| 15137 | (speedbar-center-buffer-smartly))) |
| 15138 | |
| 15139 | (defun vhdl-speedbar-expand-config (text token indent) |
| 15140 | "Expand/contract the configuration under the cursor." |
| 15141 | (cond |
| 15142 | ((string-match "+" text) ; expand configuration |
| 15143 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15144 | (conf-alist (vhdl-aget vhdl-config-alist key t)) |
| 15145 | (conf-entry (vhdl-aget conf-alist token)) |
| 15146 | (ent-alist (vhdl-aget vhdl-entity-alist key t)) |
| 15147 | (hier-alist (vhdl-get-hierarchy |
| 15148 | ent-alist conf-alist (nth 3 conf-entry) |
| 15149 | (nth 4 conf-entry) token (nth 5 conf-entry) |
| 15150 | 0 indent t)) |
| 15151 | (subpack-alist (nth 6 conf-entry)) |
| 15152 | entry) |
| 15153 | (if (not (or hier-alist subpack-alist)) |
| 15154 | (speedbar-change-expand-button-char ??) |
| 15155 | (speedbar-change-expand-button-char ?-) |
| 15156 | ;; add configuration to `vhdl-speedbar-shown-unit-alist' |
| 15157 | (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15158 | (vhdl-aput 'unit-alist token nil) |
| 15159 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 15160 | (speedbar-with-writable |
| 15161 | (save-excursion |
| 15162 | (end-of-line) (forward-char 1) |
| 15163 | ;; insert instance hierarchy |
| 15164 | (when hier-alist |
| 15165 | (vhdl-speedbar-make-title-line "Design hierarchy:" (1+ indent))) |
| 15166 | (while hier-alist |
| 15167 | (setq entry (car hier-alist)) |
| 15168 | (when (or (= vhdl-speedbar-hierarchy-depth 0) |
| 15169 | (<= (nth 9 entry) vhdl-speedbar-hierarchy-depth)) |
| 15170 | (vhdl-speedbar-make-inst-line |
| 15171 | (nth 0 entry) (nth 1 entry) (nth 2 entry) (nth 3 entry) |
| 15172 | (nth 4 entry) (nth 5 entry) (nth 6 entry) (nth 7 entry) |
| 15173 | (nth 8 entry) (1+ indent) (nth 9 entry) ": ")) |
| 15174 | (setq hier-alist (cdr hier-alist))) |
| 15175 | ;; insert required packages |
| 15176 | (vhdl-speedbar-insert-subpackages |
| 15177 | subpack-alist (1+ indent) indent))) |
| 15178 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15179 | (add-to-list 'vhdl-updated-project-list key)) |
| 15180 | (vhdl-speedbar-update-current-unit t t)))) |
| 15181 | ((string-match "-" text) ; contract configuration |
| 15182 | (speedbar-change-expand-button-char ?+) |
| 15183 | ;; remove configuration from `vhdl-speedbar-shown-unit-alist' |
| 15184 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15185 | (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15186 | (vhdl-adelete 'unit-alist token) |
| 15187 | (if unit-alist |
| 15188 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 15189 | (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 15190 | (speedbar-delete-subblock indent) |
| 15191 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15192 | (add-to-list 'vhdl-updated-project-list key)))) |
| 15193 | (t (error "Nothing to display"))) |
| 15194 | (when (equal (selected-frame) speedbar-frame) |
| 15195 | (speedbar-center-buffer-smartly))) |
| 15196 | |
| 15197 | (defun vhdl-speedbar-expand-package (text token indent) |
| 15198 | "Expand/contract the package under the cursor." |
| 15199 | (cond |
| 15200 | ((string-match "+" text) ; expand package |
| 15201 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15202 | (pack-alist (vhdl-aget vhdl-package-alist key t)) |
| 15203 | (pack-entry (vhdl-aget pack-alist token t)) |
| 15204 | (comp-alist (nth 3 pack-entry)) |
| 15205 | (func-alist (nth 4 pack-entry)) |
| 15206 | (func-body-alist (nth 8 pack-entry)) |
| 15207 | (subpack-alist (append (nth 5 pack-entry) (nth 9 pack-entry))) |
| 15208 | comp-entry func-entry func-body-entry) |
| 15209 | (if (not (or comp-alist func-alist subpack-alist)) |
| 15210 | (speedbar-change-expand-button-char ??) |
| 15211 | (speedbar-change-expand-button-char ?-) |
| 15212 | ;; add package to `vhdl-speedbar-shown-unit-alist' |
| 15213 | (let* ((unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15214 | (vhdl-aput 'unit-alist token nil) |
| 15215 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist)) |
| 15216 | (speedbar-with-writable |
| 15217 | (save-excursion |
| 15218 | (end-of-line) (forward-char 1) |
| 15219 | ;; insert components |
| 15220 | (when comp-alist |
| 15221 | (vhdl-speedbar-make-title-line "Components:" (1+ indent))) |
| 15222 | (while comp-alist |
| 15223 | (setq comp-entry (car comp-alist)) |
| 15224 | (speedbar-make-tag-line |
| 15225 | nil nil nil |
| 15226 | (cons token (nth 0 comp-entry)) |
| 15227 | (nth 1 comp-entry) 'vhdl-speedbar-find-file |
| 15228 | (cons (nth 2 comp-entry) (nth 3 comp-entry)) |
| 15229 | 'vhdl-speedbar-entity-face (1+ indent)) |
| 15230 | (setq comp-alist (cdr comp-alist))) |
| 15231 | ;; insert subprograms |
| 15232 | (when func-alist |
| 15233 | (vhdl-speedbar-make-title-line "Subprograms:" (1+ indent))) |
| 15234 | (while func-alist |
| 15235 | (setq func-entry (car func-alist) |
| 15236 | func-body-entry (vhdl-aget func-body-alist |
| 15237 | (car func-entry) t)) |
| 15238 | (when (nth 2 func-entry) |
| 15239 | (vhdl-speedbar-make-subprogram-line |
| 15240 | (nth 1 func-entry) |
| 15241 | (cons (nth 2 func-entry) (nth 3 func-entry)) |
| 15242 | (cons (nth 1 func-body-entry) (nth 2 func-body-entry)) |
| 15243 | (1+ indent))) |
| 15244 | (setq func-alist (cdr func-alist))) |
| 15245 | ;; insert required packages |
| 15246 | (vhdl-speedbar-insert-subpackages |
| 15247 | subpack-alist (1+ indent) indent))) |
| 15248 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15249 | (add-to-list 'vhdl-updated-project-list key)) |
| 15250 | (vhdl-speedbar-update-current-unit t t)))) |
| 15251 | ((string-match "-" text) ; contract package |
| 15252 | (speedbar-change-expand-button-char ?+) |
| 15253 | ;; remove package from `vhdl-speedbar-shown-unit-alist' |
| 15254 | (let* ((key (vhdl-speedbar-line-key indent)) |
| 15255 | (unit-alist (vhdl-aget vhdl-speedbar-shown-unit-alist key t))) |
| 15256 | (vhdl-adelete 'unit-alist token) |
| 15257 | (if unit-alist |
| 15258 | (vhdl-aput 'vhdl-speedbar-shown-unit-alist key unit-alist) |
| 15259 | (vhdl-adelete 'vhdl-speedbar-shown-unit-alist key)) |
| 15260 | (speedbar-delete-subblock indent) |
| 15261 | (when (memq 'display vhdl-speedbar-save-cache) |
| 15262 | (add-to-list 'vhdl-updated-project-list key)))) |
| 15263 | (t (error "Nothing to display"))) |
| 15264 | (when (equal (selected-frame) speedbar-frame) |
| 15265 | (speedbar-center-buffer-smartly))) |
| 15266 | |
| 15267 | (defun vhdl-speedbar-insert-subpackages (subpack-alist indent dir-indent) |
| 15268 | "Insert required packages." |
| 15269 | (let* ((pack-alist (vhdl-aget vhdl-package-alist |
| 15270 | (vhdl-speedbar-line-key dir-indent) t)) |
| 15271 | pack-key lib-name pack-entry) |
| 15272 | (when subpack-alist |
| 15273 | (vhdl-speedbar-make-title-line "Packages Used:" indent)) |
| 15274 | (while subpack-alist |
| 15275 | (setq pack-key (cdar subpack-alist) |
| 15276 | lib-name (caar subpack-alist)) |
| 15277 | (setq pack-entry (vhdl-aget pack-alist pack-key t)) |
| 15278 | (vhdl-speedbar-make-subpack-line |
| 15279 | (or (nth 0 pack-entry) pack-key) lib-name |
| 15280 | (cons (nth 1 pack-entry) (nth 2 pack-entry)) |
| 15281 | (cons (nth 6 pack-entry) (nth 7 pack-entry)) indent) |
| 15282 | (setq subpack-alist (cdr subpack-alist))))) |
| 15283 | |
| 15284 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15285 | ;; Display help functions |
| 15286 | |
| 15287 | (defvar vhdl-speedbar-update-current-unit t |
| 15288 | "Non-nil means to run `vhdl-speedbar-update-current-unit'.") |
| 15289 | |
| 15290 | (defun vhdl-speedbar-update-current-project () |
| 15291 | "Highlight project that is currently active." |
| 15292 | (when (and vhdl-speedbar-show-projects |
| 15293 | (not (equal vhdl-speedbar-last-selected-project vhdl-project)) |
| 15294 | (and (boundp 'speedbar-frame) |
| 15295 | (frame-live-p speedbar-frame))) |
| 15296 | (let ((last-frame (selected-frame)) |
| 15297 | (project-alist vhdl-project-alist) |
| 15298 | pos) |
| 15299 | (select-frame speedbar-frame) |
| 15300 | (speedbar-with-writable |
| 15301 | (save-excursion |
| 15302 | (while project-alist |
| 15303 | (goto-char (point-min)) |
| 15304 | (when (re-search-forward |
| 15305 | (concat "<.> \\(" (caar project-alist) "\\)$") nil t) |
| 15306 | (put-text-property (match-beginning 1) (match-end 1) 'face |
| 15307 | (if (equal (caar project-alist) vhdl-project) |
| 15308 | 'speedbar-selected-face |
| 15309 | 'speedbar-directory-face)) |
| 15310 | (when (equal (caar project-alist) vhdl-project) |
| 15311 | (setq pos (1- (match-beginning 1))))) |
| 15312 | (setq project-alist (cdr project-alist)))) |
| 15313 | (when pos (goto-char pos))) |
| 15314 | (select-frame last-frame) |
| 15315 | (setq vhdl-speedbar-last-selected-project vhdl-project))) |
| 15316 | t) |
| 15317 | |
| 15318 | (declare-function speedbar-position-cursor-on-line "speedbar" ()) |
| 15319 | |
| 15320 | (defun vhdl-speedbar-update-current-unit (&optional no-position always) |
| 15321 | "Highlight all design units that are contained in the current file. |
| 15322 | NO-POSITION non-nil means do not re-position cursor." |
| 15323 | (let ((last-frame (selected-frame)) |
| 15324 | (project-list vhdl-speedbar-shown-project-list) |
| 15325 | file-alist pos file-name) |
| 15326 | ;; get current file name |
| 15327 | (if (fboundp 'speedbar-select-attached-frame) |
| 15328 | (speedbar-select-attached-frame) |
| 15329 | (select-frame speedbar-attached-frame)) |
| 15330 | (setq file-name (abbreviate-file-name (or (buffer-file-name) ""))) |
| 15331 | (when (and vhdl-speedbar-update-current-unit |
| 15332 | (or always (not (equal file-name speedbar-last-selected-file)))) |
| 15333 | (if vhdl-speedbar-show-projects |
| 15334 | (while project-list |
| 15335 | (setq file-alist (append file-alist |
| 15336 | (vhdl-aget vhdl-file-alist |
| 15337 | (car project-list) t))) |
| 15338 | (setq project-list (cdr project-list))) |
| 15339 | (setq file-alist |
| 15340 | (vhdl-aget vhdl-file-alist |
| 15341 | (abbreviate-file-name default-directory) t))) |
| 15342 | (select-frame speedbar-frame) |
| 15343 | (set-buffer speedbar-buffer) |
| 15344 | (speedbar-with-writable |
| 15345 | (vhdl-prepare-search-1 |
| 15346 | (save-excursion |
| 15347 | ;; unhighlight last units |
| 15348 | (let* ((file-entry (vhdl-aget file-alist |
| 15349 | speedbar-last-selected-file t))) |
| 15350 | (vhdl-speedbar-update-units |
| 15351 | "\\[.\\] " (nth 0 file-entry) |
| 15352 | speedbar-last-selected-file 'vhdl-speedbar-entity-face) |
| 15353 | (vhdl-speedbar-update-units |
| 15354 | "{.} " (nth 1 file-entry) |
| 15355 | speedbar-last-selected-file 'vhdl-speedbar-architecture-face) |
| 15356 | (vhdl-speedbar-update-units |
| 15357 | "\\[.\\] " (nth 3 file-entry) |
| 15358 | speedbar-last-selected-file 'vhdl-speedbar-configuration-face) |
| 15359 | (vhdl-speedbar-update-units |
| 15360 | "[]>] " (nth 4 file-entry) |
| 15361 | speedbar-last-selected-file 'vhdl-speedbar-package-face) |
| 15362 | (vhdl-speedbar-update-units |
| 15363 | "\\[.\\].+(" '("body") |
| 15364 | speedbar-last-selected-file 'vhdl-speedbar-package-face) |
| 15365 | (vhdl-speedbar-update-units |
| 15366 | "> " (nth 6 file-entry) |
| 15367 | speedbar-last-selected-file 'vhdl-speedbar-instantiation-face)) |
| 15368 | ;; highlight current units |
| 15369 | (let* ((file-entry (vhdl-aget file-alist file-name t))) |
| 15370 | (setq |
| 15371 | pos (vhdl-speedbar-update-units |
| 15372 | "\\[.\\] " (nth 0 file-entry) |
| 15373 | file-name 'vhdl-speedbar-entity-selected-face pos) |
| 15374 | pos (vhdl-speedbar-update-units |
| 15375 | "{.} " (nth 1 file-entry) |
| 15376 | file-name 'vhdl-speedbar-architecture-selected-face pos) |
| 15377 | pos (vhdl-speedbar-update-units |
| 15378 | "\\[.\\] " (nth 3 file-entry) |
| 15379 | file-name 'vhdl-speedbar-configuration-selected-face pos) |
| 15380 | pos (vhdl-speedbar-update-units |
| 15381 | "[]>] " (nth 4 file-entry) |
| 15382 | file-name 'vhdl-speedbar-package-selected-face pos) |
| 15383 | pos (vhdl-speedbar-update-units |
| 15384 | "\\[.\\].+(" '("body") |
| 15385 | file-name 'vhdl-speedbar-package-selected-face pos) |
| 15386 | pos (vhdl-speedbar-update-units |
| 15387 | "> " (nth 6 file-entry) |
| 15388 | file-name 'vhdl-speedbar-instantiation-selected-face pos)))))) |
| 15389 | ;; move speedbar so the first highlighted unit is visible |
| 15390 | (when (and pos (not no-position)) |
| 15391 | (goto-char pos) |
| 15392 | (speedbar-center-buffer-smartly) |
| 15393 | (speedbar-position-cursor-on-line)) |
| 15394 | (setq speedbar-last-selected-file file-name)) |
| 15395 | (select-frame last-frame) |
| 15396 | t)) |
| 15397 | |
| 15398 | (defun vhdl-speedbar-update-units (text unit-list file-name face |
| 15399 | &optional pos) |
| 15400 | "Help function to highlight design units." |
| 15401 | (while unit-list |
| 15402 | (goto-char (point-min)) |
| 15403 | (while (re-search-forward |
| 15404 | (concat text "\\(" (car unit-list) "\\)\\>") nil t) |
| 15405 | (when (equal file-name (car (get-text-property |
| 15406 | (match-beginning 1) 'speedbar-token))) |
| 15407 | (setq pos (or pos (point-marker))) |
| 15408 | (put-text-property (match-beginning 1) (match-end 1) 'face face))) |
| 15409 | (setq unit-list (cdr unit-list))) |
| 15410 | pos) |
| 15411 | |
| 15412 | (declare-function speedbar-make-button "speedbar" |
| 15413 | (start end face mouse function &optional token)) |
| 15414 | |
| 15415 | (defun vhdl-speedbar-make-inst-line (inst-name inst-file-marker |
| 15416 | ent-name ent-file-marker |
| 15417 | arch-name arch-file-marker |
| 15418 | conf-name conf-file-marker |
| 15419 | lib-name depth offset delimiter) |
| 15420 | "Insert instantiation entry." |
| 15421 | (let ((start (point)) |
| 15422 | visible-start) |
| 15423 | (insert (int-to-string depth) ":") |
| 15424 | (put-text-property start (point) 'invisible t) |
| 15425 | (setq visible-start (point)) |
| 15426 | (insert-char ? (* depth speedbar-indentation-width)) |
| 15427 | (while (> offset 0) |
| 15428 | (insert "|") |
| 15429 | (insert-char (if (= offset 1) ?- ? ) (1- speedbar-indentation-width)) |
| 15430 | (setq offset (1- offset))) |
| 15431 | (put-text-property visible-start (point) 'invisible nil) |
| 15432 | (setq start (point)) |
| 15433 | (insert ">") |
| 15434 | (speedbar-make-button start (point) nil nil nil) |
| 15435 | (setq visible-start (point)) |
| 15436 | (insert " ") |
| 15437 | (setq start (point)) |
| 15438 | (if (not inst-name) |
| 15439 | (insert "(top)") |
| 15440 | (insert inst-name) |
| 15441 | (speedbar-make-button |
| 15442 | start (point) 'vhdl-speedbar-instantiation-face 'speedbar-highlight-face |
| 15443 | 'vhdl-speedbar-find-file inst-file-marker)) |
| 15444 | (insert delimiter) |
| 15445 | (when ent-name |
| 15446 | (setq start (point)) |
| 15447 | (insert ent-name) |
| 15448 | (speedbar-make-button |
| 15449 | start (point) 'vhdl-speedbar-entity-face 'speedbar-highlight-face |
| 15450 | 'vhdl-speedbar-find-file ent-file-marker) |
| 15451 | (when arch-name |
| 15452 | (insert " (") |
| 15453 | (setq start (point)) |
| 15454 | (insert arch-name) |
| 15455 | (speedbar-make-button |
| 15456 | start (point) 'vhdl-speedbar-architecture-face 'speedbar-highlight-face |
| 15457 | 'vhdl-speedbar-find-file arch-file-marker) |
| 15458 | (insert ")")) |
| 15459 | (when conf-name |
| 15460 | (insert " (") |
| 15461 | (setq start (point)) |
| 15462 | (insert conf-name) |
| 15463 | (speedbar-make-button |
| 15464 | start (point) 'vhdl-speedbar-configuration-face 'speedbar-highlight-face |
| 15465 | 'vhdl-speedbar-find-file conf-file-marker) |
| 15466 | (insert ")"))) |
| 15467 | (when (and lib-name (not (equal lib-name (downcase (vhdl-work-library))))) |
| 15468 | (setq start (point)) |
| 15469 | (insert " (" lib-name ")") |
| 15470 | (put-text-property (+ 2 start) (1- (point)) 'face |
| 15471 | 'vhdl-speedbar-library-face)) |
| 15472 | (insert-char ?\n 1) |
| 15473 | (put-text-property visible-start (point) 'invisible nil))) |
| 15474 | |
| 15475 | (defun vhdl-speedbar-make-pack-line (pack-key pack-name pack-file-marker |
| 15476 | body-file-marker depth) |
| 15477 | "Insert package entry." |
| 15478 | (let ((start (point)) |
| 15479 | visible-start) |
| 15480 | (insert (int-to-string depth) ":") |
| 15481 | (put-text-property start (point) 'invisible t) |
| 15482 | (setq visible-start (point)) |
| 15483 | (insert-char ? (* depth speedbar-indentation-width)) |
| 15484 | (put-text-property visible-start (point) 'invisible nil) |
| 15485 | (setq start (point)) |
| 15486 | (insert "[+]") |
| 15487 | (speedbar-make-button |
| 15488 | start (point) 'speedbar-button-face 'speedbar-highlight-face |
| 15489 | 'vhdl-speedbar-expand-package pack-key) |
| 15490 | (setq visible-start (point)) |
| 15491 | (insert-char ? 1 nil) |
| 15492 | (setq start (point)) |
| 15493 | (insert pack-name) |
| 15494 | (speedbar-make-button |
| 15495 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 15496 | 'vhdl-speedbar-find-file pack-file-marker) |
| 15497 | (unless (car pack-file-marker) |
| 15498 | (insert "!")) |
| 15499 | (when (car body-file-marker) |
| 15500 | (insert " (") |
| 15501 | (setq start (point)) |
| 15502 | (insert "body") |
| 15503 | (speedbar-make-button |
| 15504 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 15505 | 'vhdl-speedbar-find-file body-file-marker) |
| 15506 | (insert ")")) |
| 15507 | (insert-char ?\n 1) |
| 15508 | (put-text-property visible-start (point) 'invisible nil))) |
| 15509 | |
| 15510 | (defun vhdl-speedbar-make-subpack-line (pack-name lib-name pack-file-marker |
| 15511 | pack-body-file-marker depth) |
| 15512 | "Insert used package entry." |
| 15513 | (let ((start (point)) |
| 15514 | visible-start) |
| 15515 | (insert (int-to-string depth) ":") |
| 15516 | (put-text-property start (point) 'invisible t) |
| 15517 | (setq visible-start (point)) |
| 15518 | (insert-char ? (* depth speedbar-indentation-width)) |
| 15519 | (put-text-property visible-start (point) 'invisible nil) |
| 15520 | (setq start (point)) |
| 15521 | (insert ">") |
| 15522 | (speedbar-make-button start (point) nil nil nil) |
| 15523 | (setq visible-start (point)) |
| 15524 | (insert " ") |
| 15525 | (setq start (point)) |
| 15526 | (insert pack-name) |
| 15527 | (speedbar-make-button |
| 15528 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 15529 | 'vhdl-speedbar-find-file pack-file-marker) |
| 15530 | (when (car pack-body-file-marker) |
| 15531 | (insert " (") |
| 15532 | (setq start (point)) |
| 15533 | (insert "body") |
| 15534 | (speedbar-make-button |
| 15535 | start (point) 'vhdl-speedbar-package-face 'speedbar-highlight-face |
| 15536 | 'vhdl-speedbar-find-file pack-body-file-marker) |
| 15537 | (insert ")")) |
| 15538 | (setq start (point)) |
| 15539 | (insert " (" lib-name ")") |
| 15540 | (put-text-property (+ 2 start) (1- (point)) 'face |
| 15541 | 'vhdl-speedbar-library-face) |
| 15542 | (insert-char ?\n 1) |
| 15543 | (put-text-property visible-start (point) 'invisible nil))) |
| 15544 | |
| 15545 | (defun vhdl-speedbar-make-subprogram-line (func-name func-file-marker |
| 15546 | func-body-file-marker |
| 15547 | depth) |
| 15548 | "Insert subprogram entry." |
| 15549 | (let ((start (point)) |
| 15550 | visible-start) |
| 15551 | (insert (int-to-string depth) ":") |
| 15552 | (put-text-property start (point) 'invisible t) |
| 15553 | (setq visible-start (point)) |
| 15554 | (insert-char ? (* depth speedbar-indentation-width)) |
| 15555 | (put-text-property visible-start (point) 'invisible nil) |
| 15556 | (setq start (point)) |
| 15557 | (insert ">") |
| 15558 | (speedbar-make-button start (point) nil nil nil) |
| 15559 | (setq visible-start (point)) |
| 15560 | (insert " ") |
| 15561 | (setq start (point)) |
| 15562 | (insert func-name) |
| 15563 | (speedbar-make-button |
| 15564 | start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face |
| 15565 | 'vhdl-speedbar-find-file func-file-marker) |
| 15566 | (when (car func-body-file-marker) |
| 15567 | (insert " (") |
| 15568 | (setq start (point)) |
| 15569 | (insert "body") |
| 15570 | (speedbar-make-button |
| 15571 | start (point) 'vhdl-speedbar-subprogram-face 'speedbar-highlight-face |
| 15572 | 'vhdl-speedbar-find-file func-body-file-marker) |
| 15573 | (insert ")")) |
| 15574 | (insert-char ?\n 1) |
| 15575 | (put-text-property visible-start (point) 'invisible nil))) |
| 15576 | |
| 15577 | (defun vhdl-speedbar-make-title-line (text &optional depth) |
| 15578 | "Insert design unit title entry." |
| 15579 | (let ((start (point)) |
| 15580 | visible-start) |
| 15581 | (when depth |
| 15582 | (insert (int-to-string depth) ":") |
| 15583 | (put-text-property start (point) 'invisible t)) |
| 15584 | (setq visible-start (point)) |
| 15585 | (insert-char ? (* (or depth 0) speedbar-indentation-width)) |
| 15586 | (setq start (point)) |
| 15587 | (insert text) |
| 15588 | (speedbar-make-button start (point) nil nil nil nil) |
| 15589 | (insert-char ?\n 1) |
| 15590 | (put-text-property visible-start (point) 'invisible nil))) |
| 15591 | |
| 15592 | (defun vhdl-speedbar-insert-dirs (files level) |
| 15593 | "Insert subdirectories." |
| 15594 | (let ((dirs (car files))) |
| 15595 | (while dirs |
| 15596 | (speedbar-make-tag-line 'angle ?+ 'vhdl-speedbar-dired (car dirs) |
| 15597 | (car dirs) 'speedbar-dir-follow nil |
| 15598 | 'speedbar-directory-face level) |
| 15599 | (setq dirs (cdr dirs))))) |
| 15600 | |
| 15601 | (declare-function speedbar-reset-scanners "speedbar" ()) |
| 15602 | |
| 15603 | (defun vhdl-speedbar-dired (text token indent) |
| 15604 | "Speedbar click handler for directory expand button in hierarchy mode." |
| 15605 | (cond ((string-match "+" text) ; we have to expand this dir |
| 15606 | (setq speedbar-shown-directories |
| 15607 | (cons (expand-file-name |
| 15608 | (concat (speedbar-line-directory indent) token "/")) |
| 15609 | speedbar-shown-directories)) |
| 15610 | (speedbar-change-expand-button-char ?-) |
| 15611 | (speedbar-reset-scanners) |
| 15612 | (speedbar-with-writable |
| 15613 | (save-excursion |
| 15614 | (end-of-line) (forward-char 1) |
| 15615 | (vhdl-speedbar-insert-dirs |
| 15616 | (speedbar-file-lists |
| 15617 | (concat (speedbar-line-directory indent) token "/")) |
| 15618 | (1+ indent)) |
| 15619 | (speedbar-reset-scanners) |
| 15620 | (vhdl-speedbar-insert-dir-hierarchy |
| 15621 | (abbreviate-file-name |
| 15622 | (concat (speedbar-line-directory indent) token "/")) |
| 15623 | (1+ indent) speedbar-power-click))) |
| 15624 | (vhdl-speedbar-update-current-unit t t)) |
| 15625 | ((string-match "-" text) ; we have to contract this node |
| 15626 | (speedbar-reset-scanners) |
| 15627 | (let ((oldl speedbar-shown-directories) |
| 15628 | (newl nil) |
| 15629 | (td (expand-file-name |
| 15630 | (concat (speedbar-line-directory indent) token)))) |
| 15631 | (while oldl |
| 15632 | (if (not (string-match (concat "^" (regexp-quote td)) (car oldl))) |
| 15633 | (push (car oldl) newl)) |
| 15634 | (setq oldl (cdr oldl))) |
| 15635 | (setq speedbar-shown-directories (nreverse newl))) |
| 15636 | (speedbar-change-expand-button-char ?+) |
| 15637 | (speedbar-delete-subblock indent)) |
| 15638 | (t (error "Nothing to display"))) |
| 15639 | (when (equal (selected-frame) speedbar-frame) |
| 15640 | (speedbar-center-buffer-smartly))) |
| 15641 | |
| 15642 | (declare-function speedbar-files-item-info "speedbar" ()) |
| 15643 | |
| 15644 | (defun vhdl-speedbar-item-info () |
| 15645 | "Derive and display information about this line item." |
| 15646 | (save-excursion |
| 15647 | (beginning-of-line) |
| 15648 | ;; skip invisible number info |
| 15649 | (when (looking-at "^[0-9]+:") (goto-char (match-end 0))) |
| 15650 | (cond |
| 15651 | ;; project/directory entry |
| 15652 | ((looking-at "\\s-*<[-+?]>\\s-+\\([^\n]+\\)$") |
| 15653 | (if vhdl-speedbar-show-projects |
| 15654 | (message "Project \"%s\"" (match-string-no-properties 1)) |
| 15655 | (speedbar-files-item-info))) |
| 15656 | ;; design unit entry |
| 15657 | ((looking-at "\\(\\s-*\\([[{][-+?][]}]\\|[| -]*>\\) \\)\"?\\w") |
| 15658 | (goto-char (match-end 1)) |
| 15659 | (let ((face (get-text-property (point) 'face))) |
| 15660 | (message |
| 15661 | "%s \"%s\" in \"%s\"" |
| 15662 | ;; design unit kind |
| 15663 | (cond ((or (eq face 'vhdl-speedbar-entity-face) |
| 15664 | (eq face 'vhdl-speedbar-entity-selected-face)) |
| 15665 | (if (equal (match-string 2) ">") "Component" "Entity")) |
| 15666 | ((or (eq face 'vhdl-speedbar-architecture-face) |
| 15667 | (eq face 'vhdl-speedbar-architecture-selected-face)) |
| 15668 | "Architecture") |
| 15669 | ((or (eq face 'vhdl-speedbar-configuration-face) |
| 15670 | (eq face 'vhdl-speedbar-configuration-selected-face)) |
| 15671 | "Configuration") |
| 15672 | ((or (eq face 'vhdl-speedbar-package-face) |
| 15673 | (eq face 'vhdl-speedbar-package-selected-face)) |
| 15674 | "Package") |
| 15675 | ((or (eq face 'vhdl-speedbar-instantiation-face) |
| 15676 | (eq face 'vhdl-speedbar-instantiation-selected-face)) |
| 15677 | "Instantiation") |
| 15678 | ((eq face 'vhdl-speedbar-subprogram-face) |
| 15679 | "Subprogram") |
| 15680 | (t "")) |
| 15681 | ;; design unit name |
| 15682 | (buffer-substring-no-properties |
| 15683 | (progn (looking-at "\"?\\(\\(\\w\\|_\\)+\\)\"?") (match-beginning 1)) |
| 15684 | (match-end 1)) |
| 15685 | ;; file name |
| 15686 | (file-relative-name |
| 15687 | (or (car (get-text-property (point) 'speedbar-token)) |
| 15688 | "?") |
| 15689 | (vhdl-default-directory))))) |
| 15690 | (t (message ""))))) |
| 15691 | |
| 15692 | (declare-function speedbar-line-text "speedbar" (&optional p)) |
| 15693 | |
| 15694 | (defun vhdl-speedbar-line-text () |
| 15695 | "Calls `speedbar-line-text' and removes text properties." |
| 15696 | (let ((string (speedbar-line-text))) |
| 15697 | (set-text-properties 0 (length string) nil string) |
| 15698 | string)) |
| 15699 | |
| 15700 | (defun vhdl-speedbar-higher-text () |
| 15701 | "Get speedbar-line-text of higher level." |
| 15702 | (let (depth string) |
| 15703 | (save-excursion |
| 15704 | (beginning-of-line) |
| 15705 | (looking-at "^\\([0-9]+\\):") |
| 15706 | (setq depth (string-to-number (match-string 1))) |
| 15707 | (when (re-search-backward (format "^%d: *[[<{][-+?][]>}] \\([^ \n]+\\)" (1- depth)) nil t) |
| 15708 | (setq string (match-string 1)) |
| 15709 | (set-text-properties 0 (length string) nil string) |
| 15710 | string)))) |
| 15711 | |
| 15712 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15713 | ;; Help functions |
| 15714 | |
| 15715 | (defun vhdl-speedbar-line-key (&optional indent) |
| 15716 | "Get currently displayed directory of project name." |
| 15717 | (if vhdl-speedbar-show-projects |
| 15718 | (vhdl-speedbar-line-project) |
| 15719 | (abbreviate-file-name |
| 15720 | (file-name-as-directory (speedbar-line-directory indent))))) |
| 15721 | |
| 15722 | (defun vhdl-speedbar-line-project (&optional indent) |
| 15723 | "Get currently displayed project name." |
| 15724 | (and vhdl-speedbar-show-projects |
| 15725 | (save-excursion |
| 15726 | (end-of-line) |
| 15727 | (re-search-backward "^[0-9]+:\\s-*<[-+?]>\\s-+\\([^\n]+\\)$" nil t) |
| 15728 | (match-string-no-properties 1)))) |
| 15729 | |
| 15730 | (defun vhdl-add-modified-file () |
| 15731 | "Add file to `vhdl-modified-file-list'." |
| 15732 | (when vhdl-file-alist |
| 15733 | (add-to-list 'vhdl-modified-file-list (buffer-file-name))) |
| 15734 | nil) |
| 15735 | |
| 15736 | (defun vhdl-resolve-paths (path-list) |
| 15737 | "Resolve path wildcards in PATH-LIST." |
| 15738 | (let (path-list-1 path-list-2 path-beg path-end dir) |
| 15739 | ;; eliminate non-existent directories |
| 15740 | (while path-list |
| 15741 | (setq dir (car path-list)) |
| 15742 | (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)" dir) |
| 15743 | (if (file-directory-p (match-string 2 dir)) |
| 15744 | (push dir path-list-1) |
| 15745 | (vhdl-warning-when-idle "No such directory: \"%s\"" (match-string 2 dir))) |
| 15746 | (setq path-list (cdr path-list))) |
| 15747 | ;; resolve path wildcards |
| 15748 | (while path-list-1 |
| 15749 | (setq dir (car path-list-1)) |
| 15750 | (if (string-match "\\(-r \\)?\\(\\([^?*]*[/\\]\\)*\\)\\([^/\\]*[?*][^/\\]*\\)\\([/\\].*\\)" dir) |
| 15751 | (progn |
| 15752 | (setq path-beg (match-string 1 dir) |
| 15753 | path-end (match-string 5 dir)) |
| 15754 | (setq path-list-1 |
| 15755 | (append |
| 15756 | (mapcar |
| 15757 | (function |
| 15758 | (lambda (var) (concat path-beg var path-end))) |
| 15759 | (let ((all-list (vhdl-directory-files |
| 15760 | (match-string 2 dir) t |
| 15761 | (concat "\\<" (wildcard-to-regexp |
| 15762 | (match-string 4 dir))))) |
| 15763 | dir-list) |
| 15764 | (while all-list |
| 15765 | (when (file-directory-p (car all-list)) |
| 15766 | (push (car all-list) dir-list)) |
| 15767 | (setq all-list (cdr all-list))) |
| 15768 | dir-list)) |
| 15769 | (cdr path-list-1)))) |
| 15770 | (string-match "\\(-r \\)?\\(.*\\)[/\\].*" dir) |
| 15771 | (when (file-directory-p (match-string 2 dir)) |
| 15772 | (push dir path-list-2)) |
| 15773 | (setq path-list-1 (cdr path-list-1)))) |
| 15774 | (nreverse path-list-2))) |
| 15775 | |
| 15776 | (defun vhdl-speedbar-goto-this-unit (directory unit) |
| 15777 | "If UNIT is displayed in DIRECTORY, goto this line and return t, else nil." |
| 15778 | (let ((dest (point))) |
| 15779 | (if (and (if vhdl-speedbar-show-projects |
| 15780 | (progn (goto-char (point-min)) t) |
| 15781 | (speedbar-goto-this-file directory)) |
| 15782 | (re-search-forward (concat "[]}] " unit "\\>") nil t)) |
| 15783 | (progn (speedbar-position-cursor-on-line) |
| 15784 | t) |
| 15785 | (goto-char dest) |
| 15786 | nil))) |
| 15787 | |
| 15788 | (declare-function speedbar-find-file-in-frame "speedbar" (file)) |
| 15789 | (declare-function speedbar-set-timer "speedbar" (timeout)) |
| 15790 | ;; speedbar loads dframe at runtime. |
| 15791 | (declare-function dframe-maybee-jump-to-attached-frame "dframe" ()) |
| 15792 | |
| 15793 | (defun vhdl-speedbar-find-file (text token indent) |
| 15794 | "When user clicks on TEXT, load file with name and position in TOKEN. |
| 15795 | Jump to the design unit if `vhdl-speedbar-jump-to-unit' is t or if the file |
| 15796 | is already shown in a buffer." |
| 15797 | (if (not (car token)) |
| 15798 | (error "ERROR: File cannot be found") |
| 15799 | (let ((buffer (get-file-buffer (car token)))) |
| 15800 | (speedbar-find-file-in-frame (car token)) |
| 15801 | (when (or vhdl-speedbar-jump-to-unit buffer) |
| 15802 | (goto-char (point-min)) |
| 15803 | (forward-line (1- (cdr token))) |
| 15804 | (recenter)) |
| 15805 | (vhdl-speedbar-update-current-unit t t) |
| 15806 | (speedbar-set-timer dframe-update-speed) |
| 15807 | (dframe-maybee-jump-to-attached-frame)))) |
| 15808 | |
| 15809 | (defun vhdl-speedbar-port-copy () |
| 15810 | "Copy the port of the entity/component or subprogram under the cursor." |
| 15811 | (interactive) |
| 15812 | (let ((is-entity (vhdl-speedbar-check-unit 'entity))) |
| 15813 | (if (not (or is-entity (vhdl-speedbar-check-unit 'subprogram))) |
| 15814 | (error "ERROR: No entity/component or subprogram under cursor") |
| 15815 | (beginning-of-line) |
| 15816 | (if (looking-at "\\([0-9]\\)+:\\s-*\\(\\[[-+?]\\]\\|>\\) \\(\\(\\w\\|\\s_\\)+\\)") |
| 15817 | (condition-case info |
| 15818 | (let ((token (get-text-property |
| 15819 | (match-beginning 3) 'speedbar-token))) |
| 15820 | (vhdl-visit-file (car token) t |
| 15821 | (progn (goto-char (point-min)) |
| 15822 | (forward-line (1- (cdr token))) |
| 15823 | (end-of-line) |
| 15824 | (if is-entity |
| 15825 | (vhdl-port-copy) |
| 15826 | (vhdl-subprog-copy))))) |
| 15827 | (error (error "ERROR: %s not scanned successfully\n (%s)" |
| 15828 | (if is-entity "Port" "Interface") (cadr info)))) |
| 15829 | (error "ERROR: No entity/component or subprogram on current line"))))) |
| 15830 | |
| 15831 | (defun vhdl-speedbar-place-component () |
| 15832 | "Place the entity/component under the cursor as component." |
| 15833 | (interactive) |
| 15834 | (if (not (vhdl-speedbar-check-unit 'entity)) |
| 15835 | (error "ERROR: No entity/component under cursor") |
| 15836 | (vhdl-speedbar-port-copy) |
| 15837 | (if (fboundp 'speedbar-select-attached-frame) |
| 15838 | (speedbar-select-attached-frame) |
| 15839 | (select-frame speedbar-attached-frame)) |
| 15840 | (vhdl-compose-place-component) |
| 15841 | (select-frame speedbar-frame))) |
| 15842 | |
| 15843 | (defun vhdl-speedbar-configuration () |
| 15844 | "Generate configuration for the architecture under the cursor." |
| 15845 | (interactive) |
| 15846 | (if (not (vhdl-speedbar-check-unit 'architecture)) |
| 15847 | (error "ERROR: No architecture under cursor") |
| 15848 | (let ((arch-name (vhdl-speedbar-line-text)) |
| 15849 | (ent-name (vhdl-speedbar-higher-text))) |
| 15850 | (if (fboundp 'speedbar-select-attached-frame) |
| 15851 | (speedbar-select-attached-frame) |
| 15852 | (select-frame speedbar-attached-frame)) |
| 15853 | (vhdl-compose-configuration ent-name arch-name)))) |
| 15854 | |
| 15855 | (defun vhdl-speedbar-select-mra () |
| 15856 | "Select the architecture under the cursor as MRA." |
| 15857 | (interactive) |
| 15858 | (if (not (vhdl-speedbar-check-unit 'architecture)) |
| 15859 | (error "ERROR: No architecture under cursor") |
| 15860 | (let* ((arch-key (downcase (vhdl-speedbar-line-text))) |
| 15861 | (ent-key (downcase (vhdl-speedbar-higher-text))) |
| 15862 | (ent-alist (vhdl-aget |
| 15863 | vhdl-entity-alist |
| 15864 | (or (vhdl-project-p) |
| 15865 | (abbreviate-file-name default-directory)) t)) |
| 15866 | (ent-entry (vhdl-aget ent-alist ent-key t))) |
| 15867 | (setcar (cddr (cddr ent-entry)) arch-key) ; (nth 4 ent-entry) |
| 15868 | (speedbar-refresh)))) |
| 15869 | |
| 15870 | (declare-function speedbar-line-file "speedbar" (&optional p)) |
| 15871 | |
| 15872 | (defun vhdl-speedbar-make-design () |
| 15873 | "Make (compile) design unit or directory/project under the cursor." |
| 15874 | (interactive) |
| 15875 | (if (not (save-excursion (beginning-of-line) |
| 15876 | (looking-at "[0-9]+: *\\(\\(\\[\\)\\|<\\)"))) |
| 15877 | (error "ERROR: No primary design unit or directory/project under cursor") |
| 15878 | (let ((is-unit (match-string 2)) |
| 15879 | (unit-name (vhdl-speedbar-line-text)) |
| 15880 | (vhdl-project (vhdl-speedbar-line-project)) |
| 15881 | (directory (file-name-as-directory |
| 15882 | (or (speedbar-line-file) (speedbar-line-directory))))) |
| 15883 | (if (fboundp 'speedbar-select-attached-frame) |
| 15884 | (speedbar-select-attached-frame) |
| 15885 | (select-frame speedbar-attached-frame)) |
| 15886 | (let ((default-directory directory)) |
| 15887 | (vhdl-make (and is-unit unit-name)))))) |
| 15888 | |
| 15889 | (defun vhdl-speedbar-generate-makefile () |
| 15890 | "Generate Makefile for directory/project under the cursor." |
| 15891 | (interactive) |
| 15892 | (let ((vhdl-project (vhdl-speedbar-line-project)) |
| 15893 | (default-directory (file-name-as-directory |
| 15894 | (or (speedbar-line-file) (speedbar-line-directory))))) |
| 15895 | (vhdl-generate-makefile))) |
| 15896 | |
| 15897 | (defun vhdl-speedbar-check-unit (design-unit) |
| 15898 | "Check whether design unit under cursor corresponds to DESIGN-UNIT (or its |
| 15899 | expansion function)." |
| 15900 | (save-excursion |
| 15901 | (speedbar-position-cursor-on-line) |
| 15902 | (cond ((eq design-unit 'entity) |
| 15903 | (memq (get-text-property (match-end 0) 'face) |
| 15904 | '(vhdl-speedbar-entity-face |
| 15905 | vhdl-speedbar-entity-selected-face))) |
| 15906 | ((eq design-unit 'architecture) |
| 15907 | (memq (get-text-property (match-end 0) 'face) |
| 15908 | '(vhdl-speedbar-architecture-face |
| 15909 | vhdl-speedbar-architecture-selected-face))) |
| 15910 | ((eq design-unit 'subprogram) |
| 15911 | (eq (get-text-property (match-end 0) 'face) |
| 15912 | 'vhdl-speedbar-subprogram-face)) |
| 15913 | (t nil)))) |
| 15914 | |
| 15915 | (defun vhdl-speedbar-set-depth (depth) |
| 15916 | "Set hierarchy display depth to DEPTH and refresh speedbar." |
| 15917 | (setq vhdl-speedbar-hierarchy-depth depth) |
| 15918 | (speedbar-refresh)) |
| 15919 | |
| 15920 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 15921 | ;; Fontification |
| 15922 | |
| 15923 | (defface vhdl-speedbar-entity-face |
| 15924 | '((((class color) (background light)) (:foreground "ForestGreen")) |
| 15925 | (((class color) (background dark)) (:foreground "PaleGreen"))) |
| 15926 | "Face used for displaying entity names." |
| 15927 | :group 'speedbar-faces) |
| 15928 | |
| 15929 | (defface vhdl-speedbar-architecture-face |
| 15930 | '((((min-colors 88) (class color) (background light)) (:foreground "Blue1")) |
| 15931 | (((class color) (background light)) (:foreground "Blue")) |
| 15932 | |
| 15933 | (((class color) (background dark)) (:foreground "LightSkyBlue"))) |
| 15934 | "Face used for displaying architecture names." |
| 15935 | :group 'speedbar-faces) |
| 15936 | |
| 15937 | (defface vhdl-speedbar-configuration-face |
| 15938 | '((((class color) (background light)) (:foreground "DarkGoldenrod")) |
| 15939 | (((class color) (background dark)) (:foreground "Salmon"))) |
| 15940 | "Face used for displaying configuration names." |
| 15941 | :group 'speedbar-faces) |
| 15942 | |
| 15943 | (defface vhdl-speedbar-package-face |
| 15944 | '((((class color) (background light)) (:foreground "Grey50")) |
| 15945 | (((class color) (background dark)) (:foreground "Grey80"))) |
| 15946 | "Face used for displaying package names." |
| 15947 | :group 'speedbar-faces) |
| 15948 | |
| 15949 | (defface vhdl-speedbar-library-face |
| 15950 | '((((class color) (background light)) (:foreground "Purple")) |
| 15951 | (((class color) (background dark)) (:foreground "Orchid1"))) |
| 15952 | "Face used for displaying library names." |
| 15953 | :group 'speedbar-faces) |
| 15954 | |
| 15955 | (defface vhdl-speedbar-instantiation-face |
| 15956 | '((((class color) (background light)) (:foreground "Brown")) |
| 15957 | (((min-colors 88) (class color) (background dark)) (:foreground "Yellow1")) |
| 15958 | (((class color) (background dark)) (:foreground "Yellow"))) |
| 15959 | "Face used for displaying instantiation names." |
| 15960 | :group 'speedbar-faces) |
| 15961 | |
| 15962 | (defface vhdl-speedbar-subprogram-face |
| 15963 | '((((class color) (background light)) (:foreground "Orchid4")) |
| 15964 | (((class color) (background dark)) (:foreground "BurlyWood2"))) |
| 15965 | "Face used for displaying subprogram names." |
| 15966 | :group 'speedbar-faces) |
| 15967 | |
| 15968 | (defface vhdl-speedbar-entity-selected-face |
| 15969 | '((((class color) (background light)) (:foreground "ForestGreen" :underline t)) |
| 15970 | (((class color) (background dark)) (:foreground "PaleGreen" :underline t))) |
| 15971 | "Face used for displaying entity names." |
| 15972 | :group 'speedbar-faces) |
| 15973 | |
| 15974 | (defface vhdl-speedbar-architecture-selected-face |
| 15975 | '((((min-colors 88) (class color) (background light)) (:foreground |
| 15976 | "Blue1" :underline t)) |
| 15977 | (((class color) (background light)) (:foreground "Blue" :underline t)) |
| 15978 | (((class color) (background dark)) (:foreground "LightSkyBlue" :underline t))) |
| 15979 | "Face used for displaying architecture names." |
| 15980 | :group 'speedbar-faces) |
| 15981 | |
| 15982 | (defface vhdl-speedbar-configuration-selected-face |
| 15983 | '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) |
| 15984 | (((class color) (background dark)) (:foreground "Salmon" :underline t))) |
| 15985 | "Face used for displaying configuration names." |
| 15986 | :group 'speedbar-faces) |
| 15987 | |
| 15988 | (defface vhdl-speedbar-package-selected-face |
| 15989 | '((((class color) (background light)) (:foreground "Grey50" :underline t)) |
| 15990 | (((class color) (background dark)) (:foreground "Grey80" :underline t))) |
| 15991 | "Face used for displaying package names." |
| 15992 | :group 'speedbar-faces) |
| 15993 | |
| 15994 | (defface vhdl-speedbar-instantiation-selected-face |
| 15995 | '((((class color) (background light)) (:foreground "Brown" :underline t)) |
| 15996 | (((class color) (background dark)) (:foreground "Yellow" :underline t))) |
| 15997 | "Face used for displaying instantiation names." |
| 15998 | :group 'speedbar-faces) |
| 15999 | |
| 16000 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16001 | ;; Initialization |
| 16002 | |
| 16003 | ;; add speedbar |
| 16004 | (when (fboundp 'speedbar) |
| 16005 | (let ((current-frame (selected-frame))) |
| 16006 | (condition-case () |
| 16007 | (when (and vhdl-speedbar-auto-open |
| 16008 | (not (and (boundp 'speedbar-frame) |
| 16009 | (frame-live-p speedbar-frame)))) |
| 16010 | (speedbar-frame-mode 1)) |
| 16011 | (error (vhdl-warning-when-idle "ERROR: An error occurred while opening speedbar"))) |
| 16012 | (select-frame current-frame))) |
| 16013 | |
| 16014 | ;; initialize speedbar |
| 16015 | (if (not (boundp 'speedbar-frame)) |
| 16016 | (add-hook 'speedbar-load-hook 'vhdl-speedbar-initialize) |
| 16017 | (vhdl-speedbar-initialize) |
| 16018 | (when speedbar-frame (vhdl-speedbar-refresh))) |
| 16019 | |
| 16020 | |
| 16021 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16022 | ;;; Structural composition |
| 16023 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16024 | |
| 16025 | (defun vhdl-get-components-package-name () |
| 16026 | "Return the name of the components package." |
| 16027 | (let ((project (vhdl-project-p))) |
| 16028 | (if project |
| 16029 | (vhdl-replace-string (car vhdl-components-package-name) |
| 16030 | (subst-char-in-string ? ?_ project)) |
| 16031 | (cdr vhdl-components-package-name)))) |
| 16032 | |
| 16033 | (defun vhdl-compose-new-component () |
| 16034 | "Create entity and architecture for new component." |
| 16035 | (interactive) |
| 16036 | (let* ((case-fold-search t) |
| 16037 | (ent-name (read-from-minibuffer "entity name: " |
| 16038 | nil vhdl-minibuffer-local-map)) |
| 16039 | (arch-name |
| 16040 | (if (equal (cdr vhdl-compose-architecture-name) "") |
| 16041 | (read-from-minibuffer "architecture name: " |
| 16042 | nil vhdl-minibuffer-local-map) |
| 16043 | (vhdl-replace-string vhdl-compose-architecture-name ent-name))) |
| 16044 | ent-file-name arch-file-name ent-buffer arch-buffer project end-pos) |
| 16045 | (message "Creating component \"%s(%s)\"..." ent-name arch-name) |
| 16046 | ;; open entity file |
| 16047 | (unless (eq vhdl-compose-create-files 'none) |
| 16048 | (setq ent-file-name |
| 16049 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 16050 | "." (file-name-extension (buffer-file-name)))) |
| 16051 | (when (and (file-exists-p ent-file-name) |
| 16052 | (not (y-or-n-p (concat "File \"" ent-file-name |
| 16053 | "\" exists; overwrite? ")))) |
| 16054 | (error "ERROR: Creating component...aborted")) |
| 16055 | (find-file ent-file-name) |
| 16056 | (erase-buffer) |
| 16057 | (set-buffer-modified-p nil)) |
| 16058 | ;; insert header |
| 16059 | (if vhdl-compose-include-header |
| 16060 | (progn (vhdl-template-header) |
| 16061 | (setq end-pos (point)) |
| 16062 | (goto-char (point-max))) |
| 16063 | (vhdl-comment-display-line) (insert "\n\n")) |
| 16064 | ;; insert library clause |
| 16065 | (vhdl-template-package-std-logic-1164) |
| 16066 | (when vhdl-use-components-package |
| 16067 | (insert "\n") |
| 16068 | (vhdl-template-standard-package (vhdl-work-library) |
| 16069 | (vhdl-get-components-package-name))) |
| 16070 | (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n") |
| 16071 | ;; insert entity declaration |
| 16072 | (vhdl-insert-keyword "ENTITY ") (insert ent-name) |
| 16073 | (vhdl-insert-keyword " IS\n") |
| 16074 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 16075 | (indent-to vhdl-basic-offset) (vhdl-insert-keyword "GENERIC (\n") |
| 16076 | (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") |
| 16077 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 16078 | (indent-to vhdl-basic-offset) (vhdl-insert-keyword "PORT (\n") |
| 16079 | (indent-to (* 2 vhdl-basic-offset)) (insert ");\n") |
| 16080 | (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n")) |
| 16081 | (vhdl-insert-keyword "END ") |
| 16082 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY ")) |
| 16083 | (insert ent-name ";\n\n") |
| 16084 | (vhdl-comment-display-line) (insert "\n") |
| 16085 | ;; open architecture file |
| 16086 | (if (not (eq vhdl-compose-create-files 'separate)) |
| 16087 | (insert "\n") |
| 16088 | (goto-char (or end-pos (point-min))) |
| 16089 | (setq ent-buffer (current-buffer)) |
| 16090 | (setq arch-file-name |
| 16091 | (concat (vhdl-replace-string vhdl-architecture-file-name |
| 16092 | (concat ent-name " " arch-name) t) |
| 16093 | "." (file-name-extension (buffer-file-name)))) |
| 16094 | (when (and (file-exists-p arch-file-name) |
| 16095 | (not (y-or-n-p (concat "File \"" arch-file-name |
| 16096 | "\" exists; overwrite? ")))) |
| 16097 | (error "ERROR: Creating component...aborted")) |
| 16098 | (find-file arch-file-name) |
| 16099 | (erase-buffer) |
| 16100 | (set-buffer-modified-p nil) |
| 16101 | ;; insert header |
| 16102 | (if vhdl-compose-include-header |
| 16103 | (progn (vhdl-template-header) |
| 16104 | (goto-char (point-max))) |
| 16105 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 16106 | ;; insert architecture body |
| 16107 | (vhdl-insert-keyword "ARCHITECTURE ") (insert arch-name) |
| 16108 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 16109 | (vhdl-insert-keyword " IS\n\n") |
| 16110 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 16111 | (indent-to vhdl-basic-offset) (insert "-- Internal signal declarations\n") |
| 16112 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 16113 | (unless (or vhdl-use-components-package (vhdl-use-direct-instantiation)) |
| 16114 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 16115 | (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") |
| 16116 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n")) |
| 16117 | (vhdl-insert-keyword "BEGIN") |
| 16118 | (when vhdl-self-insert-comments |
| 16119 | (insert " -- ") |
| 16120 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) |
| 16121 | (insert arch-name)) |
| 16122 | (insert "\n\n") |
| 16123 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 16124 | (indent-to vhdl-basic-offset) (insert "-- Component instantiations\n") |
| 16125 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 16126 | (vhdl-insert-keyword "END ") |
| 16127 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ARCHITECTURE ")) |
| 16128 | (insert arch-name ";\n\n") |
| 16129 | ;; insert footer and save |
| 16130 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 16131 | (vhdl-template-footer) |
| 16132 | (vhdl-comment-display-line) (insert "\n")) |
| 16133 | (goto-char (or end-pos (point-min))) |
| 16134 | (setq arch-buffer (current-buffer)) |
| 16135 | (when ent-buffer (set-buffer ent-buffer) (save-buffer)) |
| 16136 | (set-buffer arch-buffer) (save-buffer) |
| 16137 | (message "%s" |
| 16138 | (concat (format "Creating component \"%s(%s)\"...done" ent-name arch-name) |
| 16139 | (and ent-file-name |
| 16140 | (format "\n File created: \"%s\"" ent-file-name)) |
| 16141 | (and arch-file-name |
| 16142 | (format "\n File created: \"%s\"" arch-file-name)))))) |
| 16143 | |
| 16144 | (defun vhdl-compose-place-component () |
| 16145 | "Place new component by pasting current port as component declaration and |
| 16146 | component instantiation." |
| 16147 | (interactive) |
| 16148 | (if (not vhdl-port-list) |
| 16149 | (error "ERROR: No port has been read") |
| 16150 | (save-excursion |
| 16151 | (vhdl-prepare-search-2 |
| 16152 | (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 16153 | (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) |
| 16154 | (error "ERROR: No architecture found")) |
| 16155 | (let* ((ent-name (match-string 1)) |
| 16156 | (ent-file-name |
| 16157 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 16158 | "." (file-name-extension (buffer-file-name)))) |
| 16159 | (orig-buffer (current-buffer))) |
| 16160 | (message "Placing component \"%s\"..." (nth 0 vhdl-port-list)) |
| 16161 | ;; place component declaration |
| 16162 | (unless (or vhdl-use-components-package |
| 16163 | (vhdl-use-direct-instantiation) |
| 16164 | (save-excursion |
| 16165 | (re-search-forward |
| 16166 | (concat "^\\s-*component\\s-+" |
| 16167 | (car vhdl-port-list) "\\>") nil t))) |
| 16168 | (re-search-forward "^begin\\>" nil) |
| 16169 | (beginning-of-line) |
| 16170 | (skip-chars-backward " \t\n\r\f") |
| 16171 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 16172 | (vhdl-port-paste-component t)) |
| 16173 | ;; place component instantiation |
| 16174 | (re-search-forward "^end\\>" nil) |
| 16175 | (beginning-of-line) |
| 16176 | (skip-chars-backward " \t\n\r\f") |
| 16177 | (insert "\n\n") (indent-to vhdl-basic-offset) |
| 16178 | (vhdl-port-paste-instance nil t t) |
| 16179 | ;; place use clause for used packages |
| 16180 | (when (nth 3 vhdl-port-list) |
| 16181 | ;; open entity file |
| 16182 | (when (file-exists-p ent-file-name) |
| 16183 | (find-file ent-file-name)) |
| 16184 | (goto-char (point-min)) |
| 16185 | (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) |
| 16186 | (error "ERROR: Entity not found: \"%s\"" ent-name)) |
| 16187 | (goto-char (match-beginning 0)) |
| 16188 | (if (and (save-excursion |
| 16189 | (re-search-backward "^\\(library\\|use\\)\\|end\\>" nil t)) |
| 16190 | (match-string 1)) |
| 16191 | (progn (goto-char (match-end 0)) |
| 16192 | (beginning-of-line 2)) |
| 16193 | (insert "\n") |
| 16194 | (backward-char)) |
| 16195 | (vhdl-port-paste-context-clause) |
| 16196 | (switch-to-buffer orig-buffer)) |
| 16197 | (message "Placing component \"%s\"...done" (nth 0 vhdl-port-list))))))) |
| 16198 | |
| 16199 | (defun vhdl-compose-wire-components () |
| 16200 | "Connect components." |
| 16201 | (interactive) |
| 16202 | (save-excursion |
| 16203 | (vhdl-prepare-search-2 |
| 16204 | (unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t) |
| 16205 | (re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)) |
| 16206 | (error "ERROR: No architecture found")) |
| 16207 | (let* ((ent-name (match-string 1)) |
| 16208 | (ent-file-name |
| 16209 | (concat (vhdl-replace-string vhdl-entity-file-name ent-name t) |
| 16210 | "." (file-name-extension (buffer-file-name)))) |
| 16211 | (arch-decl-pos (point-marker)) |
| 16212 | (arch-stat-pos (re-search-forward "^begin\\>" nil)) |
| 16213 | (arch-end-pos (re-search-forward "^end\\>" nil)) |
| 16214 | (pack-name (vhdl-get-components-package-name)) |
| 16215 | (pack-file-name |
| 16216 | (concat (vhdl-replace-string vhdl-package-file-name pack-name t) |
| 16217 | "." (file-name-extension (buffer-file-name)))) |
| 16218 | inst-name comp-name comp-ent-name comp-ent-file-name has-generic |
| 16219 | port-alist generic-alist inst-alist |
| 16220 | signal-name signal-entry signal-alist local-list written-list |
| 16221 | single-in-list multi-in-list single-out-list multi-out-list |
| 16222 | constant-name constant-entry constant-alist single-list multi-list |
| 16223 | port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos |
| 16224 | generic-beg-pos generic-pos generic-inst-pos generic-end-pos |
| 16225 | signal-beg-pos signal-pos |
| 16226 | constant-temp-pos port-temp-pos signal-temp-pos) |
| 16227 | (message "Wiring components...") |
| 16228 | ;; process all instances |
| 16229 | (goto-char arch-stat-pos) |
| 16230 | (while (re-search-forward |
| 16231 | (concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\(" |
| 16232 | "\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)" |
| 16233 | "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|" |
| 16234 | "\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?" |
| 16235 | "[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t) |
| 16236 | (setq inst-name (match-string-no-properties 1) |
| 16237 | comp-name (match-string-no-properties 4) |
| 16238 | comp-ent-name (match-string-no-properties 12) |
| 16239 | has-generic (or (match-string 7) (match-string 17))) |
| 16240 | ;; get port ... |
| 16241 | (if comp-name |
| 16242 | ;; ... from component declaration |
| 16243 | (vhdl-visit-file |
| 16244 | (when vhdl-use-components-package pack-file-name) t |
| 16245 | (save-excursion |
| 16246 | (goto-char (point-min)) |
| 16247 | (unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t) |
| 16248 | (error "ERROR: Component declaration not found: \"%s\"" comp-name)) |
| 16249 | (vhdl-port-copy))) |
| 16250 | ;; ... from entity declaration (direct instantiation) |
| 16251 | (setq comp-ent-file-name |
| 16252 | (concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t) |
| 16253 | "." (file-name-extension (buffer-file-name)))) |
| 16254 | (vhdl-visit-file |
| 16255 | comp-ent-file-name t |
| 16256 | (save-excursion |
| 16257 | (goto-char (point-min)) |
| 16258 | (unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t) |
| 16259 | (error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name)) |
| 16260 | (vhdl-port-copy)))) |
| 16261 | (vhdl-port-flatten t) |
| 16262 | (setq generic-alist (nth 1 vhdl-port-list) |
| 16263 | port-alist (nth 2 vhdl-port-list) |
| 16264 | vhdl-port-list nil) |
| 16265 | (setq constant-alist nil |
| 16266 | signal-alist nil) |
| 16267 | (when has-generic |
| 16268 | ;; process all constants in generic map |
| 16269 | (vhdl-forward-syntactic-ws) |
| 16270 | (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) |
| 16271 | (setq constant-name (match-string-no-properties 3)) |
| 16272 | (setq constant-entry |
| 16273 | (cons constant-name |
| 16274 | (if (match-string 1) |
| 16275 | (or (vhdl-aget generic-alist (match-string 2) t) |
| 16276 | (error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) |
| 16277 | (cdar generic-alist)))) |
| 16278 | (push constant-entry constant-alist) |
| 16279 | (setq constant-name (downcase constant-name)) |
| 16280 | (if (or (member constant-name single-list) |
| 16281 | (member constant-name multi-list)) |
| 16282 | (progn (setq single-list (delete constant-name single-list)) |
| 16283 | (add-to-list 'multi-list constant-name)) |
| 16284 | (add-to-list 'single-list constant-name)) |
| 16285 | (unless (match-string 1) |
| 16286 | (setq generic-alist (cdr generic-alist))) |
| 16287 | (vhdl-forward-syntactic-ws)) |
| 16288 | (vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t)) |
| 16289 | ;; process all signals in port map |
| 16290 | (vhdl-forward-syntactic-ws) |
| 16291 | (while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t) |
| 16292 | (setq signal-name (match-string-no-properties 3)) |
| 16293 | (setq signal-entry |
| 16294 | (cons signal-name |
| 16295 | (if (match-string 1) |
| 16296 | (or (vhdl-aget port-alist (match-string 2) t) |
| 16297 | (error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name)) |
| 16298 | (cdar port-alist)))) |
| 16299 | (push signal-entry signal-alist) |
| 16300 | (setq signal-name (downcase signal-name)) |
| 16301 | (if (equal (upcase (nth 2 signal-entry)) "IN") |
| 16302 | ;; input signal |
| 16303 | (cond |
| 16304 | ((member signal-name local-list) |
| 16305 | nil) |
| 16306 | ((or (member signal-name single-out-list) |
| 16307 | (member signal-name multi-out-list)) |
| 16308 | (setq single-out-list (delete signal-name single-out-list)) |
| 16309 | (setq multi-out-list (delete signal-name multi-out-list)) |
| 16310 | (add-to-list 'local-list signal-name)) |
| 16311 | ((member signal-name single-in-list) |
| 16312 | (setq single-in-list (delete signal-name single-in-list)) |
| 16313 | (add-to-list 'multi-in-list signal-name)) |
| 16314 | ((not (member signal-name multi-in-list)) |
| 16315 | (add-to-list 'single-in-list signal-name))) |
| 16316 | ;; output signal |
| 16317 | (cond |
| 16318 | ((member signal-name local-list) |
| 16319 | nil) |
| 16320 | ((or (member signal-name single-in-list) |
| 16321 | (member signal-name multi-in-list)) |
| 16322 | (setq single-in-list (delete signal-name single-in-list)) |
| 16323 | (setq multi-in-list (delete signal-name multi-in-list)) |
| 16324 | (add-to-list 'local-list signal-name)) |
| 16325 | ((member signal-name single-out-list) |
| 16326 | (setq single-out-list (delete signal-name single-out-list)) |
| 16327 | (add-to-list 'multi-out-list signal-name)) |
| 16328 | ((not (member signal-name multi-out-list)) |
| 16329 | (add-to-list 'single-out-list signal-name)))) |
| 16330 | (unless (match-string 1) |
| 16331 | (setq port-alist (cdr port-alist))) |
| 16332 | (vhdl-forward-syntactic-ws)) |
| 16333 | (push (list inst-name (nreverse constant-alist) |
| 16334 | (nreverse signal-alist)) inst-alist)) |
| 16335 | ;; prepare signal insertion |
| 16336 | (vhdl-goto-marker arch-decl-pos) |
| 16337 | (forward-line 1) |
| 16338 | (re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t) |
| 16339 | (setq signal-pos (point-marker)) |
| 16340 | (while (progn (vhdl-forward-syntactic-ws) |
| 16341 | (looking-at "signal\\>")) |
| 16342 | (beginning-of-line 2) |
| 16343 | (delete-region signal-pos (point))) |
| 16344 | (setq signal-beg-pos signal-pos) |
| 16345 | ;; open entity file |
| 16346 | (when (file-exists-p ent-file-name) |
| 16347 | (find-file ent-file-name)) |
| 16348 | (goto-char (point-min)) |
| 16349 | (unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t) |
| 16350 | (error "ERROR: Entity not found: \"%s\"" ent-name)) |
| 16351 | ;; prepare generic clause insertion |
| 16352 | (unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t) |
| 16353 | (match-string 1)) |
| 16354 | (goto-char (match-beginning 0)) |
| 16355 | (indent-to vhdl-basic-offset) |
| 16356 | (insert "generic ();\n\n") |
| 16357 | (backward-char 4)) |
| 16358 | (backward-char) |
| 16359 | (setq generic-pos (point-marker)) |
| 16360 | (forward-sexp) (end-of-line) |
| 16361 | (delete-region generic-pos (point)) (delete-char 1) |
| 16362 | (insert "(\n") |
| 16363 | (when multi-list |
| 16364 | (insert "\n") |
| 16365 | (indent-to (* 2 vhdl-basic-offset)) |
| 16366 | (insert "-- global generics\n")) |
| 16367 | (setq generic-beg-pos (point-marker) generic-pos (point-marker) |
| 16368 | generic-inst-pos (point-marker) generic-end-pos (point-marker)) |
| 16369 | ;; prepare port clause insertion |
| 16370 | (unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t) |
| 16371 | (match-string 1)) |
| 16372 | (goto-char (match-beginning 0)) |
| 16373 | (indent-to vhdl-basic-offset) |
| 16374 | (insert "port ();\n\n") |
| 16375 | (backward-char 4)) |
| 16376 | (backward-char) |
| 16377 | (setq port-in-pos (point-marker)) |
| 16378 | (forward-sexp) (end-of-line) |
| 16379 | (delete-region port-in-pos (point)) (delete-char 1) |
| 16380 | (insert "(\n") |
| 16381 | (when (or multi-in-list multi-out-list) |
| 16382 | (insert "\n") |
| 16383 | (indent-to (* 2 vhdl-basic-offset)) |
| 16384 | (insert "-- global ports\n")) |
| 16385 | (setq port-beg-pos (point-marker) port-in-pos (point-marker) |
| 16386 | port-out-pos (point-marker) port-inst-pos (point-marker) |
| 16387 | port-end-pos (point-marker)) |
| 16388 | ;; insert generics, ports and signals |
| 16389 | (setq inst-alist (nreverse inst-alist)) |
| 16390 | (while inst-alist |
| 16391 | (setq inst-name (nth 0 (car inst-alist)) |
| 16392 | constant-alist (nth 1 (car inst-alist)) |
| 16393 | signal-alist (nth 2 (car inst-alist)) |
| 16394 | constant-temp-pos generic-inst-pos |
| 16395 | port-temp-pos port-inst-pos |
| 16396 | signal-temp-pos signal-pos) |
| 16397 | ;; generics |
| 16398 | (while constant-alist |
| 16399 | (setq constant-name (downcase (caar constant-alist)) |
| 16400 | constant-entry (car constant-alist)) |
| 16401 | (unless (string-match "^[0-9]+" constant-name) |
| 16402 | (cond ((member constant-name written-list) |
| 16403 | nil) |
| 16404 | ((member constant-name multi-list) |
| 16405 | (vhdl-goto-marker generic-pos) |
| 16406 | (setq generic-end-pos |
| 16407 | (vhdl-max-marker |
| 16408 | generic-end-pos |
| 16409 | (vhdl-compose-insert-generic constant-entry))) |
| 16410 | (setq generic-pos (point-marker)) |
| 16411 | (add-to-list 'written-list constant-name)) |
| 16412 | (t |
| 16413 | (vhdl-goto-marker |
| 16414 | (vhdl-max-marker generic-inst-pos generic-pos)) |
| 16415 | (setq generic-end-pos |
| 16416 | (vhdl-compose-insert-generic constant-entry)) |
| 16417 | (setq generic-inst-pos (point-marker)) |
| 16418 | (add-to-list 'written-list constant-name)))) |
| 16419 | (setq constant-alist (cdr constant-alist))) |
| 16420 | (when (/= constant-temp-pos generic-inst-pos) |
| 16421 | (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) |
| 16422 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 16423 | (insert "-- generics for \"" inst-name "\"\n") |
| 16424 | (vhdl-goto-marker generic-inst-pos)) |
| 16425 | ;; ports and signals |
| 16426 | (while signal-alist |
| 16427 | (setq signal-name (downcase (caar signal-alist)) |
| 16428 | signal-entry (car signal-alist)) |
| 16429 | (cond ((member signal-name written-list) |
| 16430 | nil) |
| 16431 | ((member signal-name multi-in-list) |
| 16432 | (vhdl-goto-marker port-in-pos) |
| 16433 | (setq port-end-pos |
| 16434 | (vhdl-max-marker |
| 16435 | port-end-pos (vhdl-compose-insert-port signal-entry))) |
| 16436 | (setq port-in-pos (point-marker)) |
| 16437 | (add-to-list 'written-list signal-name)) |
| 16438 | ((member signal-name multi-out-list) |
| 16439 | (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) |
| 16440 | (setq port-end-pos |
| 16441 | (vhdl-max-marker |
| 16442 | port-end-pos (vhdl-compose-insert-port signal-entry))) |
| 16443 | (setq port-out-pos (point-marker)) |
| 16444 | (add-to-list 'written-list signal-name)) |
| 16445 | ((or (member signal-name single-in-list) |
| 16446 | (member signal-name single-out-list)) |
| 16447 | (vhdl-goto-marker |
| 16448 | (vhdl-max-marker |
| 16449 | port-inst-pos |
| 16450 | (vhdl-max-marker port-out-pos port-in-pos))) |
| 16451 | (setq port-end-pos (vhdl-compose-insert-port signal-entry)) |
| 16452 | (setq port-inst-pos (point-marker)) |
| 16453 | (add-to-list 'written-list signal-name)) |
| 16454 | ((equal (upcase (nth 2 signal-entry)) "OUT") |
| 16455 | (vhdl-goto-marker signal-pos) |
| 16456 | (vhdl-compose-insert-signal signal-entry) |
| 16457 | (setq signal-pos (point-marker)) |
| 16458 | (add-to-list 'written-list signal-name))) |
| 16459 | (setq signal-alist (cdr signal-alist))) |
| 16460 | (when (/= port-temp-pos port-inst-pos) |
| 16461 | (vhdl-goto-marker |
| 16462 | (vhdl-max-marker port-temp-pos |
| 16463 | (vhdl-max-marker port-in-pos port-out-pos))) |
| 16464 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 16465 | (insert "-- ports to \"" inst-name "\"\n") |
| 16466 | (vhdl-goto-marker port-inst-pos)) |
| 16467 | (when (/= signal-temp-pos signal-pos) |
| 16468 | (vhdl-goto-marker signal-temp-pos) |
| 16469 | (insert "\n") (indent-to vhdl-basic-offset) |
| 16470 | (insert "-- outputs of \"" inst-name "\"\n") |
| 16471 | (vhdl-goto-marker signal-pos)) |
| 16472 | (setq inst-alist (cdr inst-alist))) |
| 16473 | ;; finalize generic/port clause |
| 16474 | (vhdl-goto-marker generic-end-pos) (backward-char) |
| 16475 | (when (= generic-beg-pos generic-end-pos) |
| 16476 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 16477 | (insert ";") (backward-char)) |
| 16478 | (insert ")") |
| 16479 | (vhdl-goto-marker port-end-pos) (backward-char) |
| 16480 | (when (= port-beg-pos port-end-pos) |
| 16481 | (insert "\n") (indent-to (* 2 vhdl-basic-offset)) |
| 16482 | (insert ";") (backward-char)) |
| 16483 | (insert ")") |
| 16484 | ;; align everything |
| 16485 | (when vhdl-auto-align |
| 16486 | (vhdl-goto-marker generic-beg-pos) |
| 16487 | (vhdl-align-region-groups generic-beg-pos generic-end-pos 1) |
| 16488 | (vhdl-align-region-groups port-beg-pos port-end-pos 1) |
| 16489 | (vhdl-goto-marker signal-beg-pos) |
| 16490 | (vhdl-align-region-groups signal-beg-pos signal-pos)) |
| 16491 | (switch-to-buffer (marker-buffer signal-beg-pos)) |
| 16492 | (message "Wiring components...done"))))) |
| 16493 | |
| 16494 | (defun vhdl-compose-insert-generic (entry) |
| 16495 | "Insert ENTRY as generic declaration." |
| 16496 | (let (pos) |
| 16497 | (indent-to (* 2 vhdl-basic-offset)) |
| 16498 | (insert (nth 0 entry) " : " (nth 1 entry)) |
| 16499 | (when (nth 2 entry) |
| 16500 | (insert " := " (nth 2 entry))) |
| 16501 | (insert ";") |
| 16502 | (setq pos (point-marker)) |
| 16503 | (when (and vhdl-include-port-comments (nth 3 entry)) |
| 16504 | (vhdl-comment-insert-inline (nth 3 entry) t)) |
| 16505 | (insert "\n") |
| 16506 | pos)) |
| 16507 | |
| 16508 | (defun vhdl-compose-insert-port (entry) |
| 16509 | "Insert ENTRY as port declaration." |
| 16510 | (let (pos) |
| 16511 | (indent-to (* 2 vhdl-basic-offset)) |
| 16512 | (insert (nth 0 entry) " : " (nth 2 entry) " " (nth 3 entry) ";") |
| 16513 | (setq pos (point-marker)) |
| 16514 | (when (and vhdl-include-port-comments (nth 4 entry)) |
| 16515 | (vhdl-comment-insert-inline (nth 4 entry) t)) |
| 16516 | (insert "\n") |
| 16517 | pos)) |
| 16518 | |
| 16519 | (defun vhdl-compose-insert-signal (entry) |
| 16520 | "Insert ENTRY as signal declaration." |
| 16521 | (indent-to vhdl-basic-offset) |
| 16522 | (insert "signal " (nth 0 entry) " : " (nth 3 entry) ";") |
| 16523 | (when (and vhdl-include-port-comments (nth 4 entry)) |
| 16524 | (vhdl-comment-insert-inline (nth 4 entry) t)) |
| 16525 | (insert "\n")) |
| 16526 | |
| 16527 | (defun vhdl-compose-components-package () |
| 16528 | "Generate a package containing component declarations for all entities in the |
| 16529 | current project/directory." |
| 16530 | (interactive) |
| 16531 | (vhdl-require-hierarchy-info) |
| 16532 | (let* ((project (vhdl-project-p)) |
| 16533 | (pack-name (vhdl-get-components-package-name)) |
| 16534 | (pack-file-name |
| 16535 | (concat (vhdl-replace-string vhdl-package-file-name pack-name t) |
| 16536 | "." (file-name-extension (buffer-file-name)))) |
| 16537 | (ent-alist (vhdl-aget vhdl-entity-alist |
| 16538 | (or project |
| 16539 | (abbreviate-file-name default-directory)) t)) |
| 16540 | (lazy-lock-minimum-size 0) |
| 16541 | clause-pos component-pos) |
| 16542 | (message "Generating components package \"%s\"..." pack-name) |
| 16543 | ;; open package file |
| 16544 | (when (and (file-exists-p pack-file-name) |
| 16545 | (not (y-or-n-p (concat "File \"" pack-file-name |
| 16546 | "\" exists; overwrite? ")))) |
| 16547 | (error "ERROR: Generating components package...aborted")) |
| 16548 | (find-file pack-file-name) |
| 16549 | (erase-buffer) |
| 16550 | ;; insert header |
| 16551 | (if vhdl-compose-include-header |
| 16552 | (progn (vhdl-template-header |
| 16553 | (concat "Components package (generated by Emacs VHDL Mode " |
| 16554 | vhdl-version ")")) |
| 16555 | (goto-char (point-max))) |
| 16556 | (vhdl-comment-display-line) (insert "\n\n")) |
| 16557 | ;; insert std_logic_1164 package |
| 16558 | (vhdl-template-package-std-logic-1164) |
| 16559 | (insert "\n") (setq clause-pos (point-marker)) |
| 16560 | (insert "\n") (vhdl-comment-display-line) (insert "\n\n") |
| 16561 | ;; insert package declaration |
| 16562 | (vhdl-insert-keyword "PACKAGE ") (insert pack-name) |
| 16563 | (vhdl-insert-keyword " IS\n\n") |
| 16564 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n") |
| 16565 | (indent-to vhdl-basic-offset) (insert "-- Component declarations\n") |
| 16566 | (indent-to vhdl-basic-offset) (vhdl-comment-display-line) (insert "\n\n") |
| 16567 | (indent-to vhdl-basic-offset) |
| 16568 | (setq component-pos (point-marker)) |
| 16569 | (insert "\n\n") (vhdl-insert-keyword "END ") |
| 16570 | (unless (vhdl-standard-p '87) (vhdl-insert-keyword "PACKAGE ")) |
| 16571 | (insert pack-name ";\n\n") |
| 16572 | ;; insert footer |
| 16573 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 16574 | (vhdl-template-footer) |
| 16575 | (vhdl-comment-display-line) (insert "\n")) |
| 16576 | ;; insert component declarations |
| 16577 | (while ent-alist |
| 16578 | (vhdl-visit-file (nth 2 (car ent-alist)) nil |
| 16579 | (progn (goto-char (point-min)) |
| 16580 | (forward-line (1- (nth 3 (car ent-alist)))) |
| 16581 | (end-of-line) |
| 16582 | (vhdl-port-copy))) |
| 16583 | (goto-char component-pos) |
| 16584 | (vhdl-port-paste-component t) |
| 16585 | (when (cdr ent-alist) (insert "\n\n") (indent-to vhdl-basic-offset)) |
| 16586 | (setq component-pos (point-marker)) |
| 16587 | (goto-char clause-pos) |
| 16588 | (vhdl-port-paste-context-clause pack-name) |
| 16589 | (setq clause-pos (point-marker)) |
| 16590 | (setq ent-alist (cdr ent-alist))) |
| 16591 | (goto-char (point-min)) |
| 16592 | (save-buffer) |
| 16593 | (message "Generating components package \"%s\"...done\n File created: \"%s\"" |
| 16594 | pack-name pack-file-name))) |
| 16595 | |
| 16596 | (defun vhdl-compose-configuration-architecture (ent-name arch-name ent-alist |
| 16597 | conf-alist inst-alist |
| 16598 | &optional insert-conf) |
| 16599 | "Generate block configuration for architecture." |
| 16600 | (let ((margin (current-indentation)) |
| 16601 | (beg (point-at-bol)) |
| 16602 | ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist) |
| 16603 | ;; insert block configuration (for architecture) |
| 16604 | (vhdl-insert-keyword "FOR ") (insert arch-name "\n") |
| 16605 | (setq margin (+ margin vhdl-basic-offset)) |
| 16606 | ;; process all instances |
| 16607 | (while inst-alist |
| 16608 | (setq inst-entry (car inst-alist)) |
| 16609 | ;; is component? |
| 16610 | (when (nth 4 inst-entry) |
| 16611 | (setq insert-conf t) |
| 16612 | (setq inst-path (nth 9 inst-entry)) |
| 16613 | ;; skip common path with previous instance |
| 16614 | (while (and inst-path (equal (car inst-path) (car inst-prev-path))) |
| 16615 | (setq inst-path (cdr inst-path) |
| 16616 | inst-prev-path (cdr inst-prev-path))) |
| 16617 | ;; insert block configuration end (for previous block/generate) |
| 16618 | (while inst-prev-path |
| 16619 | (setq margin (- margin vhdl-basic-offset)) |
| 16620 | (indent-to margin) |
| 16621 | (vhdl-insert-keyword "END FOR;\n") |
| 16622 | (setq inst-prev-path (cdr inst-prev-path))) |
| 16623 | ;; insert block configuration beginning (for current block/generate) |
| 16624 | (indent-to margin) |
| 16625 | (while inst-path |
| 16626 | (setq margin (+ margin vhdl-basic-offset)) |
| 16627 | (vhdl-insert-keyword "FOR ") |
| 16628 | (insert (car inst-path) "\n") |
| 16629 | (indent-to margin) |
| 16630 | (setq inst-path (cdr inst-path))) |
| 16631 | ;; insert component configuration beginning |
| 16632 | (vhdl-insert-keyword "FOR ") |
| 16633 | (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n") |
| 16634 | ;; find subconfiguration |
| 16635 | (setq conf-key (nth 7 inst-entry)) |
| 16636 | (setq tmp-alist conf-alist) |
| 16637 | ;; use first configuration found for instance's entity |
| 16638 | (while (and tmp-alist (null conf-key)) |
| 16639 | (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist))) |
| 16640 | (setq conf-key (nth 0 (car tmp-alist)))) |
| 16641 | (setq tmp-alist (cdr tmp-alist))) |
| 16642 | (setq conf-entry (vhdl-aget conf-alist conf-key t)) |
| 16643 | ;; insert binding indication ... |
| 16644 | ;; ... with subconfiguration (if exists) |
| 16645 | (if (and vhdl-compose-configuration-use-subconfiguration conf-entry) |
| 16646 | (progn |
| 16647 | (indent-to (+ margin vhdl-basic-offset)) |
| 16648 | (vhdl-insert-keyword "USE CONFIGURATION ") |
| 16649 | (insert (vhdl-work-library) "." (nth 0 conf-entry)) |
| 16650 | (insert ";\n")) |
| 16651 | ;; ... with entity (if exists) |
| 16652 | (setq ent-entry (vhdl-aget ent-alist (nth 5 inst-entry) t)) |
| 16653 | (when ent-entry |
| 16654 | (indent-to (+ margin vhdl-basic-offset)) |
| 16655 | (vhdl-insert-keyword "USE ENTITY ") |
| 16656 | (insert (vhdl-work-library) "." (nth 0 ent-entry)) |
| 16657 | ;; insert architecture name (if architecture exists) |
| 16658 | (when (nth 3 ent-entry) |
| 16659 | (setq arch-name |
| 16660 | ;; choose architecture name a) from configuration, |
| 16661 | ;; b) from mra, or c) from first architecture |
| 16662 | (or (nth 0 (vhdl-aget (nth 3 ent-entry) |
| 16663 | (or (nth 6 inst-entry) |
| 16664 | (nth 4 ent-entry)) t)) |
| 16665 | (nth 1 (car (nth 3 ent-entry))))) |
| 16666 | (insert "(" arch-name ")")) |
| 16667 | (insert ";\n") |
| 16668 | ;; insert block configuration (for architecture of subcomponent) |
| 16669 | (when (and vhdl-compose-configuration-hierarchical |
| 16670 | (nth 3 ent-entry)) |
| 16671 | (indent-to (+ margin vhdl-basic-offset)) |
| 16672 | (vhdl-compose-configuration-architecture |
| 16673 | (nth 0 ent-entry) arch-name ent-alist conf-alist |
| 16674 | (nth 3 (vhdl-aget (nth 3 ent-entry) (downcase arch-name) t)))))) |
| 16675 | ;; insert component configuration end |
| 16676 | (indent-to margin) |
| 16677 | (vhdl-insert-keyword "END FOR;\n") |
| 16678 | (setq inst-prev-path (nth 9 inst-entry))) |
| 16679 | (setq inst-alist (cdr inst-alist))) |
| 16680 | ;; insert block configuration end (for block/generate) |
| 16681 | (while inst-prev-path |
| 16682 | (setq margin (- margin vhdl-basic-offset)) |
| 16683 | (indent-to margin) |
| 16684 | (vhdl-insert-keyword "END FOR;\n") |
| 16685 | (setq inst-prev-path (cdr inst-prev-path))) |
| 16686 | (indent-to (- margin vhdl-basic-offset)) |
| 16687 | ;; insert block configuration end or remove beginning (for architecture) |
| 16688 | (if insert-conf |
| 16689 | (vhdl-insert-keyword "END FOR;\n") |
| 16690 | (delete-region beg (point))))) |
| 16691 | |
| 16692 | (defun vhdl-compose-configuration (&optional ent-name arch-name) |
| 16693 | "Generate configuration declaration." |
| 16694 | (interactive) |
| 16695 | (vhdl-require-hierarchy-info) |
| 16696 | (let ((ent-alist (vhdl-aget vhdl-entity-alist |
| 16697 | (or (vhdl-project-p) |
| 16698 | (abbreviate-file-name default-directory)) t)) |
| 16699 | (conf-alist (vhdl-aget vhdl-config-alist |
| 16700 | (or (vhdl-project-p) |
| 16701 | (abbreviate-file-name default-directory)) t)) |
| 16702 | (from-speedbar ent-name) |
| 16703 | inst-alist conf-name conf-file-name pos) |
| 16704 | (vhdl-prepare-search-2 |
| 16705 | ;; get entity and architecture name |
| 16706 | (unless ent-name |
| 16707 | (save-excursion |
| 16708 | (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t) |
| 16709 | (not (equal "END" (upcase (match-string 1)))) |
| 16710 | (setq ent-name (match-string-no-properties 3)) |
| 16711 | (setq arch-name (match-string-no-properties 2))) |
| 16712 | (error "ERROR: Not within an architecture")))) |
| 16713 | (setq conf-name (vhdl-replace-string |
| 16714 | vhdl-compose-configuration-name |
| 16715 | (concat ent-name " " arch-name))) |
| 16716 | (setq inst-alist |
| 16717 | (nth 3 (vhdl-aget (nth 3 (vhdl-aget ent-alist (downcase ent-name) t)) |
| 16718 | (downcase arch-name) t)))) |
| 16719 | (message "Generating configuration \"%s\"..." conf-name) |
| 16720 | (if vhdl-compose-configuration-create-file |
| 16721 | ;; open configuration file |
| 16722 | (progn |
| 16723 | (setq conf-file-name |
| 16724 | (concat (vhdl-replace-string vhdl-configuration-file-name |
| 16725 | conf-name t) |
| 16726 | "." (file-name-extension (buffer-file-name)))) |
| 16727 | (when (and (file-exists-p conf-file-name) |
| 16728 | (not (y-or-n-p (concat "File \"" conf-file-name |
| 16729 | "\" exists; overwrite? ")))) |
| 16730 | (error "ERROR: Creating configuration...aborted")) |
| 16731 | (find-file conf-file-name) |
| 16732 | (erase-buffer) |
| 16733 | (set-buffer-modified-p nil) |
| 16734 | ;; insert header |
| 16735 | (if vhdl-compose-include-header |
| 16736 | (progn (vhdl-template-header |
| 16737 | (concat "Configuration declaration for design \"" |
| 16738 | ent-name "(" arch-name ")\"")) |
| 16739 | (goto-char (point-max))) |
| 16740 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 16741 | ;; goto end of architecture |
| 16742 | (unless from-speedbar |
| 16743 | (re-search-forward "^end\\>" nil) |
| 16744 | (end-of-line) (insert "\n\n") |
| 16745 | (vhdl-comment-display-line) (insert "\n\n"))) |
| 16746 | ;; insert library clause |
| 16747 | (setq pos (point)) |
| 16748 | (vhdl-template-standard-package (vhdl-work-library) nil) |
| 16749 | (when (/= pos (point)) |
| 16750 | (insert "\n\n")) |
| 16751 | ;; insert configuration |
| 16752 | (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name) |
| 16753 | (vhdl-insert-keyword " OF ") (insert ent-name) |
| 16754 | (vhdl-insert-keyword " IS\n") |
| 16755 | (indent-to vhdl-basic-offset) |
| 16756 | ;; insert block configuration (for architecture) |
| 16757 | (vhdl-compose-configuration-architecture |
| 16758 | ent-name arch-name ent-alist conf-alist inst-alist t) |
| 16759 | (vhdl-insert-keyword "END ") (insert conf-name ";") |
| 16760 | (when conf-file-name |
| 16761 | ;; insert footer and save |
| 16762 | (insert "\n\n") |
| 16763 | (if (and vhdl-compose-include-header (not (equal vhdl-file-footer ""))) |
| 16764 | (vhdl-template-footer) |
| 16765 | (vhdl-comment-display-line) (insert "\n")) |
| 16766 | (save-buffer)) |
| 16767 | (message "%s" |
| 16768 | (concat (format "Generating configuration \"%s\"...done" conf-name) |
| 16769 | (and conf-file-name |
| 16770 | (format "\n File created: \"%s\"" conf-file-name)))))) |
| 16771 | |
| 16772 | |
| 16773 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16774 | ;;; Compilation / Makefile generation |
| 16775 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16776 | ;; (using `compile.el') |
| 16777 | |
| 16778 | (defvar vhdl-compile-post-command "" |
| 16779 | "String appended to compile command after file name.") |
| 16780 | |
| 16781 | (defun vhdl-makefile-name () |
| 16782 | "Return the Makefile name of the current project or the current compiler if |
| 16783 | no project is defined." |
| 16784 | (let ((project-alist (vhdl-aget vhdl-project-alist vhdl-project)) |
| 16785 | (compiler-alist (vhdl-aget vhdl-compiler-alist vhdl-compiler))) |
| 16786 | (vhdl-replace-string |
| 16787 | (cons "\\(.*\\)\n\\(.*\\)" |
| 16788 | (or (nth 8 project-alist) (nth 8 compiler-alist))) |
| 16789 | (concat (nth 9 compiler-alist) "\n" (nth 6 project-alist))))) |
| 16790 | |
| 16791 | (defun vhdl-compile-directory () |
| 16792 | "Return the directory where compilation/make should be run." |
| 16793 | (let* ((project (vhdl-aget vhdl-project-alist (vhdl-project-p t))) |
| 16794 | (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) |
| 16795 | (directory (vhdl-resolve-env-variable |
| 16796 | (if project |
| 16797 | (vhdl-replace-string |
| 16798 | (cons "\\(.*\\)" (nth 5 project)) (nth 9 compiler)) |
| 16799 | (nth 6 compiler))))) |
| 16800 | (file-name-as-directory |
| 16801 | (if (file-name-absolute-p directory) |
| 16802 | directory |
| 16803 | (expand-file-name directory (vhdl-default-directory)))))) |
| 16804 | |
| 16805 | (defun vhdl-uniquify (in-list) |
| 16806 | "Remove duplicate elements from IN-LIST." |
| 16807 | (let (out-list) |
| 16808 | (while in-list |
| 16809 | (add-to-list 'out-list (car in-list)) |
| 16810 | (setq in-list (cdr in-list))) |
| 16811 | out-list)) |
| 16812 | |
| 16813 | (defun vhdl-set-compiler (name) |
| 16814 | "Set current compiler to NAME." |
| 16815 | (interactive |
| 16816 | (list (let ((completion-ignore-case t)) |
| 16817 | (completing-read "Compiler name: " vhdl-compiler-alist nil t)))) |
| 16818 | (if (assoc name vhdl-compiler-alist) |
| 16819 | (progn (setq vhdl-compiler name) |
| 16820 | (message "Current compiler: \"%s\"" vhdl-compiler)) |
| 16821 | (vhdl-warning (format "Unknown compiler: \"%s\"" name)))) |
| 16822 | |
| 16823 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 16824 | ;; Compilation |
| 16825 | |
| 16826 | (defun vhdl-compile-init () |
| 16827 | "Initialize for compilation." |
| 16828 | (when (and (not vhdl-emacs-22) |
| 16829 | (or (null compilation-error-regexp-alist) |
| 16830 | (not (assoc (car (nth 11 (car vhdl-compiler-alist))) |
| 16831 | compilation-error-regexp-alist)))) |
| 16832 | ;; `compilation-error-regexp-alist' |
| 16833 | (let ((commands-alist vhdl-compiler-alist) |
| 16834 | regexp-alist sublist) |
| 16835 | (while commands-alist |
| 16836 | (setq sublist (nth 11 (car commands-alist))) |
| 16837 | (unless (or (equal "" (car sublist)) |
| 16838 | (assoc (car sublist) regexp-alist)) |
| 16839 | (push (list (nth 0 sublist) |
| 16840 | (if (and (featurep 'xemacs) (not (nth 1 sublist))) |
| 16841 | 9 |
| 16842 | (nth 1 sublist)) |
| 16843 | (nth 2 sublist) (nth 3 sublist)) |
| 16844 | regexp-alist)) |
| 16845 | (setq commands-alist (cdr commands-alist))) |
| 16846 | (setq compilation-error-regexp-alist |
| 16847 | (append compilation-error-regexp-alist (nreverse regexp-alist)))) |
| 16848 | ;; `compilation-file-regexp-alist' |
| 16849 | (let ((commands-alist vhdl-compiler-alist) |
| 16850 | regexp-alist sublist) |
| 16851 | ;; matches vhdl-mode file name output |
| 16852 | (setq regexp-alist '(("^Compiling \"\\(.+\\)\"" 1))) |
| 16853 | (while commands-alist |
| 16854 | (setq sublist (nth 12 (car commands-alist))) |
| 16855 | (unless (or (equal "" (car sublist)) |
| 16856 | (assoc (car sublist) regexp-alist)) |
| 16857 | (push sublist regexp-alist)) |
| 16858 | (setq commands-alist (cdr commands-alist))) |
| 16859 | (setq compilation-file-regexp-alist |
| 16860 | (append compilation-file-regexp-alist (nreverse regexp-alist)))))) |
| 16861 | |
| 16862 | (defvar vhdl-compile-file-name nil |
| 16863 | "Name of file to be compiled.") |
| 16864 | |
| 16865 | (defun vhdl-compile-print-file-name () |
| 16866 | "Function called within `compile' to print out file name for compilers that |
| 16867 | do not print any file names." |
| 16868 | (insert "Compiling \"" vhdl-compile-file-name "\"\n")) |
| 16869 | |
| 16870 | (defun vhdl-get-compile-options (project compiler file-name |
| 16871 | &optional file-options-only) |
| 16872 | "Get compiler options. Returning nil means do not compile this file." |
| 16873 | (let* ((compiler-options (nth 1 compiler)) |
| 16874 | (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) |
| 16875 | (project-options (nth 0 project-entry)) |
| 16876 | (exception-list (and file-name (nth 2 project-entry))) |
| 16877 | (work-library (vhdl-work-library)) |
| 16878 | (case-fold-search nil) |
| 16879 | file-options) |
| 16880 | (while (and exception-list |
| 16881 | (not (string-match (caar exception-list) file-name))) |
| 16882 | (setq exception-list (cdr exception-list))) |
| 16883 | (if (and exception-list (not (cdar exception-list))) |
| 16884 | nil |
| 16885 | (if (and file-options-only (not exception-list)) |
| 16886 | 'default |
| 16887 | (setq file-options (cdar exception-list)) |
| 16888 | ;; insert library name in compiler-specific options |
| 16889 | (setq compiler-options |
| 16890 | (vhdl-replace-string (cons "\\(.*\\)" compiler-options) |
| 16891 | work-library)) |
| 16892 | ;; insert compiler-specific options in project-specific options |
| 16893 | (when project-options |
| 16894 | (setq project-options |
| 16895 | (vhdl-replace-string |
| 16896 | (cons "\\(.*\\)\n\\(.*\\)" project-options) |
| 16897 | (concat work-library "\n" compiler-options)))) |
| 16898 | ;; insert project-specific options in file-specific options |
| 16899 | (when file-options |
| 16900 | (setq file-options |
| 16901 | (vhdl-replace-string |
| 16902 | (cons "\\(.*\\)\n\\(.*\\)\n\\(.*\\)" file-options) |
| 16903 | (concat work-library "\n" compiler-options "\n" |
| 16904 | project-options)))) |
| 16905 | ;; return options |
| 16906 | (or file-options project-options compiler-options))))) |
| 16907 | |
| 16908 | (defun vhdl-get-make-options (project compiler) |
| 16909 | "Get make options." |
| 16910 | (let* ((compiler-options (nth 3 compiler)) |
| 16911 | (project-entry (vhdl-aget (nth 4 project) vhdl-compiler)) |
| 16912 | (project-options (nth 1 project-entry)) |
| 16913 | (makefile-name (vhdl-makefile-name))) |
| 16914 | ;; insert Makefile name in compiler-specific options |
| 16915 | (setq compiler-options |
| 16916 | (vhdl-replace-string (cons "\\(.*\\)" (nth 3 compiler)) |
| 16917 | makefile-name)) |
| 16918 | ;; insert compiler-specific options in project-specific options |
| 16919 | (when project-options |
| 16920 | (setq project-options |
| 16921 | (vhdl-replace-string |
| 16922 | (cons "\\(.*\\)\n\\(.*\\)" project-options) |
| 16923 | (concat makefile-name "\n" compiler-options)))) |
| 16924 | ;; return options |
| 16925 | (or project-options compiler-options))) |
| 16926 | |
| 16927 | (defun vhdl-compile () |
| 16928 | "Compile current buffer using the VHDL compiler specified in |
| 16929 | `vhdl-compiler'." |
| 16930 | (interactive) |
| 16931 | (vhdl-compile-init) |
| 16932 | (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) |
| 16933 | (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler nil) |
| 16934 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 16935 | (command (nth 0 compiler)) |
| 16936 | (default-directory (vhdl-compile-directory)) |
| 16937 | (file-name (if vhdl-compile-absolute-path |
| 16938 | (buffer-file-name) |
| 16939 | (file-relative-name (buffer-file-name)))) |
| 16940 | (options (vhdl-get-compile-options project compiler file-name)) |
| 16941 | compilation-process-setup-function) |
| 16942 | (unless (file-directory-p default-directory) |
| 16943 | (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) |
| 16944 | ;; put file name into quotes if it contains spaces |
| 16945 | (when (string-match " " file-name) |
| 16946 | (setq file-name (concat "\"" file-name "\""))) |
| 16947 | ;; print out file name if compiler does not |
| 16948 | (setq vhdl-compile-file-name (if vhdl-compile-absolute-path |
| 16949 | (buffer-file-name) |
| 16950 | (file-relative-name (buffer-file-name)))) |
| 16951 | (when (and (= 0 (nth 1 (nth 10 compiler))) |
| 16952 | (= 0 (nth 1 (nth 11 compiler)))) |
| 16953 | (setq compilation-process-setup-function 'vhdl-compile-print-file-name)) |
| 16954 | ;; run compilation |
| 16955 | (if options |
| 16956 | (when command |
| 16957 | (compile (concat command " " options " " file-name |
| 16958 | (unless (equal vhdl-compile-post-command "") |
| 16959 | (concat " " vhdl-compile-post-command))))) |
| 16960 | (vhdl-warning "Your project settings tell me not to compile this file")))) |
| 16961 | |
| 16962 | (defvar vhdl-make-target "all" |
| 16963 | "Default target for `vhdl-make' command.") |
| 16964 | |
| 16965 | (defun vhdl-make (&optional target) |
| 16966 | "Call make command for compilation of all updated source files (requires |
| 16967 | `Makefile'). Optional argument TARGET allows to compile the design |
| 16968 | specified by a target." |
| 16969 | (interactive) |
| 16970 | (setq vhdl-make-target |
| 16971 | (or target (read-from-minibuffer "Target: " vhdl-make-target |
| 16972 | vhdl-minibuffer-local-map))) |
| 16973 | (vhdl-compile-init) |
| 16974 | (let* ((project (vhdl-aget vhdl-project-alist vhdl-project)) |
| 16975 | (compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) |
| 16976 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 16977 | (command (nth 2 compiler)) |
| 16978 | (options (vhdl-get-make-options project compiler)) |
| 16979 | (default-directory (vhdl-compile-directory))) |
| 16980 | (unless (file-directory-p default-directory) |
| 16981 | (error "ERROR: Compile directory does not exist: \"%s\"" default-directory)) |
| 16982 | ;; run make |
| 16983 | (compile (concat (if (equal command "") "make" command) |
| 16984 | " " options " " vhdl-make-target)))) |
| 16985 | |
| 16986 | ;; Emacs 22+ setup |
| 16987 | (defvar vhdl-error-regexp-emacs-alist |
| 16988 | ;; Get regexps from `vhdl-compiler-alist' |
| 16989 | (let ((compiler-alist vhdl-compiler-alist) |
| 16990 | (error-regexp-alist '((vhdl-directory "^ *Compiling \"\\(.+\\)\"" 1)))) |
| 16991 | (while compiler-alist |
| 16992 | ;; only add regexps for currently selected compiler |
| 16993 | (when (or (not vhdl-compile-use-local-error-regexp) |
| 16994 | (equal vhdl-compiler (nth 0 (car compiler-alist)))) |
| 16995 | ;; add error message regexps |
| 16996 | (setq error-regexp-alist |
| 16997 | (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist))))))) |
| 16998 | (nth 11 (car compiler-alist))) |
| 16999 | error-regexp-alist)) |
| 17000 | ;; add filename regexps |
| 17001 | (when (/= 0 (nth 1 (nth 12 (car compiler-alist)))) |
| 17002 | (setq error-regexp-alist |
| 17003 | (cons (append (list (make-symbol (concat "vhdl-" (subst-char-in-string ? ?- (downcase (nth 0 (car compiler-alist)))) "-file"))) |
| 17004 | (nth 12 (car compiler-alist))) |
| 17005 | error-regexp-alist)))) |
| 17006 | (setq compiler-alist (cdr compiler-alist))) |
| 17007 | error-regexp-alist) |
| 17008 | "List of regexps for VHDL compilers. For Emacs 22+.") |
| 17009 | |
| 17010 | ;; Add error regexps using compilation-mode-hook. |
| 17011 | (defun vhdl-error-regexp-add-emacs () |
| 17012 | "Set up Emacs compile for VHDL." |
| 17013 | (interactive) |
| 17014 | (when (and (boundp 'compilation-error-regexp-alist-alist) |
| 17015 | (not (assoc 'vhdl-modelsim compilation-error-regexp-alist-alist))) |
| 17016 | ;; remove all other compilers |
| 17017 | (when vhdl-compile-use-local-error-regexp |
| 17018 | (setq compilation-error-regexp-alist nil)) |
| 17019 | ;; add VHDL compilers |
| 17020 | (mapcar |
| 17021 | (lambda (item) |
| 17022 | (push (car item) compilation-error-regexp-alist) |
| 17023 | (push item compilation-error-regexp-alist-alist)) |
| 17024 | vhdl-error-regexp-emacs-alist))) |
| 17025 | |
| 17026 | (when vhdl-emacs-22 |
| 17027 | (add-hook 'compilation-mode-hook 'vhdl-error-regexp-add-emacs)) |
| 17028 | |
| 17029 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17030 | ;; Makefile generation |
| 17031 | |
| 17032 | (defun vhdl-generate-makefile () |
| 17033 | "Generate `Makefile'." |
| 17034 | (interactive) |
| 17035 | (let* ((compiler (or (vhdl-aget vhdl-compiler-alist vhdl-compiler) |
| 17036 | (error "ERROR: No such compiler: \"%s\"" vhdl-compiler))) |
| 17037 | (command (nth 4 compiler))) |
| 17038 | ;; generate makefile |
| 17039 | (if command |
| 17040 | (let ((default-directory (vhdl-compile-directory))) |
| 17041 | (compile (vhdl-replace-string |
| 17042 | (cons "\\(.*\\) \\(.*\\)" command) |
| 17043 | (concat (vhdl-makefile-name) " " (vhdl-work-library))))) |
| 17044 | (vhdl-generate-makefile-1)))) |
| 17045 | |
| 17046 | (defun vhdl-get-packages (lib-alist work-library) |
| 17047 | "Get packages from LIB-ALIST that belong to WORK-LIBRARY." |
| 17048 | (let (pack-list) |
| 17049 | (while lib-alist |
| 17050 | (when (equal (downcase (caar lib-alist)) (downcase work-library)) |
| 17051 | (push (cdar lib-alist) pack-list)) |
| 17052 | (setq lib-alist (cdr lib-alist))) |
| 17053 | pack-list)) |
| 17054 | |
| 17055 | (defun vhdl-generate-makefile-1 () |
| 17056 | "Generate Makefile for current project or directory." |
| 17057 | ;; scan hierarchy if required |
| 17058 | (if (vhdl-project-p) |
| 17059 | (unless (or (assoc vhdl-project vhdl-file-alist) |
| 17060 | (vhdl-load-cache vhdl-project)) |
| 17061 | (vhdl-scan-project-contents vhdl-project)) |
| 17062 | (let ((directory (abbreviate-file-name default-directory))) |
| 17063 | (unless (or (assoc directory vhdl-file-alist) |
| 17064 | (vhdl-load-cache directory)) |
| 17065 | (vhdl-scan-directory-contents directory)))) |
| 17066 | (let* ((directory (abbreviate-file-name (vhdl-default-directory))) |
| 17067 | (project (vhdl-project-p)) |
| 17068 | (ent-alist (vhdl-aget vhdl-entity-alist (or project directory) t)) |
| 17069 | (conf-alist (vhdl-aget vhdl-config-alist (or project directory) t)) |
| 17070 | (pack-alist (vhdl-aget vhdl-package-alist (or project directory) t)) |
| 17071 | (regexp-list (or (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) |
| 17072 | '("\\1.vhd" "\\2_\\1.vhd" "\\1.vhd" |
| 17073 | "\\1.vhd" "\\1_body.vhd" identity))) |
| 17074 | (mapping-exist |
| 17075 | (if (nth 12 (vhdl-aget vhdl-compiler-alist vhdl-compiler)) t nil)) |
| 17076 | (ent-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 0 regexp-list))) |
| 17077 | (arch-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 1 regexp-list))) |
| 17078 | (conf-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 2 regexp-list))) |
| 17079 | (pack-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 3 regexp-list))) |
| 17080 | (pack-body-regexp (cons "\\(.*\\) \\(.*\\) \\(.*\\)" (nth 4 regexp-list))) |
| 17081 | (adjust-case (nth 5 regexp-list)) |
| 17082 | (work-library (downcase (vhdl-work-library))) |
| 17083 | (compile-directory (expand-file-name (vhdl-compile-directory) |
| 17084 | default-directory)) |
| 17085 | (makefile-name (vhdl-makefile-name)) |
| 17086 | rule-alist arch-alist inst-alist |
| 17087 | target-list depend-list unit-list prim-list second-list subcomp-list |
| 17088 | lib-alist lib-body-alist pack-list all-pack-list |
| 17089 | ent-key ent-file-name arch-key arch-file-name ent-arch-key |
| 17090 | conf-key conf-file-name pack-key pack-file-name |
| 17091 | ent-entry arch-entry conf-entry pack-entry inst-entry |
| 17092 | pack-body-key pack-body-file-name inst-ent-key inst-conf-key |
| 17093 | tmp-key tmp-list rule) |
| 17094 | ;; check prerequisites |
| 17095 | (unless (file-exists-p compile-directory) |
| 17096 | (make-directory compile-directory t)) |
| 17097 | (unless mapping-exist |
| 17098 | (vhdl-warning |
| 17099 | (format "No unit-to-file name mapping found for compiler \"%s\".\n Directory of dummy files is created instead (to be used as dependencies).\n Please contact the VHDL Mode maintainer for full support of \"%s\"" |
| 17100 | vhdl-compiler vhdl-compiler) t)) |
| 17101 | (message "Generating makefile \"%s\"..." makefile-name) |
| 17102 | ;; rules for all entities |
| 17103 | (setq tmp-list ent-alist) |
| 17104 | (while ent-alist |
| 17105 | (setq ent-entry (car ent-alist) |
| 17106 | ent-key (nth 0 ent-entry)) |
| 17107 | (when (nth 2 ent-entry) |
| 17108 | (setq ent-file-name (if vhdl-compile-absolute-path |
| 17109 | (nth 2 ent-entry) |
| 17110 | (file-relative-name (nth 2 ent-entry) |
| 17111 | compile-directory)) |
| 17112 | arch-alist (nth 4 ent-entry) |
| 17113 | lib-alist (nth 6 ent-entry) |
| 17114 | rule (vhdl-aget rule-alist ent-file-name) |
| 17115 | target-list (nth 0 rule) |
| 17116 | depend-list (nth 1 rule) |
| 17117 | second-list nil |
| 17118 | subcomp-list nil) |
| 17119 | (setq tmp-key (vhdl-replace-string |
| 17120 | ent-regexp |
| 17121 | (funcall adjust-case |
| 17122 | (concat ent-key " " work-library)))) |
| 17123 | (push (cons ent-key tmp-key) unit-list) |
| 17124 | ;; rule target for this entity |
| 17125 | (push ent-key target-list) |
| 17126 | ;; rule dependencies for all used packages |
| 17127 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 17128 | (setq depend-list (append depend-list pack-list)) |
| 17129 | (setq all-pack-list pack-list) |
| 17130 | ;; add rule |
| 17131 | (vhdl-aput 'rule-alist ent-file-name (list target-list depend-list)) |
| 17132 | ;; rules for all corresponding architectures |
| 17133 | (while arch-alist |
| 17134 | (setq arch-entry (car arch-alist) |
| 17135 | arch-key (nth 0 arch-entry) |
| 17136 | ent-arch-key (concat ent-key "-" arch-key) |
| 17137 | arch-file-name (if vhdl-compile-absolute-path |
| 17138 | (nth 2 arch-entry) |
| 17139 | (file-relative-name (nth 2 arch-entry) |
| 17140 | compile-directory)) |
| 17141 | inst-alist (nth 4 arch-entry) |
| 17142 | lib-alist (nth 5 arch-entry) |
| 17143 | rule (vhdl-aget rule-alist arch-file-name) |
| 17144 | target-list (nth 0 rule) |
| 17145 | depend-list (nth 1 rule)) |
| 17146 | (setq tmp-key (vhdl-replace-string |
| 17147 | arch-regexp |
| 17148 | (funcall adjust-case |
| 17149 | (concat arch-key " " ent-key " " |
| 17150 | work-library)))) |
| 17151 | (setq unit-list |
| 17152 | (cons (cons ent-arch-key tmp-key) unit-list)) |
| 17153 | (push ent-arch-key second-list) |
| 17154 | ;; rule target for this architecture |
| 17155 | (push ent-arch-key target-list) |
| 17156 | ;; rule dependency for corresponding entity |
| 17157 | (push ent-key depend-list) |
| 17158 | ;; rule dependencies for contained component instantiations |
| 17159 | (while inst-alist |
| 17160 | (setq inst-entry (car inst-alist)) |
| 17161 | (when (or (null (nth 8 inst-entry)) |
| 17162 | (equal (downcase (nth 8 inst-entry)) work-library)) |
| 17163 | (setq inst-ent-key (or (nth 7 inst-entry) |
| 17164 | (nth 5 inst-entry))) |
| 17165 | (setq depend-list (cons inst-ent-key depend-list) |
| 17166 | subcomp-list (cons inst-ent-key subcomp-list))) |
| 17167 | (setq inst-alist (cdr inst-alist))) |
| 17168 | ;; rule dependencies for all used packages |
| 17169 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 17170 | (setq depend-list (append depend-list pack-list)) |
| 17171 | (setq all-pack-list (append all-pack-list pack-list)) |
| 17172 | ;; add rule |
| 17173 | (vhdl-aput 'rule-alist arch-file-name (list target-list depend-list)) |
| 17174 | (setq arch-alist (cdr arch-alist))) |
| 17175 | (push (list ent-key second-list (append subcomp-list all-pack-list)) |
| 17176 | prim-list)) |
| 17177 | (setq ent-alist (cdr ent-alist))) |
| 17178 | (setq ent-alist tmp-list) |
| 17179 | ;; rules for all configurations |
| 17180 | (setq tmp-list conf-alist) |
| 17181 | (while conf-alist |
| 17182 | (setq conf-entry (car conf-alist) |
| 17183 | conf-key (nth 0 conf-entry) |
| 17184 | conf-file-name (if vhdl-compile-absolute-path |
| 17185 | (nth 2 conf-entry) |
| 17186 | (file-relative-name (nth 2 conf-entry) |
| 17187 | compile-directory)) |
| 17188 | ent-key (nth 4 conf-entry) |
| 17189 | arch-key (nth 5 conf-entry) |
| 17190 | inst-alist (nth 6 conf-entry) |
| 17191 | lib-alist (nth 7 conf-entry) |
| 17192 | rule (vhdl-aget rule-alist conf-file-name) |
| 17193 | target-list (nth 0 rule) |
| 17194 | depend-list (nth 1 rule) |
| 17195 | subcomp-list (list ent-key)) |
| 17196 | (setq tmp-key (vhdl-replace-string |
| 17197 | conf-regexp |
| 17198 | (funcall adjust-case |
| 17199 | (concat conf-key " " work-library)))) |
| 17200 | (push (cons conf-key tmp-key) unit-list) |
| 17201 | ;; rule target for this configuration |
| 17202 | (push conf-key target-list) |
| 17203 | ;; rule dependency for corresponding entity and architecture |
| 17204 | (setq depend-list |
| 17205 | (cons ent-key (cons (concat ent-key "-" arch-key) depend-list))) |
| 17206 | ;; rule dependencies for used packages |
| 17207 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 17208 | (setq depend-list (append depend-list pack-list)) |
| 17209 | ;; rule dependencies for contained component configurations |
| 17210 | (while inst-alist |
| 17211 | (setq inst-entry (car inst-alist)) |
| 17212 | (setq inst-ent-key (nth 2 inst-entry) |
| 17213 | inst-conf-key (nth 4 inst-entry)) |
| 17214 | (when (equal (downcase (nth 5 inst-entry)) work-library) |
| 17215 | (when inst-ent-key |
| 17216 | (setq depend-list (cons inst-ent-key depend-list) |
| 17217 | subcomp-list (cons inst-ent-key subcomp-list))) |
| 17218 | (when inst-conf-key |
| 17219 | (setq depend-list (cons inst-conf-key depend-list) |
| 17220 | subcomp-list (cons inst-conf-key subcomp-list)))) |
| 17221 | (setq inst-alist (cdr inst-alist))) |
| 17222 | ;; add rule |
| 17223 | (vhdl-aput 'rule-alist conf-file-name (list target-list depend-list)) |
| 17224 | (push (list conf-key nil (append subcomp-list pack-list)) prim-list) |
| 17225 | (setq conf-alist (cdr conf-alist))) |
| 17226 | (setq conf-alist tmp-list) |
| 17227 | ;; rules for all packages |
| 17228 | (setq tmp-list pack-alist) |
| 17229 | (while pack-alist |
| 17230 | (setq pack-entry (car pack-alist) |
| 17231 | pack-key (nth 0 pack-entry) |
| 17232 | pack-body-key nil) |
| 17233 | (when (nth 2 pack-entry) |
| 17234 | (setq pack-file-name (if vhdl-compile-absolute-path |
| 17235 | (nth 2 pack-entry) |
| 17236 | (file-relative-name (nth 2 pack-entry) |
| 17237 | compile-directory)) |
| 17238 | lib-alist (nth 6 pack-entry) lib-body-alist (nth 10 pack-entry) |
| 17239 | rule (vhdl-aget rule-alist pack-file-name) |
| 17240 | target-list (nth 0 rule) depend-list (nth 1 rule)) |
| 17241 | (setq tmp-key (vhdl-replace-string |
| 17242 | pack-regexp |
| 17243 | (funcall adjust-case |
| 17244 | (concat pack-key " " work-library)))) |
| 17245 | (push (cons pack-key tmp-key) unit-list) |
| 17246 | ;; rule target for this package |
| 17247 | (push pack-key target-list) |
| 17248 | ;; rule dependencies for all used packages |
| 17249 | (setq pack-list (vhdl-get-packages lib-alist work-library)) |
| 17250 | (setq depend-list (append depend-list pack-list)) |
| 17251 | (setq all-pack-list pack-list) |
| 17252 | ;; add rule |
| 17253 | (vhdl-aput 'rule-alist pack-file-name (list target-list depend-list)) |
| 17254 | ;; rules for this package's body |
| 17255 | (when (nth 7 pack-entry) |
| 17256 | (setq pack-body-key (concat pack-key "-body") |
| 17257 | pack-body-file-name (if vhdl-compile-absolute-path |
| 17258 | (nth 7 pack-entry) |
| 17259 | (file-relative-name (nth 7 pack-entry) |
| 17260 | compile-directory)) |
| 17261 | rule (vhdl-aget rule-alist pack-body-file-name) |
| 17262 | target-list (nth 0 rule) |
| 17263 | depend-list (nth 1 rule)) |
| 17264 | (setq tmp-key (vhdl-replace-string |
| 17265 | pack-body-regexp |
| 17266 | (funcall adjust-case |
| 17267 | (concat pack-key " " work-library)))) |
| 17268 | (setq unit-list |
| 17269 | (cons (cons pack-body-key tmp-key) unit-list)) |
| 17270 | ;; rule target for this package's body |
| 17271 | (push pack-body-key target-list) |
| 17272 | ;; rule dependency for corresponding package declaration |
| 17273 | (push pack-key depend-list) |
| 17274 | ;; rule dependencies for all used packages |
| 17275 | (setq pack-list (vhdl-get-packages lib-body-alist work-library)) |
| 17276 | (setq depend-list (append depend-list pack-list)) |
| 17277 | (setq all-pack-list (append all-pack-list pack-list)) |
| 17278 | ;; add rule |
| 17279 | (vhdl-aput 'rule-alist pack-body-file-name |
| 17280 | (list target-list depend-list))) |
| 17281 | (setq prim-list |
| 17282 | (cons (list pack-key (when pack-body-key (list pack-body-key)) |
| 17283 | all-pack-list) |
| 17284 | prim-list))) |
| 17285 | (setq pack-alist (cdr pack-alist))) |
| 17286 | (setq pack-alist tmp-list) |
| 17287 | ;; generate Makefile |
| 17288 | (let* ((project (vhdl-aget vhdl-project-alist project)) |
| 17289 | (compiler (vhdl-aget vhdl-compiler-alist vhdl-compiler)) |
| 17290 | (compiler-id (nth 9 compiler)) |
| 17291 | (library-directory |
| 17292 | (vhdl-resolve-env-variable |
| 17293 | (vhdl-replace-string |
| 17294 | (cons "\\(.*\\)" (or (nth 7 project) (nth 7 compiler))) |
| 17295 | compiler-id))) |
| 17296 | (makefile-path-name (expand-file-name |
| 17297 | makefile-name compile-directory)) |
| 17298 | (orig-buffer (current-buffer)) |
| 17299 | cell second-list subcomp-list options unit-key unit-name) |
| 17300 | ;; sort lists |
| 17301 | (setq unit-list (vhdl-sort-alist unit-list)) |
| 17302 | (setq prim-list (vhdl-sort-alist prim-list)) |
| 17303 | (setq tmp-list rule-alist) |
| 17304 | (while tmp-list ; pre-sort rule targets |
| 17305 | (setq cell (cdar tmp-list)) |
| 17306 | (setcar cell (sort (car cell) 'string<)) |
| 17307 | (setq tmp-list (cdr tmp-list))) |
| 17308 | (setq rule-alist ; sort by first rule target |
| 17309 | (sort rule-alist |
| 17310 | (function (lambda (a b) |
| 17311 | (string< (car (cadr a)) (car (cadr b))))))) |
| 17312 | ;; open and clear Makefile |
| 17313 | (set-buffer (find-file-noselect makefile-path-name t t)) |
| 17314 | (erase-buffer) |
| 17315 | (insert "# -*- Makefile -*-\n" |
| 17316 | "### " (file-name-nondirectory makefile-name) |
| 17317 | " - VHDL Makefile generated by Emacs VHDL Mode " vhdl-version |
| 17318 | "\n") |
| 17319 | (if project |
| 17320 | (insert "\n# Project : " (nth 0 project)) |
| 17321 | (insert "\n# Directory : \"" directory "\"")) |
| 17322 | (insert "\n# Platform : " vhdl-compiler |
| 17323 | "\n# Generated : " (format-time-string "%Y-%m-%d %T ") |
| 17324 | (user-login-name) "\n") |
| 17325 | ;; insert compile and option variable settings |
| 17326 | (insert "\n\n# Define compilation command and options\n" |
| 17327 | "\nCOMPILE = " (nth 0 compiler) |
| 17328 | "\nOPTIONS = " (vhdl-get-compile-options project compiler nil) |
| 17329 | (if (equal vhdl-compile-post-command "") "" |
| 17330 | (concat "\nPOST-COMPILE = " vhdl-compile-post-command)) |
| 17331 | "\n") |
| 17332 | ;; insert library paths |
| 17333 | (setq library-directory |
| 17334 | (directory-file-name |
| 17335 | (if (file-name-absolute-p library-directory) |
| 17336 | library-directory |
| 17337 | (file-relative-name |
| 17338 | (expand-file-name library-directory directory) |
| 17339 | compile-directory)))) |
| 17340 | (insert "\n\n# Define library paths\n" |
| 17341 | "\nLIBRARY-" work-library " = " library-directory "\n") |
| 17342 | (unless mapping-exist |
| 17343 | (insert "LIBRARY-" work-library "-make = " "$(LIBRARY-" work-library |
| 17344 | ")/make" "\n")) |
| 17345 | ;; insert variable definitions for all library unit files |
| 17346 | (insert "\n\n# Define library unit files\n") |
| 17347 | (setq tmp-list unit-list) |
| 17348 | (while unit-list |
| 17349 | (insert "\nUNIT-" work-library "-" (caar unit-list) |
| 17350 | " = \\\n\t$(LIBRARY-" work-library |
| 17351 | (if mapping-exist "" "-make") ")/" (cdar unit-list)) |
| 17352 | (setq unit-list (cdr unit-list))) |
| 17353 | ;; insert variable definition for list of all library unit files |
| 17354 | (insert "\n\n\n# Define list of all library unit files\n" |
| 17355 | "\nALL_UNITS =") |
| 17356 | (setq unit-list tmp-list) |
| 17357 | (while unit-list |
| 17358 | (insert " \\\n\t" "$(UNIT-" work-library "-" (caar unit-list) ")") |
| 17359 | (setq unit-list (cdr unit-list))) |
| 17360 | (insert "\n") |
| 17361 | (setq unit-list tmp-list) |
| 17362 | ;; insert `make all' rule |
| 17363 | (insert "\n\n\n# Rule for compiling entire design\n" |
| 17364 | "\n" (nth 0 vhdl-makefile-default-targets) " :" |
| 17365 | " \\\n\t\t" (nth 2 vhdl-makefile-default-targets) |
| 17366 | " \\\n\t\t$(ALL_UNITS)\n") |
| 17367 | ;; insert `make clean' rule |
| 17368 | (insert "\n\n# Rule for cleaning entire design\n" |
| 17369 | "\n" (nth 1 vhdl-makefile-default-targets) " : " |
| 17370 | "\n\t-rm -f $(ALL_UNITS)\n") |
| 17371 | ;; insert `make library' rule |
| 17372 | (insert "\n\n# Rule for creating library directory\n" |
| 17373 | "\n" (nth 2 vhdl-makefile-default-targets) " :" |
| 17374 | " \\\n\t\t$(LIBRARY-" work-library ")" |
| 17375 | (if mapping-exist "" |
| 17376 | (concat " \\\n\t\t$(LIBRARY-" work-library "-make)\n")) |
| 17377 | "\n" |
| 17378 | "\n$(LIBRARY-" work-library ") :" |
| 17379 | "\n\t" |
| 17380 | (vhdl-replace-string |
| 17381 | (cons "\\(.*\\)\n\\(.*\\)" (nth 5 compiler)) |
| 17382 | (concat "$(LIBRARY-" work-library ")\n" (vhdl-work-library))) |
| 17383 | "\n") |
| 17384 | (unless mapping-exist |
| 17385 | (insert "\n$(LIBRARY-" work-library "-make) :" |
| 17386 | "\n\t" |
| 17387 | "mkdir -p $(LIBRARY-" work-library "-make)\n")) |
| 17388 | ;; insert '.PHONY' declaration |
| 17389 | (insert "\n\n.PHONY : " |
| 17390 | (nth 0 vhdl-makefile-default-targets) " " |
| 17391 | (nth 1 vhdl-makefile-default-targets) " " |
| 17392 | (nth 2 vhdl-makefile-default-targets) "\n") |
| 17393 | ;; insert rule for each library unit |
| 17394 | (insert "\n\n# Rules for compiling single library units and their subhierarchy\n") |
| 17395 | (while prim-list |
| 17396 | (setq second-list (sort (nth 1 (car prim-list)) 'string<)) |
| 17397 | (setq subcomp-list |
| 17398 | (sort (vhdl-uniquify (nth 2 (car prim-list))) 'string<)) |
| 17399 | (setq unit-key (caar prim-list) |
| 17400 | unit-name (or (nth 0 (vhdl-aget ent-alist unit-key t)) |
| 17401 | (nth 0 (vhdl-aget conf-alist unit-key t)) |
| 17402 | (nth 0 (vhdl-aget pack-alist unit-key t)))) |
| 17403 | (insert "\n" unit-key) |
| 17404 | (unless (equal unit-key unit-name) |
| 17405 | (insert " \\\n" unit-name)) |
| 17406 | (insert " :" |
| 17407 | " \\\n\t\t" (nth 2 vhdl-makefile-default-targets)) |
| 17408 | (while subcomp-list |
| 17409 | (when (and (assoc (car subcomp-list) unit-list) |
| 17410 | (not (equal unit-key (car subcomp-list)))) |
| 17411 | (insert " \\\n\t\t" (car subcomp-list))) |
| 17412 | (setq subcomp-list (cdr subcomp-list))) |
| 17413 | (insert " \\\n\t\t$(UNIT-" work-library "-" unit-key ")") |
| 17414 | (while second-list |
| 17415 | (insert " \\\n\t\t$(UNIT-" work-library "-" (car second-list) ")") |
| 17416 | (setq second-list (cdr second-list))) |
| 17417 | (insert "\n") |
| 17418 | (setq prim-list (cdr prim-list))) |
| 17419 | ;; insert rule for each library unit file |
| 17420 | (insert "\n\n# Rules for compiling single library unit files\n") |
| 17421 | (while rule-alist |
| 17422 | (setq rule (car rule-alist)) |
| 17423 | ;; get compiler options for this file |
| 17424 | (setq options |
| 17425 | (vhdl-get-compile-options project compiler (nth 0 rule) t)) |
| 17426 | ;; insert rule if file is supposed to be compiled |
| 17427 | (setq target-list (nth 1 rule) |
| 17428 | depend-list (sort (vhdl-uniquify (nth 2 rule)) 'string<)) |
| 17429 | ;; insert targets |
| 17430 | (setq tmp-list target-list) |
| 17431 | (while target-list |
| 17432 | (insert "\n$(UNIT-" work-library "-" (car target-list) ")" |
| 17433 | (if (cdr target-list) " \\" " :")) |
| 17434 | (setq target-list (cdr target-list))) |
| 17435 | (setq target-list tmp-list) |
| 17436 | ;; insert file name as first dependency |
| 17437 | (insert " \\\n\t\t" (nth 0 rule)) |
| 17438 | ;; insert dependencies (except if also target or unit does not exist) |
| 17439 | (while depend-list |
| 17440 | (when (and (not (member (car depend-list) target-list)) |
| 17441 | (assoc (car depend-list) unit-list)) |
| 17442 | (insert " \\\n\t\t" |
| 17443 | "$(UNIT-" work-library "-" (car depend-list) ")")) |
| 17444 | (setq depend-list (cdr depend-list))) |
| 17445 | ;; insert compile command |
| 17446 | (if options |
| 17447 | (insert "\n\t$(COMPILE) " |
| 17448 | (if (eq options 'default) "$(OPTIONS)" options) " " |
| 17449 | (nth 0 rule) |
| 17450 | (if (equal vhdl-compile-post-command "") "" |
| 17451 | " $(POST-COMPILE)") "\n") |
| 17452 | (insert "\n")) |
| 17453 | (unless (and options mapping-exist) |
| 17454 | (setq tmp-list target-list) |
| 17455 | (while target-list |
| 17456 | (insert "\t@touch $(UNIT-" work-library "-" (car target-list) ")\n") |
| 17457 | (setq target-list (cdr target-list))) |
| 17458 | (setq target-list tmp-list)) |
| 17459 | (setq rule-alist (cdr rule-alist))) |
| 17460 | |
| 17461 | (insert "\n\n### " makefile-name " ends here\n") |
| 17462 | ;; run Makefile generation hook |
| 17463 | (run-hooks 'vhdl-makefile-generation-hook) |
| 17464 | (message "Generating makefile \"%s\"...done" makefile-name) |
| 17465 | ;; save and close file |
| 17466 | (if (file-writable-p makefile-path-name) |
| 17467 | (progn (save-buffer) |
| 17468 | (kill-buffer (current-buffer)) |
| 17469 | (set-buffer orig-buffer) |
| 17470 | (when (fboundp 'add-to-history) |
| 17471 | (add-to-history 'file-name-history makefile-path-name))) |
| 17472 | (vhdl-warning-when-idle |
| 17473 | (format "File not writable: \"%s\"" |
| 17474 | (abbreviate-file-name makefile-path-name))) |
| 17475 | (switch-to-buffer (current-buffer)))))) |
| 17476 | |
| 17477 | |
| 17478 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17479 | ;;; Bug reports |
| 17480 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17481 | ;; (using `reporter.el') |
| 17482 | |
| 17483 | (defconst vhdl-mode-help-address |
| 17484 | "Reto Zimmermann <reto@gnu.org>" |
| 17485 | "Address for VHDL Mode bug reports.") |
| 17486 | |
| 17487 | (defun vhdl-submit-bug-report () |
| 17488 | "Submit via mail a bug report on VHDL Mode." |
| 17489 | (interactive) |
| 17490 | ;; load in reporter |
| 17491 | (and |
| 17492 | (y-or-n-p "Do you want to submit a report on VHDL Mode? ") |
| 17493 | (let ((reporter-prompt-for-summary-p t)) |
| 17494 | (reporter-submit-bug-report |
| 17495 | vhdl-mode-help-address |
| 17496 | (concat "VHDL Mode " vhdl-version) |
| 17497 | (list |
| 17498 | ;; report all important user options |
| 17499 | 'vhdl-offsets-alist |
| 17500 | 'vhdl-comment-only-line-offset |
| 17501 | 'tab-width |
| 17502 | 'vhdl-electric-mode |
| 17503 | 'vhdl-stutter-mode |
| 17504 | 'vhdl-indent-tabs-mode |
| 17505 | 'vhdl-project-alist |
| 17506 | 'vhdl-project |
| 17507 | 'vhdl-project-file-name |
| 17508 | 'vhdl-project-auto-load |
| 17509 | 'vhdl-project-sort |
| 17510 | 'vhdl-compiler-alist |
| 17511 | 'vhdl-compiler |
| 17512 | 'vhdl-compile-use-local-error-regexp |
| 17513 | 'vhdl-makefile-default-targets |
| 17514 | 'vhdl-makefile-generation-hook |
| 17515 | 'vhdl-default-library |
| 17516 | 'vhdl-standard |
| 17517 | 'vhdl-basic-offset |
| 17518 | 'vhdl-upper-case-keywords |
| 17519 | 'vhdl-upper-case-types |
| 17520 | 'vhdl-upper-case-attributes |
| 17521 | 'vhdl-upper-case-enum-values |
| 17522 | 'vhdl-upper-case-constants |
| 17523 | 'vhdl-use-direct-instantiation |
| 17524 | 'vhdl-array-index-record-field-in-sensitivity-list |
| 17525 | 'vhdl-compose-configuration-name |
| 17526 | 'vhdl-entity-file-name |
| 17527 | 'vhdl-architecture-file-name |
| 17528 | 'vhdl-configuration-file-name |
| 17529 | 'vhdl-package-file-name |
| 17530 | 'vhdl-file-name-case |
| 17531 | 'vhdl-electric-keywords |
| 17532 | 'vhdl-optional-labels |
| 17533 | 'vhdl-insert-empty-lines |
| 17534 | 'vhdl-argument-list-indent |
| 17535 | 'vhdl-association-list-with-formals |
| 17536 | 'vhdl-conditions-in-parenthesis |
| 17537 | 'vhdl-zero-string |
| 17538 | 'vhdl-one-string |
| 17539 | 'vhdl-file-header |
| 17540 | 'vhdl-file-footer |
| 17541 | 'vhdl-company-name |
| 17542 | 'vhdl-copyright-string |
| 17543 | 'vhdl-platform-spec |
| 17544 | 'vhdl-date-format |
| 17545 | 'vhdl-modify-date-prefix-string |
| 17546 | 'vhdl-modify-date-on-saving |
| 17547 | 'vhdl-reset-kind |
| 17548 | 'vhdl-reset-active-high |
| 17549 | 'vhdl-clock-rising-edge |
| 17550 | 'vhdl-clock-edge-condition |
| 17551 | 'vhdl-clock-name |
| 17552 | 'vhdl-reset-name |
| 17553 | 'vhdl-model-alist |
| 17554 | 'vhdl-include-port-comments |
| 17555 | 'vhdl-include-direction-comments |
| 17556 | 'vhdl-include-type-comments |
| 17557 | 'vhdl-include-group-comments |
| 17558 | 'vhdl-actual-generic-name |
| 17559 | 'vhdl-actual-port-name |
| 17560 | 'vhdl-instance-name |
| 17561 | 'vhdl-testbench-entity-name |
| 17562 | 'vhdl-testbench-architecture-name |
| 17563 | 'vhdl-testbench-configuration-name |
| 17564 | 'vhdl-testbench-dut-name |
| 17565 | 'vhdl-testbench-include-header |
| 17566 | 'vhdl-testbench-declarations |
| 17567 | 'vhdl-testbench-statements |
| 17568 | 'vhdl-testbench-initialize-signals |
| 17569 | 'vhdl-testbench-include-library |
| 17570 | 'vhdl-testbench-include-configuration |
| 17571 | 'vhdl-testbench-create-files |
| 17572 | 'vhdl-testbench-entity-file-name |
| 17573 | 'vhdl-testbench-architecture-file-name |
| 17574 | 'vhdl-compose-create-files |
| 17575 | 'vhdl-compose-configuration-create-file |
| 17576 | 'vhdl-compose-configuration-hierarchical |
| 17577 | 'vhdl-compose-configuration-use-subconfiguration |
| 17578 | 'vhdl-compose-include-header |
| 17579 | 'vhdl-compose-architecture-name |
| 17580 | 'vhdl-components-package-name |
| 17581 | 'vhdl-use-components-package |
| 17582 | 'vhdl-self-insert-comments |
| 17583 | 'vhdl-prompt-for-comments |
| 17584 | 'vhdl-inline-comment-column |
| 17585 | 'vhdl-end-comment-column |
| 17586 | 'vhdl-auto-align |
| 17587 | 'vhdl-align-groups |
| 17588 | 'vhdl-align-group-separate |
| 17589 | 'vhdl-align-same-indent |
| 17590 | 'vhdl-highlight-keywords |
| 17591 | 'vhdl-highlight-names |
| 17592 | 'vhdl-highlight-special-words |
| 17593 | 'vhdl-highlight-forbidden-words |
| 17594 | 'vhdl-highlight-verilog-keywords |
| 17595 | 'vhdl-highlight-translate-off |
| 17596 | 'vhdl-highlight-case-sensitive |
| 17597 | 'vhdl-special-syntax-alist |
| 17598 | 'vhdl-forbidden-words |
| 17599 | 'vhdl-forbidden-syntax |
| 17600 | 'vhdl-directive-keywords |
| 17601 | 'vhdl-speedbar-auto-open |
| 17602 | 'vhdl-speedbar-display-mode |
| 17603 | 'vhdl-speedbar-scan-limit |
| 17604 | 'vhdl-speedbar-jump-to-unit |
| 17605 | 'vhdl-speedbar-update-on-saving |
| 17606 | 'vhdl-speedbar-save-cache |
| 17607 | 'vhdl-speedbar-cache-file-name |
| 17608 | 'vhdl-index-menu |
| 17609 | 'vhdl-source-file-menu |
| 17610 | 'vhdl-hideshow-menu |
| 17611 | 'vhdl-hide-all-init |
| 17612 | 'vhdl-print-two-column |
| 17613 | 'vhdl-print-customize-faces |
| 17614 | 'vhdl-intelligent-tab |
| 17615 | 'vhdl-indent-syntax-based |
| 17616 | 'vhdl-indent-comment-like-next-code-line |
| 17617 | 'vhdl-word-completion-case-sensitive |
| 17618 | 'vhdl-word-completion-in-minibuffer |
| 17619 | 'vhdl-underscore-is-part-of-word |
| 17620 | 'vhdl-mode-hook) |
| 17621 | (function |
| 17622 | (lambda () |
| 17623 | (insert |
| 17624 | (if vhdl-special-indent-hook |
| 17625 | (concat "\n@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n" |
| 17626 | "vhdl-special-indent-hook is set to '" |
| 17627 | (format "%s" vhdl-special-indent-hook) |
| 17628 | ".\nPerhaps this is your problem?\n" |
| 17629 | "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n\n") |
| 17630 | "\n")))) |
| 17631 | nil |
| 17632 | "Hi Reto,")))) |
| 17633 | |
| 17634 | |
| 17635 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17636 | ;;; Documentation |
| 17637 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17638 | |
| 17639 | (defconst vhdl-doc-release-notes nil |
| 17640 | "\ |
| 17641 | Release Notes for VHDL Mode 3.34 |
| 17642 | ================================ |
| 17643 | |
| 17644 | - Added support for GNU Emacs 22/23/24: |
| 17645 | - Compilation error parsing fixed for new `compile.el' package. |
| 17646 | |
| 17647 | - Port translation: Derive actual generic name from formal generic name. |
| 17648 | |
| 17649 | - New user options: |
| 17650 | `vhdl-actual-generic-name': Specify how actual generic names are obtained. |
| 17651 | |
| 17652 | |
| 17653 | Release Notes for VHDL Mode 3.33 |
| 17654 | ================================ |
| 17655 | |
| 17656 | New Features |
| 17657 | ------------ |
| 17658 | |
| 17659 | CONFIGURATION DECLARATION GENERATION: |
| 17660 | - Automatic generation of a configuration declaration for a design. |
| 17661 | (See documentation (`C-c C-h') in section on STRUCTURAL COMPOSITION.) |
| 17662 | |
| 17663 | |
| 17664 | Key Bindings |
| 17665 | ------------ |
| 17666 | |
| 17667 | For Emacs compliance the following key bindings have been changed: |
| 17668 | |
| 17669 | - `C-c c' -> `C-c C-c' `vhdl-comment-uncomment-region' |
| 17670 | - `C-c f' -> `C-c C-i C-f' `vhdl-fontify-buffer' |
| 17671 | - `C-c s' -> `C-c C-i C-s' `vhdl-statistics-buffer' |
| 17672 | - `C-c C-c ...' -> `C-c C-m ...' `vhdl-compose-...' |
| 17673 | |
| 17674 | |
| 17675 | User Options |
| 17676 | ------------ |
| 17677 | |
| 17678 | `vhdl-configuration-file-name': (new) |
| 17679 | Specify how the configuration file name is obtained. |
| 17680 | `vhdl-compose-configuration-name': (new) |
| 17681 | Specify how the configuration name is obtained. |
| 17682 | `vhdl-compose-configuration-create-file': (new) |
| 17683 | Specify whether a new file should be created for a configuration. |
| 17684 | `vhdl-compose-configuration-hierarchical': (new) |
| 17685 | Specify whether hierarchical configurations should be created. |
| 17686 | `vhdl-compose-configuration-use-subconfiguration': (new) |
| 17687 | Specify whether subconfigurations should be used inside configurations. |
| 17688 | `vhdl-makefile-default-targets': (new) |
| 17689 | Customize names of Makefile default targets. |
| 17690 | `vhdl-indent-comment-like-next-code-line': (new) |
| 17691 | Specify whether comment lines are indented like following code line. |
| 17692 | `vhdl-array-index-record-field-in-sensitivity-list': (new) |
| 17693 | Specify whether to include array indices / record fields in sensitivity list. |
| 17694 | ") |
| 17695 | |
| 17696 | |
| 17697 | (defconst vhdl-doc-keywords nil |
| 17698 | "\ |
| 17699 | Reserved words in VHDL |
| 17700 | ---------------------- |
| 17701 | |
| 17702 | VHDL'93/02 (IEEE Std 1076-1993/2002): |
| 17703 | `vhdl-02-keywords' : keywords |
| 17704 | `vhdl-02-types' : standardized types |
| 17705 | `vhdl-02-attributes' : standardized attributes |
| 17706 | `vhdl-02-enum-values' : standardized enumeration values |
| 17707 | `vhdl-02-functions' : standardized functions |
| 17708 | `vhdl-02-packages' : standardized packages and libraries |
| 17709 | |
| 17710 | VHDL-AMS (IEEE Std 1076.1 / 1076.1.1): |
| 17711 | `vhdl-ams-keywords' : keywords |
| 17712 | `vhdl-ams-types' : standardized types |
| 17713 | `vhdl-ams-attributes' : standardized attributes |
| 17714 | `vhdl-ams-enum-values' : standardized enumeration values |
| 17715 | `vhdl-ams-constants' : standardized constants |
| 17716 | `vhdl-ams-functions' : standardized functions |
| 17717 | |
| 17718 | Math Packages (IEEE Std 1076.2): |
| 17719 | `vhdl-math-types' : standardized types |
| 17720 | `vhdl-math-constants' : standardized constants |
| 17721 | `vhdl-math-functions' : standardized functions |
| 17722 | `vhdl-math-packages' : standardized packages |
| 17723 | |
| 17724 | Forbidden words: |
| 17725 | `vhdl-verilog-keywords' : Verilog reserved words |
| 17726 | |
| 17727 | NOTE: click `mouse-2' on variable names above (not in XEmacs).") |
| 17728 | |
| 17729 | |
| 17730 | (defconst vhdl-doc-coding-style nil |
| 17731 | "\ |
| 17732 | For VHDL coding style and naming convention guidelines, see the following |
| 17733 | references: |
| 17734 | |
| 17735 | \[1] Ben Cohen. |
| 17736 | \"VHDL Coding Styles and Methodologies\". |
| 17737 | Kluwer Academic Publishers, 1999. |
| 17738 | http://members.aol.com/vhdlcohen/vhdl/ |
| 17739 | |
| 17740 | \[2] Michael Keating and Pierre Bricaud. |
| 17741 | \"Reuse Methodology Manual, Second Edition\". |
| 17742 | Kluwer Academic Publishers, 1999. |
| 17743 | http://www.openmore.com/openmore/rmm2.html |
| 17744 | |
| 17745 | \[3] European Space Agency. |
| 17746 | \"VHDL Modelling Guidelines\". |
| 17747 | ftp://ftp.estec.esa.nl/pub/vhdl/doc/ModelGuide.{pdf,ps} |
| 17748 | |
| 17749 | Use user options `vhdl-highlight-special-words' and `vhdl-special-syntax-alist' |
| 17750 | to visually support naming conventions.") |
| 17751 | |
| 17752 | |
| 17753 | (defun vhdl-version () |
| 17754 | "Echo the current version of VHDL Mode in the minibuffer." |
| 17755 | (interactive) |
| 17756 | (message "VHDL Mode %s (%s)" vhdl-version vhdl-time-stamp) |
| 17757 | (vhdl-keep-region-active)) |
| 17758 | |
| 17759 | (defun vhdl-doc-variable (variable) |
| 17760 | "Display VARIABLE's documentation in *Help* buffer." |
| 17761 | (interactive) |
| 17762 | (unless (featurep 'xemacs) |
| 17763 | (help-setup-xref (list #'vhdl-doc-variable variable) |
| 17764 | (called-interactively-p 'interactive))) |
| 17765 | (with-output-to-temp-buffer |
| 17766 | (if (fboundp 'help-buffer) (help-buffer) "*Help*") |
| 17767 | (princ (documentation-property variable 'variable-documentation)) |
| 17768 | (with-current-buffer standard-output |
| 17769 | (help-mode)) |
| 17770 | (help-print-return-message))) |
| 17771 | |
| 17772 | (defun vhdl-doc-mode () |
| 17773 | "Display VHDL Mode documentation in *Help* buffer." |
| 17774 | (interactive) |
| 17775 | (unless (featurep 'xemacs) |
| 17776 | (help-setup-xref (list #'vhdl-doc-mode) |
| 17777 | (called-interactively-p 'interactive))) |
| 17778 | (with-output-to-temp-buffer |
| 17779 | (if (fboundp 'help-buffer) (help-buffer) "*Help*") |
| 17780 | (princ mode-name) |
| 17781 | (princ " mode:\n") |
| 17782 | (princ (documentation 'vhdl-mode)) |
| 17783 | (with-current-buffer standard-output |
| 17784 | (help-mode)) |
| 17785 | (help-print-return-message))) |
| 17786 | |
| 17787 | |
| 17788 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 17789 | |
| 17790 | (provide 'vhdl-mode) |
| 17791 | |
| 17792 | ;;; vhdl-mode.el ends here |